I650: Release 3
New Hardware support: - IBM 653 Storage Unit: provides machine opcodes for Floating Point, Immediate Access Storage (IAS), Three Index registers, Cards Punch-read synchronizers 2 and 3. New Software included: - FORTRANSIT: version II (S), plus run time PACKAGE with standard Fortran functions. - Reorganized sw directory, separating each language in its own folder. Each one Includes a 00_readme.txt file with restoration notes and comments. New features: - Support for SOAP opcode mnemonics in addition to regular IBM mnemonics - FAST / REALTIME CPU options - PROP pseudo register - CARDDECK ECHOLAST command
This commit is contained in:
parent
b51d250598
commit
13cb294274
79 changed files with 16830 additions and 803 deletions
|
@ -10,20 +10,39 @@ cd sw
|
||||||
; set throttle 11k
|
; set throttle 11k
|
||||||
; set throttle 55/5
|
; set throttle 55/5
|
||||||
|
|
||||||
|
do build_soap_from_source.ini
|
||||||
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
do Build_soap_from_source.ini
|
do run_soap.ini soap/soap_example_1_src.txt 1000
|
||||||
set env -P "Press enter to continue . . . "
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
do soap_and_run.ini soap_example_1_src.txt 1000
|
do build_is_from_decks.ini ntr lbox
|
||||||
set env -P "Press enter to continue . . . "
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
do Build_is_from_decks.ini ntr lbox
|
do run_is.ini bell/is_example_1_src.txt
|
||||||
set env -P "Press enter to continue . . . "
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
do is_run.ini is_example_1_src.txt
|
do run_it.ini it/it_example_1_src.txt it/it_example_1_data.txt
|
||||||
set env -P "Press enter to continue . . . "
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
do it_run.ini it_example_1_src.txt it_example_1_data.txt deck_out.dck
|
do run_it.ini it/it_example_2_src.txt nul
|
||||||
set env -P "Press enter to continue . . . "
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
do it_run.ini it_example_2_src.txt nul deck_out.dck
|
do build_fortransit_pack.ini
|
||||||
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
|
do run_fortransit.ini fortransit/fortransit_example_2_src.txt fortransit/fortransit_example_2_data.txt
|
||||||
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
|
do run_fortransit.ini fortransit/fortransit_example_1_src.txt nul
|
||||||
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
|
do run_fortransit.ini fortransit/fortransit_example_4_src.txt
|
||||||
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
|
do run_fortransit.ini fortransit/fortransit_example_5_src.txt
|
||||||
|
set env -P "Press Enter to continue . . . "
|
||||||
|
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:end
|
||||||
|
|
319
I650/i650_cdp.c
319
I650/i650_cdp.c
|
@ -137,6 +137,8 @@ void encode_lpt_num(t_int64 d, int l)
|
||||||
#define wf_sN_NNNNNNN_NN 3
|
#define wf_sN_NNNNNNN_NN 3
|
||||||
#define wf_sN_NNN_NNN_NNN 4
|
#define wf_sN_NNN_NNN_NNN 4
|
||||||
#define wf_nnnnnnnnnNs 5
|
#define wf_nnnnnnnnnNs 5
|
||||||
|
#define wf_nnnnnnnnnH 6
|
||||||
|
#define wf_NNNNNNNNNN 7
|
||||||
|
|
||||||
void encode_lpt_word(t_int64 d, int NegZero, int wFormat)
|
void encode_lpt_word(t_int64 d, int NegZero, int wFormat)
|
||||||
{
|
{
|
||||||
|
@ -163,6 +165,16 @@ void encode_lpt_word(t_int64 d, int NegZero, int wFormat)
|
||||||
} else if (wFormat == wf_nnnnnnnnnNs) {
|
} else if (wFormat == wf_nnnnnnnnnNs) {
|
||||||
encode_lpt_num(d,-10); // replace leading zeroes by spaces
|
encode_lpt_num(d,-10); // replace leading zeroes by spaces
|
||||||
encode_char(0, neg ? '-':' ');
|
encode_char(0, neg ? '-':' ');
|
||||||
|
} else if (wFormat == wf_nnnnnnnnnH) {
|
||||||
|
if (d < 10) {
|
||||||
|
encode_lpt_spc(9);
|
||||||
|
} else {
|
||||||
|
encode_lpt_num(d / 10, -9); // print 9 digits, replacing leading zeroes by spaces
|
||||||
|
}
|
||||||
|
n = d % 10;
|
||||||
|
encode_char(0, (n==0) ? '+':'A'+n-1); // hi punch on last digit
|
||||||
|
} else if (wFormat == wf_NNNNNNNNNN) {
|
||||||
|
encode_lpt_num(d,10);
|
||||||
} else { // default: wFormat == wf_NNNNNNNNNNs
|
} else { // default: wFormat == wf_NNNNNNNNNNs
|
||||||
encode_lpt_num(d,10);
|
encode_lpt_num(d,10);
|
||||||
encode_char(0, neg ? '-':' ');
|
encode_char(0, neg ? '-':' ');
|
||||||
|
@ -209,17 +221,18 @@ void encode_pch_str(const char * buf)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
void encode_8word_wiring(int addr)
|
void encode_8word_wiring(void)
|
||||||
{
|
{
|
||||||
// encode 8 numerical words per card
|
// encode 8 numerical words per card
|
||||||
// get the decoded data from drum at addr
|
// get the decoded data from IOSync
|
||||||
int i, NegZero;
|
int i, NegZero;
|
||||||
t_int64 d;
|
t_int64 d;
|
||||||
char pch_word[20];
|
char pch_word[20];
|
||||||
|
|
||||||
// punch card
|
// punch card
|
||||||
for(i=0;i<8;i++) {
|
for(i=0;i<8;i++) {
|
||||||
ReadDrum(addr + i, &d, &NegZero);
|
d = IOSync[i];
|
||||||
|
NegZero = IOSync_NegativeZeroFlag[i];
|
||||||
sprintf_word(pch_word, d, NegZero, 0);
|
sprintf_word(pch_word, d, NegZero, 0);
|
||||||
encode_pch_str(pch_word);
|
encode_pch_str(pch_word);
|
||||||
}
|
}
|
||||||
|
@ -227,13 +240,14 @@ void encode_8word_wiring(int addr)
|
||||||
// print out card contents
|
// print out card contents
|
||||||
// 8 words in format NN NNNN NNNN+
|
// 8 words in format NN NNNN NNNN+
|
||||||
for(i=0;i<8;i++) {
|
for(i=0;i<8;i++) {
|
||||||
ReadDrum(addr + i, &d, &NegZero);
|
d = IOSync[i];
|
||||||
|
NegZero = IOSync_NegativeZeroFlag[i];
|
||||||
encode_lpt_word(d, NegZero, wf_NN_NNNN_NNNNs);
|
encode_lpt_word(d, NegZero, wf_NN_NNNN_NNNNs);
|
||||||
encode_lpt_spc(1);
|
encode_lpt_spc(1);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void encode_soap_wiring(int addr)
|
void encode_soap_wiring(void)
|
||||||
{
|
{
|
||||||
// encode soap card simulating soap control panel wiring for 533
|
// encode soap card simulating soap control panel wiring for 533
|
||||||
// from SOAP II manual at http://www.bitsavers.org/pdf/ibm/650/24-4000-0_SOAPII.pdf
|
// from SOAP II manual at http://www.bitsavers.org/pdf/ibm/650/24-4000-0_SOAPII.pdf
|
||||||
|
@ -279,19 +293,19 @@ void encode_soap_wiring(int addr)
|
||||||
int i, sv_card_nbuf, n;
|
int i, sv_card_nbuf, n;
|
||||||
int pat1, pat2;
|
int pat1, pat2;
|
||||||
|
|
||||||
word_to_ascii(loc, 1, 5, DRUM[addr + 0]);
|
word_to_ascii(loc, 1, 5, IOSync[0]);
|
||||||
word_to_ascii(data_addr, 1, 5, DRUM[addr + 1]);
|
word_to_ascii(data_addr, 1, 5, IOSync[1]);
|
||||||
word_to_ascii(inst_addr, 1, 5, DRUM[addr + 2]);
|
word_to_ascii(inst_addr, 1, 5, IOSync[2]);
|
||||||
word_to_ascii(OpCode, 1, 3, DRUM[addr + 3]);
|
word_to_ascii(OpCode, 1, 3, IOSync[3]);
|
||||||
word_to_ascii(Data_Tag, 4, 1, DRUM[addr + 3]);
|
word_to_ascii(Data_Tag, 4, 1, IOSync[3]);
|
||||||
word_to_ascii(Instr_Tag, 5, 1, DRUM[addr + 3]);
|
word_to_ascii(Instr_Tag, 5, 1, IOSync[3]);
|
||||||
word_to_ascii(rem1, 1, 5, DRUM[addr + 4]);
|
word_to_ascii(rem1, 1, 5, IOSync[4]);
|
||||||
word_to_ascii(rem2, 1, 5, DRUM[addr + 5]);
|
word_to_ascii(rem2, 1, 5, IOSync[5]);
|
||||||
instr = DRUM[addr + 6];
|
instr = IOSync[6];
|
||||||
location = (int) ((DRUM[addr + 7] / D4) % D4);
|
location = (int) ((IOSync[7] / D4) % D4);
|
||||||
ty = (int) ( DRUM[addr + 7] % 10);
|
ty = (int) ( IOSync[7] % 10);
|
||||||
CardNum = (int) ( DRUM[addr + 8] % D4);
|
CardNum = (int) ( IOSync[8] % D4);
|
||||||
d = DRUM[addr + 9];
|
d = IOSync[9];
|
||||||
b_blk_op = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
b_blk_op = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
b_blk_i = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
b_blk_i = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
b_blk_d = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
b_blk_d = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
@ -303,13 +317,13 @@ void encode_soap_wiring(int addr)
|
||||||
neg = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
neg = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
b_non_blank = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
b_non_blank = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
|
||||||
// printf("bits %06d%04d%c ", printfw(DRUM[addr + 9])); // to echo the status digits of punched card
|
// printf("bits %06d%04d%c ", printfw(IOSync[9])); // to echo the control word of punched card
|
||||||
|
|
||||||
// generate card
|
// generate card
|
||||||
if (b_pch_b) {
|
if (b_pch_b) {
|
||||||
// punch availability table (pat pseudo-op output)
|
// punch availability table (pat pseudo-op output)
|
||||||
for(i=0;i<8;i++) {
|
for(i=0;i<8;i++) {
|
||||||
sprintf_word(pch_word, DRUM[addr + i], 0, 1);
|
sprintf_word(pch_word, IOSync[i], 0, 1);
|
||||||
encode_pch_str(pch_word);
|
encode_pch_str(pch_word);
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
|
@ -353,10 +367,10 @@ void encode_soap_wiring(int addr)
|
||||||
if (b_pch_b) {
|
if (b_pch_b) {
|
||||||
// print availability table (pat pseudo-op output)
|
// print availability table (pat pseudo-op output)
|
||||||
for(i=0; i<4; i++) {
|
for(i=0; i<4; i++) {
|
||||||
d = DRUM[addr + i*2];
|
d = IOSync[i*2];
|
||||||
pat1 = (int) ((d / D4) % D4);
|
pat1 = (int) ((d / D4) % D4);
|
||||||
pat2 = (int) ( d % D4);
|
pat2 = (int) ( d % D4);
|
||||||
d = DRUM[addr + i*2 + 1];
|
d = IOSync[i*2 + 1];
|
||||||
encode_lpt_num(pat1, 4);
|
encode_lpt_num(pat1, 4);
|
||||||
encode_lpt_spc(2);
|
encode_lpt_spc(2);
|
||||||
encode_lpt_num(d, 10);
|
encode_lpt_num(d, 10);
|
||||||
|
@ -412,7 +426,7 @@ void encode_soap_wiring(int addr)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void encode_is_wiring(int addr)
|
void encode_is_wiring(void)
|
||||||
{
|
{
|
||||||
// encode Floationg Decimal Interpretive System (IS) card simulating control panel wiring for 533 as described
|
// encode Floationg Decimal Interpretive System (IS) card simulating control panel wiring for 533 as described
|
||||||
// in manual at http://www.bitsavers.org/pdf/ibm/650/28-4024_FltDecIntrpSys
|
// in manual at http://www.bitsavers.org/pdf/ibm/650/28-4024_FltDecIntrpSys
|
||||||
|
@ -454,19 +468,20 @@ void encode_is_wiring(int addr)
|
||||||
char pch_word[20];
|
char pch_word[20];
|
||||||
int bSetHiPunch;
|
int bSetHiPunch;
|
||||||
|
|
||||||
bSetHiPunch = (DRUM[addr] < 0) ? 2 : 0; // first bSetHiPunch is 2 if word negative (signals a load card must be punched)
|
bSetHiPunch = (IOSync[0] < 0) ? 2 : 0; // first bSetHiPunch is 2 if word negative (signals a load card must be punched)
|
||||||
|
|
||||||
loc = (int) ((DRUM[addr] / D4) % D4);
|
loc = (int) ((IOSync[0] / D4) % D4);
|
||||||
CardNum = (int) ((DRUM[addr+9] / D4) % D4);
|
CardNum = (int) ((IOSync[9] / D4) % D4);
|
||||||
wc = (int) ((DRUM[addr+1] / D4) % D4);
|
wc = (int) ((IOSync[1] / D4) % D4);
|
||||||
PrNum = (int) ( DRUM[addr+8]);
|
PrNum = (int) ( IOSync[8]);
|
||||||
bTraceCard = (DRUM[addr] / D8) > 0 ? 1 : 0; // if to higher digits are nonzero -> is a trace card
|
bTraceCard = (IOSync[0] / D8) > 0 ? 1 : 0; // if to higher digits are nonzero -> is a trace card
|
||||||
|
|
||||||
if (bSetHiPunch) {
|
if (bSetHiPunch) {
|
||||||
// punch a load card
|
// punch a load card
|
||||||
for(i=0;i<8;i++) {
|
for(i=0;i<8;i++) {
|
||||||
ReadDrum(addr + i, &d, &NegZero);
|
d = IOSync[i];
|
||||||
if ((i==0) && (d < 0)) d = -d; // get absolute value for DRUM[addr + 0]
|
NegZero = IOSync_NegativeZeroFlag[i];
|
||||||
|
if ((i==0) && (d < 0)) d = -d; // get absolute value for IOSync[0]
|
||||||
sprintf_word(pch_word, d, NegZero, bSetHiPunch);
|
sprintf_word(pch_word, d, NegZero, bSetHiPunch);
|
||||||
if (bSetHiPunch==2) bSetHiPunch = 1; // if bSetHiPunch is 2 change it to bSetHiPunch = 1
|
if (bSetHiPunch==2) bSetHiPunch = 1; // if bSetHiPunch is 2 change it to bSetHiPunch = 1
|
||||||
encode_pch_str(pch_word);
|
encode_pch_str(pch_word);
|
||||||
|
@ -481,7 +496,8 @@ void encode_is_wiring(int addr)
|
||||||
encode_pch_str(pch_word);
|
encode_pch_str(pch_word);
|
||||||
for(i=0;i<6;i++) {
|
for(i=0;i<6;i++) {
|
||||||
if (i<wc) {
|
if (i<wc) {
|
||||||
ReadDrum(addr + i + 2, &d, &NegZero);
|
d = IOSync[i+2];
|
||||||
|
NegZero = IOSync_NegativeZeroFlag[i+2];
|
||||||
if ((d < 0) || ((d==0) && (NegZero))) {
|
if ((d < 0) || ((d==0) && (NegZero))) {
|
||||||
encode_pch_str("-");
|
encode_pch_str("-");
|
||||||
d = -d;
|
d = -d;
|
||||||
|
@ -517,7 +533,8 @@ void encode_is_wiring(int addr)
|
||||||
}
|
}
|
||||||
for(i=2;i<2+wc;i++) {
|
for(i=2;i<2+wc;i++) {
|
||||||
encode_lpt_spc(2);
|
encode_lpt_spc(2);
|
||||||
ReadDrum(addr + i, &d, &NegZero);
|
d = IOSync[i];
|
||||||
|
NegZero = IOSync_NegativeZeroFlag[i];
|
||||||
if ((bTraceCard) && (i<5)) {
|
if ((bTraceCard) && (i<5)) {
|
||||||
// if printing a trace card, first three words are printed as intructions (+N NNN NNN NNN)
|
// if printing a trace card, first three words are printed as intructions (+N NNN NNN NNN)
|
||||||
encode_lpt_word(d, NegZero, wf_sN_NNN_NNN_NNN);
|
encode_lpt_word(d, NegZero, wf_sN_NNN_NNN_NNN);
|
||||||
|
@ -529,7 +546,7 @@ void encode_is_wiring(int addr)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void encode_it_wiring(int addr)
|
void encode_it_wiring(void)
|
||||||
{
|
{
|
||||||
// encode card for IT compiler modified soap
|
// encode card for IT compiler modified soap
|
||||||
// from IT manual at http://www.bitsavers.org/pdf/ibm/650/CarnegieInternalTranslator.pdf
|
// from IT manual at http://www.bitsavers.org/pdf/ibm/650/CarnegieInternalTranslator.pdf
|
||||||
|
@ -599,14 +616,14 @@ void encode_it_wiring(int addr)
|
||||||
int b, neg, b_pit, b_reg, b_resv, b_data; // punch control flags
|
int b, neg, b_pit, b_reg, b_resv, b_data; // punch control flags
|
||||||
int i;
|
int i;
|
||||||
|
|
||||||
word_to_ascii(loc, 1, 5, DRUM[addr + 0]);
|
word_to_ascii(loc, 1, 5, IOSync[0]);
|
||||||
word_to_ascii(OpCode, 1, 3, DRUM[addr + 1]);
|
word_to_ascii(OpCode, 1, 3, IOSync[1]);
|
||||||
word_to_ascii(data_addr, 1, 5, DRUM[addr + 2]);
|
word_to_ascii(data_addr, 1, 5, IOSync[2]);
|
||||||
word_to_ascii(inst_addr, 1, 5, DRUM[addr + 3]);
|
word_to_ascii(inst_addr, 1, 5, IOSync[3]);
|
||||||
word_to_ascii(rem1, 1, 5, DRUM[addr + 4]);
|
word_to_ascii(rem1, 1, 5, IOSync[4]);
|
||||||
word_to_ascii(rem2, 1, 5, DRUM[addr + 5]);
|
word_to_ascii(rem2, 1, 5, IOSync[5]);
|
||||||
CardNum = (int) ((DRUM[addr + 8] / D4) % D4);
|
CardNum = (int) ((IOSync[8] / D4) % D4);
|
||||||
d = DRUM[addr + 9];
|
d = IOSync[9];
|
||||||
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
b_data = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
b_data = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
@ -618,17 +635,17 @@ void encode_it_wiring(int addr)
|
||||||
b_reg = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
b_reg = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
b_resv = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
b_resv = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
|
||||||
// printf("bits %06d%04d%c ", printfw(DRUM[addr + 9])); // to echo the status digits of punched card
|
// printf("bits %06d%04d%c ", printfw(IOSync[9])); // to echo the control word of punched card
|
||||||
|
|
||||||
// generate card
|
// generate card
|
||||||
if (b_data) {
|
if (b_data) {
|
||||||
// punch type 1 data out card
|
// punch type 1 data out card
|
||||||
for (i=0;i<4;i++) {
|
for (i=0;i<4;i++) {
|
||||||
sprintf_word(pch_word, DRUM[addr + i*2+0], 0, (i==0) ? 3:0); // punch variable name
|
sprintf_word(pch_word, IOSync[i*2+0], 0, (i==0) ? 3:0); // punch variable name
|
||||||
encode_pch_str(pch_word);
|
encode_pch_str(pch_word);
|
||||||
sprintf_word(pch_word, DRUM[addr + i*2+1], 0, (i==0) ? 3:0); // punch variable value
|
sprintf_word(pch_word, IOSync[i*2+1], 0, (i==0) ? 3:0); // punch variable value
|
||||||
encode_pch_str(pch_word);
|
encode_pch_str(pch_word);
|
||||||
if (DRUM[addr + i*2+2] == 0) break; // if next word is zero, no more variables to punch
|
if (IOSync[i*2+2] == 0) break; // if next word is zero, no more variables to punch
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
// punch SOAP source instruction
|
// punch SOAP source instruction
|
||||||
|
@ -663,11 +680,11 @@ void encode_it_wiring(int addr)
|
||||||
if (b_data) {
|
if (b_data) {
|
||||||
// print type 1 data out card. replace leading zeroes by spaces on each word
|
// print type 1 data out card. replace leading zeroes by spaces on each word
|
||||||
for (i=0;i<4;i++) {
|
for (i=0;i<4;i++) {
|
||||||
encode_lpt_word(DRUM[addr + i*2+0], 0, wf_nnnnnnnnnNs); // print variable name
|
encode_lpt_word(IOSync[i*2+0], 0, wf_nnnnnnnnnNs); // print variable name
|
||||||
encode_lpt_spc(1);
|
encode_lpt_spc(1);
|
||||||
encode_lpt_word(DRUM[addr + i*2+1], 0, wf_nnnnnnnnnNs); // print variable value
|
encode_lpt_word(IOSync[i*2+1], 0, wf_nnnnnnnnnNs); // print variable value
|
||||||
encode_lpt_spc(1);
|
encode_lpt_spc(1);
|
||||||
if (DRUM[addr + i*2+2] == 0) break; // if next word is zero, no more variables to punch
|
if (IOSync[i*2+2] == 0) break; // if next word is zero, no more variables to punch
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
// print generated soap source listing
|
// print generated soap source listing
|
||||||
|
@ -685,6 +702,197 @@ void encode_it_wiring(int addr)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void encode_fortransit_wiring(void)
|
||||||
|
{
|
||||||
|
// encode card for FORTRANSIT modified IT compiler
|
||||||
|
// from FORTRANSIT manual at http://bitsavers.org/pdf/ibm/650/28-4028_FOR_TRANSIT.pdf
|
||||||
|
// implemented Fortransit II (S)
|
||||||
|
// word 1986 (control word) specifies what is being punched)
|
||||||
|
// storage in output block
|
||||||
|
// +-------------------+
|
||||||
|
// Word 1977: | <- statement -> | Alphabetic
|
||||||
|
// 1978: | <- statement -> | Alphabetic
|
||||||
|
// 1979: | <- statement -> | Alphabetic
|
||||||
|
// 1980: | <- statement -> | Alphabetic
|
||||||
|
// 1981: | <- statement -> | Alphabetic
|
||||||
|
// 1982: | <- statement -> | Alphabetic
|
||||||
|
// +-------------------+
|
||||||
|
// 1983: | | Not Used
|
||||||
|
// 1984: | | Not Used
|
||||||
|
// +-----------+-------+
|
||||||
|
// 1985: | |N N N N| N N N N=Statement Number
|
||||||
|
// 1986: |a|b|c|d|e|f|g|h|i|j| Control Word
|
||||||
|
// a = 0/8 =8 -> punch a data card
|
||||||
|
// b = 0/8
|
||||||
|
// c = 0/8
|
||||||
|
// d = 0/8 =8 -> ???
|
||||||
|
// e = 0/8
|
||||||
|
// f = 0/8
|
||||||
|
// g = 0/8 =8 -> punching a IT source card, =0 -> punching SOAP card
|
||||||
|
// h = 0/8
|
||||||
|
// i = 0/8 =8 -> punching a FORTRANSIT card
|
||||||
|
// j = 0/8 =8 -> punching an IT header card (8 word load card format)
|
||||||
|
//
|
||||||
|
// IT card punch format
|
||||||
|
// Column: 1 2 3 4 | 5 | 6 - 42 | 43 - 70 | 71 72 | 73 - 80 |
|
||||||
|
// N N N N | + | | Statement | | Statement |
|
||||||
|
// Statement | Y(12) | | max 28 | | number as |
|
||||||
|
// Number | Punch | | chars | | comment |
|
||||||
|
//
|
||||||
|
//
|
||||||
|
// SOAP card storage in output block
|
||||||
|
// +-------------------+
|
||||||
|
// Word 1977: | <- Loc. Label -> | Alphabetic
|
||||||
|
// 1978: | <- Data Addr -> | Alphabetic
|
||||||
|
// 1979: | <- Inst Addr -> | Alphabetic
|
||||||
|
// 1980: | <- Op Code -> | Alphabetic
|
||||||
|
// 1981: | <- Remarks -> | Alphabetic
|
||||||
|
// 1982: | <- Remarks -> | Alphabetic
|
||||||
|
// +-------------------+
|
||||||
|
// 1983: | | Not Used
|
||||||
|
// 1984: | | Not Used
|
||||||
|
// +-------------------+
|
||||||
|
// 1985: | |N N N N| N N N N=Card Number as defined above
|
||||||
|
// 1986: | <- Control Word-> | As defined above
|
||||||
|
|
||||||
|
char pch_word[20];
|
||||||
|
char lin[31];
|
||||||
|
char loc[6], data_addr[6], inst_addr[6], OpCode[6], rem1[6], rem2[6];
|
||||||
|
t_int64 d;
|
||||||
|
int CardNum;
|
||||||
|
int b, neg, b_it_hdr, b_it_src, b_fort, b_soap, b_data; // punch control word flags
|
||||||
|
int i;
|
||||||
|
|
||||||
|
word_to_ascii(&lin[0], 1, 5, IOSync[0]);
|
||||||
|
word_to_ascii(&lin[5], 1, 5, IOSync[1]);
|
||||||
|
word_to_ascii(&lin[10], 1, 5, IOSync[2]);
|
||||||
|
word_to_ascii(&lin[15], 1, 5, IOSync[3]);
|
||||||
|
word_to_ascii(&lin[20], 1, 5, IOSync[4]);
|
||||||
|
word_to_ascii(&lin[25], 1, 5, IOSync[5]);
|
||||||
|
lin[30] = 0;
|
||||||
|
|
||||||
|
CardNum = (int) (IOSync[8] % D4);
|
||||||
|
|
||||||
|
word_to_ascii(loc, 1, 5, IOSync[0]);
|
||||||
|
word_to_ascii(data_addr, 1, 5, IOSync[1]);
|
||||||
|
word_to_ascii(inst_addr, 1, 5, IOSync[2]);
|
||||||
|
word_to_ascii(OpCode, 1, 3, IOSync[3]);
|
||||||
|
word_to_ascii(rem1, 1, 5, IOSync[4]);
|
||||||
|
word_to_ascii(rem2, 1, 5, IOSync[5]);
|
||||||
|
|
||||||
|
neg = 0;
|
||||||
|
|
||||||
|
d = IOSync[9];
|
||||||
|
b_it_hdr = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
b_fort = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
b_it_src = ((int) (d % 10) == 8) ? 1:0; d = d / 10; b_soap = ((b_fort == 1) && (b_it_src == 0));
|
||||||
|
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
b = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
b_data = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
|
||||||
|
|
||||||
|
// printf("bits %06d%04d%c ", printfw(IOSync[9])); // to echo the control word of punched card
|
||||||
|
// generate card
|
||||||
|
if (b_data) {
|
||||||
|
// punch data card output for PUNCH fortransit command
|
||||||
|
for (i=0;i<8;i++) {
|
||||||
|
sprintf_word(pch_word, IOSync[i], 0, 0);
|
||||||
|
encode_pch_str(pch_word);
|
||||||
|
}
|
||||||
|
} else if (b_it_hdr) {
|
||||||
|
// punch IT header card as 8 word per card load card format
|
||||||
|
for (i=0;i<8;i++) {
|
||||||
|
sprintf_word(pch_word, IOSync[i], 0, 1);
|
||||||
|
encode_pch_str(pch_word);
|
||||||
|
}
|
||||||
|
} else if (b_soap) {
|
||||||
|
// punch SOAP source instruction
|
||||||
|
for(i=0;i<40;i++) encode_pch_str(" "); // leave 40 first columns blank
|
||||||
|
encode_pch_str(" ");
|
||||||
|
encode_char(neg == 0 ? ' ' : '-', 0);
|
||||||
|
encode_pch_str(loc);
|
||||||
|
encode_pch_str(OpCode);
|
||||||
|
encode_pch_str(data_addr);
|
||||||
|
encode_pch_str(" ");
|
||||||
|
encode_pch_str(inst_addr);
|
||||||
|
encode_pch_str(" ");
|
||||||
|
encode_pch_str(rem1);
|
||||||
|
encode_pch_str(rem2);
|
||||||
|
// convert to lowercase for punching
|
||||||
|
for (i=40;i<card_nbuf;i++)
|
||||||
|
if ((card_buf[i] >= 'A') && (card_buf[i] <= 'Z'))
|
||||||
|
card_buf[i] = card_buf[i] - 'A' + 'a';
|
||||||
|
} else if (b_it_src) {
|
||||||
|
// punch IT source card
|
||||||
|
sprintf_word(pch_word, CardNum, 0, 0); // punch statement number
|
||||||
|
for (i=0;i<4;i++) pch_word[i] = pch_word[i+6];
|
||||||
|
pch_word[4] = '+';
|
||||||
|
for (i=5;i<10;i++) pch_word[i] = ' '; // punch separation spaces
|
||||||
|
encode_pch_str(pch_word);
|
||||||
|
for (i=10;i<42;i++) encode_pch_str(" ");
|
||||||
|
encode_pch_str(lin); // punch statement
|
||||||
|
encode_pch_str(" ");
|
||||||
|
sprintf_word(pch_word, CardNum, 0, 0); // punch statement number again as comment
|
||||||
|
for (i=0;i<4;i++) pch_word[i] = pch_word[i+6];
|
||||||
|
pch_word[4] = 0;
|
||||||
|
encode_pch_str(pch_word);
|
||||||
|
// convert to lowercase for punching
|
||||||
|
for (i=0;i<card_nbuf;i++)
|
||||||
|
if ((card_buf[i] >= 'A') && (card_buf[i] <= 'Z'))
|
||||||
|
card_buf[i] = card_buf[i] - 'A' + 'a';
|
||||||
|
}
|
||||||
|
|
||||||
|
// generate printout
|
||||||
|
if (b_data) {
|
||||||
|
// print data card output for PUNCH fortransit command
|
||||||
|
for (i=0;i<8;i++) {
|
||||||
|
d = IOSync[i];
|
||||||
|
if ((d == 0) && (i != 0)) {
|
||||||
|
encode_lpt_spc(11);
|
||||||
|
} else {
|
||||||
|
encode_lpt_word(d, 0, wf_nnnnnnnnnNs);
|
||||||
|
}
|
||||||
|
encode_lpt_spc(1);
|
||||||
|
}
|
||||||
|
} else if (b_it_hdr) {
|
||||||
|
// print IT header card as 8 word per card load card format
|
||||||
|
for (i=0;i<8;i++) {
|
||||||
|
if (i==4) {
|
||||||
|
encode_lpt_word(IOSync[i], 0, wf_NNNNNNNNNN);
|
||||||
|
} else {
|
||||||
|
encode_lpt_word(IOSync[i], 0, wf_nnnnnnnnnH);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else if (b_soap) {
|
||||||
|
// print generated SOAP source listing
|
||||||
|
encode_lpt_spc(2);
|
||||||
|
encode_lpt_num(CardNum, -4);
|
||||||
|
encode_lpt_spc(6);
|
||||||
|
encode_lpt_str(loc);
|
||||||
|
encode_lpt_spc(2); encode_char(0, neg ? '-':' '); encode_lpt_spc(1);
|
||||||
|
encode_lpt_str(OpCode); encode_lpt_spc(3);
|
||||||
|
encode_lpt_str(data_addr); encode_lpt_spc(3);
|
||||||
|
encode_lpt_str(inst_addr); encode_lpt_spc(6);
|
||||||
|
encode_lpt_str(rem1); encode_lpt_str(rem2);
|
||||||
|
} else if (b_it_src) {
|
||||||
|
// print generated it source listing
|
||||||
|
if (CardNum == 0) {
|
||||||
|
encode_lpt_spc(5);
|
||||||
|
} else {
|
||||||
|
encode_lpt_num(CardNum, -4);
|
||||||
|
encode_lpt_str("+");
|
||||||
|
}
|
||||||
|
encode_lpt_spc(37);
|
||||||
|
encode_lpt_str(lin);
|
||||||
|
encode_lpt_spc(4);
|
||||||
|
encode_lpt_num(CardNum, 4);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Card punch routine */
|
/* Card punch routine */
|
||||||
uint32 cdp_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
|
uint32 cdp_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
|
||||||
{
|
{
|
||||||
|
@ -710,19 +918,22 @@ uint32 cdp_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
|
||||||
|
|
||||||
if (wiring == WIRING_SOAP) {
|
if (wiring == WIRING_SOAP) {
|
||||||
// encode soap card simulating soap control panel wiring for 533 (gasp!)
|
// encode soap card simulating soap control panel wiring for 533 (gasp!)
|
||||||
encode_soap_wiring(addr);
|
encode_soap_wiring();
|
||||||
} else if (wiring == WIRING_IS) {
|
} else if (wiring == WIRING_IS) {
|
||||||
// encode floating point interpretive system (bell interpreter) card
|
// encode floating point interpretive system (bell interpreter) card
|
||||||
encode_is_wiring(addr);
|
encode_is_wiring();
|
||||||
} else if (wiring == WIRING_IT) {
|
} else if (wiring == WIRING_IT) {
|
||||||
// encode Carnegie Internal Translator compiler card
|
// encode Carnegie Internal Translator compiler card
|
||||||
encode_it_wiring(addr);
|
encode_it_wiring();
|
||||||
|
} else if (wiring == WIRING_FORTRANSIT) {
|
||||||
|
// encode Fortransit translator card
|
||||||
|
encode_fortransit_wiring();
|
||||||
} else if (wiring == WIRING_8WORD) {
|
} else if (wiring == WIRING_8WORD) {
|
||||||
// encode 8 words per card
|
// encode 8 words per card
|
||||||
encode_8word_wiring(addr);
|
encode_8word_wiring();
|
||||||
} else {
|
} else {
|
||||||
// default wiring: decode up to 8 numerical words per card
|
// default wiring: decode up to 8 numerical words per card
|
||||||
encode_8word_wiring(addr);
|
encode_8word_wiring();
|
||||||
}
|
}
|
||||||
|
|
||||||
if ((card_nlpt == 1) && (card_lpt[0] == 0)) {
|
if ((card_nlpt == 1) && (card_lpt[0] == 0)) {
|
||||||
|
|
308
I650/i650_cdr.c
308
I650/i650_cdr.c
|
@ -74,16 +74,20 @@ DEVICE cdr_dev = {
|
||||||
NULL, NULL, &cdr_help, NULL, NULL, &cdr_description
|
NULL, NULL, &cdr_help, NULL, NULL, &cdr_description
|
||||||
};
|
};
|
||||||
|
|
||||||
|
// buffer to hold read cards in take hopper of each unit
|
||||||
|
// to be printed by carddeck command
|
||||||
|
char ReadHopper[3 * MAX_CARDS_IN_READ_TAKE_HOPPER * 80];
|
||||||
|
int ReadHopperLast[3];
|
||||||
|
|
||||||
// get 10 digits word with sign from card buf (the data struct). return 1 if HiPunch set on any digit
|
// get 10 digits word with sign from card buf (the data struct). return 1 if HiPunch set on any digit
|
||||||
int decode_8word_wiring(struct _card_data * data, int addr)
|
int decode_8word_wiring(struct _card_data * data, int bCheckForHiPunch)
|
||||||
{
|
{
|
||||||
// decode up to 8 numerical words per card
|
// decode up to 8 numerical words per card
|
||||||
// input card
|
// input card
|
||||||
// NNNNNNNNNN ... 8 times
|
// NNNNNNNNNN ... 8 times
|
||||||
// If last digit of word has X(11) punch whole word is set as negative value
|
// If last digit of word has X(11) punch whole word is set as negative value
|
||||||
// If N is non numeric, a 0 is assumed
|
// If N is non numeric, a 0 is assumed
|
||||||
// put the decoded data in drum at addr (if addr < 0 -> do not store in drum)
|
// put the decoded data in IO Sync buffer (if bCheckForHiPunch = 1 -> do not store in IO Sync Buffer)
|
||||||
// return 1 if any colum has Y(12) hi-punch set
|
// return 1 if any colum has Y(12) hi-punch set
|
||||||
uint16 c1,c2;
|
uint16 c1,c2;
|
||||||
int wn,iCol,iDigit;
|
int wn,iCol,iDigit;
|
||||||
|
@ -113,7 +117,7 @@ int decode_8word_wiring(struct _card_data * data, int addr)
|
||||||
c1 = c1 & 0x3FF; // remove X and Y punches
|
c1 = c1 & 0x3FF; // remove X and Y punches
|
||||||
c2 = data->hol_to_ascii[c1]; // convert to ascii again
|
c2 = data->hol_to_ascii[c1]; // convert to ascii again
|
||||||
c2 = c2 - '0'; // convert ascii to binary digit
|
c2 = c2 - '0'; // convert ascii to binary digit
|
||||||
if (c2 > 9) c2 = 0; // nondigits chars interpreted as zero
|
if (c2 > 9) c2 = 0; // nondigits chars interpreted as zero
|
||||||
d = d * 10 + c2;
|
d = d * 10 + c2;
|
||||||
}
|
}
|
||||||
// end of word. set sign
|
// end of word. set sign
|
||||||
|
@ -121,15 +125,18 @@ int decode_8word_wiring(struct _card_data * data, int addr)
|
||||||
d = -d; // yes, change sign of word read
|
d = -d; // yes, change sign of word read
|
||||||
if (d == 0) NegZero=1; // word read is minus zero
|
if (d == 0) NegZero=1; // word read is minus zero
|
||||||
}
|
}
|
||||||
if (addr >= 0) WriteDrum(addr++, d, NegZero); // store word read from card into drum
|
|
||||||
|
|
||||||
|
if (bCheckForHiPunch == 0) {
|
||||||
|
IOSync [wn]=d;
|
||||||
|
IOSync_NegativeZeroFlag[wn]=NegZero;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
return HiPunch;
|
return HiPunch;
|
||||||
}
|
}
|
||||||
|
|
||||||
// load soap symbolic info, This is a facility to help debugging of soap programs into SimH
|
// load soap symbolic info, This is a facility to help debugging of soap programs into SimH
|
||||||
// does not exist in real hw
|
// does not exist in real hw
|
||||||
void decode_soap_symb_info(struct _card_data * data, int addr)
|
void decode_soap_symb_info(struct _card_data * data)
|
||||||
{
|
{
|
||||||
t_int64 d;
|
t_int64 d;
|
||||||
int op,da,ia,i,i2,p;
|
int op,da,ia,i,i2,p;
|
||||||
|
@ -137,16 +144,16 @@ void decode_soap_symb_info(struct _card_data * data, int addr)
|
||||||
uint16 c1,c2;
|
uint16 c1,c2;
|
||||||
|
|
||||||
// check soap 1-word load card initial word
|
// check soap 1-word load card initial word
|
||||||
d = DRUM[addr + 0];
|
d = IOSync[0];
|
||||||
if (d != 6919541953LL) return; // not a 1-word load card
|
if (d != 6919541953LL) return; // not a 1-word load card
|
||||||
|
|
||||||
// get the address where the 1-word card will be loaded (into da)
|
// get the address where the 1-word card will be loaded (into da)
|
||||||
d = DRUM[addr+2];
|
d = IOSync[2];
|
||||||
op = Shift_Digits(&d, 2); // current inst opcode
|
op = Shift_Digits(&d, 2); // current inst opcode
|
||||||
da = Shift_Digits(&d, 4); // addr of data
|
da = Shift_Digits(&d, 4); // addr of data
|
||||||
ia = Shift_Digits(&d, 4); // addr of next instr
|
ia = Shift_Digits(&d, 4); // addr of next instr
|
||||||
if ((op != 24) && (ia != 8000)) return; // not a 1-word load card
|
if ((op != 24) && (ia != 8000)) return; // not a 1-word load card
|
||||||
if (da >= (int)MEMSIZE) return; // destination address out of range
|
if (da >= (int)DRUMSIZE) return; // symbolic info can only be associated to drum addrs
|
||||||
|
|
||||||
// convert card image punches to ascii buf for processing, starting at col 40
|
// convert card image punches to ascii buf for processing, starting at col 40
|
||||||
// keep 026 fortran charset
|
// keep 026 fortran charset
|
||||||
|
@ -210,7 +217,7 @@ t_int64 decode_alpha_word(char * buf, int n)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
void decode_soap_wiring(struct _card_data * data, int addr)
|
void decode_soap_wiring(struct _card_data * data)
|
||||||
{
|
{
|
||||||
// decode soap card simulating soap control panel wiring for 533
|
// decode soap card simulating soap control panel wiring for 533
|
||||||
// from SOAP II manual at http://www.bitsavers.org/pdf/ibm/650/24-4000-0_SOAPII.pdf
|
// from SOAP II manual at http://www.bitsavers.org/pdf/ibm/650/24-4000-0_SOAPII.pdf
|
||||||
|
@ -254,26 +261,26 @@ void decode_soap_wiring(struct _card_data * data, int addr)
|
||||||
}
|
}
|
||||||
buf[80] = 0; // terminate string
|
buf[80] = 0; // terminate string
|
||||||
|
|
||||||
DRUM[addr + 0] = decode_alpha_word(&buf[42], 5); // Location (5 chars)
|
IOSync[0] = decode_alpha_word(&buf[42], 5); // Location (5 chars)
|
||||||
DRUM[addr + 1] = decode_alpha_word(&buf[50], 5); // Data Addr (5 chars)
|
IOSync[1] = decode_alpha_word(&buf[50], 5); // Data Addr (5 chars)
|
||||||
DRUM[addr + 2] = decode_alpha_word(&buf[56], 5); // Inst Addr (5 chars)
|
IOSync[2] = decode_alpha_word(&buf[56], 5); // Inst Addr (5 chars)
|
||||||
DRUM[addr + 3] = decode_alpha_word(&buf[47], 3) * D4 + // OpCode (3 chars only)
|
IOSync[3] = decode_alpha_word(&buf[47], 3) * D4 + // OpCode (3 chars only)
|
||||||
decode_alpha_word(&buf[55], 1) * 100 + // Data Addr Tag (1 char only)
|
decode_alpha_word(&buf[55], 1) * 100 + // Data Addr Tag (1 char only)
|
||||||
decode_alpha_word(&buf[61], 1); // Instr Addr Tag (1 char only)
|
decode_alpha_word(&buf[61], 1); // Instr Addr Tag (1 char only)
|
||||||
DRUM[addr + 4] = decode_alpha_word(&buf[62], 5); // Remarks
|
IOSync[4] = decode_alpha_word(&buf[62], 5); // Remarks
|
||||||
DRUM[addr + 5] = decode_alpha_word(&buf[67], 5); // Remarks
|
IOSync[5] = decode_alpha_word(&buf[67], 5); // Remarks
|
||||||
|
|
||||||
DRUM[addr + 6] = decode_num_word(&buf[43], 4, 0); // Absolute Part of location
|
IOSync[6] = decode_num_word(&buf[43], 4, 0); // Absolute Part of location
|
||||||
DRUM[addr + 7] = decode_num_word(&buf[51], 4, 0); // Absolute Part of Data Addr
|
IOSync[7] = decode_num_word(&buf[51], 4, 0); // Absolute Part of Data Addr
|
||||||
DRUM[addr + 8] = decode_num_word(&buf[57], 4, 0); // Absolute Part of Instr Addr
|
IOSync[8] = decode_num_word(&buf[57], 4, 0); // Absolute Part of Instr Addr
|
||||||
|
|
||||||
ty = buf[40] - '0';
|
ty = buf[40] - '0';
|
||||||
if ((ty < 0) || (ty > 9)) ty = 0;
|
if ((ty < 0) || (ty > 9)) ty = 0;
|
||||||
neg = (buf[41] == '-') ? 8:0;
|
neg = (buf[41] == '-') ? 8:0;
|
||||||
|
|
||||||
DRUM[addr + 9] = ty * 100 +
|
IOSync[9] = ty * 100 +
|
||||||
(ty ? 80:0) +
|
(ty ? 80:0) +
|
||||||
neg; // |T b n| T=Type (0 if Blank), b=0/8 (for non blank type), n=0/8 (for negative)
|
neg; // |T b n| T=Type (0 if Blank), b=0/8 (for non blank type), n=0/8 (for negative)
|
||||||
}
|
}
|
||||||
|
|
||||||
int sformat(char * buf, const char * match)
|
int sformat(char * buf, const char * match)
|
||||||
|
@ -293,7 +300,7 @@ int sformat(char * buf, const char * match)
|
||||||
return 1; // end of match string -> return 1 -> buf matches
|
return 1; // end of match string -> return 1 -> buf matches
|
||||||
}
|
}
|
||||||
|
|
||||||
void decode_is_wiring(struct _card_data * data, int addr)
|
void decode_is_wiring(struct _card_data * data)
|
||||||
{
|
{
|
||||||
// decode Floationg Decimal Interpretive System (IS) card simulating control panel wiring for 533 as described
|
// decode Floationg Decimal Interpretive System (IS) card simulating control panel wiring for 533 as described
|
||||||
// in manual at http://www.bitsavers.org/pdf/ibm/650/28-4024_FltDecIntrpSys.pdf
|
// in manual at http://www.bitsavers.org/pdf/ibm/650/28-4024_FltDecIntrpSys.pdf
|
||||||
|
@ -339,7 +346,6 @@ void decode_is_wiring(struct _card_data * data, int addr)
|
||||||
// 1959: | Problem Number |
|
// 1959: | Problem Number |
|
||||||
// +-------------------+
|
// +-------------------+
|
||||||
//
|
//
|
||||||
// put the decoded data in drum at addr (if addr < 0 -> do not store in drum)
|
|
||||||
// card number is ignored on reading
|
// card number is ignored on reading
|
||||||
|
|
||||||
int wc,neg,i;
|
int wc,neg,i;
|
||||||
|
@ -360,15 +366,15 @@ void decode_is_wiring(struct _card_data * data, int addr)
|
||||||
if ( sformat(&buf[6], " ")) {
|
if ( sformat(&buf[6], " ")) {
|
||||||
// card with firsts 26 cols blank = blank card: read as all zero, one word count
|
// card with firsts 26 cols blank = blank card: read as all zero, one word count
|
||||||
// this allows to have blank cards/comments card as long as the comment starts on column 27 of more
|
// this allows to have blank cards/comments card as long as the comment starts on column 27 of more
|
||||||
DRUM[addr + 1] = 1 * D4; // word count
|
IOSync[1] = 1 * D4; // word count
|
||||||
} else if ( sformat(&buf[5], " NNN ")) {
|
} else if ( sformat(&buf[5], " NNN ")) {
|
||||||
// alternate format for loading IT program (IT transfer card)
|
// alternate format for loading IT program (IT transfer card)
|
||||||
DRUM[addr + 0] = decode_num_word(&buf[6], 3, 0) * D4; // start location (3 digits)
|
IOSync[0] = decode_num_word(&buf[6], 3, 0) * D4; // start location (3 digits)
|
||||||
DRUM[addr + 1] = 0; // word count = 0
|
IOSync[1] = 0; // word count = 0
|
||||||
} else if ( sformat(&buf[5], " NNN +N NNN NNN NNN ")) {
|
} else if ( sformat(&buf[5], " NNN +N NNN NNN NNN ")) {
|
||||||
// alternate format for loading IT program (IT instruction)
|
// alternate format for loading IT program (IT instruction)
|
||||||
DRUM[addr + 0] = decode_num_word(&buf[6], 3, 0) * D4; // location (3 digits)
|
IOSync[0] = decode_num_word(&buf[6], 3, 0) * D4; // location (3 digits)
|
||||||
DRUM[addr + 1] = 1 * D4; // word count
|
IOSync[1] = 1 * D4; // word count
|
||||||
NegZero = 0;
|
NegZero = 0;
|
||||||
neg = (buf[10] == '-') ? 1:0;
|
neg = (buf[10] == '-') ? 1:0;
|
||||||
d = decode_num_word(&buf[11], 1, 0) * 10 * D8 + // O1
|
d = decode_num_word(&buf[11], 1, 0) * 10 * D8 + // O1
|
||||||
|
@ -379,11 +385,12 @@ void decode_is_wiring(struct _card_data * data, int addr)
|
||||||
d=-d;
|
d=-d;
|
||||||
if (d==0) NegZero = 1;
|
if (d==0) NegZero = 1;
|
||||||
}
|
}
|
||||||
WriteDrum(addr + 2, d, NegZero);
|
IOSync [2]=d;
|
||||||
|
IOSync_NegativeZeroFlag[2]=NegZero;
|
||||||
} else if ( sformat(&buf[5], " NNN +N NNNNNNN NN ")) {
|
} else if ( sformat(&buf[5], " NNN +N NNNNNNN NN ")) {
|
||||||
// alternate format for loading IT program (numeric constant in float format)
|
// alternate format for loading IT program (numeric constant in float format)
|
||||||
DRUM[addr + 0] = decode_num_word(&buf[6], 3, 0) * D4; // location (3 digits)
|
IOSync[0] = decode_num_word(&buf[6], 3, 0) * D4; // location (3 digits)
|
||||||
DRUM[addr + 1] = 1 * D4; // word count
|
IOSync[1] = 1 * D4; // word count
|
||||||
NegZero = 0;
|
NegZero = 0;
|
||||||
neg = (buf[10] == '-') ? 1:0;
|
neg = (buf[10] == '-') ? 1:0;
|
||||||
d = decode_num_word(&buf[11], 1, 0) * 10 * D8 + // integer part of mantissa
|
d = decode_num_word(&buf[11], 1, 0) * 10 * D8 + // integer part of mantissa
|
||||||
|
@ -393,24 +400,25 @@ void decode_is_wiring(struct _card_data * data, int addr)
|
||||||
d=-d;
|
d=-d;
|
||||||
if (d==0) NegZero = 1;
|
if (d==0) NegZero = 1;
|
||||||
}
|
}
|
||||||
WriteDrum(addr + 2, d, NegZero);
|
IOSync [2]=d;
|
||||||
|
IOSync_NegativeZeroFlag[2]=NegZero;
|
||||||
} else if ( (sformat(&buf[6], " NNNN NN NNNN NNNN ")) ||
|
} else if ( (sformat(&buf[6], " NNNN NN NNNN NNNN ")) ||
|
||||||
(sformat(&buf[6], " NNNN NN NNNN ")) ||
|
(sformat(&buf[6], " NNNN NN NNNN ")) ||
|
||||||
(sformat(&buf[6], " NNNN NN NNNN ")) ||
|
(sformat(&buf[6], " NNNN NN NNNN ")) ||
|
||||||
(sformat(&buf[6], " NNNN NN "))
|
(sformat(&buf[6], " NNNN NN "))
|
||||||
) {
|
) {
|
||||||
// alternate format for loading main IT system deck
|
// alternate format for loading main IT system deck
|
||||||
DRUM[addr + 0] = decode_num_word(&buf[7], 4, 0) * D4; // location (4 digits)
|
IOSync[0] = decode_num_word(&buf[7], 4, 0) * D4; // location (4 digits)
|
||||||
DRUM[addr + 1] = 1 * D4; // word count = 1
|
IOSync[1] = 1 * D4; // word count = 1
|
||||||
DRUM[addr + 2] = decode_num_word(&buf[12], 2, 1) * D8 + // op
|
IOSync[2] = decode_num_word(&buf[12], 2, 1) * D8 + // op
|
||||||
decode_num_word(&buf[15], 4, 1) * D4 + // data address
|
decode_num_word(&buf[15], 4, 1) * D4 + // data address
|
||||||
decode_num_word(&buf[20], 4, 1); // instr addr, no negative zero allowed
|
decode_num_word(&buf[20], 4, 1); // instr addr, no negative zero allowed
|
||||||
} else {
|
} else {
|
||||||
// regular IT read/punch format
|
// regular IT read/punch format
|
||||||
DRUM[addr + 0] = decode_num_word(&buf[6], 3, 0) * D4; // location (3 digits)
|
IOSync[0] = decode_num_word(&buf[6], 3, 0) * D4; // location (3 digits)
|
||||||
wc = (int) decode_num_word(&buf[9], 1, 1);
|
wc = (int) decode_num_word(&buf[9], 1, 1);
|
||||||
if (wc > 6) wc = 6;
|
if (wc > 6) wc = 6;
|
||||||
DRUM[addr + 1] = wc * D4; // word count
|
IOSync[1] = wc * D4; // word count
|
||||||
for (i=0;i<wc;i++) {
|
for (i=0;i<wc;i++) {
|
||||||
NegZero = 0;
|
NegZero = 0;
|
||||||
neg = (buf[10 + 11*i] == '-') ? 1:0;
|
neg = (buf[10 + 11*i] == '-') ? 1:0;
|
||||||
|
@ -419,13 +427,14 @@ void decode_is_wiring(struct _card_data * data, int addr)
|
||||||
d=-d;
|
d=-d;
|
||||||
if (d==0) NegZero = 1;
|
if (d==0) NegZero = 1;
|
||||||
}
|
}
|
||||||
WriteDrum(addr + 2 + i, d, NegZero);
|
IOSync [2+i]=d;
|
||||||
|
IOSync_NegativeZeroFlag[2+i]=NegZero;
|
||||||
}
|
}
|
||||||
DRUM[addr + 9] = decode_num_word(&buf[76], 3, 1); // problem number
|
IOSync[9] = decode_num_word(&buf[76], 3, 1); // problem number
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void decode_it_wiring(struct _card_data * data, int addr)
|
void decode_it_wiring(struct _card_data * data)
|
||||||
{
|
{
|
||||||
// decode IT compiler card simulating control panel wiring for 533
|
// decode IT compiler card simulating control panel wiring for 533
|
||||||
// from IT manual at http://www.bitsavers.org/pdf/ibm/650/CarnegieInternalTranslator.pdf
|
// from IT manual at http://www.bitsavers.org/pdf/ibm/650/CarnegieInternalTranslator.pdf
|
||||||
|
@ -485,22 +494,143 @@ void decode_it_wiring(struct _card_data * data, int addr)
|
||||||
if (buf[2] == '+') {
|
if (buf[2] == '+') {
|
||||||
// type 1 data card
|
// type 1 data card
|
||||||
// re-read as 8 word per card
|
// re-read as 8 word per card
|
||||||
decode_8word_wiring(data, addr);
|
decode_8word_wiring(data, 0);
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
DRUM[addr + 0] = decode_alpha_word(&buf[42], 5); // Statement (5 chars)
|
IOSync[0] = decode_alpha_word(&buf[42], 5); // Statement (5 chars)
|
||||||
DRUM[addr + 1] = decode_alpha_word(&buf[47], 5); // Statement (5 chars)
|
IOSync[1] = decode_alpha_word(&buf[47], 5); // Statement (5 chars)
|
||||||
DRUM[addr + 2] = decode_alpha_word(&buf[52], 5); // Statement (5 chars)
|
IOSync[2] = decode_alpha_word(&buf[52], 5); // Statement (5 chars)
|
||||||
DRUM[addr + 3] = decode_alpha_word(&buf[57], 5); // Statement (5 chars)
|
IOSync[3] = decode_alpha_word(&buf[57], 5); // Statement (5 chars)
|
||||||
DRUM[addr + 4] = decode_alpha_word(&buf[62], 5); // Statement (5 chars)
|
IOSync[4] = decode_alpha_word(&buf[62], 5); // Statement (5 chars)
|
||||||
DRUM[addr + 5] = decode_alpha_word(&buf[67], 3); // Statement (3 chars)
|
IOSync[5] = decode_alpha_word(&buf[67], 3); // Statement (3 chars)
|
||||||
|
|
||||||
DRUM[addr + 6] = decode_num_word(&buf[0], 4, 1); // Statement Number (space is read as digit zero)
|
IOSync[6] = decode_num_word(&buf[0], 4, 1); // Statement Number (space is read as digit zero)
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void decode_fortransit_wiring(struct _card_data * data)
|
||||||
|
{
|
||||||
|
// decode FORTRANSIT translator card simulating control panel wiring for 533
|
||||||
|
// from FORTRANSIT manual at http://bitsavers.org/pdf/ibm/650/28-4028_FOR_TRANSIT.pdf
|
||||||
|
// implemented Fortransit II (S)
|
||||||
|
// fortran source program input card
|
||||||
|
// Column: 1 | 2 3 4 5 | 6 | 7 - 36 | 37 - 80 |
|
||||||
|
// C | N N N N | cont | Statement | Blank |
|
||||||
|
//
|
||||||
|
// C = Blank or Comment if C is present
|
||||||
|
// NNNN = Blank or statement number
|
||||||
|
// cont = Blank or non-blank/non-zero for continuation card
|
||||||
|
//
|
||||||
|
// storage in input block
|
||||||
|
// +-------------------+
|
||||||
|
// Word 1951: | <- Statement -> | Alphabetic
|
||||||
|
// 1952: | <- Statement -> | Alphabetic
|
||||||
|
// 1953: | <- Statement -> | Alphabetic
|
||||||
|
// 1954: | <- Statement -> | Alphabetic
|
||||||
|
// 1955: | <- Statement -> | Alphabetic
|
||||||
|
// 1956: | <- Statement -> | Alphabetic
|
||||||
|
// +-------------------+
|
||||||
|
// 1957: | | Not used
|
||||||
|
// 1958: | | Not used
|
||||||
|
// 1959: | | Not used
|
||||||
|
// +-+-+-------+-------+
|
||||||
|
// 1960: |m t| |N N N N| m = 8/0 (8 -> comment card)
|
||||||
|
// +---+-------+-------+ t = 8/0 (8 -> continuatin card)
|
||||||
|
// NNNN = statement sumber
|
||||||
|
//
|
||||||
|
// it source program input card
|
||||||
|
// Column: 1 2 3 4 | 5 | 6 - 42 | 43 - 70 | 71 72 | 73 - 80 |
|
||||||
|
// N N N N | + | | Statement | | Comments |
|
||||||
|
// Statement | Y(12) | | max 28 | | max 8 |
|
||||||
|
// Number | Punch | | chars | | chars |
|
||||||
|
//
|
||||||
|
// storage in input block
|
||||||
|
// +-------------------+
|
||||||
|
// Word 0051: | <- Statement -> | Alphabetic
|
||||||
|
// 0052: | <- Statement -> | Alphabetic
|
||||||
|
// 0053: | <- Statement -> | Alphabetic
|
||||||
|
// 0054: | <- Statement -> | Alphabetic
|
||||||
|
// 0055: | <- Statement -> | Alphabetic
|
||||||
|
// 0056: | <- Statement -> | Alphabetic
|
||||||
|
// +-+-+-+-+-+-|-+-+-+-|
|
||||||
|
// 0057: | |N N N N| Statement Number
|
||||||
|
// +-+-+-+-+-+-|-+-+-+-|
|
||||||
|
// 0058: | | Not used
|
||||||
|
// 0059: | | Not used
|
||||||
|
// 0060: | | Not used
|
||||||
|
// +-------------------+
|
||||||
|
//
|
||||||
|
// fortransit input data card
|
||||||
|
// Column: 1 - 10 | 11 - 20 | 21 - 30 | 31 - 40 | 41 - 50 | 51 - 60 | 61 - 70 | 71 72 | 73 | 74 - 80 |
|
||||||
|
// Word1 | Word2 | Word3 | Word4 | Word5 | Word6 | Word7 | | + |
|
||||||
|
// | Y(12) |
|
||||||
|
// Word = word to be loaded into FORTRANSITIT variable. Must match the variable type where it is read in
|
||||||
|
// float (MMMMMMMM EE -> M=mantisa, EE=exponent, 1000000051 is 1.0)
|
||||||
|
// fixed (NNNNNNNNNN -> 000000030J is -302)
|
||||||
|
// if word is negative, last digit get X(11) overpunch
|
||||||
|
// If last digit of word has X(11) punch whole word is set as negative value
|
||||||
|
// If N is non numeric, a 0 is assumed
|
||||||
|
//
|
||||||
|
// storage in input block
|
||||||
|
// +-------------------+
|
||||||
|
// Word 1951: | <- Word1 -> |
|
||||||
|
// 1952: | <- Word2 -> |
|
||||||
|
// 1953: | <- Word3 -> |
|
||||||
|
// 1954: | <- Word4 -> |
|
||||||
|
// 1955: | <- Word5 -> |
|
||||||
|
// 1956: | <- Word6 -> |
|
||||||
|
// 1957: | <- Word7 -> |
|
||||||
|
// +-------------------+
|
||||||
|
// 1958: | | Not used
|
||||||
|
// 1959: | | Not used
|
||||||
|
// 1960: | | Not used
|
||||||
|
// +-------------------+
|
||||||
|
//
|
||||||
|
char buf[81];
|
||||||
|
int i;
|
||||||
|
uint16 c1,c2;
|
||||||
|
|
||||||
|
// convert card image punches to ascii buf for processing
|
||||||
|
// keep 026 fortran charset
|
||||||
|
for (i=0;i<80;i++) {
|
||||||
|
c1 = data->image[i];
|
||||||
|
c2 = data->hol_to_ascii[c1];
|
||||||
|
c2 = toupper(c2);
|
||||||
|
c2 = (strchr(mem_to_ascii, c2)) ? c2:' ';
|
||||||
|
if (c2 == '~') c2 = ' ';
|
||||||
|
buf[i] = (char) c2;
|
||||||
|
}
|
||||||
|
buf[80] = 0; // terminate string
|
||||||
|
|
||||||
|
if (buf[72] == '+') {
|
||||||
|
// read data card input for READ fortransit command
|
||||||
|
// re-read as 8 word per card
|
||||||
|
decode_8word_wiring(data, 0);
|
||||||
|
return;
|
||||||
|
} else if (buf[4] == '+') {
|
||||||
|
// it source statement
|
||||||
|
IOSync[0] = decode_alpha_word(&buf[42], 5); // Statement (5 chars)
|
||||||
|
IOSync[1] = decode_alpha_word(&buf[47], 5); // Statement (5 chars)
|
||||||
|
IOSync[2] = decode_alpha_word(&buf[52], 5); // Statement (5 chars)
|
||||||
|
IOSync[3] = decode_alpha_word(&buf[57], 5); // Statement (5 chars)
|
||||||
|
IOSync[4] = decode_alpha_word(&buf[62], 5); // Statement (5 chars)
|
||||||
|
IOSync[5] = decode_alpha_word(&buf[67], 5); // Statement (5 chars)
|
||||||
|
|
||||||
|
IOSync[6] = decode_num_word(&buf[0], 4, 1); // Statement Number (space is read as digit zero)
|
||||||
|
} else {
|
||||||
|
// fortran source statement
|
||||||
|
IOSync[0] = decode_alpha_word(&buf[6], 5); // Statement (5 chars)
|
||||||
|
IOSync[1] = decode_alpha_word(&buf[11], 5); // Statement (5 chars)
|
||||||
|
IOSync[2] = decode_alpha_word(&buf[16], 5); // Statement (5 chars)
|
||||||
|
IOSync[3] = decode_alpha_word(&buf[21], 5); // Statement (5 chars)
|
||||||
|
IOSync[4] = decode_alpha_word(&buf[26], 5); // Statement (5 chars)
|
||||||
|
IOSync[5] = decode_alpha_word(&buf[31], 5); // Statement (5 chars)
|
||||||
|
|
||||||
|
IOSync[9] = ( (buf[0] == 'C') ? (t_int64) 80 * D8 : 0 ) + // is a comment card
|
||||||
|
( ((buf[5] != ' ') && (buf[5] != 0)) ? (t_int64) 8 * D8 : 0 ) + // continuation line
|
||||||
|
( decode_num_word(&buf[1], 4, 1) ); // statement number
|
||||||
|
}
|
||||||
|
}
|
||||||
/*
|
/*
|
||||||
* Device entry points for card reader.
|
* Device entry points for card reader.
|
||||||
*/
|
*/
|
||||||
|
@ -510,13 +640,17 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
|
||||||
uint32 wiring;
|
uint32 wiring;
|
||||||
int i;
|
int i;
|
||||||
char cbuf[81];
|
char cbuf[81];
|
||||||
|
int ncdr, ic;
|
||||||
|
|
||||||
/* Are we currently tranfering? */
|
/* Are we currently tranfering? */
|
||||||
if (uptr->u5 & URCSTA_BUSY)
|
if (uptr->u5 & URCSTA_BUSY)
|
||||||
return SCPE_BUSY;
|
return SCPE_BUSY;
|
||||||
|
|
||||||
// clear read buffer in drum (where words read from cards will be stored)
|
// clear IO Sync buffer (where words read from cards will be stored)
|
||||||
for (i=0;i<10;i++) WriteDrum(addr + i, 0, 0);
|
for (i=0;i<10;i++) {
|
||||||
|
IOSync [i]=0;
|
||||||
|
IOSync_NegativeZeroFlag[i]=0;
|
||||||
|
}
|
||||||
|
|
||||||
/* Test ready */
|
/* Test ready */
|
||||||
if ((uptr->flags & UNIT_ATT) == 0) {
|
if ((uptr->flags & UNIT_ATT) == 0) {
|
||||||
|
@ -553,29 +687,40 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
|
||||||
cbuf[80] = 0; // terminate string
|
cbuf[80] = 0; // terminate string
|
||||||
sim_debug(DEBUG_DETAIL, &cpu_dev, "Read Card: %s\n", sim_trim_endspc(cbuf));
|
sim_debug(DEBUG_DETAIL, &cpu_dev, "Read Card: %s\n", sim_trim_endspc(cbuf));
|
||||||
|
|
||||||
|
// save read card in last read card buffer to be eventually printed
|
||||||
|
// by carddec echolast scp command
|
||||||
|
ncdr = uptr - &cdr_unit[1]; // ncdr is the card reader: 0 for cdr1, 1 for cdr2, 2 for cdr3
|
||||||
|
if ((ncdr >= 0) && (ncdr < 3)) { // safety check, not needed (should allways be true) but just to be sure
|
||||||
|
// advance read buffer last card
|
||||||
|
ReadHopperLast[ncdr] = (ReadHopperLast[ncdr] + 1) % MAX_CARDS_IN_READ_TAKE_HOPPER;
|
||||||
|
// save card in read card hopper buffer
|
||||||
|
ic = (ncdr * MAX_CARDS_IN_READ_TAKE_HOPPER + ReadHopperLast[ncdr]) * 80;
|
||||||
|
for (i=0; i<80; i++) ReadHopper[ic + i] = cbuf[i];
|
||||||
|
}
|
||||||
|
|
||||||
// uint16 data->image[] array that holds the actual punched rows on card
|
// uint16 data->image[] array that holds the actual punched rows on card
|
||||||
// using this codification:
|
// using this codification:
|
||||||
//
|
//
|
||||||
// Row Name value in image[] comments
|
// Row Name value in image[] comments
|
||||||
//
|
//
|
||||||
// Y 0x800 Hi Punch Y(12)
|
// Y 0x800 Hi Punch Y(12)
|
||||||
// X 0x400 Minus Punch X(11)
|
// X 0x400 Minus Punch X(11)
|
||||||
// 0 0x200 also called T (Ten, 10)
|
// 0 0x200 also called T (Ten, 10)
|
||||||
// 1 0x100
|
// 1 0x100
|
||||||
// 2 0x080
|
// 2 0x080
|
||||||
// 3 0x040
|
// 3 0x040
|
||||||
// 4 0x020
|
// 4 0x020
|
||||||
// 5 0x010
|
// 5 0x010
|
||||||
// 6 0x008
|
// 6 0x008
|
||||||
// 7 0x004
|
// 7 0x004
|
||||||
// 8 0x002
|
// 8 0x002
|
||||||
// 9 0x001
|
// 9 0x001
|
||||||
//
|
//
|
||||||
// If several columns are punched, the values are ORed: eg char A is represented as a punch
|
// If several columns are punched, the values are ORed: eg char A is represented as a punch
|
||||||
// on row Y and row 1, so it value in image array will be 0x800 | 0x100 -> 0x900
|
// on row Y and row 1, so it value in image array will be 0x800 | 0x100 -> 0x900
|
||||||
|
|
||||||
// check if it is a load card (Y(12) = HiPunch set on any column of card) signales it
|
// check if it is a load card (Y(12) = HiPunch set on any column of card) signales it
|
||||||
if (decode_8word_wiring(data, -1)) {
|
if (decode_8word_wiring(data, 1)) {
|
||||||
uptr->u5 |= URCSTA_LOAD;
|
uptr->u5 |= URCSTA_LOAD;
|
||||||
} else {
|
} else {
|
||||||
uptr->u5 &= ~URCSTA_LOAD;
|
uptr->u5 &= ~URCSTA_LOAD;
|
||||||
|
@ -583,27 +728,30 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
|
||||||
|
|
||||||
wiring = (uptr->flags & UNIT_CARD_WIRING);
|
wiring = (uptr->flags & UNIT_CARD_WIRING);
|
||||||
|
|
||||||
// translate chars read from card and copy to drum memory words
|
// translate chars read from card and copy to memory words
|
||||||
// using the control panel wiring.
|
// using the control panel wiring.
|
||||||
if (uptr->u5 & URCSTA_LOAD) {
|
if (uptr->u5 & URCSTA_LOAD) {
|
||||||
// load card -> use 8 words per card encoding
|
// load card -> use 8 words per card encoding
|
||||||
decode_8word_wiring(data, addr);
|
decode_8word_wiring(data, 0);
|
||||||
if (uptr->u5 & URCSTA_SOAPSYMB) {
|
if (uptr->u5 & URCSTA_SOAPSYMB) {
|
||||||
// requested to load soap symb info
|
// requested to load soap symb info
|
||||||
decode_soap_symb_info(data, addr);
|
decode_soap_symb_info(data);
|
||||||
}
|
}
|
||||||
} else if (wiring == WIRING_SOAP) {
|
} else if (wiring == WIRING_SOAP) {
|
||||||
// decode soap card simulating soap control panel wiring for 533 (gasp!)
|
// decode soap card simulating soap control panel wiring for 533 (gasp!)
|
||||||
decode_soap_wiring(data, addr);
|
decode_soap_wiring(data);
|
||||||
} else if (wiring == WIRING_IS) {
|
} else if (wiring == WIRING_IS) {
|
||||||
// decode floating point interpretive system (bell interpreter) card
|
// decode floating point interpretive system (bell interpreter) card
|
||||||
decode_is_wiring(data, addr);
|
decode_is_wiring(data);
|
||||||
} else if (wiring == WIRING_IT) {
|
} else if (wiring == WIRING_IT) {
|
||||||
// decode Carnegie Internal Translator compiler card
|
// decode Carnegie Internal Translator compiler card
|
||||||
decode_it_wiring(data, addr);
|
decode_it_wiring(data);
|
||||||
|
} else if (wiring == WIRING_FORTRANSIT) {
|
||||||
|
// decode Fortransit translator card
|
||||||
|
decode_fortransit_wiring(data);
|
||||||
} else {
|
} else {
|
||||||
// default wiring: decode up to 8 numerical words per card. Can be a load card
|
// default wiring: decode up to 8 numerical words per card. Can be a load card
|
||||||
decode_8word_wiring(data, addr);
|
decode_8word_wiring(data, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
uptr->u5 &= ~URCSTA_BUSY;
|
uptr->u5 &= ~URCSTA_BUSY;
|
||||||
|
@ -656,6 +804,7 @@ t_stat
|
||||||
cdr_attach(UNIT * uptr, CONST char *file)
|
cdr_attach(UNIT * uptr, CONST char *file)
|
||||||
{
|
{
|
||||||
t_stat r;
|
t_stat r;
|
||||||
|
int ncdr, ic1, ic2, i;
|
||||||
|
|
||||||
if (uptr->flags & UNIT_ATT) // remove current deck in read hopper before attaching
|
if (uptr->flags & UNIT_ATT) // remove current deck in read hopper before attaching
|
||||||
sim_card_detach(uptr); // the new one
|
sim_card_detach(uptr); // the new one
|
||||||
|
@ -669,6 +818,17 @@ cdr_attach(UNIT * uptr, CONST char *file)
|
||||||
if (sim_switches & SWMASK ('L')) { /* Load Symbolic SOAP info? */
|
if (sim_switches & SWMASK ('L')) { /* Load Symbolic SOAP info? */
|
||||||
uptr->u5 |= URCSTA_SOAPSYMB;
|
uptr->u5 |= URCSTA_SOAPSYMB;
|
||||||
}
|
}
|
||||||
|
// clear read card take hopper buffer
|
||||||
|
ncdr = uptr - &cdr_unit[1]; // ncdr is the card reader: 0 for cdr1, 1 for cdr2, 2 for cdr3
|
||||||
|
if ((ncdr >= 0) && (ncdr < 3)) { // safety check, not needed (should allways be true) but just to be sure
|
||||||
|
// reset last read card number
|
||||||
|
ReadHopperLast[ncdr] = 0;
|
||||||
|
// clear buffer
|
||||||
|
ic1 = (ncdr * MAX_CARDS_IN_READ_TAKE_HOPPER) * 80;
|
||||||
|
ic2 = ic1 + MAX_CARDS_IN_READ_TAKE_HOPPER * 80;
|
||||||
|
for (i=ic1; i<ic2; i++) ReadHopper[i] = 0;
|
||||||
|
}
|
||||||
|
|
||||||
return SCPE_OK;
|
return SCPE_OK;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
1163
I650/i650_cpu.c
1163
I650/i650_cpu.c
File diff suppressed because it is too large
Load diff
247
I650/i650_defs.h
247
I650/i650_defs.h
|
@ -36,17 +36,28 @@
|
||||||
|
|
||||||
|
|
||||||
/* Memory */
|
/* Memory */
|
||||||
#define MAXMEMSIZE (4000)
|
#define MAXDRUMSIZE (4000)
|
||||||
#define MEMSIZE cpu_unit.capac /* actual memory size */
|
#define DRUMSIZE ((int)(cpu_unit.capac % 10) * 1000) /* actual drum memory size */
|
||||||
#define MEMMASK (MEMSIZE - 1) /* Memory bits */
|
|
||||||
|
|
||||||
#define MEM_ADDR_OK(x) (((uint32) (x)) < MEMSIZE)
|
extern t_int64 DRUM[MAXDRUMSIZE];
|
||||||
extern t_int64 DRUM[MAXMEMSIZE];
|
extern int DRUM_NegativeZeroFlag[MAXDRUMSIZE];
|
||||||
extern int DRUM_NegativeZeroFlag[MAXMEMSIZE];
|
extern char DRUM_Symbolic_Buffer[MAXDRUMSIZE * 80];
|
||||||
extern char DRUM_Symbolic_Buffer[MAXMEMSIZE * 80];
|
|
||||||
|
extern t_int64 IOSync[10];
|
||||||
|
extern int IOSync_NegativeZeroFlag[10];
|
||||||
|
|
||||||
|
#define STOR (cpu_unit.flags & OPTION_STOR)
|
||||||
|
#define CNTRL (cpu_unit.flags & OPTION_CNTRL)
|
||||||
|
#define FAST (cpu_unit.flags & OPTION_FAST)
|
||||||
|
|
||||||
|
extern t_int64 IAS[60];
|
||||||
|
extern int IAS_NegativeZeroFlag[60];
|
||||||
|
extern int IAS_TimingRing;
|
||||||
|
|
||||||
|
extern int WriteAddr(int AR, t_int64 d, int NegZero);
|
||||||
|
extern int ReadAddr(int AR, t_int64 * d, int * NegZero);
|
||||||
|
extern CONST char * DecodeOpcode(t_int64 d, int * opcode, int * DA, int * IA);
|
||||||
|
|
||||||
extern int WriteDrum(int AR, t_int64 d, int NegZero);
|
|
||||||
extern int ReadDrum(int AR, t_int64 * d, int * NegZero);
|
|
||||||
|
|
||||||
/* digits contants */
|
/* digits contants */
|
||||||
#define D10 (10000000000LL) // ten digits (10 zeroes)
|
#define D10 (10000000000LL) // ten digits (10 zeroes)
|
||||||
|
@ -86,10 +97,16 @@ extern DEBTAB crd_debug[];
|
||||||
extern DEVICE cp_dev;
|
extern DEVICE cp_dev;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
// max number of cards in deck for carddeck internal command
|
||||||
|
#define MAX_CARDS_IN_DECK 10000
|
||||||
|
#define MAX_CARDS_IN_READ_TAKE_HOPPER 10
|
||||||
|
|
||||||
extern DIB cdr_dib;
|
extern DIB cdr_dib;
|
||||||
extern DEVICE cdr_dev;
|
extern DEVICE cdr_dev;
|
||||||
extern uint32 cdr_cmd(UNIT *, uint16, uint16);
|
extern uint32 cdr_cmd(UNIT *, uint16, uint16);
|
||||||
extern UNIT cdr_unit[4];
|
extern UNIT cdr_unit[4];
|
||||||
|
extern char ReadHopper[3 * MAX_CARDS_IN_READ_TAKE_HOPPER * 80];
|
||||||
|
extern int ReadHopperLast[3];
|
||||||
|
|
||||||
extern DIB cdp_dib;
|
extern DIB cdp_dib;
|
||||||
extern DEVICE cdp_dev;
|
extern DEVICE cdp_dev;
|
||||||
|
@ -103,58 +120,6 @@ extern UNIT cdp_unit[4];
|
||||||
#define URCSTA_SOAPSYMB 02000 /* Get soap symbolic info when reading the card */
|
#define URCSTA_SOAPSYMB 02000 /* Get soap symbolic info when reading the card */
|
||||||
|
|
||||||
|
|
||||||
/* Character codes in IBM 650 as stated in p4 Andree Programming the IBM 650 Mag Drum
|
|
||||||
Also stated in www.bitsavers.org/pdf/ibm/650/28-4028_FOR_TRANSIT.pdf p37
|
|
||||||
*/
|
|
||||||
#define CHR_BLANK 00
|
|
||||||
#define CHR_DOT 18 // card code: 12-3-8 .
|
|
||||||
#define CHR_RPARENT 19 // 12-4-8 )
|
|
||||||
#define CHR_AMPERSAND 20 // 12 +
|
|
||||||
#define CHR_DOLLAR 28 // 11-3-8 $
|
|
||||||
#define CHR_STAR 29 // 11-4-8 *
|
|
||||||
#define CHR_NEG 30 // 11 - minus sign for negative value
|
|
||||||
#define CHR_SLASH 31 // 0-1 /
|
|
||||||
#define CHR_COMMA 38 // 0-3-8 ,
|
|
||||||
#define CHR_LPARENT 39 // 0-4-8 (
|
|
||||||
#define CHR_EQUAL 48 // 3-8 =
|
|
||||||
#define CHR_MINUS 49 // 4-8 -
|
|
||||||
#define CHR_A 61
|
|
||||||
#define CHR_B 62
|
|
||||||
#define CHR_C 63
|
|
||||||
#define CHR_D 64
|
|
||||||
#define CHR_E 65
|
|
||||||
#define CHR_F 66
|
|
||||||
#define CHR_G 67
|
|
||||||
#define CHR_H 68
|
|
||||||
#define CHR_I 69
|
|
||||||
#define CHR_J 71
|
|
||||||
#define CHR_K 72
|
|
||||||
#define CHR_L 73
|
|
||||||
#define CHR_M 74
|
|
||||||
#define CHR_N 75
|
|
||||||
#define CHR_O 76
|
|
||||||
#define CHR_P 77
|
|
||||||
#define CHR_Q 78
|
|
||||||
#define CHR_R 79
|
|
||||||
#define CHR_S 82
|
|
||||||
#define CHR_T 83
|
|
||||||
#define CHR_U 84
|
|
||||||
#define CHR_V 85
|
|
||||||
#define CHR_W 86
|
|
||||||
#define CHR_X 87
|
|
||||||
#define CHR_Y 88
|
|
||||||
#define CHR_Z 89
|
|
||||||
#define CHR_0 90
|
|
||||||
#define CHR_1 91
|
|
||||||
#define CHR_2 92
|
|
||||||
#define CHR_3 93
|
|
||||||
#define CHR_4 94
|
|
||||||
#define CHR_5 95
|
|
||||||
#define CHR_6 96
|
|
||||||
#define CHR_7 97
|
|
||||||
#define CHR_8 98
|
|
||||||
#define CHR_9 99
|
|
||||||
|
|
||||||
extern struct card_wirings {
|
extern struct card_wirings {
|
||||||
uint32 mode;
|
uint32 mode;
|
||||||
const char *name;
|
const char *name;
|
||||||
|
@ -178,6 +143,7 @@ extern int cycle_time;
|
||||||
extern const char *cpu_description(DEVICE *dptr);
|
extern const char *cpu_description(DEVICE *dptr);
|
||||||
|
|
||||||
/* Opcodes */
|
/* Opcodes */
|
||||||
|
// Instructions on Basic machine
|
||||||
#define OP_AABL 17 // Add absolute to lower accumulator
|
#define OP_AABL 17 // Add absolute to lower accumulator
|
||||||
#define OP_AL 15 // Add to lower accumulator
|
#define OP_AL 15 // Add to lower accumulator
|
||||||
#define OP_AU 10 // Add to upper accumulator
|
#define OP_AU 10 // Add to upper accumulator
|
||||||
|
@ -195,33 +161,136 @@ extern const char *cpu_description(DEVICE *dptr);
|
||||||
#define OP_BRD8 98
|
#define OP_BRD8 98
|
||||||
#define OP_BRD9 99
|
#define OP_BRD9 99
|
||||||
#define OP_BRD10 90
|
#define OP_BRD10 90
|
||||||
#define OP_DIV 14 // Divide
|
#define OP_DIV 14 // Divide
|
||||||
#define OP_DIVRU 64 // Divide and reset upper accumulator
|
#define OP_DIVRU 64 // Divide and reset upper accumulator
|
||||||
#define OP_LD 69 // Load distributor
|
#define OP_LD 69 // Load distributor
|
||||||
#define OP_MULT 19 // Multiply
|
#define OP_MULT 19 // Multiply
|
||||||
#define OP_NOOP 00 // No operation
|
#define OP_NOOP 00 // No operation
|
||||||
#define OP_PCH 71 // Punch a card
|
#define OP_PCH 71 // Punch a card
|
||||||
#define OP_RD 70 // Read a card
|
#define OP_RD 70 // Read a card
|
||||||
#define OP_RAABL 67 // Reset accumulator and add absolute to lower accumulator
|
#define OP_RAABL 67 // Reset accumulator and add absolute to lower accumulator
|
||||||
#define OP_RAL 65 // Reset accumulator and add to lower accumulator
|
#define OP_RAL 65 // Reset accumulator and add to lower accumulator
|
||||||
#define OP_RAU 60 // Reset accumulator and add to upper accumulator
|
#define OP_RAU 60 // Reset accumulator and add to upper accumulator
|
||||||
#define OP_RSABL 68 // Reset accumulator and subtract absolute from lower accumulator
|
#define OP_RSABL 68 // Reset accumulator and subtract absolute from lower accumulator
|
||||||
#define OP_RSL 66 // Reset accumulator and subtract from lower accumulator
|
#define OP_RSL 66 // Reset accumulator and subtract from lower accumulator
|
||||||
#define OP_RSU 61 // Reset accumulator and subtract from upper accumulator
|
#define OP_RSU 61 // Reset accumulator and subtract from upper accumulator
|
||||||
#define OP_SLT 35 // Shift accumulator left
|
#define OP_SLT 35 // Shift accumulator left
|
||||||
#define OP_SCT 36 // Shift accumulator left and count
|
#define OP_SCT 36 // Shift accumulator left and count
|
||||||
#define OP_SRT 30 // Shift accumulator right
|
#define OP_SRT 30 // Shift accumulator right
|
||||||
#define OP_SRD 31 // Shift accumulator right and round accumulator
|
#define OP_SRD 31 // Shift accumulator right and round accumulator
|
||||||
#define OP_STOP 01 // Stop if console switch is set to stop, otherwise continue as a NO-OP
|
#define OP_STOP 01 // Stop if console switch is set to stop, otherwise continue as a NO-OP
|
||||||
#define OP_STD 24 // Store distributor into memory
|
#define OP_STD 24 // Store distributor into memory
|
||||||
#define OP_STDA 22 // Store lower accumulator data address into distributor, then store distributor into memory
|
#define OP_STDA 22 // Store lower accumulator data address into distributor, then store distributor into memory
|
||||||
#define OP_STIA 23 // Store lower accumulator instruction address into distributor, then store distributor into memory
|
#define OP_STIA 23 // Store lower accumulator instruction address into distributor, then store distributor into memory
|
||||||
#define OP_STL 20 // Store lower accumulator into memory
|
#define OP_STL 20 // Store lower accumulator into memory
|
||||||
#define OP_STU 21 // Store upper accumulator into memory
|
#define OP_STU 21 // Store upper accumulator into memory
|
||||||
#define OP_SABL 18 // Subtract absolute from lower accumulator
|
#define OP_SABL 18 // Subtract absolute from lower accumulator
|
||||||
#define OP_SL 16 // Subtract from lower accumulator
|
#define OP_SL 16 // Subtract from lower accumulator
|
||||||
#define OP_SU 11 // Subtract from upper accumulator
|
#define OP_SU 11 // Subtract from upper accumulator
|
||||||
#define OP_TLU 84 // Table lookup
|
#define OP_TLU 84 // Table lookup
|
||||||
|
// Instructions on Storage Unit
|
||||||
|
// opcodes for indexing
|
||||||
|
#define OP_AXA 50 // Add to index register A
|
||||||
|
#define OP_SXA 51 // Substract from index A
|
||||||
|
#define OP_RAA 80 // Reset Add Index A
|
||||||
|
#define OP_RSA 81 // Reset Substract Index A
|
||||||
|
#define OP_NZA 40 // Branch Non Zero Index A
|
||||||
|
#define OP_BMA 41 // Branch Minus Index A
|
||||||
|
#define OP_AXB 52 // Add to index register B
|
||||||
|
#define OP_SXB 53 // Substract from index B
|
||||||
|
#define OP_RAB 82 // Reset Add Index B
|
||||||
|
#define OP_RSB 83 // Reset Substract Index B
|
||||||
|
#define OP_NZB 42 // Branch Non Zero Index B
|
||||||
|
#define OP_BMB 43 // Branch Minus Index B
|
||||||
|
#define OP_AXC 58 // Add to index register C
|
||||||
|
#define OP_SXC 59 // Substract from index C
|
||||||
|
#define OP_RAC 88 // Reset Add Index C
|
||||||
|
#define OP_RSC 89 // Reset Substract Index C
|
||||||
|
#define OP_NZC 48 // Branch Non Zero Index C
|
||||||
|
#define OP_BMC 49 // Branch Minus Index C
|
||||||
|
// io for synchronizers 2 & 3
|
||||||
|
#define OP_RC1 72 // Read Conditional sync 1
|
||||||
|
#define OP_RD2 73 // Read Sync 2
|
||||||
|
#define OP_WR2 74 // Write Sync 2
|
||||||
|
#define OP_RC2 75 // Read Conditional Sync 2
|
||||||
|
#define OP_RD3 76 // Read Sync 3
|
||||||
|
#define OP_WR3 77 // Write Sync 3
|
||||||
|
#define OP_RC3 78 // Read Conditional Sync 3
|
||||||
|
// immediate access storage (ias)
|
||||||
|
#define OP_LIB 8 // Load IAS block
|
||||||
|
#define OP_LDI 9 // Load IAS
|
||||||
|
#define OP_SIB 28 // Store IAS Block
|
||||||
|
#define OP_STI 29 // Store IAS
|
||||||
|
#define OP_SET 27 // Set IAS Timing Ring
|
||||||
|
// floating point
|
||||||
|
#define OP_FAD 32 // Floating Add
|
||||||
|
#define OP_FSB 33 // Floating Subtract
|
||||||
|
#define OP_FMP 39 // Floating Multiply
|
||||||
|
#define OP_FDV 34 // Floating Divide
|
||||||
|
#define OP_UFA 02 // Unnormalized Floating Add
|
||||||
|
#define OP_FAM 37 // Floating Add Absolute (Magnitude)
|
||||||
|
#define OP_FSM 38 // Floating Subtract Absolute (Magnitude)
|
||||||
|
// Instructions on Control Unit
|
||||||
|
// tape
|
||||||
|
#define OP_RTN 04 // Read Tape Numeric
|
||||||
|
#define OP_RTA 05 // Read Tape Alphameric
|
||||||
|
#define OP_WTN 06 // Write Tape Numeric
|
||||||
|
#define OP_WTA 07 // Write Tape Alphameric
|
||||||
|
#define OP_RTC 03 // Read Tape for Checking
|
||||||
|
#define OP_NTS 25 // Branch no Tape Signal
|
||||||
|
#define OP_NEF 54 // Branch no End of File
|
||||||
|
#define OP_RWD 55 // Rewind Tape
|
||||||
|
#define OP_WTM 56 // Write Tape Mark
|
||||||
|
#define OP_BST 57 // Backspace Tape
|
||||||
|
// ramac disk
|
||||||
|
#define OP_SDS 85 // Seek Disk Storage
|
||||||
|
#define OP_RDS 86 // Read Disk Storage
|
||||||
|
#define OP_WDS 87 // Write Disk Storage
|
||||||
|
// inquiry stations
|
||||||
|
#define OP_BIN 26 // Branch on Inquiry
|
||||||
|
#define OP_RPY 79 // Reply on Inquiry
|
||||||
|
|
||||||
|
// Valid Data Address (DA)
|
||||||
|
#define vda_D 1 // 0000-1999 Drum
|
||||||
|
#define vda_A 2 // 8000-8003 Arithmetic unit registers (ACC Low & Hi), Distributor, Console Switches register
|
||||||
|
#define vda_I 4 // 8005-8007 Index Registers (IR)
|
||||||
|
#define vda_T 8 // 8010-8015 Tape address
|
||||||
|
#define vda_S 16 // 9000-9059 Immediate Access Storage (IAS)
|
||||||
|
#define vda_9000 32 // 9000 Only addr 9000 valid
|
||||||
|
|
||||||
|
#define vda_DAITS (vda_D | vda_A | vda_I | vda_T | vda_S )
|
||||||
|
#define vda_DAIS (vda_D | vda_A | vda_I | vda_S )
|
||||||
|
#define vda_DAS (vda_D | vda_A | vda_S )
|
||||||
|
#define vda_DS (vda_D | vda_S )
|
||||||
|
|
||||||
|
#define opReadDA 1 // opcode fetchs data from DA address
|
||||||
|
#define opWriteDA 2 // opcode write data to DA
|
||||||
|
|
||||||
|
#define opStorUnit 1 // opcode available if IBM 653 Storage Unit is present
|
||||||
|
#define opCntrlUnit 2 // opcode available if IBM 652 Control Unit is present
|
||||||
|
|
||||||
|
#define IL_RD1 1 // interlock on drum area 01-10/51-60 used in reading with RD1
|
||||||
|
#define IL_WR1 2 // interlock on drum area 27-36/77-86 used in writing for WR1
|
||||||
|
#define IL_RD23 3 // interlock on drum area 39-48/89-98 used in reading with RD2/RD3
|
||||||
|
#define IL_WR23 4 // interlock on drum area 13-22/63-72 used in writing for WR2/WR3
|
||||||
|
#define IL_IAS 5 // interlock on ias access
|
||||||
|
#define IL_array 6 // interlock array definition value
|
||||||
|
|
||||||
|
/* Symbol tables */
|
||||||
|
typedef struct
|
||||||
|
{
|
||||||
|
uint16 opbase; // opcode number
|
||||||
|
const char *name1; // opcode name as in operation manual
|
||||||
|
const char *name2; // opcode name as in soap
|
||||||
|
uint8 opRW; // =wDA, rDA or zero
|
||||||
|
int option; // =0 -> opcode in basic machine, =1 -> Opcode because Storage Unit, =2 -> Opcode because Control Unit
|
||||||
|
int validDA; // valid data address for this instruction
|
||||||
|
int opInterLock; // Interlock required by opcode
|
||||||
|
}
|
||||||
|
t_opcode;
|
||||||
|
|
||||||
|
extern t_opcode base_ops[100];
|
||||||
|
|
||||||
|
|
||||||
#define NEGZERO_value 0x7fffFFFFffffFFFF
|
#define NEGZERO_value 0x7fffFFFFffffFFFF
|
||||||
#define AccNegative (((AccNegativeZeroFlag) || (ACC[1]<0) || (ACC[0]<0)) ? 1:0)
|
#define AccNegative (((AccNegativeZeroFlag) || (ACC[1]<0) || (ACC[0]<0)) ? 1:0)
|
||||||
|
@ -237,6 +306,7 @@ extern const char *cpu_description(DEVICE *dptr);
|
||||||
#define WIRING_SOAP ( 0x100 << UNIT_V_CARD_MODE)
|
#define WIRING_SOAP ( 0x100 << UNIT_V_CARD_MODE)
|
||||||
#define WIRING_IS ( 0x200 << UNIT_V_CARD_MODE)
|
#define WIRING_IS ( 0x200 << UNIT_V_CARD_MODE)
|
||||||
#define WIRING_IT ( 0x300 << UNIT_V_CARD_MODE)
|
#define WIRING_IT ( 0x300 << UNIT_V_CARD_MODE)
|
||||||
|
#define WIRING_FORTRANSIT ( 0x400 << UNIT_V_CARD_MODE)
|
||||||
#define UNIT_CARD_ECHO ( 0x1000 << UNIT_V_CARD_MODE)
|
#define UNIT_CARD_ECHO ( 0x1000 << UNIT_V_CARD_MODE)
|
||||||
#define UNIT_CARD_PRINT ( 0x2000 << UNIT_V_CARD_MODE)
|
#define UNIT_CARD_PRINT ( 0x2000 << UNIT_V_CARD_MODE)
|
||||||
|
|
||||||
|
@ -246,3 +316,4 @@ extern int Shift_Digits(t_int64 * d, int nDigits);
|
||||||
extern char * word_to_ascii(char * buf, int CharStart, int CharLen, t_int64 d);
|
extern char * word_to_ascii(char * buf, int CharStart, int CharLen, t_int64 d);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
412
I650/i650_sys.c
412
I650/i650_sys.c
|
@ -98,10 +98,11 @@ DEBTAB crd_debug[] = {
|
||||||
|
|
||||||
// simulator available IBM 533 wirings
|
// simulator available IBM 533 wirings
|
||||||
struct card_wirings wirings[] = {
|
struct card_wirings wirings[] = {
|
||||||
{WIRING_8WORD, "8WORD"},
|
{WIRING_8WORD, "8WORD"},
|
||||||
{WIRING_SOAP, "SOAP"},
|
{WIRING_SOAP, "SOAP"},
|
||||||
{WIRING_IS, "IS"},
|
{WIRING_IS, "IS"},
|
||||||
{WIRING_IT, "IT"},
|
{WIRING_IT, "IT"},
|
||||||
|
{WIRING_FORTRANSIT, "FORTRANSIT"},
|
||||||
{0, 0},
|
{0, 0},
|
||||||
};
|
};
|
||||||
|
|
||||||
|
@ -177,7 +178,9 @@ void
|
||||||
vm_init(void) {
|
vm_init(void) {
|
||||||
int i;
|
int i;
|
||||||
// Initialize vm memory to all plus zero
|
// Initialize vm memory to all plus zero
|
||||||
for(i = 0; i < MAXMEMSIZE; i++) DRUM[i] = DRUM_NegativeZeroFlag[i] = 0;
|
for(i = 0; i < MAXDRUMSIZE; i++) DRUM[i] = DRUM_NegativeZeroFlag[i] = 0;
|
||||||
|
for(i = 0; i < 60; i++) IAS[i] = IAS_NegativeZeroFlag[i] = 0;
|
||||||
|
|
||||||
// init specific commands
|
// init specific commands
|
||||||
sim_vm_cmd = aux_cmds; /* set up the auxiliary command table */
|
sim_vm_cmd = aux_cmds; /* set up the auxiliary command table */
|
||||||
}
|
}
|
||||||
|
@ -193,68 +196,125 @@ sim_load(FILE * fileref, CONST char *cptr, CONST char *fnam, int flag)
|
||||||
/* Currently not implimented until I know format of load files */
|
/* Currently not implimented until I know format of load files */
|
||||||
return SCPE_NOFNC;
|
return SCPE_NOFNC;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Symbol tables */
|
|
||||||
typedef struct _opcode
|
|
||||||
{
|
|
||||||
uint16 opbase;
|
|
||||||
const char *name;
|
|
||||||
uint8 bReadData; // =1 if inst fetchs data from memory
|
|
||||||
}
|
|
||||||
t_opcode;
|
|
||||||
|
|
||||||
/* Opcodes */
|
/* Opcodes */
|
||||||
t_opcode base_ops[] = {
|
t_opcode base_ops[100] = {
|
||||||
{OP_AABL, "AABL", 1},
|
// opcode name soap name R/W? option Valid Data Address
|
||||||
{OP_AL, "AL", 1},
|
{OP_NOOP, "NOOP", "NOP", 0, 0, vda_DAITS},
|
||||||
{OP_AU, "AU", 1},
|
{OP_STOP, "STOP", "HLT", 0, 0, vda_DAITS},
|
||||||
{OP_BRNZ, "BRNZ", 0},
|
{OP_UFA, "FASN", "UFA", opReadDA, opStorUnit, vda_DAIS},
|
||||||
{OP_BRMIN, "BRMIN", 0},
|
{OP_RTC, "RCT", "RTC", 0, opCntrlUnit, vda_T},
|
||||||
{OP_BRNZU, "BRNZU", 0},
|
{OP_RTN, "RT", "RTN", 0, opCntrlUnit, vda_T},
|
||||||
{OP_BROV, "BROV", 0},
|
{OP_RTA, "RTA", "RTA", 0, opCntrlUnit, vda_T},
|
||||||
{OP_BRD1, "BRD1", 0},
|
{OP_WTN, "WT", "WTN", 0, opCntrlUnit, vda_T},
|
||||||
{OP_BRD2, "BRD2", 0},
|
{OP_WTA, "WTA", "WTA", 0, opCntrlUnit, vda_T},
|
||||||
{OP_BRD3, "BRD3", 0},
|
{OP_LIB, "LBB", "LIB", opReadDA, opStorUnit, vda_D, IL_IAS},
|
||||||
{OP_BRD4, "BRD4", 0},
|
{OP_LDI, "LB", "LDI", opReadDA, opStorUnit, vda_D, IL_IAS},
|
||||||
{OP_BRD5, "BRD5", 0},
|
|
||||||
{OP_BRD6, "BRD6", 0},
|
{OP_AU, "AU", "AUP", opReadDA, 0, vda_DAIS},
|
||||||
{OP_BRD7, "BRD7", 0},
|
{OP_SU, "SU", "SUP", opReadDA, 0, vda_DAIS},
|
||||||
{OP_BRD8, "BRD8", 0},
|
{12, NULL, NULL, 0, 0, 0},
|
||||||
{OP_BRD9, "BRD9", 0},
|
{13, NULL, NULL, 0, 0, 0},
|
||||||
{OP_BRD10, "BRD10", 0},
|
{OP_DIV, "DIV", "DIV", opReadDA, 0, vda_DAIS},
|
||||||
{OP_DIV, "DIV", 1},
|
{OP_AL, "AL", "ALO", opReadDA, 0, vda_DAIS},
|
||||||
{OP_DIVRU, "DIVRU", 1},
|
{OP_SL, "SL", "SLO", opReadDA, 0, vda_DAIS},
|
||||||
{OP_LD, "LD", 1},
|
{OP_AABL, "AABL", "AML", opReadDA, 0, vda_DAIS},
|
||||||
{OP_MULT, "MULT", 1},
|
{OP_SABL, "SABL", "SML", opReadDA, 0, vda_DAIS},
|
||||||
{OP_NOOP, "NOOP", 0},
|
{OP_MULT, "MULT", "MPY", opReadDA, 0, vda_DAIS},
|
||||||
{OP_PCH, "PCH", 0},
|
|
||||||
{OP_RD, "RD", 0},
|
{OP_STL, "STL", "STL", opWriteDA, 0, vda_DS},
|
||||||
{OP_RAABL, "RAABL", 1},
|
{OP_STU, "STU", "STU", opWriteDA, 0, vda_DS},
|
||||||
{OP_RAL, "RAL", 1},
|
{OP_STDA, "STDA", "SDA", opWriteDA, 0, vda_DS},
|
||||||
{OP_RAU, "RAU", 1},
|
{OP_STIA, "STIA", "SIA", opWriteDA, 0, vda_DS},
|
||||||
{OP_RSABL, "RSABL", 1},
|
{OP_STD, "STD", "STD", opWriteDA, 0, vda_DS},
|
||||||
{OP_RSL, "RSL", 1},
|
{OP_NTS, "BNTS", "NTS", 0, opCntrlUnit, vda_DAIS},
|
||||||
{OP_RSU, "RSU", 1},
|
{OP_BIN, "BIN", "BIN", 0, opCntrlUnit, vda_D},
|
||||||
{OP_SLT, "SLT", 0},
|
{OP_SET, "SET", "SET", 0, opStorUnit, vda_S, IL_IAS},
|
||||||
{OP_SCT, "SCT", 0},
|
{OP_SIB, "STBB", "SIB", 0, opStorUnit, vda_D, IL_IAS},
|
||||||
{OP_SRT, "SRT", 0},
|
{OP_STI, "STB", "STI", 0, opStorUnit, vda_D, IL_IAS},
|
||||||
{OP_SRD, "SRD", 0},
|
|
||||||
{OP_STOP, "STOP", 0},
|
{OP_SRT, "SRT", "SRT", 0, 0, vda_DAITS},
|
||||||
{OP_STD, "STD", 0},
|
{OP_SRD, "SRD", "SRD", 0, 0, vda_DAITS},
|
||||||
{OP_STDA, "STDA", 0},
|
{OP_FAD, "FA", "FAD", opReadDA, opStorUnit, vda_DAIS},
|
||||||
{OP_STIA, "STIA", 0},
|
{OP_FSB, "FS", "FSB", opReadDA, opStorUnit, vda_DAIS},
|
||||||
{OP_STL, "STL", 0},
|
{OP_FDV, "FD", "FDV", opReadDA, opStorUnit, vda_DAIS},
|
||||||
{OP_STU, "STU", 0},
|
{OP_SLT, "SLT", "SLT", 0, 0, vda_DAITS},
|
||||||
{OP_SABL, "SABL", 1},
|
{OP_SCT, "SCT", "SCT", 0, 0, vda_DAITS},
|
||||||
{OP_SL, "SL", 1},
|
{OP_FAM, "FAAB", "FAM", opReadDA, opStorUnit, vda_DAIS},
|
||||||
{OP_SU, "SU", 1},
|
{OP_FSM, "FSAB", "FSM", opReadDA, opStorUnit, vda_DAIS},
|
||||||
{OP_TLU, "TLU", 0},
|
{OP_FMP, "FM", "FMP", opReadDA, opStorUnit, vda_DAIS},
|
||||||
{0, NULL, 0}
|
|
||||||
|
{OP_NZA, "BNZA", "NZA", 0, opStorUnit, vda_DAIS},
|
||||||
|
{OP_BMA, "BMNA", "BMA", 0, opStorUnit, vda_DAIS},
|
||||||
|
{OP_NZB, "BNZB", "NZB", 0, opStorUnit, vda_DAIS},
|
||||||
|
{OP_BMB, "BMNB", "BMB", 0, opStorUnit, vda_DAIS},
|
||||||
|
{OP_BRNZU, "BRNZU", "NZU", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRNZ, "BRNZ", "NZE", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRMIN, "BRMIN", "BMI", 0, 0, vda_DAIS},
|
||||||
|
{OP_BROV, "BROV", "BOV", 0, 0, vda_DAIS},
|
||||||
|
{OP_NZC, "BNZC", "NZC", 0, opStorUnit, vda_DAIS},
|
||||||
|
{OP_BMC, "BMNC", "BMC", 0, opStorUnit, vda_DAIS},
|
||||||
|
|
||||||
|
{OP_AXA, "AA", "AXA", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_SXA, "SA", "SXA", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_AXB, "AB", "AXB", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_SXB, "SB", "SXB", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_NEF, "BRNEF", "NEF", 0, opCntrlUnit, vda_DAIS},
|
||||||
|
{OP_RWD, "RWD", "RWD", 0, opCntrlUnit, vda_T},
|
||||||
|
{OP_WTM, "WTM", "WTM", 0, opCntrlUnit, vda_T},
|
||||||
|
{OP_BST, "BSP", "BST", 0, opCntrlUnit, vda_T},
|
||||||
|
{OP_AXC, "AC", "AXC", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_SXC, "SC", "SXC", 0, opStorUnit, vda_DAS},
|
||||||
|
|
||||||
|
{OP_RAU, "RAU", "RAU", opReadDA, 0, vda_DAIS},
|
||||||
|
{OP_RSU, "RSU", "RSU", opReadDA, 0, vda_DAIS},
|
||||||
|
{62, NULL, NULL, 0, 0, 0},
|
||||||
|
{63, NULL, NULL, 0, 0, 0},
|
||||||
|
{OP_DIVRU, "DIVRU", "DVR", opReadDA, 0, vda_DAIS},
|
||||||
|
{OP_RAL, "RAL", "RAL", opReadDA, 0, vda_DAIS},
|
||||||
|
{OP_RSL, "RSL", "RSL", opReadDA, 0, vda_DAIS},
|
||||||
|
{OP_RAABL, "RAABL", "RAM", opReadDA, 0, vda_DAIS},
|
||||||
|
{OP_RSABL, "RSABL", "RSM", opReadDA, 0, vda_DAIS},
|
||||||
|
{OP_LD, "LD", "LDD", opReadDA, 0, vda_DAIS},
|
||||||
|
|
||||||
|
{OP_RD, "RD", "RD1", 0, 0, vda_DS, IL_RD1},
|
||||||
|
{OP_PCH, "PCH", "WR1", 0, 0, vda_DS, IL_WR1},
|
||||||
|
{OP_RC1, "RC1", "RC1", 0, opStorUnit, vda_DS, IL_RD1},
|
||||||
|
{OP_RD2, "RD2", "RD2", 0, opStorUnit, vda_DS, IL_RD23},
|
||||||
|
{OP_WR2, "WR2", "WR2", 0, opStorUnit, vda_DS, IL_WR23},
|
||||||
|
{OP_RC2, "RC2", "RC2", 0, opStorUnit, vda_DS, IL_RD23},
|
||||||
|
{OP_RD3, "RD3", "RD3", 0, opStorUnit, vda_DS, IL_RD23},
|
||||||
|
{OP_WR3, "WR3", "WR3", 0, opStorUnit, vda_DS, IL_WR23},
|
||||||
|
{OP_RC3, "RC3", "RC3", 0, opStorUnit, vda_DS, IL_RD23},
|
||||||
|
{OP_RPY, "RPY", "RPY", 0, opCntrlUnit, vda_D},
|
||||||
|
|
||||||
|
{OP_RAA, "RAA", "RAA", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_RSA, "RSA", "RSA", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_RAB, "RAB", "RAB", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_RSB, "RSB", "RSB", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_TLU, "TLU", "TLU", 0, 0, vda_DS},
|
||||||
|
{OP_SDS, "SDS", "SDS", 0, opCntrlUnit, vda_9000},
|
||||||
|
{OP_RDS, "RDS", "RDS", 0, opCntrlUnit, vda_9000},
|
||||||
|
{OP_WDS, "WDS", "WDS", 0, opCntrlUnit, vda_9000},
|
||||||
|
{OP_RAC, "RAC", "RAC", 0, opStorUnit, vda_DAS},
|
||||||
|
{OP_RSC, "RSC", "RSC", 0, opStorUnit, vda_DAS},
|
||||||
|
|
||||||
|
{OP_BRD10, "BRD10", "BDO", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRD1, "BRD1", "BD1", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRD2, "BRD2", "BD2", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRD3, "BRD3", "BD3", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRD4, "BRD4", "BD4", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRD5, "BRD5", "BD5", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRD6, "BRD6", "BD6", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRD7, "BRD7", "BD7", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRD8, "BRD8", "BD8", 0, 0, vda_DAIS},
|
||||||
|
{OP_BRD9, "BRD9", "BD9", 0, 0, vda_DAIS}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Print out an instruction */
|
/* Print out an instruction */
|
||||||
void
|
void
|
||||||
print_opcode(FILE * of, t_int64 val, t_opcode * tab)
|
print_opcode(FILE * of, t_int64 val)
|
||||||
{
|
{
|
||||||
|
|
||||||
int sgn;
|
int sgn;
|
||||||
|
@ -262,25 +322,21 @@ print_opcode(FILE * of, t_int64 val, t_opcode * tab)
|
||||||
int DA;
|
int DA;
|
||||||
int op;
|
int op;
|
||||||
int n;
|
int n;
|
||||||
|
CONST char * opname;
|
||||||
|
|
||||||
if (val < 0) {sgn = -1; val = -val;} else sgn = 1;
|
if (val < 0) {sgn = -1; val = -val;} else sgn = 1;
|
||||||
op = Shift_Digits(&val, 2); // opcode
|
|
||||||
DA = Shift_Digits(&val, 4); // data address
|
|
||||||
IA = Shift_Digits(&val, 4); // intruction address
|
|
||||||
|
|
||||||
while (tab->name != NULL) {
|
opname = DecodeOpcode(val, &op, &DA, &IA);
|
||||||
if (tab->opbase == op) {
|
if (opname == NULL) {
|
||||||
fputs(tab->name, of);
|
fprintf(of, " %d Unknown opcode", op);
|
||||||
n = strlen(tab->name);
|
return;
|
||||||
while (n++<6) fputc(' ', of);
|
|
||||||
fprintf(of, "%04d ", DA);
|
|
||||||
fputc(' ', of);
|
|
||||||
fprintf(of, "%04d ", IA);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
tab++;
|
|
||||||
}
|
}
|
||||||
fprintf(of, " %d Unknown opcode", op);
|
fputs(opname, of);
|
||||||
|
n = strlen(opname);
|
||||||
|
while (n++<6) fputc(' ', of);
|
||||||
|
fprintf(of, "%04d ", DA);
|
||||||
|
fputc(' ', of);
|
||||||
|
fprintf(of, "%04d ", IA);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Symbolic decode
|
/* Symbolic decode
|
||||||
|
@ -298,7 +354,7 @@ print_opcode(FILE * of, t_int64 val, t_opcode * tab)
|
||||||
t_stat
|
t_stat
|
||||||
fprint_sym(FILE * of, t_addr addr, t_value * val, UNIT * uptr, int32 sw)
|
fprint_sym(FILE * of, t_addr addr, t_value * val, UNIT * uptr, int32 sw)
|
||||||
{
|
{
|
||||||
t_int64 inst;
|
t_int64 d, inst;
|
||||||
int NegZero;
|
int NegZero;
|
||||||
int ch;
|
int ch;
|
||||||
|
|
||||||
|
@ -318,9 +374,10 @@ fprint_sym(FILE * of, t_addr addr, t_value * val, UNIT * uptr, int32 sw)
|
||||||
if (sw & SWMASK('C') ) {
|
if (sw & SWMASK('C') ) {
|
||||||
int i;
|
int i;
|
||||||
|
|
||||||
|
d = inst;
|
||||||
fputs(" '", of);
|
fputs(" '", of);
|
||||||
for (i=0;i<5;i++) {
|
for (i=0;i<5;i++) {
|
||||||
ch = Shift_Digits(&inst, 2);
|
ch = Shift_Digits(&d, 2);
|
||||||
fputc(mem_to_ascii[ch], of);
|
fputc(mem_to_ascii[ch], of);
|
||||||
}
|
}
|
||||||
fputc('\'', of);
|
fputc('\'', of);
|
||||||
|
@ -329,20 +386,25 @@ fprint_sym(FILE * of, t_addr addr, t_value * val, UNIT * uptr, int32 sw)
|
||||||
if (sw & SWMASK('M')) {
|
if (sw & SWMASK('M')) {
|
||||||
fputs(" ", of);
|
fputs(" ", of);
|
||||||
inst = AbsWord(inst);
|
inst = AbsWord(inst);
|
||||||
print_opcode(of, inst, base_ops);
|
print_opcode(of, inst);
|
||||||
}
|
}
|
||||||
return SCPE_OK;
|
return SCPE_OK;
|
||||||
}
|
}
|
||||||
|
|
||||||
t_opcode *
|
int
|
||||||
find_opcode(char *op, t_opcode * tab)
|
find_opcode(char *op)
|
||||||
{
|
{
|
||||||
while (tab->name != NULL) {
|
int i;
|
||||||
if (*tab->name != '\0' && strcmp(op, tab->name) == 0)
|
if (op == NULL) return -1;
|
||||||
return tab;
|
for (i=0;i<100;i++) {
|
||||||
tab++;
|
if (base_ops[i].name1 == NULL) continue;
|
||||||
|
// accept both mnemonic sets: operation manual one (name1) and soap one (name2)
|
||||||
|
if ((base_ops[i].name1 != NULL) && (strcmp(op, base_ops[i].name1) == 0))
|
||||||
|
return i;
|
||||||
|
if ((base_ops[i].name2 != NULL) && (strcmp(op, base_ops[i].name2) == 0))
|
||||||
|
return i;
|
||||||
}
|
}
|
||||||
return NULL;
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* read n digits, optionally with sign NNNN[+|-]
|
/* read n digits, optionally with sign NNNN[+|-]
|
||||||
|
@ -414,9 +476,8 @@ int ascii_to_NN(int ch)
|
||||||
t_stat parse_sym(CONST char *cptr, t_addr addr, UNIT * uptr, t_value * val, int32 sw)
|
t_stat parse_sym(CONST char *cptr, t_addr addr, UNIT * uptr, t_value * val, int32 sw)
|
||||||
{
|
{
|
||||||
t_int64 d;
|
t_int64 d;
|
||||||
int da, ia;
|
int op, da, ia;
|
||||||
char ch, opcode[100];
|
char ch, opcode[100];
|
||||||
t_opcode *op;
|
|
||||||
int i;
|
int i;
|
||||||
int neg, IsNeg;
|
int neg, IsNeg;
|
||||||
|
|
||||||
|
@ -429,8 +490,14 @@ t_stat parse_sym(CONST char *cptr, t_addr addr, UNIT * uptr, t_value * val, int3
|
||||||
|
|
||||||
cptr = get_glyph(cptr, opcode, 0);
|
cptr = get_glyph(cptr, opcode, 0);
|
||||||
|
|
||||||
op = find_opcode(opcode, base_ops);
|
op = find_opcode(opcode);
|
||||||
if (op == 0) return STOP_UUO;
|
if (op < 0) return STOP_UUO;
|
||||||
|
|
||||||
|
if (DecodeOpcode(op * (t_int64) D8, &op, &da, &ia) == NULL) {
|
||||||
|
// opcode exists, but not availble because associated hw (Storage Unit or Control Unit)
|
||||||
|
// is not enabled
|
||||||
|
return STOP_UUO;
|
||||||
|
}
|
||||||
|
|
||||||
while (isspace(*cptr)) cptr++;
|
while (isspace(*cptr)) cptr++;
|
||||||
/* Collect first argument: da */
|
/* Collect first argument: da */
|
||||||
|
@ -443,13 +510,15 @@ t_stat parse_sym(CONST char *cptr, t_addr addr, UNIT * uptr, t_value * val, int3
|
||||||
cptr = parse_n(&d, cptr, 4);
|
cptr = parse_n(&d, cptr, 4);
|
||||||
ia = (int) d;
|
ia = (int) d;
|
||||||
// construct inst
|
// construct inst
|
||||||
d = op->opbase * (t_int64) D8 + da * (t_int64) D4 + (t_int64) ia;
|
d = op * (t_int64) D8 + da * (t_int64) D4 + (t_int64) ia;
|
||||||
} else if (sw & SWMASK('C')) {
|
} else if (sw & SWMASK('C')) {
|
||||||
d = 0;
|
d = 0;
|
||||||
|
if ((*cptr == 34) || (*cptr == 39)) cptr++; // skip double or single quotes if present
|
||||||
for(i=0; i<5;i++) {
|
for(i=0; i<5;i++) {
|
||||||
d = d * 100;
|
d = d * 100;
|
||||||
ch = *cptr;
|
ch = *cptr;
|
||||||
if (ch == '\0') continue;
|
if (ch == '\0') continue;
|
||||||
|
if ((*cptr == 34) || (*cptr == 39)) continue; // double or single quotes mark end of text
|
||||||
cptr++;
|
cptr++;
|
||||||
d = d + ascii_to_NN(ch);
|
d = d + ascii_to_NN(ch);
|
||||||
}
|
}
|
||||||
|
@ -469,24 +538,6 @@ t_stat parse_sym(CONST char *cptr, t_addr addr, UNIT * uptr, t_value * val, int3
|
||||||
return SCPE_OK;
|
return SCPE_OK;
|
||||||
}
|
}
|
||||||
|
|
||||||
// get data for opcode
|
|
||||||
// return pointer to opcode name if opcode found, else NULL
|
|
||||||
const char * get_opcode_data(int opcode, int * bReadData)
|
|
||||||
{
|
|
||||||
t_opcode * tab = base_ops;
|
|
||||||
|
|
||||||
*bReadData = 0;
|
|
||||||
while (tab->name != NULL) {
|
|
||||||
if (tab->opbase == opcode) {
|
|
||||||
*bReadData = tab->bReadData;
|
|
||||||
return tab->name;
|
|
||||||
}
|
|
||||||
tab++;
|
|
||||||
}
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/* Helper functions */
|
/* Helper functions */
|
||||||
|
|
||||||
// set in buf string ascii chars form word d ( chars: c1c2c3c4c5 )
|
// set in buf string ascii chars form word d ( chars: c1c2c3c4c5 )
|
||||||
|
@ -568,10 +619,10 @@ int Shift_Digits(t_int64 * d, int nDigits)
|
||||||
the source deck to be splitted
|
the source deck to be splitted
|
||||||
|
|
||||||
<count> number of cards in each splitted deck.
|
<count> number of cards in each splitted deck.
|
||||||
If count >= 0, indicates the cards on first destination deck file
|
If count > 0, indicates the cards on first destination deck file
|
||||||
remaining cards go to the second destination deck
|
remaining cards go to the second destination deck
|
||||||
If count < 0, indicates the cards on second destination deck file
|
If count < 0, indicates the cards on second destination deck file
|
||||||
(so deck 2 contains lasts count cards from source)
|
(so deck 2 contains lasts count cards from source)
|
||||||
|
|
||||||
<file1> first destination deck file
|
<file1> first destination deck file
|
||||||
<file2> second destination deck file
|
<file2> second destination deck file
|
||||||
|
@ -602,14 +653,20 @@ int Shift_Digits(t_int64 * d, int nDigits)
|
||||||
|
|
||||||
carddeck print <file>
|
carddeck print <file>
|
||||||
|
|
||||||
|
carddeck echolast echo on console last n cards already read that are in the take hopper
|
||||||
|
|
||||||
|
carddeck echolasty <count> <dev>
|
||||||
|
|
||||||
|
<count> number of cards to display (upo to 10)
|
||||||
|
|
||||||
|
<dev> should be cdr1 to cdr3. Unit for Take hopper
|
||||||
|
|
||||||
|
|
||||||
switches: if present mut be just after carddeck and before deck operation
|
switches: if present mut be just after carddeck and before deck operation
|
||||||
-Q quiet return status.
|
-Q quiet return status.
|
||||||
|
|
||||||
*/
|
*/
|
||||||
|
|
||||||
// max number of cards in deck for cadrdeck internal command
|
|
||||||
#define MAX_CARDS_IN_DECK 10000
|
|
||||||
|
|
||||||
// load card file fn and add its cards to
|
// load card file fn and add its cards to
|
||||||
// DeckImage array, up to a max of nMaxCards
|
// DeckImage array, up to a max of nMaxCards
|
||||||
// increment nCards with the number of added cards
|
// increment nCards with the number of added cards
|
||||||
|
@ -702,6 +759,38 @@ t_stat deck_save(CONST char *fn, uint16 * DeckImage, int card, int nCards)
|
||||||
return r;
|
return r;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// echo/print nCards from DeckImage array
|
||||||
|
// uses cdp0 device/unit
|
||||||
|
void deck_print_echo(uint16 * DeckImage, int nCards, int bPrint, int bEcho)
|
||||||
|
{
|
||||||
|
char line[81];
|
||||||
|
int i,c,nc;
|
||||||
|
|
||||||
|
for (nc=0; nc<nCards; nc++) {
|
||||||
|
// read card, check and, store in line
|
||||||
|
for (i=0;i<80;i++) {
|
||||||
|
c = DeckImage[nc * 80 + i];
|
||||||
|
c = toupper(c); // IBM 407 can only print uppercase
|
||||||
|
if ((c == '?') || (c == '!')) c = '0'; // remove Y(12) or X(11) punch on zero
|
||||||
|
if (strchr(mem_to_ascii, c) == 0) c = ' '; // space if not in IBM 650 character set
|
||||||
|
line[i] = c;
|
||||||
|
}
|
||||||
|
line[80]=0;
|
||||||
|
sim_trim_endspc(line);
|
||||||
|
// echo on console (add CR LF)
|
||||||
|
if (bEcho) {
|
||||||
|
for (i=0;i<(int)strlen(line);i++) sim_putchar(line[i]);
|
||||||
|
sim_putchar(13);sim_putchar(10);
|
||||||
|
}
|
||||||
|
// printout will be directed to file attached to CDP0 unit, if any
|
||||||
|
if ((bPrint) && (cdp_unit[0].flags & UNIT_ATT)) {
|
||||||
|
sim_fwrite(line, 1, strlen(line), cdp_unit[0].fileref); // fwrite clears line!
|
||||||
|
line[0] = 13; line[1] = 10; line[2] = 0;
|
||||||
|
sim_fwrite(line, 1, 2, cdp_unit[0].fileref);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
// carddeck split <count> <dev|file0> <file1> <file2>
|
// carddeck split <count> <dev|file0> <file1> <file2>
|
||||||
static t_stat deck_split_cmd(CONST char *cptr)
|
static t_stat deck_split_cmd(CONST char *cptr)
|
||||||
{
|
{
|
||||||
|
@ -727,14 +816,16 @@ static t_stat deck_split_cmd(CONST char *cptr)
|
||||||
cptr = get_glyph (cptr, gbuf, 0); // get cards count param
|
cptr = get_glyph (cptr, gbuf, 0); // get cards count param
|
||||||
nCards1 = (int32) get_uint (gbuf, 10, 10000, &r);
|
nCards1 = (int32) get_uint (gbuf, 10, 10000, &r);
|
||||||
if (r != SCPE_OK) return sim_messagef (SCPE_ARG, "Invalid count value\n");
|
if (r != SCPE_OK) return sim_messagef (SCPE_ARG, "Invalid count value\n");
|
||||||
|
if (nCards1 == 0) return sim_messagef (SCPE_ARG, "Count cannot be zero\n");
|
||||||
|
|
||||||
cptr = get_glyph (cptr, gbuf, 0); // get dev|file0 param
|
get_glyph (cptr, gbuf, 0); // get dev param
|
||||||
|
cptr = get_glyph_quoted (cptr, fn0, 0); // re-read using get_glyph_quoted to do not
|
||||||
|
// change the capitalization of file name
|
||||||
if ((strlen(gbuf) != 4) || (strncmp(gbuf, "CDP", 3)) ||
|
if ((strlen(gbuf) != 4) || (strncmp(gbuf, "CDP", 3)) ||
|
||||||
(gbuf[3] < '1') || (gbuf[3] > '3') ) {
|
(gbuf[3] < '1') || (gbuf[3] > '3') ) {
|
||||||
// is a file
|
// is a file
|
||||||
strcpy(fn0, gbuf);
|
|
||||||
} else {
|
} else {
|
||||||
// is cpd1 cpd2 or cpd3 device
|
// is cdp1 cdp2 or cdp3 device
|
||||||
dptr = find_unit (gbuf, &uptr); /* locate unit */
|
dptr = find_unit (gbuf, &uptr); /* locate unit */
|
||||||
if (dptr == NULL) /* found dev? */
|
if (dptr == NULL) /* found dev? */
|
||||||
return SCPE_NXDEV;
|
return SCPE_NXDEV;
|
||||||
|
@ -742,6 +833,7 @@ static t_stat deck_split_cmd(CONST char *cptr)
|
||||||
return SCPE_NXUN;
|
return SCPE_NXUN;
|
||||||
if ((uptr->flags & UNIT_ATT) == 0) /* attached? */
|
if ((uptr->flags & UNIT_ATT) == 0) /* attached? */
|
||||||
return SCPE_NOTATT;
|
return SCPE_NOTATT;
|
||||||
|
// get the file name
|
||||||
strcpy(fn0, uptr->filename);
|
strcpy(fn0, uptr->filename);
|
||||||
sim_card_detach(uptr); // detach file from cdp device to be splitted
|
sim_card_detach(uptr); // detach file from cdp device to be splitted
|
||||||
}
|
}
|
||||||
|
@ -842,11 +934,10 @@ static t_stat deck_join_cmd(CONST char *cptr)
|
||||||
static t_stat deck_print_cmd(CONST char *cptr)
|
static t_stat deck_print_cmd(CONST char *cptr)
|
||||||
{
|
{
|
||||||
char fn[4*CBUFSIZE];
|
char fn[4*CBUFSIZE];
|
||||||
char line[81];
|
|
||||||
t_stat r;
|
t_stat r;
|
||||||
|
|
||||||
uint16 DeckImage[80 * MAX_CARDS_IN_DECK];
|
uint16 DeckImage[80 * MAX_CARDS_IN_DECK];
|
||||||
int i,c,nc,nCards;
|
int nCards;
|
||||||
|
|
||||||
while (sim_isspace (*cptr)) cptr++; // trim leading spc
|
while (sim_isspace (*cptr)) cptr++; // trim leading spc
|
||||||
cptr = get_glyph_quoted (cptr, fn, 0); // get next param: source filename
|
cptr = get_glyph_quoted (cptr, fn, 0); // get next param: source filename
|
||||||
|
@ -858,27 +949,7 @@ static t_stat deck_print_cmd(CONST char *cptr)
|
||||||
r = deck_load(fn, DeckImage, &nCards);
|
r = deck_load(fn, DeckImage, &nCards);
|
||||||
if (r != SCPE_OK) return sim_messagef (r, "Cannot read deck to print (%s)\n", fn);
|
if (r != SCPE_OK) return sim_messagef (r, "Cannot read deck to print (%s)\n", fn);
|
||||||
|
|
||||||
for (nc=0; nc<nCards; nc++) {
|
deck_print_echo(DeckImage, nCards, 1,1);
|
||||||
// read card, check and, store in line
|
|
||||||
for (i=0;i<80;i++) {
|
|
||||||
c = DeckImage[nc * 80 + i];
|
|
||||||
c = toupper(c); // IBM 407 can only print uppercase
|
|
||||||
if ((c == '?') || (c == '!')) c = '0'; // remove Y(12) or X(11) punch on zero
|
|
||||||
if (strchr(mem_to_ascii, c) == 0) c = ' '; // space if not in IBM 650 character set
|
|
||||||
line[i] = c;
|
|
||||||
}
|
|
||||||
line[80]=0;
|
|
||||||
sim_trim_endspc(line);
|
|
||||||
// echo on console (add CR LF)
|
|
||||||
for (i=0;i<(int)strlen(line);i++) sim_putchar(line[i]);
|
|
||||||
sim_putchar(13);sim_putchar(10);
|
|
||||||
// printout will be directed to file attached to CDP0 unit, if any
|
|
||||||
if (cdp_unit[0].flags & UNIT_ATT) {
|
|
||||||
sim_fwrite(line, 1, strlen(line), cdp_unit[0].fileref); // fwrite clears line!
|
|
||||||
line[0] = 13; line[1] = 10; line[2] = 0;
|
|
||||||
sim_fwrite(line, 1, 2, cdp_unit[0].fileref);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
if ((sim_switches & SWMASK ('Q')) == 0) {
|
if ((sim_switches & SWMASK ('Q')) == 0) {
|
||||||
sim_messagef (SCPE_OK, "Printed Deck with %d cards (%s)\n", nCards, fn);
|
sim_messagef (SCPE_OK, "Printed Deck with %d cards (%s)\n", nCards, fn);
|
||||||
|
@ -887,6 +958,60 @@ static t_stat deck_print_cmd(CONST char *cptr)
|
||||||
return SCPE_OK;
|
return SCPE_OK;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// carddeck echolast <dev> <count>
|
||||||
|
static t_stat deck_echolast_cmd(CONST char *cptr)
|
||||||
|
{
|
||||||
|
char gbuf[4*CBUFSIZE];
|
||||||
|
t_stat r;
|
||||||
|
|
||||||
|
uint16 DeckImage[80 * MAX_CARDS_IN_DECK];
|
||||||
|
int i,nc,nCards, ic, nh, ncdr;
|
||||||
|
|
||||||
|
while (sim_isspace (*cptr)) cptr++; // trim leading spc
|
||||||
|
|
||||||
|
cptr = get_glyph (cptr, gbuf, 0); // get cards count param
|
||||||
|
nCards = (int32) get_uint (gbuf, 10, MAX_CARDS_IN_READ_TAKE_HOPPER, &r);
|
||||||
|
if (r != SCPE_OK) return sim_messagef (SCPE_ARG, "Invalid count value\n");
|
||||||
|
if (nCards == 0) return sim_messagef (SCPE_ARG, "Count cannot be zero\n");
|
||||||
|
|
||||||
|
cptr = get_glyph (cptr, gbuf, 0); // get dev param
|
||||||
|
if ((strlen(gbuf) != 4) || (strncmp(gbuf, "CDR", 3)) ||
|
||||||
|
(gbuf[3] < '1') || (gbuf[3] > '3') ) {
|
||||||
|
return sim_messagef (SCPE_ARG, "Device should be CDR1 CDR2 or CDR3\n");
|
||||||
|
}
|
||||||
|
ncdr = gbuf[3] - '1'; // ncdr=0 for cdr1, =1 for cdr2, and so on
|
||||||
|
if ((ncdr >= 0) && (ncdr < 3)){
|
||||||
|
// safety check
|
||||||
|
} else {
|
||||||
|
return sim_messagef (SCPE_ARG, "Invalid Device number\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
if (*cptr) return sim_messagef (SCPE_ARG, "Extra unknown parameters\n");
|
||||||
|
|
||||||
|
// get nCards form read card take hopper buffer
|
||||||
|
// that is, print last nCards read
|
||||||
|
|
||||||
|
// get last nCards cards, so
|
||||||
|
// first card to echo is count ones before last one
|
||||||
|
nh = ReadHopperLast[ncdr] - (nCards-1);
|
||||||
|
nh = nh % MAX_CARDS_IN_READ_TAKE_HOPPER;
|
||||||
|
for (nc=0; nc<nCards; nc++) {
|
||||||
|
// copy card form read hopper buf to deck image
|
||||||
|
ic = (ncdr * MAX_CARDS_IN_READ_TAKE_HOPPER + nh) * 80;
|
||||||
|
for (i=0;i<80;i++) DeckImage[nc * 80 + i] = ReadHopper[ic + i];
|
||||||
|
// get previous read card
|
||||||
|
nh = (nh + 1) % MAX_CARDS_IN_READ_TAKE_HOPPER;
|
||||||
|
}
|
||||||
|
|
||||||
|
deck_print_echo(DeckImage, nCards, 0,1);
|
||||||
|
|
||||||
|
if ((sim_switches & SWMASK ('Q')) == 0) {
|
||||||
|
sim_messagef (SCPE_OK, "Last %d cards from Read take Hopper\n", nCards);
|
||||||
|
}
|
||||||
|
|
||||||
|
return SCPE_OK;
|
||||||
|
}
|
||||||
|
|
||||||
static t_stat ibm650_deck_cmd(int32 arg, CONST char *buf)
|
static t_stat ibm650_deck_cmd(int32 arg, CONST char *buf)
|
||||||
{
|
{
|
||||||
char gbuf[4*CBUFSIZE];
|
char gbuf[4*CBUFSIZE];
|
||||||
|
@ -907,6 +1032,9 @@ static t_stat ibm650_deck_cmd(int32 arg, CONST char *buf)
|
||||||
if (strcmp(gbuf, "PRINT") == 0) {
|
if (strcmp(gbuf, "PRINT") == 0) {
|
||||||
return deck_print_cmd(cptr);
|
return deck_print_cmd(cptr);
|
||||||
}
|
}
|
||||||
|
if (strcmp(gbuf, "ECHOLAST") == 0) {
|
||||||
|
return deck_echolast_cmd(cptr);
|
||||||
|
}
|
||||||
return sim_messagef (SCPE_ARG, "Unknown deck command operation\n");
|
return sim_messagef (SCPE_ARG, "Unknown deck command operation\n");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -14,7 +14,7 @@
|
||||||
|
|
||||||
set cpu 2k
|
set cpu 2k
|
||||||
|
|
||||||
att cdr1 -q soapII.dck
|
att cdr1 -q soap/soapII.dck
|
||||||
|
|
||||||
echo ***
|
echo ***
|
||||||
echo *** Load soap deck into drum
|
echo *** Load soap deck into drum
|
||||||
|
@ -24,9 +24,9 @@ d csw 7019519999
|
||||||
d ar 8000
|
d ar 8000
|
||||||
go
|
go
|
||||||
|
|
||||||
; Now put interpretive system loader source cards in reader and start soap assembler
|
; Now put bell interpretive system loader source cards in reader and start soap assembler
|
||||||
|
|
||||||
att cdr1 is_sys_load_src.txt
|
att cdr1 -q bell/is_sys_load_src.txt
|
||||||
set cdr1 wiring=soap
|
set cdr1 wiring=soap
|
||||||
|
|
||||||
att cdp1 -n -q deck_out.dck
|
att cdp1 -n -q deck_out.dck
|
||||||
|
@ -45,7 +45,7 @@ echo *** Read interpretive system loader into drum
|
||||||
echo ***
|
echo ***
|
||||||
|
|
||||||
det cdp1
|
det cdp1
|
||||||
att cdr1 deck_out.dck
|
att cdr1 -q deck_out.dck
|
||||||
|
|
||||||
d csw 7019519999
|
d csw 7019519999
|
||||||
d ar 8000
|
d ar 8000
|
||||||
|
@ -53,19 +53,19 @@ go
|
||||||
|
|
||||||
; Prepare a deck with is main source deck and optional user selected extra decks
|
; Prepare a deck with is main source deck and optional user selected extra decks
|
||||||
|
|
||||||
carddeck -q join is_main_src.txt as deck_in.dck
|
carddeck -q join bell/is_main_src.txt as deck_in.dck
|
||||||
|
|
||||||
:add_extra_decks
|
:add_extra_decks
|
||||||
if "%1" == "" goto run
|
if "%1" == "" goto run
|
||||||
|
|
||||||
if -i "%1" == "TR" carddeck -q join deck_in.dck is_main_src.txt as deck_in.dck
|
if -i "%1" == "TR" carddeck -q join deck_in.dck bell/is_main_src.txt as deck_in.dck
|
||||||
if -i "%1" == "LBOX" carddeck -q join deck_in.dck is_set_loopbox.txt as deck_in.dck
|
if -i "%1" == "LBOX" carddeck -q join deck_in.dck bell/is_set_loopbox.txt as deck_in.dck
|
||||||
|
|
||||||
shift
|
shift
|
||||||
goto add_extra_decks
|
goto add_extra_decks
|
||||||
:run
|
:run
|
||||||
|
|
||||||
att cdr1 deck_in.dck
|
att cdr1 -q deck_in.dck
|
||||||
set cdr1 wiring=is
|
set cdr1 wiring=is
|
||||||
|
|
||||||
; Execute the loader to read prepared is source deck
|
; Execute the loader to read prepared is source deck
|
||||||
|
@ -84,7 +84,7 @@ echo *** Run system generation to punch
|
||||||
echo *** interpretive system main deck (1-word per card)
|
echo *** interpretive system main deck (1-word per card)
|
||||||
echo ***
|
echo ***
|
||||||
|
|
||||||
att cdp1 -n -q is.dck
|
att cdp1 -n -q bell/is.dck
|
||||||
set cdp1 echo, print, wiring=is
|
set cdp1 echo, print, wiring=is
|
||||||
|
|
||||||
d ar 0801
|
d ar 0801
|
||||||
|
|
|
@ -11,9 +11,9 @@ set cdr1 wiring=soap
|
||||||
|
|
||||||
; prepare deck: SOAP (condensed deck as 7 word per card format) then SOAP source code to assemble
|
; prepare deck: SOAP (condensed deck as 7 word per card format) then SOAP source code to assemble
|
||||||
|
|
||||||
carddeck -q join soapII_condensed_card.dck soap_src.txt as deck_in.dck
|
carddeck -q join soap/soapII_condensed_card.dck soap/soap_src.txt as deck_in.dck
|
||||||
|
|
||||||
att cdr1 deck_in.dck
|
att cdr1 -q deck_in.dck
|
||||||
att cdp1 -n -q deck_out.dck
|
att cdp1 -n -q deck_out.dck
|
||||||
set cdp1 echo, print, wiring=soap
|
set cdp1 echo, print, wiring=soap
|
||||||
att cdp0 -n -q print.txt
|
att cdp0 -n -q print.txt
|
||||||
|
@ -23,6 +23,9 @@ d csw 7019511951
|
||||||
d ar 8000
|
d ar 8000
|
||||||
go
|
go
|
||||||
|
|
||||||
|
; deck_out.dck file contains the assembled program
|
||||||
|
; note: it is not binary equal to soapII.dck. soapII.dck reproduces original listing
|
||||||
|
; and has been manually pathced/tuned after aseembling
|
||||||
|
|
||||||
:end
|
:end
|
||||||
|
|
||||||
|
|
26
I650/sw/bell/00_readme.txt
Normal file
26
I650/sw/bell/00_readme.txt
Normal file
|
@ -0,0 +1,26 @@
|
||||||
|
|
||||||
|
Restoration comments May/2018
|
||||||
|
|
||||||
|
Floating Point Interpretive System (BELL interpreter)
|
||||||
|
From Bitsavers Manual 28-4024_FltDecIntrpSys.pdf
|
||||||
|
|
||||||
|
Do not uses the loader stated in manual.
|
||||||
|
Instead, I wrote a loader (SOAP source code is_sys_load_src.txt)
|
||||||
|
that allows reading the original listing from manual and generating
|
||||||
|
a 1-word per card load deck.
|
||||||
|
|
||||||
|
A new deck (deck 21) has been written to defined two new
|
||||||
|
O2 instructions (see is_set_loopbox.txt):
|
||||||
|
|
||||||
|
set loopbox O2=800
|
||||||
|
tr zero O2=453
|
||||||
|
|
||||||
|
These instructions allows a more general use of index
|
||||||
|
loopbox concept (see is_example_1_src.txt)
|
||||||
|
|
||||||
|
Floating point numbers are encoded as
|
||||||
|
|
||||||
|
2300000049 = 0.23
|
||||||
|
1000000050 = 1.0
|
||||||
|
1500000052 = 150.0
|
||||||
|
|
|
@ -1049,8 +1049,8 @@
|
||||||
6I1954195C000000104I241948800?101963197?000000000?000000000?000000000?000000000?
|
6I1954195C000000104I241948800?101963197?000000000?000000000?000000000?000000000?
|
||||||
6I1954195C000000105?241949800?441973109E000000000?000000000?000000000?000000000?
|
6I1954195C000000105?241949800?441973109E000000000?000000000?000000000?000000000?
|
||||||
6I1954195C000000105A241950800?151977198G000000000?000000000?000000000?000000000?
|
6I1954195C000000105A241950800?151977198G000000000?000000000?000000000?000000000?
|
||||||
6I1954195C000000105B241951800?000000000?000000000?000000000?000000000?000000000?
|
6I1954195C000000105B241951800?000989000?000000000?000000000?000000000?000000000?
|
||||||
6I1954195C000000105C241952800?000000000?000000000?000000000?000000000?000000000?
|
6I1954195C000000105C241952800?000001000?000000000?000000000?000000000?000000000?
|
||||||
6I1954195C000000105D241953800?000000000?000000000?000000000?000000000?000000000?
|
6I1954195C000000105D241953800?000000000?000000000?000000000?000000000?000000000?
|
||||||
6I1954195C000000105E241954800?000000000?000000000?000000000?000000000?000000000?
|
6I1954195C000000105E241954800?000000000?000000000?000000000?000000000?000000000?
|
||||||
6I1954195C000000105F241955800?000000000?000000000?000000000?000000000?000000000?
|
6I1954195C000000105F241955800?000000000?000000000?000000000?000000000?000000000?
|
106
I650/sw/build_fortransit_pack.ini
Normal file
106
I650/sw/build_fortransit_pack.ini
Normal file
|
@ -0,0 +1,106 @@
|
||||||
|
|
||||||
|
; set console -n log=log.txt
|
||||||
|
; set debug -n debug.txt
|
||||||
|
; set debug stdout
|
||||||
|
; set cpu debug=cmd;data;detail
|
||||||
|
|
||||||
|
|
||||||
|
; Load soap deck into drum (1 word per card format), but does not execute it
|
||||||
|
|
||||||
|
set cpu 2k
|
||||||
|
|
||||||
|
att cdr1 -q soap/soapII.dck
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Load soap deck into drum
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
d csw 7019519999
|
||||||
|
d ar 8000
|
||||||
|
go
|
||||||
|
|
||||||
|
; create the function load deck with
|
||||||
|
; - program to load function title cards
|
||||||
|
; - standard fortransit functions definitions for translator
|
||||||
|
|
||||||
|
carddeck -q join fortransit/fortransit_addfn_src.txt as deck_soap.dck
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Run SOAP assembler
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
att cdr1 deck_soap.dck
|
||||||
|
set cdr1 wiring=soap
|
||||||
|
|
||||||
|
att cdp1 -n -q fortransit/fortransit_addfn.dck
|
||||||
|
set cdp1 echo, print, wiring=soap
|
||||||
|
|
||||||
|
d ar 1000
|
||||||
|
go
|
||||||
|
|
||||||
|
; check if programed stop because an error is detected
|
||||||
|
if not prop=01 goto assemble_ok0
|
||||||
|
|
||||||
|
echo
|
||||||
|
echo *** (assembling error code in AR)
|
||||||
|
echo
|
||||||
|
|
||||||
|
ex ar
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:assemble_ok0
|
||||||
|
|
||||||
|
; create the pack source deck with
|
||||||
|
; - entry point cards
|
||||||
|
; - reservation cards
|
||||||
|
; - subroutines in symbolic SOAP format
|
||||||
|
|
||||||
|
carddeck -q join fortransit/pack_entry_src.txt fortransit/pack_res1.txt fortransit/pack_src.txt as deck_soap.dck
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Run SOAP assembler
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
att cdr1 deck_soap.dck
|
||||||
|
set cdr1 wiring=soap
|
||||||
|
|
||||||
|
att cdp1 -n -q fortransit/pack.dck
|
||||||
|
set cdp1 echo, print, wiring=soap
|
||||||
|
|
||||||
|
d ar 1000
|
||||||
|
go
|
||||||
|
|
||||||
|
; check if programed stop because an error is detected
|
||||||
|
if not prop=01 goto assemble_ok1
|
||||||
|
|
||||||
|
echo
|
||||||
|
echo *** (assembling error code in AR)
|
||||||
|
echo
|
||||||
|
|
||||||
|
ex ar
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:assemble_ok1
|
||||||
|
|
||||||
|
; check if programed stop because normal termination
|
||||||
|
if prop=70 if ar=1951 goto assemble_ok2
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:assemble_ok2
|
||||||
|
|
||||||
|
; punch availability table to check
|
||||||
|
; address that are free
|
||||||
|
|
||||||
|
det cdr1
|
||||||
|
det cdp1
|
||||||
|
|
||||||
|
; attach dummy file so puch will not fail
|
||||||
|
att cdp1 nul
|
||||||
|
|
||||||
|
d ar 1900
|
||||||
|
go
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:end
|
||||||
|
|
186
I650/sw/fortransit/00_readme.txt
Normal file
186
I650/sw/fortransit/00_readme.txt
Normal file
|
@ -0,0 +1,186 @@
|
||||||
|
|
||||||
|
Restoration comments May/2018
|
||||||
|
|
||||||
|
Fortransit
|
||||||
|
From Bitsavers Manual CarnegieInternalTranslator.pdf (listings)
|
||||||
|
and fortransit.pdf (reference manual)
|
||||||
|
|
||||||
|
Fortansit comes in 4 versions: Fortransit I, I (S), II, II (S).
|
||||||
|
"(S)" means special character support on IBM 533 card read-punch.
|
||||||
|
"I" means basic IBM 650, "II" means IBM 650 + IBM 653 Storage Unit
|
||||||
|
that provides Floating Point and Index instructions.
|
||||||
|
We are using Version II (S).
|
||||||
|
|
||||||
|
In the original listing on IT for Fortransit II there an error
|
||||||
|
on lines 670, 671. These lines are in fact a bugfix replacement
|
||||||
|
for lines 660 and 661. The missing 670 and 671 lines has been
|
||||||
|
recovered for the IT for Fortransit I listing:
|
||||||
|
|
||||||
|
ALO 8001 1455 15 8001 1864 RSV: ADDED MISSING CARDS
|
||||||
|
ALO UBSR 1864 15 0664 1419
|
||||||
|
|
||||||
|
On the original manual, the following pieces of software are
|
||||||
|
missing:
|
||||||
|
|
||||||
|
SOAP-PACKAGE (SOAP II modified to be used by Fortransit)
|
||||||
|
Subroutines PACKAGE (with built in functions to be called
|
||||||
|
by object program in run-time)
|
||||||
|
Add function title program
|
||||||
|
|
||||||
|
The compilation and run procedure has been slightly modified
|
||||||
|
in its implementation in run_fortransit.ini script from what
|
||||||
|
it is stated in manual. This is to allow the use of standard
|
||||||
|
SOAP II assembler and the Subroutines package.
|
||||||
|
|
||||||
|
Also an Add function title program (fortransit_addfn_listing.txt)
|
||||||
|
has been rewritten to allow the usage of function title cards
|
||||||
|
as stated in manual, and to populate the standard fortransit
|
||||||
|
functions to be recognized by the translator.
|
||||||
|
|
||||||
|
The missing subroutines PACKAGE has been re-created adapting the
|
||||||
|
available IT run-time PACKAGES P1, P2, P3 and P4 to
|
||||||
|
FORTRANSIT. PUNCH and READ routines has been written from
|
||||||
|
scratch according to functional description from manual.
|
||||||
|
|
||||||
|
The PACKAGE provides the subroutines stated in fortransit.pdf
|
||||||
|
in page 36, and also provides a set of functions to be
|
||||||
|
used in fortransit source code:
|
||||||
|
|
||||||
|
A=LOGF(B) base 10 Logarithm: log 10
|
||||||
|
A=EXPF(B) base 10 exponent: 10^(B)
|
||||||
|
A=LNF(B) base e logarithm: neperian log e
|
||||||
|
A=EXPNF(B) base e exponent: e^(float)
|
||||||
|
A=COSF(B) cosine
|
||||||
|
A=SINF(B) sine
|
||||||
|
A=SQRT(B) square root
|
||||||
|
A=ABSF(B) absolute value
|
||||||
|
A=INTF(B) integer part
|
||||||
|
A=MAXF(B,C,...) returns maximum value of argument list
|
||||||
|
|
||||||
|
All functions has FLOAT arguments and returns FLOAT value.
|
||||||
|
If a FIXED argument is given, the program will stop with AR=9099
|
||||||
|
|
||||||
|
9099 ALARM FUNCTION ARG IS FIX BUT SHOULD BE FLOAT
|
||||||
|
|
||||||
|
There is no check on number nor type of MAXF arguments.
|
||||||
|
A maximum of 10 is safe, more will overwrite the program.
|
||||||
|
|
||||||
|
FORTRANSIT object program only needs few functions to be
|
||||||
|
present in run time PACKAGE. These are identified as
|
||||||
|
BUILT-IN SUBROUTINES (180 WORDS) in file pack_listing.txt
|
||||||
|
|
||||||
|
Any other function can be deleted from source code
|
||||||
|
PACKAGE (pack_src.txt) to free storage for program or data.
|
||||||
|
|
||||||
|
List of functions that can be removed to free drum memory:
|
||||||
|
|
||||||
|
SOAP Description IT number
|
||||||
|
label
|
||||||
|
|
||||||
|
E00AK FIX ** FIX 10
|
||||||
|
E00AL FLOAT ** FIX 11
|
||||||
|
E00LQ FLOAT ** FLOAT 302
|
||||||
|
E00AB LOGF 1
|
||||||
|
E00AC EXPF 2
|
||||||
|
E00LO LNF 300
|
||||||
|
E00LP EXPNF 301
|
||||||
|
E00AV COSF 21
|
||||||
|
E00AW SINF 22
|
||||||
|
E00AX SQRTF 23
|
||||||
|
E00AY ABSF 24
|
||||||
|
E00AZ INTF 25
|
||||||
|
E00BA MAXF 26
|
||||||
|
|
||||||
|
If functions 10,11 are removed, the corresponding
|
||||||
|
** power operator with these types should not be used
|
||||||
|
|
||||||
|
FIX ** FLOAT or FLOAT ** FLOAT requires the presence of
|
||||||
|
302, 1 and 2 functions.
|
||||||
|
|
||||||
|
LNF requires LOGF, EXPNF requires EXPF.
|
||||||
|
SINF requires COSF.
|
||||||
|
All other functions are independent.
|
||||||
|
|
||||||
|
Any attempt to use a non present function will stop the
|
||||||
|
program with AR=90nn where nn is the IT number of function:
|
||||||
|
|
||||||
|
9010 ALARM FIX ** FIX UNDEF
|
||||||
|
9011 ALARM FLOAT ** FIX UNDEF
|
||||||
|
9302 ALARM FLOAT ** FLOAT UNDEF
|
||||||
|
9001 ALARM LOGF UNDEF
|
||||||
|
9002 ALARM EXPF UNDEF
|
||||||
|
9300 ALARM LNF UNDEF
|
||||||
|
9301 ALARM EXPNF UNDEF
|
||||||
|
9021 ALARM COSF UNDEF
|
||||||
|
9022 ALARM SINF UNDEF
|
||||||
|
9023 ALARM SQRTF UNDEF
|
||||||
|
9024 ALARM ABSF UNDEF
|
||||||
|
9025 ALARM INTF UNDEF
|
||||||
|
9026 ALARM MAXF UNDEF
|
||||||
|
|
||||||
|
The functions for power to a FIX value (10 and 11) provides
|
||||||
|
exact values. Raise power to FLOAT value is calculated using
|
||||||
|
LOGF and EXPF, that are implemented with a polynomial
|
||||||
|
approximation.
|
||||||
|
|
||||||
|
The type or a FIX**FIX is also FIX (10**I for example). This
|
||||||
|
means that the maximum value allowed is 999999999. If the
|
||||||
|
computed value of a power to fix is bigger than this maximum
|
||||||
|
value, the program will stop with AR=0003 (so halt 0003 occurs
|
||||||
|
on E00AK routine, not in E00LQ as stated in manual)
|
||||||
|
|
||||||
|
SQRTF square root function requires a zero or positive argument.
|
||||||
|
If argument is negative, program will stop with AR=0012
|
||||||
|
|
||||||
|
0012 ALARM SQRT WITH NEGATIVE ARGUMENT
|
||||||
|
|
||||||
|
COSF and SINF function expects a float argument in radians
|
||||||
|
(thus cosf(pi/2) = 0, sinf(pi/2) = 0). If argument is greater
|
||||||
|
that 1E10, program will stop with AR=0013
|
||||||
|
|
||||||
|
0013 ALARM RADIAN ARG TOO BIG
|
||||||
|
|
||||||
|
As FORTRANSIT uses index register for DO loop variable control
|
||||||
|
only values in range 0..1999 are safe for start and end loop
|
||||||
|
values. Any other values can be used (e.g. DO 10, I=-5,15)
|
||||||
|
and will compiled without warning, but the generated compiler
|
||||||
|
code is wrong. The construct
|
||||||
|
|
||||||
|
J=-5
|
||||||
|
DO 10 I=J,15
|
||||||
|
c do stuff
|
||||||
|
10 continue
|
||||||
|
|
||||||
|
will compile and work fine iterating but only iterates once.
|
||||||
|
This DO is implemented as
|
||||||
|
|
||||||
|
i=j
|
||||||
|
for(;;) {
|
||||||
|
// do stuff
|
||||||
|
if (i-15 < 0) break;
|
||||||
|
}
|
||||||
|
|
||||||
|
So DO does not support any negative initial value.
|
||||||
|
DO loop variable con only get vaues in
|
||||||
|
range 0 to 9999. For example,
|
||||||
|
|
||||||
|
J=10000
|
||||||
|
K=15000
|
||||||
|
DO 10 I=J,K
|
||||||
|
|
||||||
|
will iterate from 0 to 5000 (modulo 10000 on supplied values).
|
||||||
|
|
||||||
|
PACKAGE occupies drum address 1401 up to 1999, leaving
|
||||||
|
address 1 to 1400 for fortransit program and data. By deleting
|
||||||
|
non build in routines, the pack can be reduced to occupy
|
||||||
|
only locations 1780 to 1999.
|
||||||
|
|
||||||
|
Floating point numbers are encoded as
|
||||||
|
|
||||||
|
2300000049 = 0.023
|
||||||
|
1000000050 = 0.1
|
||||||
|
1000000051 = 1.0
|
||||||
|
1500000052 = 15.0
|
||||||
|
|
||||||
|
|
||||||
|
|
71
I650/sw/fortransit/fortransit_addfn.dck
Normal file
71
I650/sw/fortransit/fortransit_addfn.dck
Normal file
|
@ -0,0 +1,71 @@
|
||||||
|
0?0000800? 0001 1
|
||||||
|
0?0000800? 0002 1 add function title routine
|
||||||
|
0?0000800? 0003 1 temporaly stored in ji table
|
||||||
|
0?0000800? 0004 1
|
||||||
|
0?0000800? 0005 1 missing from original listing
|
||||||
|
0?0000800? 0006 1 rewritten by roberto sancho
|
||||||
|
0?0000800? 0007 1 in may 2018
|
||||||
|
0?0000800? 0008 1
|
||||||
|
0?0000800? 0009 blr 0000 1999
|
||||||
|
0?0000800? 0010 1
|
||||||
|
0?0000800? 0011 bla 1500 1519
|
||||||
|
0?0000800? 0012 regr1951 1960 read band
|
||||||
|
0?0000800? 0013 equone 0066
|
||||||
|
0?0000800? 0014 equcnakb 1140
|
||||||
|
0?0000800? 0015 equreset 0228
|
||||||
|
0?0000800? 0016 1
|
||||||
|
0?0000800? 0017 equfstp6 1000
|
||||||
|
0?0000800? 0018 equfstp7 1002
|
||||||
|
0?0000800? 0019 equfnnum 1160
|
||||||
|
0?0000800? 0020 1
|
||||||
|
0?0000800? 0021 synaddfn 1500 entry pt
|
||||||
|
0?0000800? 0022 1
|
||||||
|
6I1954195C 0023241500800?651160151E addfnralfnnum if no fn
|
||||||
|
6I1954195C 0024241515800?451518151I nze fnl1 go fnl1
|
||||||
|
6I1954195C 0025241518800?161140150A slocnakb hlt 6 if
|
||||||
|
6I1954195C 0026241501800?461504100? bmi fstp6 10 fn def
|
||||||
|
6I1954195C 0027241504800?651160151F ralfnnum hlt 7 if
|
||||||
|
6I1954195C 0028241516800?151502800B alo 8002 not in
|
||||||
|
6I1954195C 0029241502800?601149150C rau 1149 alphabtic
|
||||||
|
6I1954195C 0030241503800?111952150G supr0002 order
|
||||||
|
6I1954195C 0031241507800?461519100B bmifnl1 fstp7
|
||||||
|
6I1954195C 0032241519800?651160151G fnl1 ralfnnum
|
||||||
|
6I1954195C 0033241517800?101952150H aupr0002 store
|
||||||
|
6I1954195C 0034241508800?151511800B alo 8002 fort fn
|
||||||
|
6I1954195C 0035241511800?211150150E stu 1150 name
|
||||||
|
6I1954195C 0036241505800?651160150F ralfnnum incr num
|
||||||
|
6I1954195C 0037241506800?150066150I aloone of defnd
|
||||||
|
6I1954195C 0038241509800?201160151C stlfnnum functs
|
||||||
|
6I1954195C 0039241513800?101953151? aupr0003 store
|
||||||
|
6I1954195C 0040241510800?151514800B alo 8002 it fn
|
||||||
|
6I1954195C 0041241514800?211160151B stu 1160 fnl2 name
|
||||||
|
6I1954195C 0042241512800?701951022H fnl2 rd1 1951 reset continue
|
||||||
|
0?0000800? 0043 1
|
||||||
|
6I1954195C 0044241000800?010006999I fstp6hlt 0006 fnl2
|
||||||
|
6I1954195C 0045241002800?010007999I fstp7hlt 0007 fnl2
|
||||||
|
6I1954195C 0046241160800?000000000? fnnum 00 0000 0000
|
||||||
|
0?0000800? 0047 1
|
||||||
|
0?0000800? 0048 1 load fortran functions in tabl
|
||||||
|
0?0000800? 0049 1
|
||||||
|
6I1954195C 0050241150800?000073756F 1150alf lnf soap2 fortran
|
||||||
|
6I1954195C 0051241151800?006162826F 1151alf absf soap2 func names
|
||||||
|
6I1954195C 0052241152800?006376826F 1152alf cosf soap2 in ascendi
|
||||||
|
6I1954195C 0053241153800?006587776F 1153alf expf soap2 order
|
||||||
|
6I1954195C 0054241154800?006975836F 1154alf intf soap2
|
||||||
|
6I1954195C 0055241155800?007376676F 1155alf logf soap2 right just
|
||||||
|
6I1954195C 0056241156800?007461876F 1156alf maxf soap2
|
||||||
|
6I1954195C 0057241157800?008269756F 1157alf sinf soap2
|
||||||
|
6I1954195C 0058241158800?658777756F 1158alfexpnf soap2
|
||||||
|
6I1954195C 0059241159800?827879836F 1159alfsqrtf soap2
|
||||||
|
0?0000800? 0060 1
|
||||||
|
6I1954195C 0061241161800?939090657B 1161alf300ek soap2 correspond
|
||||||
|
6I1954195C 0062241162800?929465720? 1162alf24ek soap2 func names
|
||||||
|
6I1954195C 0063241163800?929165720? 1163alf21ek soap2 left justi
|
||||||
|
6I1954195C 0064241164800?926572000? 1164alf2ek soap2
|
||||||
|
6I1954195C 0065241165800?929565720? 1165alf25ek soap2
|
||||||
|
6I1954195C 0066241166800?916572000? 1166alf1ek soap2
|
||||||
|
6I1954195C 0067241167800?929665720? 1167alf26ek soap2
|
||||||
|
6I1954195C 0068241168800?929265720? 1168alf22ek soap2
|
||||||
|
6I1954195C 0069241169800?939091657B 1169alf301ek soap2
|
||||||
|
6I1954195C 0070241170800?929365720? 1170alf23ek soap2
|
||||||
|
0?0000800? 0071 1
|
71
I650/sw/fortransit/fortransit_addfn_listing.txt
Normal file
71
I650/sw/fortransit/fortransit_addfn_listing.txt
Normal file
|
@ -0,0 +1,71 @@
|
||||||
|
1 1
|
||||||
|
2 1 ADD FUNCTION TITLE ROUTINE
|
||||||
|
3 1 TEMPORALY STORED IN JI TABLE
|
||||||
|
4 1
|
||||||
|
5 1 MISSING FROM ORIGINAL LISTING
|
||||||
|
6 1 REWRITTEN BY ROBERTO SANCHO
|
||||||
|
7 1 IN MAY 2018
|
||||||
|
8 1
|
||||||
|
9 BLR 0000 1999
|
||||||
|
10 1
|
||||||
|
11 BLA 1500 1519
|
||||||
|
12 REG R1951 1960 READ BAND
|
||||||
|
13 EQU ONE 0066
|
||||||
|
14 EQU CNAKB 1140
|
||||||
|
15 EQU RESET 0228
|
||||||
|
16 1
|
||||||
|
17 EQU FSTP6 1000
|
||||||
|
18 EQU FSTP7 1002
|
||||||
|
19 EQU FNNUM 1160
|
||||||
|
20 1
|
||||||
|
21 SYN ADDFN 1500 ENTRY PT
|
||||||
|
22 1
|
||||||
|
23 ADDFN RAL FNNUM IF NO FN 1500 65 1160 1515
|
||||||
|
24 NZE FNL1 GO FNL1 1515 45 1518 1519
|
||||||
|
25 SLO CNAKB HLT 6 IF 1518 16 1140 1501
|
||||||
|
26 BMI FSTP6 10 FN DEF 1501 46 1504 1000
|
||||||
|
27 RAL FNNUM HLT 7 IF 1504 65 1160 1516
|
||||||
|
28 ALO 8002 NOT IN 1516 15 1502 8002
|
||||||
|
29 RAU 1149 ALPHABTIC 1502 60 1149 1503
|
||||||
|
30 SUP R0002 ORDER 1503 11 1952 1507
|
||||||
|
31 BMI FNL1 FSTP7 1507 46 1519 1002
|
||||||
|
32 FNL1 RAL FNNUM 1519 65 1160 1517
|
||||||
|
33 AUP R0002 STORE 1517 10 1952 1508
|
||||||
|
34 ALO 8002 FORT FN 1508 15 1511 8002
|
||||||
|
35 STU 1150 NAME 1511 21 1150 1505
|
||||||
|
36 RAL FNNUM INCR NUM 1505 65 1160 1506
|
||||||
|
37 ALO ONE OF DEFND 1506 15 0066 1509
|
||||||
|
38 STL FNNUM FUNCTS 1509 20 1160 1513
|
||||||
|
39 AUP R0003 STORE 1513 10 1953 1510
|
||||||
|
40 ALO 8002 IT FN 1510 15 1514 8002
|
||||||
|
41 STU 1160 FNL2 NAME 1514 21 1160 1512
|
||||||
|
42 FNL2 RD1 1951 RESET CONTINUE 1512 70 1951 0228
|
||||||
|
43 1
|
||||||
|
44 FSTP6 HLT 0006 FNL2 1000 01 0006 9999
|
||||||
|
45 FSTP7 HLT 0007 FNL2 1002 01 0007 9999
|
||||||
|
46 FNNUM 00 0000 0000 1160 00 0000 0000
|
||||||
|
47 1
|
||||||
|
48 1 LOAD FORTRAN FUNCTIONS IN TABLE
|
||||||
|
49 1
|
||||||
|
50 1150 ALF LNF FORTRAN
|
||||||
|
51 1151 ALF ABSF FUNC NAMES
|
||||||
|
52 1152 ALF COSF IN ASCENDING
|
||||||
|
53 1153 ALF EXPF ORDER
|
||||||
|
54 1154 ALF INTF
|
||||||
|
55 1155 ALF LOGF RIGHT JUSTIFIED
|
||||||
|
56 1156 ALF MAXF
|
||||||
|
57 1157 ALF SINF
|
||||||
|
58 1158 ALF EXPNF
|
||||||
|
59 1159 ALF SQRTF
|
||||||
|
60 1
|
||||||
|
61 1161 ALF 300EK CORRESPONDING IT
|
||||||
|
62 1162 ALF 24EK FUNC NAMES
|
||||||
|
63 1163 ALF 21EK LEFT JUSTIFIED
|
||||||
|
64 1164 ALF 2EK
|
||||||
|
65 1165 ALF 25EK
|
||||||
|
66 1166 ALF 1EK
|
||||||
|
67 1167 ALF 26EK
|
||||||
|
68 1168 ALF 22EK
|
||||||
|
69 1169 ALF 301EK
|
||||||
|
70 1170 ALF 23EK
|
||||||
|
71 1
|
71
I650/sw/fortransit/fortransit_addfn_src.txt
Normal file
71
I650/sw/fortransit/fortransit_addfn_src.txt
Normal file
|
@ -0,0 +1,71 @@
|
||||||
|
1
|
||||||
|
1 add function title routine
|
||||||
|
1 temporaly stored in ji table
|
||||||
|
1
|
||||||
|
1 missing from original listing
|
||||||
|
1 rewritten by roberto sancho
|
||||||
|
1 in may 2018
|
||||||
|
1
|
||||||
|
blr 0000 1999
|
||||||
|
1
|
||||||
|
bla 1500 1519
|
||||||
|
regr1951 1960 read band
|
||||||
|
equone 0066
|
||||||
|
equcnakb 1140
|
||||||
|
equreset 0228
|
||||||
|
1
|
||||||
|
equfstp6 1000
|
||||||
|
equfstp7 1002
|
||||||
|
equfnnum 1160
|
||||||
|
1
|
||||||
|
synaddfn 1500 entry pt
|
||||||
|
1
|
||||||
|
addfnralfnnum if no fn
|
||||||
|
nze fnl1 go fnl1
|
||||||
|
slocnakb hlt 6 if
|
||||||
|
bmi fstp6 10 fn def
|
||||||
|
ralfnnum hlt 7 if
|
||||||
|
alo 8002 not in
|
||||||
|
rau 1149 alphabtic
|
||||||
|
supr0002 order
|
||||||
|
bmifnl1 fstp7
|
||||||
|
fnl1 ralfnnum
|
||||||
|
aupr0002 store
|
||||||
|
alo 8002 fort fn
|
||||||
|
stu 1150 name
|
||||||
|
ralfnnum incr num
|
||||||
|
aloone of defnd
|
||||||
|
stlfnnum functs
|
||||||
|
aupr0003 store
|
||||||
|
alo 8002 it fn
|
||||||
|
stu 1160 fnl2 name
|
||||||
|
fnl2 rd1 1951 reset continue
|
||||||
|
1
|
||||||
|
fstp6hlt 0006 fnl2
|
||||||
|
fstp7hlt 0007 fnl2
|
||||||
|
fnnum 00 0000 0000
|
||||||
|
1
|
||||||
|
1 load fortran functions in table
|
||||||
|
1
|
||||||
|
1150alf lnf fortran
|
||||||
|
1151alf absf func names
|
||||||
|
1152alf cosf in ascending
|
||||||
|
1153alf expf order
|
||||||
|
1154alf intf
|
||||||
|
1155alf logf right justified
|
||||||
|
1156alf maxf
|
||||||
|
1157alf sinf
|
||||||
|
1158alfexpnf
|
||||||
|
1159alfsqrtf
|
||||||
|
1
|
||||||
|
1161alf300ek corresponding it
|
||||||
|
1162alf24ek func names
|
||||||
|
1163alf21ek left justified
|
||||||
|
1164alf2ek
|
||||||
|
1165alf25ek
|
||||||
|
1166alf1ek
|
||||||
|
1167alf26ek
|
||||||
|
1168alf22ek
|
||||||
|
1169alf301ek
|
||||||
|
1170alf23ek
|
||||||
|
1
|
34
I650/sw/fortransit/fortransit_example_1_src.txt
Normal file
34
I650/sw/fortransit/fortransit_example_1_src.txt
Normal file
|
@ -0,0 +1,34 @@
|
||||||
|
c ------------------------------
|
||||||
|
c prime number generator using the sieve of eratosthenes
|
||||||
|
c converted to fortransit
|
||||||
|
c ------------------------------
|
||||||
|
c
|
||||||
|
dimension ifl(50)
|
||||||
|
c *** set ending number to be tested (must match array dimension)
|
||||||
|
isize=50
|
||||||
|
c *** mark all numbers in the sieve as prime initially, except 2
|
||||||
|
do 10 i=1,isize
|
||||||
|
10 ifl(i)=1
|
||||||
|
ifl(1)=0
|
||||||
|
c
|
||||||
|
c *** work through the list, finding the next marked number
|
||||||
|
c
|
||||||
|
do 40 num=1,isize
|
||||||
|
if (ifl(num)) 15,40,15
|
||||||
|
c *** marked number is the current prime, form its first multiple
|
||||||
|
15 iprme=num
|
||||||
|
mult=iprme+iprme
|
||||||
|
c *** unmark all multiples of the current prime
|
||||||
|
20 if (mult-isize) 25,25,40
|
||||||
|
25 do 30 i=mult,isize,iprme
|
||||||
|
30 ifl(i)=0
|
||||||
|
c *** go find next unmarked number
|
||||||
|
40 continue
|
||||||
|
c
|
||||||
|
c *** print results - all numbers that are still marked
|
||||||
|
c
|
||||||
|
do 50 num=1,isize
|
||||||
|
if (ifl(num)) 45,50,45
|
||||||
|
45 punch, num
|
||||||
|
50 continue
|
||||||
|
end
|
7
I650/sw/fortransit/fortransit_example_2_data.txt
Normal file
7
I650/sw/fortransit/fortransit_example_2_data.txt
Normal file
|
@ -0,0 +1,7 @@
|
||||||
|
1600000052200000005110000000511400000052130000005K1000000051600000005J +
|
||||||
|
1700000052700000005J8000000051150000005230000000512000000051100000005K +
|
||||||
|
1100000052200000005J5000000051120000005K18000000529000000051300000005J +
|
||||||
|
800000005J60000000511200000052200000005150000000511300000052400000005J +
|
||||||
|
3000000051900000005J7000000051400000005J1000000052500000005J1100000052 +
|
||||||
|
000000000300000000040000000005 +
|
||||||
|
[ word ][ word ][ word ][ word ][ word ][ word ][ word ] +
|
12
I650/sw/fortransit/fortransit_example_2_src.txt
Normal file
12
I650/sw/fortransit/fortransit_example_2_src.txt
Normal file
|
@ -0,0 +1,12 @@
|
||||||
|
c rectangular matrix
|
||||||
|
c multiplication
|
||||||
|
dimension a(4,5), b(5,3)
|
||||||
|
read 1,a,b
|
||||||
|
read 1,n,m,l
|
||||||
|
7 do 4 j=1,n
|
||||||
|
1 do 4 i=1,m
|
||||||
|
6 sum=0.0
|
||||||
|
2 do 3 k=1,l
|
||||||
|
3 sum = sum+a(i,k) * b(k,j)
|
||||||
|
4 punch 1, sum, i,j
|
||||||
|
8 end
|
7
I650/sw/fortransit/fortransit_example_3_src.txt
Normal file
7
I650/sw/fortransit/fortransit_example_3_src.txt
Normal file
|
@ -0,0 +1,7 @@
|
||||||
|
|
||||||
|
0?0000150?00657579669193657200 ENRF 13EK
|
||||||
|
0?0000150?00768483669196657200 OUTF 16EK
|
||||||
|
c ------------------------------
|
||||||
|
y=outf(a,b,c,d,enrf(
|
||||||
|
1e,f,g),h)
|
||||||
|
end
|
118
I650/sw/fortransit/fortransit_example_4_src.txt
Normal file
118
I650/sw/fortransit/fortransit_example_4_src.txt
Normal file
|
@ -0,0 +1,118 @@
|
||||||
|
c ------------------------------
|
||||||
|
c package functions test
|
||||||
|
c ------------------------------
|
||||||
|
c
|
||||||
|
c test cosf and sinf
|
||||||
|
c
|
||||||
|
pi=3.1415926
|
||||||
|
ainc=pi/10.0
|
||||||
|
do 1 i=0,20
|
||||||
|
a1=ainc*i
|
||||||
|
a2=cosf(a1)
|
||||||
|
a3=sinf(a1)
|
||||||
|
1 punch,i,a1,a2,a3
|
||||||
|
i=1111
|
||||||
|
punch,i
|
||||||
|
c pause
|
||||||
|
c
|
||||||
|
c test sqrtf
|
||||||
|
c
|
||||||
|
do 2 i=0,9
|
||||||
|
a1=i
|
||||||
|
a2=sqrtf(a1)
|
||||||
|
ia2=a2
|
||||||
|
2 punch,i,a2,ia2
|
||||||
|
i=2222
|
||||||
|
punch,i
|
||||||
|
c pause
|
||||||
|
c
|
||||||
|
c test maxf
|
||||||
|
c
|
||||||
|
a=maxf(3.0,1.0,4.0,2.0)
|
||||||
|
b=maxf(-3.0,-1.0,-4.0,-2.0)
|
||||||
|
i=0
|
||||||
|
punch,i,a,b
|
||||||
|
i=3333
|
||||||
|
punch,i
|
||||||
|
c pause
|
||||||
|
c
|
||||||
|
c test intf
|
||||||
|
c
|
||||||
|
do 4 i=0,18
|
||||||
|
a1=1.23456789e12 / (10.0**i)
|
||||||
|
a2=intf(-a1)
|
||||||
|
if (a1 - 1.0e8) 42,41,41
|
||||||
|
41 ia2=0
|
||||||
|
go to 4
|
||||||
|
42 ia2=a2
|
||||||
|
4 punch,i,a1,a2,ia2
|
||||||
|
i=4444
|
||||||
|
punch,i
|
||||||
|
c pause
|
||||||
|
c
|
||||||
|
c test absf
|
||||||
|
c
|
||||||
|
do 5 i=0,10
|
||||||
|
a1=i
|
||||||
|
a2=absf(a1)
|
||||||
|
a3=-a1
|
||||||
|
a4=absf(a3)
|
||||||
|
5 punch,i,a2,a3,a4
|
||||||
|
i=5555
|
||||||
|
punch,i
|
||||||
|
c pause
|
||||||
|
c
|
||||||
|
c test expnf and lnf
|
||||||
|
c
|
||||||
|
do 6 i=1,10,2
|
||||||
|
a1=i
|
||||||
|
a2=expnf(a1)
|
||||||
|
a3=lnf(a1)
|
||||||
|
ia1=a1
|
||||||
|
ia2=a2
|
||||||
|
ia3=a3
|
||||||
|
6 punch,i,a2,ia2,a3,ia3
|
||||||
|
i=6666
|
||||||
|
punch,i
|
||||||
|
c pause
|
||||||
|
c
|
||||||
|
c test expf and logf
|
||||||
|
c
|
||||||
|
do 7 i=0,10
|
||||||
|
a1=(i-5)
|
||||||
|
a2=expf(a1)
|
||||||
|
a3=logf(a2)
|
||||||
|
ia1=a1
|
||||||
|
ia2=a2
|
||||||
|
ia3=a3
|
||||||
|
7 punch,i,a1,ia1,a2,ia2,a3,ia3
|
||||||
|
i=7777
|
||||||
|
punch,i
|
||||||
|
c pause
|
||||||
|
c
|
||||||
|
c test float**float
|
||||||
|
c
|
||||||
|
do 8 i=0,10
|
||||||
|
a1=(i-5)
|
||||||
|
a1=a1/2
|
||||||
|
a2=10.0**a1
|
||||||
|
ia1=a1
|
||||||
|
ia2=a2
|
||||||
|
8 punch,i,a1,ia1,a2,ia2
|
||||||
|
i=8888
|
||||||
|
punch,i
|
||||||
|
c pause
|
||||||
|
c
|
||||||
|
c test float**int and int**int
|
||||||
|
c
|
||||||
|
do 9 i=0,10
|
||||||
|
ia1=2**i
|
||||||
|
a2=2.0**i
|
||||||
|
ia2=a2
|
||||||
|
a3=i
|
||||||
|
a4=4.0**a3
|
||||||
|
ia4=a4
|
||||||
|
9 punch,i,ia1,a2,ia2,a4,ia4
|
||||||
|
i=9999
|
||||||
|
punch,i
|
||||||
|
end
|
42
I650/sw/fortransit/fortransit_example_5_src.txt
Normal file
42
I650/sw/fortransit/fortransit_example_5_src.txt
Normal file
|
@ -0,0 +1,42 @@
|
||||||
|
c ------------------------------
|
||||||
|
c card punch graphics
|
||||||
|
c ------------------------------
|
||||||
|
c
|
||||||
|
pi=3.1415926
|
||||||
|
do 40 i=0,20
|
||||||
|
c
|
||||||
|
a1=(i/20.0)*(2.0*pi)
|
||||||
|
a1=cosf(a1)
|
||||||
|
a1=intf(a1*9)
|
||||||
|
j=a1
|
||||||
|
if (j) 10,11,12
|
||||||
|
10 i1=0
|
||||||
|
i2=10**(10+j)
|
||||||
|
go to 15
|
||||||
|
11 i1=0
|
||||||
|
i2=10**9
|
||||||
|
go to 15
|
||||||
|
12 i1=10**j
|
||||||
|
i2=10**9
|
||||||
|
go to 15
|
||||||
|
15 continue
|
||||||
|
c
|
||||||
|
a1=100.0-(i-10.0)*(i-10.0)
|
||||||
|
a1=sqrtf(a1)
|
||||||
|
a1=intf(9.0-a1*1.8)
|
||||||
|
j=a1
|
||||||
|
if (j) 20,21,22
|
||||||
|
20 i3=0
|
||||||
|
i4=10**(10+j)
|
||||||
|
go to 25
|
||||||
|
21 i3=0
|
||||||
|
i4=10**9
|
||||||
|
go to 25
|
||||||
|
22 i3=10**j
|
||||||
|
i4=10**9
|
||||||
|
go to 25
|
||||||
|
25 continue
|
||||||
|
c
|
||||||
|
40 punch,i,i1,i2,i3,i4
|
||||||
|
pause
|
||||||
|
end
|
1762
I650/sw/fortransit/fortransit_translator.dck
Normal file
1762
I650/sw/fortransit/fortransit_translator.dck
Normal file
File diff suppressed because it is too large
Load diff
1729
I650/sw/fortransit/fortransit_translator_listing.txt
Normal file
1729
I650/sw/fortransit/fortransit_translator_listing.txt
Normal file
File diff suppressed because it is too large
Load diff
1724
I650/sw/fortransit/fortransit_translator_src.txt
Normal file
1724
I650/sw/fortransit/fortransit_translator_src.txt
Normal file
File diff suppressed because it is too large
Load diff
1691
I650/sw/fortransit/it_compiler.dck
Normal file
1691
I650/sw/fortransit/it_compiler.dck
Normal file
File diff suppressed because it is too large
Load diff
1841
I650/sw/fortransit/it_compiler_listing.txt
Normal file
1841
I650/sw/fortransit/it_compiler_listing.txt
Normal file
File diff suppressed because it is too large
Load diff
749
I650/sw/fortransit/pack.dck
Normal file
749
I650/sw/fortransit/pack.dck
Normal file
|
@ -0,0 +1,749 @@
|
||||||
|
0?0000800? 0001 1
|
||||||
|
0?0000800? 0002 1 fortran package missing
|
||||||
|
0?0000800? 0003 1 from original listing
|
||||||
|
0?0000800? 0004 1 rewritten by roberto sancho
|
||||||
|
0?0000800? 0005 1 in may 2018
|
||||||
|
0?0000800? 0006 1
|
||||||
|
0?0000800? 0007 1 fortran package
|
||||||
|
0?0000800? 0008 1 entry points
|
||||||
|
0?0000800? 0009 1
|
||||||
|
0?0000800? 0010 synlaaaa 1999 initial lo
|
||||||
|
0?0000800? 0011 synacc 0000 reserve ac
|
||||||
|
0?0000800? 0012 1
|
||||||
|
0?0000800? 0013 1 built-in subroutines (180 word
|
||||||
|
0?0000800? 0014 1
|
||||||
|
0?0000800? 0015 syne00aa 1961 check over
|
||||||
|
0?0000800? 0016 syne00th 1962 float (u)
|
||||||
|
0?0000800? 0017 syne00ae 1963 fix (l) to
|
||||||
|
0?0000800? 0018 syne00af 1964 fix (l) to
|
||||||
|
0?0000800? 0019 syne00aq 1965 read entry
|
||||||
|
0?0000800? 0020 syne00ar 1966 punch entr
|
||||||
|
0?0000800? 0021 synezzza 1967 save index
|
||||||
|
0?0000800? 0022 synezzzb 1968 restore in
|
||||||
|
0?0000800? 0023 1
|
||||||
|
0?0000800? 0024 1 power subroutines
|
||||||
|
0?0000800? 0025 1
|
||||||
|
0?0000800? 0026 syne00ak 1949 fix (l) **
|
||||||
|
0?0000800? 0027 syne00al 1948 float (u)
|
||||||
|
0?0000800? 0028 syne00lq 1947 float (u)
|
||||||
|
0?0000800? 0029 1
|
||||||
|
0?0000800? 0030 1 function subroutines
|
||||||
|
0?0000800? 0031 1
|
||||||
|
0?0000800? 0032 syne00ab 1969 logf (1)
|
||||||
|
0?0000800? 0033 syne00ac 1970 expf (2)
|
||||||
|
0?0000800? 0034 syne00lo 1971 lnf (300
|
||||||
|
0?0000800? 0035 syne00lp 1972 expnf (301
|
||||||
|
0?0000800? 0036 syne00av 1973 cosf (21)
|
||||||
|
0?0000800? 0037 syne00aw 1974 sinf (22)
|
||||||
|
0?0000800? 0038 syne00ax 1975 sqrtf (23)
|
||||||
|
0?0000800? 0039 syne00ay 1976 absf (24)
|
||||||
|
0?0000800? 0040 syne00az 1945 intf (25)
|
||||||
|
0?0000800? 0041 syne00ba 1946 maxf (26)
|
||||||
|
0?0000800? 0042 1
|
||||||
|
0?0000800? 0043 1 end of fortran package entry p
|
||||||
|
0?0000800? 0044 1
|
||||||
|
0?0000800? 0045 1
|
||||||
|
0?0000800? 0046 1 fortran
|
||||||
|
0?0000800? 0047 1 package reservation
|
||||||
|
0?0000800? 0048 1 for package build
|
||||||
|
0?0000800? 0049 1
|
||||||
|
0?0000800? 0050 1 includes
|
||||||
|
0?0000800? 0051 1 - float fix conversions
|
||||||
|
0?0000800? 0052 1 - fortran read punch statemens
|
||||||
|
0?0000800? 0053 1 - fortran power operator
|
||||||
|
0?0000800? 0054 1 - fortran functions
|
||||||
|
0?0000800? 0055 1 excludes
|
||||||
|
0?0000800? 0056 1 - nothing
|
||||||
|
0?0000800? 0057 1
|
||||||
|
0?0000800? 0058 regy0002 0002 fortransit
|
||||||
|
0?0000800? 0059 1 vars start
|
||||||
|
0?0000800? 0060 blr 0000 1400 reserve al
|
||||||
|
0?0000800? 0061 1 drum excep
|
||||||
|
0?0000800? 0062 1 pack space
|
||||||
|
0?0000800? 0063 1
|
||||||
|
0?0000800? 0064 1 end of package reservation
|
||||||
|
0?0000800? 0065 1
|
||||||
|
0?0000800? 0066 1
|
||||||
|
0?0000800? 0067 1 fortran package
|
||||||
|
0?0000800? 0068 1 source code
|
||||||
|
0?0000800? 0069 1
|
||||||
|
0?0000800? 0070 blr 1945 1950 entry powe
|
||||||
|
0?0000800? 0071 regp1951 1960 read band
|
||||||
|
0?0000800? 0072 blr 1961 1968 entry buil
|
||||||
|
0?0000800? 0073 blr 1969 1976 entry func
|
||||||
|
0?0000800? 0074 regj1977 1986 punch band
|
||||||
|
0?0000800? 0075 blr 1987 1987
|
||||||
|
0?0000800? 0076 regw1988 1998 storage ba
|
||||||
|
0?0000800? 0077 1
|
||||||
|
0?0000800? 0078 1 save index registers
|
||||||
|
0?0000800? 0079 1
|
||||||
|
6I1954195C 0080241967800?241420142C ezzzastdezzzx
|
||||||
|
6I1954195C 0081241423800?698005142I ldd 8005
|
||||||
|
6I1954195C 0082241429800?241432143E stdezzia
|
||||||
|
6I1954195C 0083241435800?698006144A ldd 8006
|
||||||
|
6I1954195C 0084241441800?241444144G stdezzib
|
||||||
|
6I1954195C 0085241447800?698007140C ldd 8007
|
||||||
|
6I1954195C 0086241403800?241406142? stdezzic ezzzx
|
||||||
|
0?0000800? 0087 1
|
||||||
|
0?0000800? 0088 1 restore saved index registers
|
||||||
|
0?0000800? 0089 1
|
||||||
|
6I1954195C 0090241968800?691432148E ezzzblddezzia
|
||||||
|
6I1954195C 0091241485800?808001149A raa 8001
|
||||||
|
6I1954195C 0092241491800?691444149G lddezzib
|
||||||
|
6I1954195C 0093241497800?828001145C rab 8001
|
||||||
|
6I1954195C 0094241453800?691406140I lddezzic
|
||||||
|
6I1954195C 0095241409800?888001141E rac 8001 erthx
|
||||||
|
6I1954195C 0096241420800?000000000? ezzzx 00 0000 0000
|
||||||
|
6I1954195C 0097241432800?000000000? ezzia 00 0000 0000
|
||||||
|
6I1954195C 0098241444800?000000000? ezzib 00 0000 0000
|
||||||
|
6I1954195C 0099241406800?000000000? ezzic 00 0000 0000
|
||||||
|
0?0000800? 0100 1
|
||||||
|
0?0000800? 0101 1 overflow checking
|
||||||
|
0?0000800? 0102 1
|
||||||
|
6I1954195C 0103241961800?471414800A e00aabov 8001
|
||||||
|
6I1954195C 0104241414800?010100800A hlt 0100 8001 alarm arit
|
||||||
|
0?0000800? 0105 1
|
||||||
|
0?0000800? 0106 1 (l) fixed point - (u) float
|
||||||
|
0?0000800? 0107 1
|
||||||
|
6I1954195C 0108241962800?241415141H e00thstderthx float uppe
|
||||||
|
6I1954195C 0109241418800?300002142E srt 0002 to fix low
|
||||||
|
6I1954195C 0110241425800?211430143C stuartha save manti
|
||||||
|
6I1954195C 0111241433800?678002154A ram 8002 test exp
|
||||||
|
6I1954195C 0112241541800?161494144I slon51 store zero
|
||||||
|
6I1954195C 0113241449800?461402150C bmiad1 if less th
|
||||||
|
6I1954195C 0114241503800?161456141A slon10 51 ala
|
||||||
|
6I1954195C 0115241411800?461464146E bmi ad3 if grtr th
|
||||||
|
6I1954195C 0116241464800?300004147E srt 0004 60
|
||||||
|
6I1954195C 0117241475800?151428148C aloonet
|
||||||
|
6I1954195C 0118241483800?691436143I lddad2a modify
|
||||||
|
6I1954195C 0119241439800?221443144F sdaad2 shift
|
||||||
|
6I1954195C 0120241446800?651430153E ralartha
|
||||||
|
6I1954195C 0121241535800?350002144C slt 0002 ad2
|
||||||
|
6I1954195C 0122241402800?658003141E ad1 ral 8003 erthx store zero
|
||||||
|
6I1954195C 0123241443800?300000141E ad2 srt 0000 erthx shift cons
|
||||||
|
6I1954195C 0124241436800?300000141E ad2a srt 0000 erthx
|
||||||
|
6I1954195C 0125241465800?691415146H ad3 ldderthx
|
||||||
|
6I1954195C 0126241468800?010501800A hlt 0501 8001 alarm floa
|
||||||
|
6I1954195C 0127241456800?100000000? n10 10 0000 0000
|
||||||
|
6I1954195C 0128241494800?510000000? n51 51 0000 0000
|
||||||
|
6I1954195C 0129241428800?000001000? onet 00 0001 0000
|
||||||
|
6I1954195C 0130241415800?000000000? erthx 00 0000 0000
|
||||||
|
6I1954195C 0131241430800?000000000? artha 00 0000 0000
|
||||||
|
0?0000800? 0132 1
|
||||||
|
0?0000800? 0133 1 (u) and (acc) float - (l) fix
|
||||||
|
0?0000800? 0134 1
|
||||||
|
6I1954195C 0135241964800?241430153C e00afstdartha float to u
|
||||||
|
6I1954195C 0136241533800?691486196C ldd e00ae and acc
|
||||||
|
6I1954195C 0137241486800?210000143? stuacc artha
|
||||||
|
0?0000800? 0138 1
|
||||||
|
0?0000800? 0139 1 (u) float - (l) fixed point
|
||||||
|
0?0000800? 0140 1
|
||||||
|
6I1954195C 0141241963800?241415151H e00aestderthx float to u
|
||||||
|
6I1954195C 0142241518800?608002142G rau 8002 ae0 only
|
||||||
|
6I1954195C 0143241427800?360000149I ae0 sct 0000 normalize
|
||||||
|
6I1954195C 0144241499800?201553150F stlarthb
|
||||||
|
6I1954195C 0145241506800?471402146A bovad1 zero check
|
||||||
|
6I1954195C 0146241461800?658003141I ral 8003
|
||||||
|
6I1954195C 0147241419800?310002147G srd 0002 round for
|
||||||
|
6I1954195C 0148241477800?350002158C slt 0002 placing ex
|
||||||
|
6I1954195C 0149241583800?441437143H nzu ae6 check roun
|
||||||
|
6I1954195C 0150241437800?698003154D ldd 8003 overflow
|
||||||
|
6I1954195C 0151241544800?300001140A srt 0001
|
||||||
|
6I1954195C 0152241401800?158001143H alo 8001 ae6
|
||||||
|
6I1954195C 0153241438800?461591144B ae6 bmiae2 insert
|
||||||
|
6I1954195C 0154241442800?151445154I aloaj3 ae5 exponent
|
||||||
|
6I1954195C 0155241591800?161445154I ae2 sloaj3 ae5
|
||||||
|
6I1954195C 0156241549800?161553140G ae5 sloarthb
|
||||||
|
6I1954195C 0157241407800?608002141E rau 8002 erthx
|
||||||
|
6I1954195C 0158241445800?000000006? aj3 00 0000 0060
|
||||||
|
6I1954195C 0159241553800?000000000? arthb 00 0000 0000
|
||||||
|
0?0000800? 0160 1
|
||||||
|
0?0000800? 0161 1 punch card
|
||||||
|
0?0000800? 0162 1
|
||||||
|
6I1954195C 0163241966800?241415156H e00arstderthx punch out
|
||||||
|
6I1954195C 0164241568800?691984148G lddj0008
|
||||||
|
6I1954195C 0165241487800?231984153G siaj0008 store stmn
|
||||||
|
6I1954195C 0166241537800?691428143A lddonet
|
||||||
|
6I1954195C 0167241431800?221585148H sdanvars and nvars
|
||||||
|
6I1954195C 0168241488800?168001149E slo 8001 if stmt ze
|
||||||
|
6I1954195C 0169241495800?451448159I nzear3 punch if
|
||||||
|
6I1954195C 0170241599800?658000145G ral 8000 8000 is ne
|
||||||
|
6I1954195C 0171241457800?461448141E bmiar3 erthx else exit
|
||||||
|
6I1954195C 0172241448800?691451140D ar3 lddar3a ar5 init pch c
|
||||||
|
6I1954195C 0173241451800?651585148I ar3a ralnvars dec nvars
|
||||||
|
6I1954195C 0174241489800?161428163C sloonet
|
||||||
|
6I1954195C 0175241633800?461536158G bmiar8 test word
|
||||||
|
6I1954195C 0176241587800?201585153H stlnvars count
|
||||||
|
6I1954195C 0177241538800?151641800B alo 8002 get nword
|
||||||
|
6I1954195C 0178241641800?651989149C ralw0002 in lower
|
||||||
|
6I1954195C 0179241493800?691496164I lddnword
|
||||||
|
6I1954195C 0180241649800?221496169I sdanword store num
|
||||||
|
6I1954195C 0181241699800?350004145I slt 0004
|
||||||
|
6I1954195C 0182241459800?691412151E lddadwrd
|
||||||
|
6I1954195C 0183241515800?221412156E sdaadwrd ar4 store addr
|
||||||
|
6I1954195C 0184241565800?651618147C ar4 ralnpch is card fu
|
||||||
|
6I1954195C 0185241473800?161426148A sloarn7
|
||||||
|
6I1954195C 0186241481800?461434163E bmiar4a
|
||||||
|
6I1954195C 0187241635800?711977152G pchj0001 yes punch
|
||||||
|
6I1954195C 0188241527800?691434140D lddar4a ar5 call init
|
||||||
|
6I1954195C 0189241434800?651618152C ar4a ralnpch incr no of
|
||||||
|
6I1954195C 0190241523800?151428168C aloonet punched w
|
||||||
|
6I1954195C 0191241683800?201618142A stlnpch
|
||||||
|
6I1954195C 0192241421800?651412141G raladwrd indr adwrd
|
||||||
|
6I1954195C 0193241417800?151428173C aloonet
|
||||||
|
6I1954195C 0194241733800?201412161E stladwrd
|
||||||
|
6I1954195C 0195241615800?161428178C sloonet
|
||||||
|
6I1954195C 0196241783800?151586800B alo 8002 get adwrd
|
||||||
|
6I1954195C 0197241586800?650001140E raly0000 contents
|
||||||
|
6I1954195C 0198241405800?201509146B stldatwd store in
|
||||||
|
6I1954195C 0199241462800?601665146I raudatld
|
||||||
|
6I1954195C 0200241469800?151618157C alonpch store at
|
||||||
|
6I1954195C 0201241573800?151476800C alo 8003 j0000 plu
|
||||||
|
6I1954195C 0202241476800?241976147I stdj0000 npch
|
||||||
|
6I1954195C 0203241479800?651496150A ralnword decr var n
|
||||||
|
6I1954195C 0204241501800?161428183C sloonet to be pun
|
||||||
|
6I1954195C 0205241833800?451636145A nze ar3a
|
||||||
|
6I1954195C 0206241636800?461451144? bmiar3a
|
||||||
|
6I1954195C 0207241440800?201496156E stlnword ar4
|
||||||
|
6I1954195C 0208241404800?241507141? ar5 stdar5x sub init p
|
||||||
|
6I1954195C 0209241410800?651984153I ralj0008 incr card
|
||||||
|
6I1954195C 0210241539800?151428188C aloonet number
|
||||||
|
6I1954195C 0211241883800?201984163G stlj0008
|
||||||
|
6I1954195C 0212241637800?211618147A stunpch card with
|
||||||
|
6I1954195C 0213241471800?241977148? stdj0001 punched w
|
||||||
|
6I1954195C 0214241480800?241978153A stdj0002 set punch
|
||||||
|
6I1954195C 0215241531800?241979148B stdj0003 band to
|
||||||
|
6I1954195C 0216241482800?241980193C stdj0004 zeroes
|
||||||
|
6I1954195C 0217241933800?241981148D stdj0005
|
||||||
|
6I1954195C 0218241484800?241982168E stdj0006
|
||||||
|
6I1954195C 0219241685800?241983150G stdj0007 ar5x
|
||||||
|
6I1954195C 0220241536800?711977141E ar8 pchj0001 erthx punch
|
||||||
|
6I1954195C 0221241428800?000001000? onet 00 0001 0000
|
||||||
|
6I1954195C 0222241426800?000007000? arn7 00 0007 0000
|
||||||
|
6I1954195C 0223241984800?000000000? j0008 00 0000 0000 card count
|
||||||
|
6I1954195C 0224241986800?800000008? j0010 80 0000 0080 control cn
|
||||||
|
6I1954195C 0225241507800?000000000? ar5x 00 0000 0000 exit for s
|
||||||
|
6I1954195C 0226241585800?000000000? nvars 00 0000 0000 num of var
|
||||||
|
6I1954195C 0227241496800?000000000? nword 00 0000 0000 num of wor
|
||||||
|
6I1954195C 0228241412800?000000000? adwrd 00 0000 0000 addr of wo
|
||||||
|
6I1954195C 0229241618800?000000000? npch 00 0000 0000 num of wor
|
||||||
|
6I1954195C 0230241509800?000000000? datwd 00 0000 0000 data word
|
||||||
|
0?0000800? 0231 1
|
||||||
|
0?0000800? 0232 1 read card
|
||||||
|
0?0000800? 0233 1
|
||||||
|
6I1954195C 0234241965800?241415166H e00aqstderthx read in
|
||||||
|
6I1954195C 0235241668800?691428158A lddonet
|
||||||
|
6I1954195C 0236241581800?221585158H sdanvars nvars to r
|
||||||
|
6I1954195C 0237241588800?211618152A stunpch aq3a init to ze
|
||||||
|
6I1954195C 0238241521800?651585158I aq3a ralnvars dec nvars
|
||||||
|
6I1954195C 0239241589800?161428153D sloonet
|
||||||
|
6I1954195C 0240241534800?461415163H bmierthx exit if ze
|
||||||
|
6I1954195C 0241241638800?201585168H stlnvars
|
||||||
|
6I1954195C 0242241688800?151691800B alo 8002 get nword
|
||||||
|
6I1954195C 0243241691800?651989154C ralw0002 in lower
|
||||||
|
6I1954195C 0244241543800?691496174I lddnword
|
||||||
|
6I1954195C 0245241749800?221496179I sdanword store num
|
||||||
|
6I1954195C 0246241799800?350004155I slt 0004
|
||||||
|
6I1954195C 0247241559800?691412171E lddadwrd
|
||||||
|
6I1954195C 0248241715800?221412176E sdaadwrd aq4 store addr
|
||||||
|
6I1954195C 0249241765800?651618162C aq4 ralnpch check if s
|
||||||
|
6I1954195C 0250241623800?451526157G nzeaq4a
|
||||||
|
6I1954195C 0251241577800?701951155A rcdp0001 yes read
|
||||||
|
6I1954195C 0252241551800?691426152I lddarn7
|
||||||
|
6I1954195C 0253241529800?241618152F stdnpch aq4a
|
||||||
|
6I1954195C 0254241526800?651618167C aq4a ralnpch decr no of
|
||||||
|
6I1954195C 0255241673800?161428158D sloonet punched wo
|
||||||
|
6I1954195C 0256241584800?201618157A stlnpch
|
||||||
|
6I1954195C 0257241571800?651426163A ralarn7
|
||||||
|
6I1954195C 0258241631800?161618172C slonpch get word a
|
||||||
|
6I1954195C 0259241723800?151576800B alo 8002 p0000 plu
|
||||||
|
6I1954195C 0260241576800?691950160C lddp0000 npch in d
|
||||||
|
6I1954195C 0261241603800?241509151B stddatwd store it
|
||||||
|
6I1954195C 0262241512800?601665151I raudatld
|
||||||
|
6I1954195C 0263241519800?151412146G aloadwrd incr adwrd
|
||||||
|
6I1954195C 0264241467800?151428163D aloonet
|
||||||
|
6I1954195C 0265241634800?201412181E stladwrd
|
||||||
|
6I1954195C 0266241815800?161428168D sloonet
|
||||||
|
6I1954195C 0267241684800?151687800C alo 8003 set adwrd
|
||||||
|
6I1954195C 0268241687800?240001145D stdy0000 contents
|
||||||
|
6I1954195C 0269241454800?651496160A ralnword decr var n
|
||||||
|
6I1954195C 0270241601800?161428173D sloonet to be rea
|
||||||
|
6I1954195C 0271241734800?451738152A nze aq3a
|
||||||
|
6I1954195C 0272241738800?461521149B bmiaq3a
|
||||||
|
6I1954195C 0273241492800?201496176E stlnword aq4
|
||||||
|
6I1954195C 0274241428800?000001000? onet 00 0001 0000
|
||||||
|
6I1954195C 0275241665800?691509800B datldldddatwd 8002 load card
|
||||||
|
0?0000800? 0276 1
|
||||||
|
0?0000800? 0277 1 alarm if try to use a not defi
|
||||||
|
0?0000800? 0278 1
|
||||||
|
6I1954195C 0279241949800?019010800A e00akhlt 9010 8001 alarm fix
|
||||||
|
6I1954195C 0280241948800?019011800A e00alhlt 9011 8001 alarm floa
|
||||||
|
6I1954195C 0281241947800?019302800A e00lqhlt 9302 8001 alarm floa
|
||||||
|
6I1954195C 0282241969800?019001800A e00abhlt 9001 8001 alarm logf
|
||||||
|
6I1954195C 0283241970800?019002800A e00achlt 9002 8001 alarm expf
|
||||||
|
6I1954195C 0284241971800?019300800A e00lohlt 9300 8001 alarm lnf
|
||||||
|
6I1954195C 0285241972800?019301800A e00lphlt 9301 8001 alarm expn
|
||||||
|
6I1954195C 0286241973800?019021800A e00avhlt 9021 8001 alarm cosf
|
||||||
|
6I1954195C 0287241974800?019022800A e00awhlt 9022 8001 alarm sinf
|
||||||
|
6I1954195C 0288241975800?019023800A e00axhlt 9023 8001 alarm sqrt
|
||||||
|
6I1954195C 0289241976800?019024800A e00ayhlt 9024 8001 alarm absf
|
||||||
|
6I1954195C 0290241945800?019025800A e00azhlt 9025 8001 alarm intf
|
||||||
|
6I1954195C 0291241946800?019026800A e00bahlt 9026 8001 alarm maxf
|
||||||
|
6I1954195C 0292241450800?019099800A ezztyhlt 9099 8001 alarm func
|
||||||
|
0?0000800? 0293 1
|
||||||
|
0?0000800? 0294 1 start of subroutines
|
||||||
|
0?0000800? 0295 1
|
||||||
|
0?0000800? 0296 1
|
||||||
|
0?0000800? 0297 1 (l) and (acc) fixed - (l) fix
|
||||||
|
0?0000800? 0298 1
|
||||||
|
6I1954195C 0299241949800?241415171H e00akstderthx power fix
|
||||||
|
6I1954195C 0300241718800?201430178D stlartha ak1 m is argmn
|
||||||
|
6I1954195C 0301241784800?670000145E ak1 ramacc p equals
|
||||||
|
6I1954195C 0302241455800?201553155F stlarthb abval pow
|
||||||
|
6I1954195C 0303241556800?651609141C ralone h is resul
|
||||||
|
6I1954195C 0304241413800?201517147? stlarthc ak3 init to o
|
||||||
|
6I1954195C 0305241470800?601553155G ak3 rauarthb p is gtst
|
||||||
|
6I1954195C 0306241557800?191460168A mpyn50 intgr in
|
||||||
|
6I1954195C 0307241681800?211553160F stuarthb p over tw
|
||||||
|
6I1954195C 0308241606800?658002186E ral 8002 is remaind
|
||||||
|
6I1954195C 0309241865800?451768156I nze ak5 zero
|
||||||
|
6I1954195C 0310241768800?601517162A rauarthc if not h i
|
||||||
|
6I1954195C 0311241621800?191430165A mpyartha h times m
|
||||||
|
6I1954195C 0312241651800?441505165F nzuak12
|
||||||
|
6I1954195C 0313241656800?201517156I stlarthc ak5
|
||||||
|
6I1954195C 0314241569800?601553160G ak5 rauarthb
|
||||||
|
6I1954195C 0315241607800?441511156B nzu ak6 is p zero
|
||||||
|
6I1954195C 0316241511800?601430173E rauartha if not
|
||||||
|
6I1954195C 0317241735800?198001165I mpy 8001 m equals
|
||||||
|
6I1954195C 0318241659800?441505151D nzuak12
|
||||||
|
6I1954195C 0319241514800?201430147? stlartha ak3 m squared
|
||||||
|
6I1954195C 0320241562800?600000155E ak6 rauacc is power n
|
||||||
|
6I1954195C 0321241555800?461408170I bmi ak7 if so is h
|
||||||
|
6I1954195C 0322241408800?671517167A ramarthc zero
|
||||||
|
6I1954195C 0323241671800?451424152E nze ak8 if not is
|
||||||
|
6I1954195C 0324241424800?161609146C sloone one
|
||||||
|
6I1954195C 0325241463800?451416170I nzeak10 ak7
|
||||||
|
6I1954195C 0326241709800?651517172A ak7 ralarthc ak11 exhibit h
|
||||||
|
6I1954195C 0327241416800?658003172A ak10 ral 8003 ak11
|
||||||
|
6I1954195C 0328241721800?200000141E ak11 stlacc erthx
|
||||||
|
6I1954195C 0329241505800?691415181H ak12 ldderthx
|
||||||
|
6I1954195C 0330241818800?010003800A hlt 0003 8001 alarm over
|
||||||
|
6I1954195C 0331241525800?691415186H ak8 ldderthx
|
||||||
|
6I1954195C 0332241868800?010010800A hlt 0010 8001 alarm zero
|
||||||
|
6I1954195C 0333241460800?500000000? n50 50 0000 0000
|
||||||
|
6I1954195C 0334241609800?000000000A one 00 0000 0001
|
||||||
|
6I1954195C 0335241517800?000000000? arthc 00 0000 0000
|
||||||
|
0?0000800? 0336 1
|
||||||
|
0?0000800? 0337 1 (u) and (acc) float - (u) flo
|
||||||
|
0?0000800? 0338 1
|
||||||
|
6I1954195C 0339241948800?241415191H e00alstderthx power floa
|
||||||
|
6I1954195C 0340241918800?211430183D stuartha al1 m is argmn
|
||||||
|
6I1954195C 0341241834800?670000160E al1 ramacc p equals
|
||||||
|
6I1954195C 0342241605800?201553170F stlarthb abval pow
|
||||||
|
6I1954195C 0343241706800?651759151C ralfp1 h is resul
|
||||||
|
6I1954195C 0344241513800?201517152? stlarthc al3 init to f
|
||||||
|
6I1954195C 0345241520800?601553165G al3 rauarthb p is gtst
|
||||||
|
6I1954195C 0346241657800?191460173A mpyn50 intgr in
|
||||||
|
6I1954195C 0347241731800?211553175F stuarthb p over tw
|
||||||
|
6I1954195C 0348241756800?658002191E ral 8002 is remaind
|
||||||
|
6I1954195C 0349241915800?451619166I nze al5 zero
|
||||||
|
6I1954195C 0350241619800?601517177A rauarthc if not h i
|
||||||
|
6I1954195C 0351241771800?391430153? fmpartha h times m
|
||||||
|
6I1954195C 0352241530800?471884178E boval12
|
||||||
|
6I1954195C 0353241785800?211517166I stuarthc al5
|
||||||
|
6I1954195C 0354241669800?601553170G al5 rauarthb
|
||||||
|
6I1954195C 0355241707800?441561161B nzu al6 is p zero
|
||||||
|
6I1954195C 0356241561800?601430183E rauartha if not
|
||||||
|
6I1954195C 0357241835800?398001178H fmp 8001 m equals
|
||||||
|
6I1954195C 0358241788800?471884159C boval12
|
||||||
|
6I1954195C 0359241593800?211430152? stuartha al3 m squared
|
||||||
|
6I1954195C 0360241612800?600000165E al6 rauacc is power n
|
||||||
|
6I1954195C 0361241655800?461458180I bmi al7 if so is h
|
||||||
|
6I1954195C 0362241458800?671517182A ramarthc zero
|
||||||
|
6I1954195C 0363241821800?451474157E nze al8 if not cal
|
||||||
|
6I1954195C 0364241474800?601759156C raufp1 h recipro
|
||||||
|
6I1954195C 0365241563800?341517156G fdvarthc al11
|
||||||
|
6I1954195C 0366241809800?601517156G al7 rauarthc al11 exhibit h
|
||||||
|
6I1954195C 0367241567800?210000141E al11 stuacc erthx
|
||||||
|
6I1954195C 0368241884800?691415171I al12 ldderthx
|
||||||
|
6I1954195C 0369241719800?010049800A hlt 0049 8001 alarm over
|
||||||
|
6I1954195C 0370241575800?691415176I al8 ldderthx
|
||||||
|
6I1954195C 0371241769800?010011800A hlt 0011 8001 alarm zero
|
||||||
|
6I1954195C 0372241460800?500000000? n50 50 0000 0000
|
||||||
|
6I1954195C 0373241759800?100000005A fp1 10 0000 0051
|
||||||
|
0?0000800? 0374 1
|
||||||
|
0?0000800? 0375 1 (u) float - 10 ** (u) float
|
||||||
|
0?0000800? 0376 1
|
||||||
|
6I1954195C 0377241970800?241415181I e00acstderthx exponentia
|
||||||
|
6I1954195C 0378241819800?451422177C nze ac5 is argumen
|
||||||
|
6I1954195C 0379241422800?441625145? nzu ezzty alarm func
|
||||||
|
6I1954195C 0380241625800?300002178A srt 0002 zero
|
||||||
|
6I1954195C 0381241781800?211517157? stuarthc if not let
|
||||||
|
6I1954195C 0382241570800?688002157I rsm 8002 n be mant
|
||||||
|
6I1954195C 0383241579800?151532173G alon52 x be powe
|
||||||
|
6I1954195C 0384241737800?461490174A bmiac4 is x grtr
|
||||||
|
6I1954195C 0385241741800?350001154G slt 0001 than ten
|
||||||
|
6I1954195C 0386241547800?441773145B nzuac5 or less th
|
||||||
|
6I1954195C 0387241452800?300005146F srt 0005 minus eig
|
||||||
|
6I1954195C 0388241466800?151869182C aloac6 if x withi
|
||||||
|
6I1954195C 0389241823800?201553180F stlarthb bounds ge
|
||||||
|
6I1954195C 0390241806800?601517187A rauarthc int and
|
||||||
|
6I1954195C 0391241871800?300006155C srt 0006 arthb fract part
|
||||||
|
6I1954195C 0392241532800?520000000? n52 52 0000 0000 of argume
|
||||||
|
6I1954195C 0393241869800?300000179A ac6 srt 0000 is arg neg
|
||||||
|
6I1954195C 0394241791800?461594154E bmiac8 if so int
|
||||||
|
6I1954195C 0395241545800?211553185F stuarthb ac1 int minus
|
||||||
|
6I1954195C 0396241594800?111609161C ac8 supone and fract
|
||||||
|
6I1954195C 0397241613800?211553190F stuarthb fract plus
|
||||||
|
6I1954195C 0398241906800?658002151F ral 8002
|
||||||
|
6I1954195C 0399241516800?151919185F alon999 ac1
|
||||||
|
6I1954195C 0400241856800?201517162? ac1 stlarthc arthc is f
|
||||||
|
6I1954195C 0401241620800?608002162I rau 8002 arthb is i
|
||||||
|
6I1954195C 0402241629800?191582165C mpyac18 generate
|
||||||
|
6I1954195C 0403241653800?608003161A rau 8003
|
||||||
|
6I1954195C 0404241611800?101564167? aupac17 polynomia
|
||||||
|
6I1954195C 0405241670800?191517178G mpyarthc
|
||||||
|
6I1954195C 0406241787800?608003159E rau 8003 approxima
|
||||||
|
6I1954195C 0407241595800?101498170C aupac16
|
||||||
|
6I1954195C 0408241703800?191517183G mpyarthc
|
||||||
|
6I1954195C 0409241837800?608003164E rau 8003 for
|
||||||
|
6I1954195C 0410241645800?101548175C aupac15
|
||||||
|
6I1954195C 0411241753800?191517188G mpyarthc exponentia
|
||||||
|
6I1954195C 0412241887800?608003169E rau 8003
|
||||||
|
6I1954195C 0413241695800?101598180C aupac14
|
||||||
|
6I1954195C 0414241803800?191517193G mpyarthc
|
||||||
|
6I1954195C 0415241937800?608003174E rau 8003
|
||||||
|
6I1954195C 0416241745800?101648185C aupac13
|
||||||
|
6I1954195C 0417241853800?191517183H mpyarthc
|
||||||
|
6I1954195C 0418241838800?608003179E rau 8003
|
||||||
|
6I1954195C 0419241795800?101698190C aupac12
|
||||||
|
6I1954195C 0420241903800?191517188H mpyarthc square
|
||||||
|
6I1954195C 0421241888800?608003184E rau 8003 result
|
||||||
|
6I1954195C 0422241845800?101456166A aupn10 scale and
|
||||||
|
6I1954195C 0423241661800?198003188E mpy 8003 float the
|
||||||
|
6I1954195C 0424241885800?300001184A srt 0001 exit
|
||||||
|
6I1954195C 0425241841800?211430193D stuartha
|
||||||
|
6I1954195C 0426241934800?601938164C rauac19
|
||||||
|
6I1954195C 0427241643800?101553175G auparthb
|
||||||
|
6I1954195C 0428241757800?461510171A bmiac20
|
||||||
|
6I1954195C 0429241711800?300002161G srt 0002
|
||||||
|
6I1954195C 0430241617800?441921147B nzuac21
|
||||||
|
6I1954195C 0431241472800?101430193E aupartha
|
||||||
|
6I1954195C 0432241935800?300008151? srt 0008 ac20
|
||||||
|
6I1954195C 0433241490800?651517152B ac4 ralarthc
|
||||||
|
6I1954195C 0434241522800?461675192A bmi ac21
|
||||||
|
6I1954195C 0435241675800?608003141E rau 8003 erthx result zer
|
||||||
|
6I1954195C 0436241773800?601759141E ac5 raufp1 erthx result 1 b
|
||||||
|
6I1954195C 0437241510800?608002141E ac20 rau 8002 erthx result in
|
||||||
|
6I1954195C 0438241921800?691415172? ac21 ldderthx
|
||||||
|
6I1954195C 0439241720800?010049800A hlt 0049 8001 alarm over
|
||||||
|
6I1954195C 0440241698800?115129277F ac12 11 5129 2776
|
||||||
|
6I1954195C 0441241648800?066273088D ac13 06 6273 0884
|
||||||
|
6I1954195C 0442241598800?025439357E ac14 02 5439 3575
|
||||||
|
6I1954195C 0443241548800?007295173G ac15 00 7295 1737
|
||||||
|
6I1954195C 0444241498800?001742112? ac16 00 1742 1120
|
||||||
|
6I1954195C 0445241564800?000255491H ac17 00 0255 4918
|
||||||
|
6I1954195C 0446241582800?000093264C ac18 00 0093 2643
|
||||||
|
6I1954195C 0447241938800?000000005A ac19 00 0000 0051
|
||||||
|
6I1954195C 0448241919800?999999999I n999 99 9999 9999
|
||||||
|
6I1954195C 0449241456800?100000000? n10 10 0000 0000
|
||||||
|
6I1954195C 0450241609800?000000000A one 00 0000 0001
|
||||||
|
6I1954195C 0451241759800?100000005A fp1 10 0000 0051
|
||||||
|
6I1954195C 0452241517800?000000000? arthc 00 0000 0000
|
||||||
|
0?0000800? 0453 1
|
||||||
|
0?0000800? 0454 1 (u) float - log 10 (u) float
|
||||||
|
0?0000800? 0455 1
|
||||||
|
6I1954195C 0456241969800?451572187C e00abnze ab10 if log arg
|
||||||
|
6I1954195C 0457241572800?441725145? nzu ezzty alarm func
|
||||||
|
6I1954195C 0458241725800?461873167I bmiab10 or neg ala
|
||||||
|
6I1954195C 0459241679800?241415177? stderthx
|
||||||
|
6I1954195C 0460241770800?300002162G srt 0002
|
||||||
|
6I1954195C 0461241627800?201553180G stlarthb store powe
|
||||||
|
6I1954195C 0462241807800?608003156F rau 8003 form z
|
||||||
|
6I1954195C 0463241566800?101820177E aupab1 equal arg
|
||||||
|
6I1954195C 0464241775800?211517187? stuarthc minus root
|
||||||
|
6I1954195C 0465241870800?111923167G supab2 ten over a
|
||||||
|
6I1954195C 0466241677800?641517172G dvrarthc plus root
|
||||||
|
6I1954195C 0467241727800?201430168F stlartha ten
|
||||||
|
6I1954195C 0468241686800?608002189E rau 8002
|
||||||
|
6I1954195C 0469241895800?198001192? mpy 8001 z square
|
||||||
|
6I1954195C 0470241920800?211517162B stuarthc
|
||||||
|
6I1954195C 0471241622800?608003172I rau 8003 generate
|
||||||
|
6I1954195C 0472241729800?191632150D mpyab7
|
||||||
|
6I1954195C 0473241504800?608003176A rau 8003 polynomial
|
||||||
|
6I1954195C 0474241761800?101614167B aupab6
|
||||||
|
6I1954195C 0475241672800?191517163I mpyarthc approximat
|
||||||
|
6I1954195C 0476241639800?608003159G rau 8003
|
||||||
|
6I1954195C 0477241597800?101500170E aupab5
|
||||||
|
6I1954195C 0478241705800?191517168I mpyarthc
|
||||||
|
6I1954195C 0479241689800?608003164G rau 8003
|
||||||
|
6I1954195C 0480241647800?101550175E aupab4
|
||||||
|
6I1954195C 0481241755800?191517173I mpyarthc
|
||||||
|
6I1954195C 0482241739800?608003169G rau 8003
|
||||||
|
6I1954195C 0483241697800?101600180E aupab3
|
||||||
|
6I1954195C 0484241805800?191430170A mpyartha
|
||||||
|
6I1954195C 0485241701800?658003185I ral 8003
|
||||||
|
6I1954195C 0486241859800?151460161F alon50
|
||||||
|
6I1954195C 0487241616800?300002152D srt 0002
|
||||||
|
6I1954195C 0488241524800?151553185G aloarthb add power
|
||||||
|
6I1954195C 0489241857800?161460166F slon50
|
||||||
|
6I1954195C 0490241666800?310002182E srd 0002 round
|
||||||
|
6I1954195C 0491241825800?608002173F rau 8002
|
||||||
|
6I1954195C 0492241736800?360000190I sct 0000 normalize
|
||||||
|
6I1954195C 0493241909800?471662166D bovab12
|
||||||
|
6I1954195C 0494241664800?461667172B bmi ab13
|
||||||
|
6I1954195C 0495241667800?111772177G supab9 ab11 adjust
|
||||||
|
6I1954195C 0496241777800?118002166B ab11 sup 8002 ab12 power
|
||||||
|
6I1954195C 0497241662800?608003182B ab12 rau 8003
|
||||||
|
6I1954195C 0498241822800?331759141E fsbfp1 erthx
|
||||||
|
6I1954195C 0499241722800?101772177G ab13 aupab9 ab11
|
||||||
|
6I1954195C 0500241873800?010001800A ab10 hlt 0001 8001 alarm log
|
||||||
|
6I1954195C 0501241820800?003162278? ab1 00 3162 2780
|
||||||
|
6I1954195C 0502241923800?006324556? ab2 00 6324 5560
|
||||||
|
6I1954195C 0503241600800?868591718? ab3 86 8591 7180
|
||||||
|
6I1954195C 0504241550800?289335524? ab4 28 9335 5240
|
||||||
|
6I1954195C 0505241500800?177522071? ab5 17 7522 0710
|
||||||
|
6I1954195C 0506241614800?094376476? ab6 09 4376 4760
|
||||||
|
6I1954195C 0507241632800?191337714? ab7 19 1337 7140
|
||||||
|
6I1954195C 0508241460800?500000000? n50 50 0000 0000
|
||||||
|
6I1954195C 0509241759800?100000005A fp1 10 0000 0051
|
||||||
|
6I1954195C 0510241772800?000000005D ab9 00 0000 0054
|
||||||
|
6I1954195C 0511241517800?000000000? arthc 00 0000 0000
|
||||||
|
0?0000800? 0512 1
|
||||||
|
0?0000800? 0513 1 (u) and (acc) float - (u) flo
|
||||||
|
0?0000800? 0514 1 u**acc = 10**(lo
|
||||||
|
0?0000800? 0515 1 = exp(log
|
||||||
|
0?0000800? 0516 1
|
||||||
|
6I1954195C 0517241947800?241650155D e00lqstdlq1
|
||||||
|
6I1954195C 0518241554800?691907196I ldd e00ab log 10 (u)
|
||||||
|
6I1954195C 0519241907800?390000170? fmpacc mult by ac
|
||||||
|
6I1954195C 0520241700800?691650197? lddlq1 e00ac 10 ** u
|
||||||
|
6I1954195C 0521241650800?000000000? lq1 00 0000 0000
|
||||||
|
0?0000800? 0522 1
|
||||||
|
0?0000800? 0523 1 (u) float - log e (u) float
|
||||||
|
0?0000800? 0524 1 ln(u) = log(u) /
|
||||||
|
0?0000800? 0525 1 log10(e)=0.434294
|
||||||
|
0?0000800? 0526 1
|
||||||
|
6I1954195C 0527241971800?241650160D e00lostdlq1
|
||||||
|
6I1954195C 0528241604800?691508196I ldd e00ab log 10 (u)
|
||||||
|
6I1954195C 0529241508800?341811165? fdvloge lq1 div by log
|
||||||
|
6I1954195C 0530241650800?000000000? lq1 00 0000 0000
|
||||||
|
6I1954195C 0531241811800?434294485? loge 43 4294 4850
|
||||||
|
0?0000800? 0532 1
|
||||||
|
0?0000800? 0533 1 (u) float - e ** (u) float
|
||||||
|
0?0000800? 0534 1 expn(u) = e ** u
|
||||||
|
0?0000800? 0535 1 e=2.71828182846
|
||||||
|
0?0000800? 0536 1
|
||||||
|
6I1954195C 0537241972800?241650165D e00lpstdlq1
|
||||||
|
6I1954195C 0538241654800?391811186A fmploge mult by lo
|
||||||
|
6I1954195C 0539241861800?691650197? lddlq1 e00ac 10 ** u
|
||||||
|
6I1954195C 0540241650800?000000000? lq1 00 0000 0000
|
||||||
|
6I1954195C 0541241811800?434294485? loge 43 4294 4850
|
||||||
|
0?0000800? 0542 1
|
||||||
|
0?0000800? 0543 1 (u) float - absolute value (u
|
||||||
|
0?0000800? 0544 1
|
||||||
|
6I1954195C 0545241976800?451580800A e00aynze 8001 exit if ze
|
||||||
|
6I1954195C 0546241580800?441786145? nzu ezzty alarm func
|
||||||
|
6I1954195C 0547241786800?241415187B stderthx
|
||||||
|
6I1954195C 0548241872800?678003177I ram 8003 remove sgn
|
||||||
|
6I1954195C 0549241779800?608002141E rau 8002 erthx result in
|
||||||
|
0?0000800? 0550 1
|
||||||
|
0?0000800? 0551 1 (u) float - integer part (u)
|
||||||
|
0?0000800? 0552 1
|
||||||
|
6I1954195C 0553241945800?451748800A e00aznze 8001 exit if ze
|
||||||
|
6I1954195C 0554241748800?441751145? nzu ezzty alarm func
|
||||||
|
6I1954195C 0555241751800?241415192B stderthx
|
||||||
|
6I1954195C 0556241922800?211517157D stuarthc save arg
|
||||||
|
6I1954195C 0557241574800?300002183A srt 0002 exp in low
|
||||||
|
6I1954195C 0558241831800?211430183F stuartha mant in h
|
||||||
|
6I1954195C 0559241836800?688002154F rsm 8002 make exp n
|
||||||
|
6I1954195C 0560241546800?151849170D alon57
|
||||||
|
6I1954195C 0561241704800?461558160H bmiaz4 big num so
|
||||||
|
6I1954195C 0562241608800?151911171F alon01
|
||||||
|
6I1954195C 0563241716800?350001162D slt 0001
|
||||||
|
6I1954195C 0564241624800?441827147H nzuaz5 small num
|
||||||
|
6I1954195C 0565241478800?300005189A srt 0005 set as rig
|
||||||
|
6I1954195C 0566241891800?151644189I aloaz6 shifts to
|
||||||
|
6I1954195C 0567241899800?201553165H stlarthb
|
||||||
|
6I1954195C 0568241658800?601430155C rauartha arthb
|
||||||
|
6I1954195C 0569241849800?570000000? n57 57 0000 0000
|
||||||
|
6I1954195C 0570241911800?010000000? n01 01 0000 0000
|
||||||
|
6I1954195C 0571241644800?300000171G az6 srt 0000
|
||||||
|
6I1954195C 0572241717800?608003142G rau 8003 ae0 go to fix
|
||||||
|
6I1954195C 0573241827800?608002188F az5 rau 8002
|
||||||
|
6I1954195C 0574241886800?608002141E rau 8002 erthx return zer
|
||||||
|
6I1954195C 0575241558800?601517141E az4 rauarthc erthx return the
|
||||||
|
0?0000800? 0576 1
|
||||||
|
0?0000800? 0577 1 (u) float - max (float, float
|
||||||
|
0?0000800? 0578 1 should have two o
|
||||||
|
0?0000800? 0579 1
|
||||||
|
6I1954195C 0580241946800?241415167D e00bastderthx
|
||||||
|
6I1954195C 0581241674800?211430193F stuartha arg is max
|
||||||
|
6I1954195C 0582241936800?651415172D ralerthx ba0
|
||||||
|
6I1954195C 0583241724800?161877188A ba0 sloba10
|
||||||
|
6I1954195C 0584241881800?461789183I bmiba9 no more ar
|
||||||
|
6I1954195C 0585241839800?651415177D ralerthx set arg ad
|
||||||
|
6I1954195C 0586241774800?691927163? lddba1 to be rea
|
||||||
|
6I1954195C 0587241630800?221927192G sdaba1 ba1
|
||||||
|
6I1954195C 0588241927800?600000185E ba1 rau 0000 read arg
|
||||||
|
6I1954195C 0589241855800?211553170H stuarthb
|
||||||
|
6I1954195C 0590241708800?331430175H fsbartha is grtr th
|
||||||
|
6I1954195C 0591241758800?461712176B bmiba2 current re
|
||||||
|
6I1954195C 0592241762800?601553180H rauarthb yes store
|
||||||
|
6I1954195C 0593241808800?211430171B stuartha ba2 new result
|
||||||
|
6I1954195C 0594241712800?651415182D ba2 ralerthx select nex
|
||||||
|
6I1954195C 0595241824800?161428188I sloonet arg
|
||||||
|
6I1954195C 0596241889800?201415172D stlerthx ba0
|
||||||
|
6I1954195C 0597241789800?601430141E ba9 rauartha erthx result in
|
||||||
|
6I1954195C 0598241877800?001950000? ba10 00p0000 0000 fist arg a
|
||||||
|
0?0000800? 0599 1
|
||||||
|
0?0000800? 0600 1 (u) float - square root (u) f
|
||||||
|
0?0000800? 0601 1
|
||||||
|
6I1954195C 0602241975800?451528800A e00axnze 8001 exit if ze
|
||||||
|
6I1954195C 0603241528800?441931145? nzu ezzty alarm func
|
||||||
|
6I1954195C 0604241931800?461939154? bmiax1 alarm sqrt
|
||||||
|
6I1954195C 0605241540800?241415187D stderthx
|
||||||
|
6I1954195C 0606241874800?300002168B srt 0002
|
||||||
|
6I1954195C 0607241682800?441590164? nzu ax2 test for z
|
||||||
|
6I1954195C 0608241590800?161911176F slon01 convert fo
|
||||||
|
6I1954195C 0609241766800?201553185H stlarthb break up e
|
||||||
|
6I1954195C 0610241858800?658003181F ral 8003 and mantis
|
||||||
|
6I1954195C 0611241816800?350002192D slt 0002 calculate
|
||||||
|
6I1954195C 0612241924800?201430169? stlartha initial x
|
||||||
|
6I1954195C 0613241690800?101609166C aupone ax3
|
||||||
|
6I1954195C 0614241750800?601430174? ax4 rauartha calculate
|
||||||
|
6I1954195C 0615241740800?641517157H dvrarthc next x
|
||||||
|
6I1954195C 0616241578800?168001179? slo 8001 value
|
||||||
|
6I1954195C 0617241790800?451694159F nze ax5
|
||||||
|
6I1954195C 0618241694800?461747159F bmi ax5 test for e
|
||||||
|
6I1954195C 0619241747800?158001190E alo 8001
|
||||||
|
6I1954195C 0620241905800?158001166C alo 8001 ax3
|
||||||
|
6I1954195C 0621241663800?641866162H ax3 dvrtwo recycle
|
||||||
|
6I1954195C 0622241628800?201517175? stlarthc ax4
|
||||||
|
6I1954195C 0623241596800?651553190H ax5 ralarthb modify
|
||||||
|
6I1954195C 0624241908800?151812176G alon49 exponent
|
||||||
|
6I1954195C 0625241767800?300008184? srt 0008
|
||||||
|
6I1954195C 0626241840800?141866167H divtwo
|
||||||
|
6I1954195C 0627241678800?158003189? alo 8003
|
||||||
|
6I1954195C 0628241890800?201553156? stlarthb test even
|
||||||
|
6I1954195C 0629241560800?441713171D nzu ax6 odd exp
|
||||||
|
6I1954195C 0630241713800?601517187E rauarthc exp odd
|
||||||
|
6I1954195C 0631241875800?300001173B srt 0001
|
||||||
|
6I1954195C 0632241732800?191940186B mpyax11 mpy by sqr
|
||||||
|
6I1954195C 0633241862800?310010194A srd 0010 ax7 of 10
|
||||||
|
6I1954195C 0634241941800?350002179G ax7 slt 0002
|
||||||
|
6I1954195C 0635241797800?151553161? aloarthb
|
||||||
|
6I1954195C 0636241610800?151609176C aloone exp 50 to
|
||||||
|
6I1954195C 0637241763800?608002141E rau 8002 erthx go to exit
|
||||||
|
6I1954195C 0638241714800?651517192E ax6 ralarthc exp even
|
||||||
|
6I1954195C 0639241925800?310002194A srd 0002 ax7
|
||||||
|
6I1954195C 0640241640800?608003141E ax2 rau 8003 erthx result zer
|
||||||
|
6I1954195C 0641241939800?010012800A ax1 hlt 0012 8001 alarm sqrt
|
||||||
|
6I1954195C 0642241609800?000000000A one 00 0000 0001 constants
|
||||||
|
6I1954195C 0643241866800?000000000B two 00 0000 0002
|
||||||
|
6I1954195C 0644241812800?490000000? n49 49 0000 0000
|
||||||
|
6I1954195C 0645241940800?031622776F ax11 03 1622 7766
|
||||||
|
0?0000800? 0646 1
|
||||||
|
0?0000800? 0647 1 (u) float - cosinus (u) float
|
||||||
|
0?0000800? 0648 1
|
||||||
|
6I1954195C 0649241973800?241415162F e00avstderthx av0
|
||||||
|
6I1954195C 0650241626800?451680178B av0 nze av4 cos(0) is
|
||||||
|
6I1954195C 0651241680800?441542145? nzu ezzty alarm func
|
||||||
|
6I1954195C 0652241542800?300002180? srt 0002 argument
|
||||||
|
6I1954195C 0653241800800?211430159B stuartha alarm if p
|
||||||
|
6I1954195C 0654241592800?688002180A rsm 8002 overscal
|
||||||
|
6I1954195C 0655241801800?151911191F alon01 convert fo
|
||||||
|
6I1954195C 0656241916800?151849175D alon57 cosx equal
|
||||||
|
6I1954195C 0657241754800?461660171? bmiav2 one if pw
|
||||||
|
6I1954195C 0658241710800?161813181G sloav3 underscal
|
||||||
|
6I1954195C 0659241817800?461676178B bmi av4
|
||||||
|
6I1954195C 0660241676800?300004164B srt 0004
|
||||||
|
6I1954195C 0661241642800?151646185A aloav5
|
||||||
|
6I1954195C 0662241851800?201760186C stlav6
|
||||||
|
6I1954195C 0663241863800?601430169B rauartha form
|
||||||
|
6I1954195C 0664241692800?191696176? mpyav7 av6 fractiona
|
||||||
|
6I1954195C 0665241760800?011760176D av6 hltav6 av23 and intgr
|
||||||
|
6I1954195C 0666241764800?201517172F av23 stlarthc parts
|
||||||
|
6I1954195C 0667241726800?608003174B rau 8003
|
||||||
|
6I1954195C 0668241742800?191460183B mpyn50 form s as
|
||||||
|
6I1954195C 0669241832800?201553181? stlarthb one minus
|
||||||
|
6I1954195C 0670241810800?681517177F rsmarthc twice abv
|
||||||
|
6I1954195C 0671241776800?188001179B sml 8001 of fractn
|
||||||
|
6I1954195C 0672241792800?151919182F alon999 part
|
||||||
|
6I1954195C 0673241826800?608002184B rau 8002
|
||||||
|
6I1954195C 0674241842800?211430189B stuartha
|
||||||
|
6I1954195C 0675241892800?198001186G mpy 8001 form sine
|
||||||
|
6I1954195C 0676241867800?211517187F stuarthc
|
||||||
|
6I1954195C 0677241876800?601829194B rauav16 polynomia
|
||||||
|
6I1954195C 0678241942800?191517169C mpyarthc approximat
|
||||||
|
6I1954195C 0679241693800?608003190A rau 8003
|
||||||
|
6I1954195C 0680241901800?101804186? aupav15
|
||||||
|
6I1954195C 0681241860800?191517174C mpyarthc
|
||||||
|
6I1954195C 0682241743800?608003150B rau 8003
|
||||||
|
6I1954195C 0683241502800?101910191G aupav14
|
||||||
|
6I1954195C 0684241917800?191517179C mpyarthc
|
||||||
|
6I1954195C 0685241793800?608003155B rau 8003
|
||||||
|
6I1954195C 0686241552800?101912192F aupav13
|
||||||
|
6I1954195C 0687241926800?191517184C mpyarthc
|
||||||
|
6I1954195C 0688241843800?300001185? srt 0001
|
||||||
|
6I1954195C 0689241850800?608003191C rau 8003
|
||||||
|
6I1954195C 0690241913800?101728189C auppih equals one
|
||||||
|
6I1954195C 0691241893800?191430160B mpyartha
|
||||||
|
6I1954195C 0692241602800?360000177H sct 0000
|
||||||
|
6I1954195C 0693241778800?471882194C bovav19
|
||||||
|
6I1954195C 0694241943800?201430174D stlartha
|
||||||
|
6I1954195C 0695241744800?658003165B ral 8003 round
|
||||||
|
6I1954195C 0696241652800?300002181D srt 0002 and
|
||||||
|
6I1954195C 0697241814800?201517182H stlarthc adjust
|
||||||
|
6I1954195C 0698241828800?611430179D rsuartha power
|
||||||
|
6I1954195C 0699241794800?300002170B srt 0002
|
||||||
|
6I1954195C 0700241702800?461864191D bmi av25
|
||||||
|
6I1954195C 0701241864800?118003187H sup 8003
|
||||||
|
6I1954195C 0702241878800?151460192H alon50 av24
|
||||||
|
6I1954195C 0703241928800?101517187I av24 auparthc
|
||||||
|
6I1954195C 0704241879800?350002184D slt 0002 av22
|
||||||
|
6I1954195C 0705241844800?211430189D av22 stuartha determine
|
||||||
|
6I1954195C 0706241894800?601553192I rauarthb sign of
|
||||||
|
6I1954195C 0707241929800?441944174F nzu av20 result
|
||||||
|
6I1954195C 0708241944800?661430179F rslartha av26
|
||||||
|
6I1954195C 0709241746800?651430179F av20 ralartha av26
|
||||||
|
6I1954195C 0710241914800?118003173? av25 sup 8003
|
||||||
|
6I1954195C 0711241730800?161460192H slon50 av24
|
||||||
|
6I1954195C 0712241660800?601553178? av2 rauarthb overscale
|
||||||
|
6I1954195C 0713241780800?691415183? ldderthx display
|
||||||
|
6I1954195C 0714241830800?010013800A hlt 0013 8001 alarm radi
|
||||||
|
6I1954195C 0715241796800?608002188? av26 rau 8002
|
||||||
|
6I1954195C 0716241880800?461846189F bmiav27
|
||||||
|
6I1954195C 0717241896800?101609141E aupone erthx
|
||||||
|
6I1954195C 0718241846800?111609141E av27 supone erthx
|
||||||
|
6I1954195C 0719241782800?651847179F av4 ralav21 av26 cosx is on
|
||||||
|
6I1954195C 0720241882800?658002189G av19 ral 8002 cosx is ze
|
||||||
|
6I1954195C 0721241897800?168001179F slo 8001 av26
|
||||||
|
6I1954195C 0722241900800?601847184D av17 rauav21 av22 cosx is pl
|
||||||
|
6I1954195C 0723241813800?110000000? av3 11 0000 0000 or minus
|
||||||
|
6I1954195C 0724241646800?310011176D av5 srd 0011 av23
|
||||||
|
6I1954195C 0725241696800?318309886B av7 31 8309 8862
|
||||||
|
6I1954195C 0726241728800?157079632G pih 15 7079 6327 pi / 2 in
|
||||||
|
6I1954195C 0727241912800?645963711J av13 64 5963 7111
|
||||||
|
6I1954195C 0728241910800?079689679C av14 07 9689 6793
|
||||||
|
6I1954195C 0729241804800?004673765O av15 00 4673 7656
|
||||||
|
6I1954195C 0730241829800?000151484B av16 00 0151 4842
|
||||||
|
6I1954195C 0731241847800?100000005? av21 10 0000 0050
|
||||||
|
6I1954195C 0732241919800?999999999I n999 99 9999 9999
|
||||||
|
6I1954195C 0733241460800?500000000? n50 50 0000 0000
|
||||||
|
6I1954195C 0734241609800?000000000A one 00 0000 0001
|
||||||
|
6I1954195C 0735241911800?010000000? n01 01 0000 0000
|
||||||
|
6I1954195C 0736241849800?570000000? n57 57 0000 0000
|
||||||
|
0?0000800? 0737 1
|
||||||
|
0?0000800? 0738 1 (u) float - sinus (u) float (
|
||||||
|
0?0000800? 0739 1
|
||||||
|
6I1954195C 0740241974800?451930800A e00awnze 8001 sin(0) is
|
||||||
|
6I1954195C 0741241930800?441798145? nzu ezzty alarm func
|
||||||
|
6I1954195C 0742241798800?241415193B stderthx
|
||||||
|
6I1954195C 0743241932800?211430184H stuartha
|
||||||
|
6I1954195C 0744241848800?601752189H raufpih
|
||||||
|
6I1954195C 0745241898800?331430162F fsbartha av0 sin a = co
|
||||||
|
6I1954195C 0746241752800?157079635A fpih 15 7079 6351 pi / 2 flo
|
||||||
|
0?0000800? 0747 1
|
||||||
|
0?0000800? 0748 1 end of fortran package
|
||||||
|
0?0000800? 0749 1
|
44
I650/sw/fortransit/pack_entry_src.txt
Normal file
44
I650/sw/fortransit/pack_entry_src.txt
Normal file
|
@ -0,0 +1,44 @@
|
||||||
|
1
|
||||||
|
1 fortran package missing
|
||||||
|
1 from original listing
|
||||||
|
1 rewritten by roberto sancho
|
||||||
|
1 in may 2018
|
||||||
|
1
|
||||||
|
1 fortran package
|
||||||
|
1 entry points
|
||||||
|
1
|
||||||
|
synlaaaa 1999 initial locn
|
||||||
|
synacc 0000 reserve acc
|
||||||
|
1
|
||||||
|
1 built-in subroutines (180 words)
|
||||||
|
1
|
||||||
|
syne00aa 1961 check overlow (0)
|
||||||
|
syne00th 1962 float (u) to fix (l) (501)
|
||||||
|
syne00ae 1963 fix (l) to float (u) (4)
|
||||||
|
syne00af 1964 fix (l) to float (u) and (acc) (5)
|
||||||
|
syne00aq 1965 read entry (16)
|
||||||
|
syne00ar 1966 punch entry (17)
|
||||||
|
synezzza 1967 save index reg
|
||||||
|
synezzzb 1968 restore index reg
|
||||||
|
1
|
||||||
|
1 power subroutines
|
||||||
|
1
|
||||||
|
syne00ak 1949 fix (l) ** fix (acc) to float (u) and (acc) (10)
|
||||||
|
syne00al 1948 float (u) ** fix (acc) to float (u) and (acc) (11)
|
||||||
|
syne00lq 1947 float (u) ** float (acc) to float (u) and (acc) (302)
|
||||||
|
1
|
||||||
|
1 function subroutines
|
||||||
|
1
|
||||||
|
syne00ab 1969 logf (1)
|
||||||
|
syne00ac 1970 expf (2)
|
||||||
|
syne00lo 1971 lnf (300)
|
||||||
|
syne00lp 1972 expnf (301)
|
||||||
|
syne00av 1973 cosf (21)
|
||||||
|
syne00aw 1974 sinf (22)
|
||||||
|
syne00ax 1975 sqrtf (23)
|
||||||
|
syne00ay 1976 absf (24)
|
||||||
|
syne00az 1945 intf (25)
|
||||||
|
syne00ba 1946 maxf (26)
|
||||||
|
1
|
||||||
|
1 end of fortran package entry points
|
||||||
|
1
|
774
I650/sw/fortransit/pack_listing.txt
Normal file
774
I650/sw/fortransit/pack_listing.txt
Normal file
|
@ -0,0 +1,774 @@
|
||||||
|
1
|
||||||
|
1 FORTRAN PACKAGE MISSING
|
||||||
|
1 FROM ORIGINAL LISTING
|
||||||
|
1 REWRITTEN BY ROBERTO SANCHO
|
||||||
|
1 IN MAY 2018
|
||||||
|
1
|
||||||
|
1 FORTRAN PACKAGE
|
||||||
|
1 ENTRY POINTS
|
||||||
|
1
|
||||||
|
SYN LAAAA 1999 INITIAL LOCN
|
||||||
|
SYN ACC 0000 RESERVE ACC
|
||||||
|
1
|
||||||
|
1 BUILT-IN SUBROUTINES (180 WORDS)
|
||||||
|
1
|
||||||
|
SYN E00AA 1961 CHECK OVERLOW (0)
|
||||||
|
SYN E00TH 1962 FLOAT (U) TO FIX (L) (501)
|
||||||
|
SYN E00AE 1963 FIX (L) TO FLOAT (U) (4)
|
||||||
|
SYN E00AF 1964 FIX (L) TO FLOAT (U) AND (ACC) (5)
|
||||||
|
SYN E00AQ 1965 READ ENTRY (16)
|
||||||
|
SYN E00AR 1966 PUNCH ENTRY (17)
|
||||||
|
SYN EZZZA 1967 SAVE INDEX REG
|
||||||
|
SYN EZZZB 1968 RESTORE INDEX REG
|
||||||
|
1
|
||||||
|
1 POWER SUBROUTINES
|
||||||
|
1
|
||||||
|
SYN E00AK 1949 FIX (L) ** FIX (ACC) TO FIX (L) (10)
|
||||||
|
SYN E00AL 1948 FLOAT (U) ** FIX (ACC) TO FLOAT (U) AND (ACC) (11)
|
||||||
|
SYN E00LQ 1947 FLOAT (U) ** FLOAT (ACC) TO FLOAT (U) AND (ACC) (302)
|
||||||
|
1
|
||||||
|
1 FUNCTION SUBROUTINES
|
||||||
|
1
|
||||||
|
SYN E00AB 1969 LOGF (1)
|
||||||
|
SYN E00AC 1970 EXPF (2)
|
||||||
|
SYN E00LO 1971 LNF (300)
|
||||||
|
SYN E00LP 1972 EXPNF (301)
|
||||||
|
SYN E00AV 1973 COSF (21)
|
||||||
|
SYN E00AW 1974 SINF (22)
|
||||||
|
SYN E00AX 1975 SQRTF (23)
|
||||||
|
SYN E00AY 1976 ABSF (24)
|
||||||
|
SYN E00AZ 1945 INTF (25)
|
||||||
|
SYN E00BA 1946 MAXF (26)
|
||||||
|
1
|
||||||
|
1
|
||||||
|
1 END OF FORTRAN PACKAGE ENTRY POINTS
|
||||||
|
1
|
||||||
|
1 -----------------------------------
|
||||||
|
1
|
||||||
|
1 FORTRAN
|
||||||
|
1 PACKAGE RESERVATION
|
||||||
|
1 FOR PACKAGE BUILD
|
||||||
|
1
|
||||||
|
1 INCLUDES
|
||||||
|
1 - FLOAT FIX CONVERSIONS
|
||||||
|
1 - FORTRAN READ PUNCH STATEMENS
|
||||||
|
1 - FORTRAN POWER OPERATOR
|
||||||
|
1 - FORTRAN FUNCTIONS
|
||||||
|
1 EXCLUDES
|
||||||
|
1 - NOTHING
|
||||||
|
1
|
||||||
|
REG Y0002 0002 FORTRANSIT
|
||||||
|
1 VARS START ADDR
|
||||||
|
BLR 0000 1400 RESERVE ALL
|
||||||
|
1 DRUM EXCEPT
|
||||||
|
1 PACK SPACE
|
||||||
|
1
|
||||||
|
1 END OF PACKAGE RESERVATION
|
||||||
|
1
|
||||||
|
1 -----------------------------------
|
||||||
|
1
|
||||||
|
1 FORTRAN
|
||||||
|
1 PACKAGE RESERVATION
|
||||||
|
1 FOR PACKAGE USE
|
||||||
|
1
|
||||||
|
1 INCLUDES
|
||||||
|
1 - FLOAT FIX CONVERSIONS
|
||||||
|
1 - FORTRAN READ PUNCH STATEMENS
|
||||||
|
1 - FORTRAN POWER OPERATOR
|
||||||
|
1 - FORTRAN FUNCTIONS
|
||||||
|
1 EXCLUDES
|
||||||
|
1 - NOTHING
|
||||||
|
1
|
||||||
|
REG P1951 1960 READ BAND
|
||||||
|
REG J1977 1986 PUNCH BAND
|
||||||
|
REG W1988 1998 STORAGE BAND
|
||||||
|
BLR 1401 1999 RESERVE
|
||||||
|
1 PACK SPACE
|
||||||
|
1
|
||||||
|
1 END OF PACKAGE RESERVATION
|
||||||
|
1
|
||||||
|
1 -----------------------------------
|
||||||
|
1
|
||||||
|
1 FORTRAN PACKAGE
|
||||||
|
1 SOURCE CODE
|
||||||
|
1
|
||||||
|
BLR 1945 1950 ENTRY POWER SUBR TOTAL RESERVATION
|
||||||
|
REG P1951 1960 READ BAND 1947 - 1999, 0000
|
||||||
|
BLR 1961 1968 ENTRY BUILT-IN SUBR (54 WORDS)
|
||||||
|
BLR 1969 1976 ENTRY FUNC SUBR
|
||||||
|
REG J1977 1986 PUNCH BAND
|
||||||
|
BLR 1987 1987
|
||||||
|
REG W1988 1998 STORAGE BAND
|
||||||
|
1
|
||||||
|
1 SAVE INDEX REGISTERS
|
||||||
|
1
|
||||||
|
EZZZA STD EZZZX
|
||||||
|
LDD 8005
|
||||||
|
STD EZZIA
|
||||||
|
LDD 8006
|
||||||
|
STD EZZIB
|
||||||
|
LDD 8007
|
||||||
|
STD EZZIC EZZZX
|
||||||
|
1
|
||||||
|
1 RESTORE SAVED INDEX REGISTERS AND RETURN TO ERTHX
|
||||||
|
1
|
||||||
|
EZZZB LDD EZZIA
|
||||||
|
RAA 8001
|
||||||
|
LDD EZZIB
|
||||||
|
RAB 8001
|
||||||
|
LDD EZZIC
|
||||||
|
RAC 8001 ERTHX
|
||||||
|
EZZZX 00 0000 0000
|
||||||
|
EZZIA 00 0000 0000
|
||||||
|
EZZIB 00 0000 0000
|
||||||
|
EZZIC 00 0000 0000
|
||||||
|
1
|
||||||
|
1 OVERFLOW CHECKING
|
||||||
|
1
|
||||||
|
E00AA BOV 8001
|
||||||
|
HLT 0100 8001 ALARM ARITHMETIC OVERFLOW
|
||||||
|
1
|
||||||
|
1 (L) FIXED POINT <- (U) FLOAT
|
||||||
|
1
|
||||||
|
E00TH STD ERTHX FLOAT UPPER
|
||||||
|
SRT 0002 TO FIX LOWER
|
||||||
|
STU ARTHA SAVE MANTISSA
|
||||||
|
RAM 8002 TEST EXP
|
||||||
|
SLO N51 STORE ZERO
|
||||||
|
BMI AD1 IF LESS THAN
|
||||||
|
SLO N10 51 ALARM
|
||||||
|
BMI AD3 IF GRTR THAN
|
||||||
|
SRT 0004 60
|
||||||
|
ALO ONET
|
||||||
|
LDD AD2A MODIFY
|
||||||
|
SDA AD2 SHIFT
|
||||||
|
RAL ARTHA
|
||||||
|
SLT 0002 AD2
|
||||||
|
AD1 RAL 8003 ERTHX STORE ZERO
|
||||||
|
AD2 SRT 0000 ERTHX SHIFT CONST
|
||||||
|
AD2A SRT 0000 ERTHX
|
||||||
|
AD3 LDD ERTHX
|
||||||
|
HLT 0501 8001 ALARM FLOAT >= 10E10 THUS CANNOT BE CONVERTED TO FIX
|
||||||
|
N10 10 0000 0000
|
||||||
|
N51 51 0000 0000
|
||||||
|
ONET 00 0001 0000
|
||||||
|
ERTHX 00 0000 0000
|
||||||
|
ARTHA 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (U) AND (ACC) FLOAT <- (L) FIXED POINT
|
||||||
|
1
|
||||||
|
E00AF STD ARTHA FLOAT TO UP
|
||||||
|
LDD E00AE AND ACC
|
||||||
|
STU ACC ARTHA
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- (L) FIXED POINT
|
||||||
|
1
|
||||||
|
E00AE STD ERTHX FLOAT TO UP
|
||||||
|
RAU 8002 AE0 ONLY
|
||||||
|
AE0 SCT 0000 NORMALIZE
|
||||||
|
STL ARTHB
|
||||||
|
BOV AD1 ZERO CHECK
|
||||||
|
RAL 8003
|
||||||
|
SRD 0002 ROUND FOR
|
||||||
|
SLT 0002 PLACING EXP
|
||||||
|
NZU AE6 CHECK ROUND
|
||||||
|
LDD 8003 OVERFLOW
|
||||||
|
SRT 0001
|
||||||
|
ALO 8001 AE6
|
||||||
|
AE6 BMI AE2 INSERT
|
||||||
|
ALO AJ3 AE5 EXPONENT
|
||||||
|
AE2 SLO AJ3 AE5
|
||||||
|
AE5 SLO ARTHB
|
||||||
|
RAU 8002 ERTHX
|
||||||
|
AJ3 00 0000 0060
|
||||||
|
ARTHB 00 0000 0000
|
||||||
|
1
|
||||||
|
1 PUNCH CARD
|
||||||
|
1
|
||||||
|
E00AR STD ERTHX PUNCH OUT
|
||||||
|
LDD J0008
|
||||||
|
SIA J0008 STORE STMNT
|
||||||
|
LDD ONET
|
||||||
|
SDA NVARS AND NVARS TO PCH
|
||||||
|
SLO 8001 IF STMT ZERO
|
||||||
|
NZE AR3 PUNCH IF
|
||||||
|
RAL 8000 8000 IS NEG
|
||||||
|
BMI AR3 ERTHX ELSE EXIT
|
||||||
|
AR3 LDD AR3A AR5 INIT PCH CARD
|
||||||
|
AR3A RAL NVARS DEC NVARS
|
||||||
|
SLO ONET
|
||||||
|
BMI AR8 TEST WORD
|
||||||
|
STL NVARS COUNT
|
||||||
|
ALO 8002 GET NWORD ADDR
|
||||||
|
RAL W0002 IN LOWER
|
||||||
|
LDD NWORD
|
||||||
|
SDA NWORD STORE NUM OF WORDS TO PUNCH
|
||||||
|
SLT 0004
|
||||||
|
LDD ADWRD
|
||||||
|
SDA ADWRD AR4 STORE ADDR OF WORD TO PUNCH
|
||||||
|
AR4 RAL NPCH IS CARD FULL
|
||||||
|
SLO ARN7
|
||||||
|
BMI AR4A
|
||||||
|
PCH J0001 YES PUNCH AND
|
||||||
|
LDD AR4A AR5 CALL INIT CARD
|
||||||
|
AR4A RAL NPCH INCR NO OF
|
||||||
|
ALO ONET PUNCHED WORDS NPCH
|
||||||
|
STL NPCH
|
||||||
|
RAL ADWRD INDR ADWRD
|
||||||
|
ALO ONET
|
||||||
|
STL ADWRD
|
||||||
|
SLO ONET
|
||||||
|
ALO 8002 GET ADWRD
|
||||||
|
RAL Y0000 CONTENTS
|
||||||
|
STL DATWD STORE IN DATWD
|
||||||
|
RAU DATLD
|
||||||
|
ALO NPCH STORE AT
|
||||||
|
ALO 8003 J0000 PLUS
|
||||||
|
STD J0000 NPCH
|
||||||
|
RAL NWORD DECR VAR NWORDS
|
||||||
|
SLO ONET TO BE PUNCHED
|
||||||
|
NZE AR3A
|
||||||
|
BMI AR3A
|
||||||
|
STL NWORD AR4
|
||||||
|
AR5 STD AR5X SUB INIT PCH CARD
|
||||||
|
RAL J0008 INCR CARD
|
||||||
|
ALO ONET NUMBER
|
||||||
|
STL J0008
|
||||||
|
STU NPCH CARD WITH ZERO
|
||||||
|
STD J0001 PUNCHED WORDS
|
||||||
|
STD J0002 SET PUNCH
|
||||||
|
STD J0003 BAND TO
|
||||||
|
STD J0004 ZEROES
|
||||||
|
STD J0005
|
||||||
|
STD J0006
|
||||||
|
STD J0007 AR5X
|
||||||
|
AR8 PCH J0001 ERTHX PUNCH
|
||||||
|
ONET 00 0001 0000
|
||||||
|
ARN7 00 0007 0000
|
||||||
|
J0008 00 0000 0000 CARD COUNTER
|
||||||
|
J0010 80 0000 0080 CONTROL CNST
|
||||||
|
AR5X 00 0000 0000 EXIT FOR SUB INIT PCH CARD
|
||||||
|
NVARS 00 0000 0000 NUM OF VARS TO PCH
|
||||||
|
NWORD 00 0000 0000 NUM OF WORDS PER VAR TO PCH
|
||||||
|
ADWRD 00 0000 0000 ADDR OF WORD TO PCH
|
||||||
|
NPCH 00 0000 0000 NUM OF WORDS PUNCHED IN CHARD
|
||||||
|
DATWD 00 0000 0000 DATA WORD TO BE PUNCHED
|
||||||
|
1
|
||||||
|
1 READ CARD
|
||||||
|
1
|
||||||
|
E00AQ STD ERTHX READ IN
|
||||||
|
LDD ONET
|
||||||
|
SDA NVARS NVARS TO READ
|
||||||
|
STU NPCH AQ3A INIT TO ZERO
|
||||||
|
AQ3A RAL NVARS DEC NVARS
|
||||||
|
SLO ONET
|
||||||
|
BMI ERTHX EXIT IF ZERO
|
||||||
|
STL NVARS
|
||||||
|
ALO 8002 GET NWORD ADDR
|
||||||
|
RAL W0002 IN LOWER
|
||||||
|
LDD NWORD
|
||||||
|
SDA NWORD STORE NUM OF WORDS TO RD
|
||||||
|
SLT 0004
|
||||||
|
LDD ADWRD
|
||||||
|
SDA ADWRD AQ4 STORE ADDR OF WORD TO RD
|
||||||
|
AQ4 RAL NPCH CHECK IF SHOULD RD NEW CARD
|
||||||
|
NZE AQ4A
|
||||||
|
RCD P0001 YES READ CARD
|
||||||
|
LDD ARN7
|
||||||
|
STD NPCH AQ4A
|
||||||
|
AQ4A RAL NPCH DECR NO OF AVAILABLE
|
||||||
|
SLO ONET PUNCHED WORDS NPCH IN READ CARD
|
||||||
|
STL NPCH
|
||||||
|
RAL ARN7
|
||||||
|
SLO NPCH GET WORD AT
|
||||||
|
ALO 8002 P0000 PLUS
|
||||||
|
LDD P0000 NPCH IN DIST
|
||||||
|
STD DATWD STORE IT IN DATWD
|
||||||
|
RAU DATLD
|
||||||
|
ALO ADWRD INCR ADWRD
|
||||||
|
ALO ONET
|
||||||
|
STL ADWRD
|
||||||
|
SLO ONET
|
||||||
|
ALO 8003 SET ADWRD
|
||||||
|
STD Y0000 CONTENTS FROM UPPER
|
||||||
|
RAL NWORD DECR VAR NWORDS
|
||||||
|
SLO ONET TO BE READ
|
||||||
|
NZE AQ3A
|
||||||
|
BMI AQ3A
|
||||||
|
STL NWORD AQ4
|
||||||
|
ONET 00 0001 0000
|
||||||
|
DATLD LDD DATWD 8002 LOAD CARD WORD INTO DIST AND JUMP TO LOWER
|
||||||
|
1
|
||||||
|
1 ALARM IF TRY TO USE A NOT DEFINED SUBROUTINE
|
||||||
|
1
|
||||||
|
E00AK HLT 9010 8001 ALARM FIX ** FIX UNDEF
|
||||||
|
E00AL HLT 9011 8001 ALARM FLOAT ** FIX UNDEF
|
||||||
|
E00LQ HLT 9302 8001 ALARM FLOAT ** FLOAT UNDEF
|
||||||
|
E00AB HLT 9001 8001 ALARM LOGF UNDEF
|
||||||
|
E00AC HLT 9002 8001 ALARM EXPF UNDEF
|
||||||
|
E00LO HLT 9300 8001 ALARM LNF UNDEF
|
||||||
|
E00LP HLT 9301 8001 ALARM EXPNF UNDEF
|
||||||
|
E00AV HLT 9021 8001 ALARM COSF UNDEF
|
||||||
|
E00AW HLT 9022 8001 ALARM SINF UNDEF
|
||||||
|
E00AX HLT 9023 8001 ALARM SQRTF UNDEF
|
||||||
|
E00AY HLT 9024 8001 ALARM ABSF UNDEF
|
||||||
|
E00AZ HLT 9025 8001 ALARM INTF UNDEF
|
||||||
|
E00BA HLT 9026 8001 ALARM MAXF UNDEF
|
||||||
|
EZZTY HLT 9099 8001 ALARM FUNCTION ARG IS FIX BUT SHOULD BE FLOAT
|
||||||
|
1
|
||||||
|
1 START OF SUBROUTINES
|
||||||
|
1
|
||||||
|
1 (L) AND (ACC) FIXED <- (L) FIXED ** (ACC) FIXED
|
||||||
|
1
|
||||||
|
E00AK STD ERTHX POWER FIX FIX. M ** P
|
||||||
|
STL ARTHA AK1 M IS ARGMNT
|
||||||
|
AK1 RAM ACC P EQUALS
|
||||||
|
STL ARTHB ABVAL POWER
|
||||||
|
RAL ONE H IS RESULT
|
||||||
|
STL ARTHC AK3 INIT TO ONE
|
||||||
|
AK3 RAU ARTHB P IS GTST
|
||||||
|
MPY N50 INTGR IN
|
||||||
|
STU ARTHB P OVER TWO
|
||||||
|
RAL 8002 IS REMAINDER
|
||||||
|
NZE AK5 ZERO
|
||||||
|
RAU ARTHC IF NOT H IS
|
||||||
|
MPY ARTHA H TIMES M
|
||||||
|
NZU AK12
|
||||||
|
STL ARTHC AK5
|
||||||
|
AK5 RAU ARTHB
|
||||||
|
NZU AK6 IS P ZERO
|
||||||
|
RAU ARTHA IF NOT
|
||||||
|
MPY 8001 M EQUALS
|
||||||
|
NZU AK12
|
||||||
|
STL ARTHA AK3 M SQUARED
|
||||||
|
AK6 RAU ACC IS POWER NEG
|
||||||
|
BMI AK7 IF SO IS H
|
||||||
|
RAM ARTHC ZERO
|
||||||
|
NZE AK8 IF NOT IS H
|
||||||
|
SLO ONE ONE
|
||||||
|
NZE AK10 AK7
|
||||||
|
AK7 RAL ARTHC AK11 EXHIBIT H
|
||||||
|
AK10 RAL 8003 AK11
|
||||||
|
AK11 STL ACC ERTHX
|
||||||
|
AK12 LDD ERTHX
|
||||||
|
HLT 0003 8001 ALARM OVERFLOW. FIX**FIX RESULTS IN VALUE >= 10E10
|
||||||
|
AK8 LDD ERTHX
|
||||||
|
HLT 0010 8001 ALARM ZERO RAISED TO NEG
|
||||||
|
N50 50 0000 0000
|
||||||
|
ONE 00 0000 0001
|
||||||
|
ARTHC 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (U) AND (ACC) FLOAT <- (U) FLOAT ** (ACC) FIXED
|
||||||
|
1
|
||||||
|
E00AL STD ERTHX POWER FLOAT FIX. M ** P
|
||||||
|
STU ARTHA AL1 M IS ARGMNT
|
||||||
|
AL1 RAM ACC P EQUALS
|
||||||
|
STL ARTHB ABVAL POWER
|
||||||
|
RAL FP1 H IS RESULT
|
||||||
|
STL ARTHC AL3 INIT TO FLOAT ONE
|
||||||
|
AL3 RAU ARTHB P IS GTST
|
||||||
|
MPY N50 INTGR IN
|
||||||
|
STU ARTHB P OVER TWO
|
||||||
|
RAL 8002 IS REMAINDER
|
||||||
|
NZE AL5 ZERO
|
||||||
|
RAU ARTHC IF NOT H IS
|
||||||
|
FMP ARTHA H TIMES M
|
||||||
|
BOV AL12
|
||||||
|
STU ARTHC AL5
|
||||||
|
AL5 RAU ARTHB
|
||||||
|
NZU AL6 IS P ZERO
|
||||||
|
RAU ARTHA IF NOT
|
||||||
|
FMP 8001 M EQUALS
|
||||||
|
BOV AL12
|
||||||
|
STU ARTHA AL3 M SQUARED
|
||||||
|
AL6 RAU ACC IS POWER NEG
|
||||||
|
BMI AL7 IF SO IS H
|
||||||
|
RAM ARTHC ZERO
|
||||||
|
NZE AL8 IF NOT CALC
|
||||||
|
RAU FP1 H RECIPROCAL
|
||||||
|
FDV ARTHC AL11
|
||||||
|
AL7 RAU ARTHC AL11 EXHIBIT H
|
||||||
|
AL11 STU ACC ERTHX
|
||||||
|
AL12 LDD ERTHX
|
||||||
|
HLT 0049 8001 ALARM OVERFLOW. FLOAT**FIX RESULTS IN VALUE >= 10E49
|
||||||
|
AL8 LDD ERTHX
|
||||||
|
HLT 0011 8001 ALARM ZERO RAISED TO NEG
|
||||||
|
N50 50 0000 0000
|
||||||
|
FP1 10 0000 0051
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- 10 ** (U) FLOAT
|
||||||
|
1
|
||||||
|
E00AC STD ERTHX EXPONENTIAL
|
||||||
|
NZE AC5 IS ARGUMENT
|
||||||
|
NZU EZZTY ALARM FUNCTION ARG IS FIX BUT SHOULD BE FLOAT
|
||||||
|
SRT 0002 ZERO
|
||||||
|
STU ARTHC IF NOT LET
|
||||||
|
RSM 8002 N BE MANTSA
|
||||||
|
ALO N52 X BE POWER
|
||||||
|
BMI AC4 IS X GRTR
|
||||||
|
SLT 0001 THAN TEN
|
||||||
|
NZU AC5 OR LESS THAN
|
||||||
|
SRT 0005 MINUS EIGHT
|
||||||
|
ALO AC6 IF X WITHIN
|
||||||
|
STL ARTHB BOUNDS GEN
|
||||||
|
RAU ARTHC INT AND
|
||||||
|
SRT 0006 ARTHB FRACT PARTS
|
||||||
|
N52 52 0000 0000 OF ARGUMENT
|
||||||
|
AC6 SRT 0000 IS ARG NEG
|
||||||
|
BMI AC8 IF SO INT IS
|
||||||
|
STU ARTHB AC1 INT MINUS 1
|
||||||
|
AC8 SUP ONE AND FRACT IS
|
||||||
|
STU ARTHB FRACT PLUS 1
|
||||||
|
RAL 8002
|
||||||
|
ALO N999 AC1
|
||||||
|
AC1 STL ARTHC ARTHC IS FRAC PART
|
||||||
|
RAU 8002 ARTHB IS INT PART
|
||||||
|
MPY AC18 GENERATE
|
||||||
|
RAU 8003
|
||||||
|
AUP AC17 POLYNOMIAL
|
||||||
|
MPY ARTHC
|
||||||
|
RAU 8003 APPROXIM
|
||||||
|
AUP AC16 ATION
|
||||||
|
MPY ARTHC
|
||||||
|
RAU 8003 FOR
|
||||||
|
AUP AC15
|
||||||
|
MPY ARTHC EXPONENTIAL
|
||||||
|
RAU 8003
|
||||||
|
AUP AC14
|
||||||
|
MPY ARTHC
|
||||||
|
RAU 8003
|
||||||
|
AUP AC13
|
||||||
|
MPY ARTHC
|
||||||
|
RAU 8003
|
||||||
|
AUP AC12
|
||||||
|
MPY ARTHC SQUARE
|
||||||
|
RAU 8003 RESULT
|
||||||
|
AUP N10 SCALE AND
|
||||||
|
MPY 8003 FLOAT THEN
|
||||||
|
SRT 0001 EXIT
|
||||||
|
STU ARTHA
|
||||||
|
RAU AC19
|
||||||
|
AUP ARTHB
|
||||||
|
BMI AC20
|
||||||
|
SRT 0002
|
||||||
|
NZU AC21
|
||||||
|
AUP ARTHA
|
||||||
|
SRT 0008 AC20
|
||||||
|
AC4 RAL ARTHC
|
||||||
|
BMI AC21
|
||||||
|
RAU 8003 ERTHX RESULT ZERO
|
||||||
|
AC5 RAU FP1 ERTHX RESULT 1 BECAUSE ARGMNT IS ZERO
|
||||||
|
AC20 RAU 8002 ERTHX RESULT IN UPPER
|
||||||
|
AC21 LDD ERTHX
|
||||||
|
HLT 0049 8001 ALARM OVERFLOW. 10**FLOAT RESULTS IN VALUE >= 10E49
|
||||||
|
AC12 11 5129 2776
|
||||||
|
AC13 06 6273 0884
|
||||||
|
AC14 02 5439 3575
|
||||||
|
AC15 00 7295 1737
|
||||||
|
AC16 00 1742 1120
|
||||||
|
AC17 00 0255 4918
|
||||||
|
AC18 00 0093 2643
|
||||||
|
AC19 00 0000 0051
|
||||||
|
N999 99 9999 9999
|
||||||
|
N10 10 0000 0000
|
||||||
|
ONE 00 0000 0001
|
||||||
|
FP1 10 0000 0051
|
||||||
|
ARTHC 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- LOG 10 (U) FLOAT
|
||||||
|
1
|
||||||
|
E00AB NZE AB10 IF LOG ARG ZERO
|
||||||
|
NZU EZZTY ALARM FUNCTION ARG IS FIX BUT SHOULD BE FLOAT
|
||||||
|
BMI AB10 OR NEG ALARM
|
||||||
|
STD ERTHX
|
||||||
|
SRT 0002
|
||||||
|
STL ARTHB STORE POWER
|
||||||
|
RAU 8003 FORM Z
|
||||||
|
AUP AB1 EQUAL ARG
|
||||||
|
STU ARTHC MINUS ROOT
|
||||||
|
SUP AB2 TEN OVER ARG
|
||||||
|
DVR ARTHC PLUS ROOT
|
||||||
|
STL ARTHA TEN
|
||||||
|
RAU 8002
|
||||||
|
MPY 8001 Z SQUARE
|
||||||
|
STU ARTHC
|
||||||
|
RAU 8003 GENERATE
|
||||||
|
MPY AB7
|
||||||
|
RAU 8003 POLYNOMIAL
|
||||||
|
AUP AB6
|
||||||
|
MPY ARTHC APPROXIMATN
|
||||||
|
RAU 8003
|
||||||
|
AUP AB5
|
||||||
|
MPY ARTHC
|
||||||
|
RAU 8003
|
||||||
|
AUP AB4
|
||||||
|
MPY ARTHC
|
||||||
|
RAU 8003
|
||||||
|
AUP AB3
|
||||||
|
MPY ARTHA
|
||||||
|
RAL 8003
|
||||||
|
ALO N50
|
||||||
|
SRT 0002
|
||||||
|
ALO ARTHB ADD POWER
|
||||||
|
SLO N50
|
||||||
|
SRD 0002 ROUND
|
||||||
|
RAU 8002
|
||||||
|
SCT 0000 NORMALIZE
|
||||||
|
BOV AB12
|
||||||
|
BMI AB13
|
||||||
|
SUP AB9 AB11 ADJUST
|
||||||
|
AB11 SUP 8002 AB12 POWER
|
||||||
|
AB12 RAU 8003
|
||||||
|
FSB FP1 ERTHX
|
||||||
|
AB13 AUP AB9 AB11
|
||||||
|
AB10 HLT 0001 8001 ALARM LOG (ZERO OR NEGAVIVE)
|
||||||
|
AB1 00 3162 2780
|
||||||
|
AB2 00 6324 5560
|
||||||
|
AB3 86 8591 7180
|
||||||
|
AB4 28 9335 5240
|
||||||
|
AB5 17 7522 0710
|
||||||
|
AB6 09 4376 4760
|
||||||
|
AB7 19 1337 7140
|
||||||
|
N50 50 0000 0000
|
||||||
|
FP1 10 0000 0051
|
||||||
|
AB9 00 0000 0054
|
||||||
|
ARTHC 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (U) AND (ACC) FLOAT <- (U) FLOAT ** (ACC) FLOAT
|
||||||
|
1 U**ACC = 10**(LOG10(U)*ACC)
|
||||||
|
1 = EXP(LOG10(U)*ACC)
|
||||||
|
1
|
||||||
|
E00LQ STD LQ1
|
||||||
|
LDD E00AB LOG 10 (U)
|
||||||
|
FMP ACC MULT BY ACC
|
||||||
|
LDD LQ1 E00AC 10 ** U
|
||||||
|
LQ1 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- LOG E (U) FLOAT
|
||||||
|
1 LN(U) = LOG(U) / LOG(E)
|
||||||
|
1 LOG10(E)=0.4342944819
|
||||||
|
1
|
||||||
|
E00LO STD LQ1
|
||||||
|
LDD E00AB LOG 10 (U)
|
||||||
|
FDV LOGE LQ1 DIV BY LOG(E) CONST
|
||||||
|
LQ1 00 0000 0000
|
||||||
|
LOGE 43 4294 4850
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- E ** (U) FLOAT
|
||||||
|
1 EXPN(U) = E ** U = EXP(LOG10(E)*U)
|
||||||
|
1 E=2.71828182846
|
||||||
|
1
|
||||||
|
E00LP STD LQ1
|
||||||
|
FMP LOGE MULT BY LOG(E) CONST
|
||||||
|
LDD LQ1 E00AC 10 ** U
|
||||||
|
LQ1 00 0000 0000
|
||||||
|
LOGE 43 4294 4850
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- ABSOLUTE VALUE (U) FLOAT
|
||||||
|
1
|
||||||
|
E00AY NZE 8001 EXIT IF ZERO
|
||||||
|
NZU EZZTY ALARM FUNCTION ARG IS FIX BUT SHOULD BE FLOAT
|
||||||
|
STD ERTHX
|
||||||
|
RAM 8003 REMOVE SGN
|
||||||
|
RAU 8002 ERTHX RESULT IN UPPER AND EXIT
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- INTEGER PART (U) FLOAT
|
||||||
|
1
|
||||||
|
E00AZ NZE 8001 EXIT IF ZERO
|
||||||
|
NZU EZZTY ALARM FUNCTION ARG IS FIX BUT SHOULD BE FLOAT
|
||||||
|
STD ERTHX
|
||||||
|
STU ARTHC SAVE ARG
|
||||||
|
SRT 0002 EXP IN LOWER
|
||||||
|
STU ARTHA MANT IN H
|
||||||
|
RSM 8002 MAKE EXP NEG
|
||||||
|
ALO N57
|
||||||
|
BMI AZ4 BIG NUM SO NO FRACT PART TO REMOVE
|
||||||
|
ALO N01
|
||||||
|
SLT 0001
|
||||||
|
NZU AZ5 SMALL NUM SO NO INT PART
|
||||||
|
SRT 0005 SET AS RIGHT
|
||||||
|
ALO AZ6 SHIFTS TO DO
|
||||||
|
STL ARTHB
|
||||||
|
RAU ARTHA ARTHB
|
||||||
|
N57 57 0000 0000
|
||||||
|
N01 01 0000 0000
|
||||||
|
AZ6 SRT 0000
|
||||||
|
RAU 8003 AE0 GO TO FIX TO FLOAT CONVERSION ROUTINE
|
||||||
|
AZ5 RAU 8002
|
||||||
|
RAU 8002 ERTHX RETURN ZERO
|
||||||
|
AZ4 RAU ARTHC ERTHX RETURN THE ARG UNCHANGED
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- MAX (FLOAT, FLOAT, ...)
|
||||||
|
1 SHOULD HAVE TWO OR MORE FLOAT PARAMETERS
|
||||||
|
1
|
||||||
|
E00BA STD ERTHX
|
||||||
|
STU ARTHA ARG IS MAX
|
||||||
|
RAL ERTHX BA0
|
||||||
|
BA0 SLO BA10
|
||||||
|
BMI BA9 NO MORE ARGS
|
||||||
|
RAL ERTHX SET ARG ADDR
|
||||||
|
LDD BA1 TO BE READ
|
||||||
|
SDA BA1 BA1
|
||||||
|
BA1 RAU 0000 READ ARG
|
||||||
|
STU ARTHB
|
||||||
|
FSB ARTHA IS GRTR THAN
|
||||||
|
BMI BA2 CURRENT RESULT
|
||||||
|
RAU ARTHB YES STORE AS
|
||||||
|
STU ARTHA BA2 NEW RESULT
|
||||||
|
BA2 RAL ERTHX SELECT NEXT
|
||||||
|
SLO ONET ARG
|
||||||
|
STL ERTHX BA0
|
||||||
|
BA9 RAU ARTHA ERTHX RESULT IN UPPER
|
||||||
|
BA10 00 P0000 0000 FIST ARG ADDR
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- SQUARE ROOT (U) FLOAT
|
||||||
|
1
|
||||||
|
E00AX NZE 8001 EXIT IF ZERO
|
||||||
|
NZU EZZTY ALARM FUNCTION ARG IS FIX BUT SHOULD BE FLOAT
|
||||||
|
BMI AX1 ALARM SQRT(NEG)
|
||||||
|
STD ERTHX
|
||||||
|
SRT 0002
|
||||||
|
NZU AX2 TEST FOR ZRO
|
||||||
|
SLO N01 CONVERT FORTRANSIT EXP (1.0=1E51) TO IT EXP (1.0=1E50)
|
||||||
|
STL ARTHB BREAK UP EXP
|
||||||
|
RAL 8003 AND MANTISSA
|
||||||
|
SLT 0002 CALCULATE
|
||||||
|
STL ARTHA INITIAL X
|
||||||
|
AUP ONE AX3
|
||||||
|
AX4 RAU ARTHA CALCULATE
|
||||||
|
DVR ARTHC NEXT X
|
||||||
|
SLO 8001 VALUE
|
||||||
|
NZE AX5
|
||||||
|
BMI AX5 TEST FOR END
|
||||||
|
ALO 8001
|
||||||
|
ALO 8001 AX3
|
||||||
|
AX3 DVR TWO RECYCLE
|
||||||
|
STL ARTHC AX4
|
||||||
|
AX5 RAL ARTHB MODIFY
|
||||||
|
ALO N49 EXPONENT
|
||||||
|
SRT 0008
|
||||||
|
DIV TWO
|
||||||
|
ALO 8003
|
||||||
|
STL ARTHB TEST EVEN OR
|
||||||
|
NZU AX6 ODD EXP
|
||||||
|
RAU ARTHC EXP ODD
|
||||||
|
SRT 0001
|
||||||
|
MPY AX11 MPY BY SQRT
|
||||||
|
SRD 0010 AX7 OF 10
|
||||||
|
AX7 SLT 0002
|
||||||
|
ALO ARTHB
|
||||||
|
ALO ONE EXP 50 TO 51
|
||||||
|
RAU 8002 ERTHX GO TO EXIT
|
||||||
|
AX6 RAL ARTHC EXP EVEN
|
||||||
|
SRD 0002 AX7
|
||||||
|
AX2 RAU 8003 ERTHX RESULT ZERO
|
||||||
|
AX1 HLT 0012 8001 ALARM SQRT WITH NEGATIVE ARGUMENT
|
||||||
|
ONE 00 0000 0001 CONSTANTS
|
||||||
|
TWO 00 0000 0002
|
||||||
|
N49 49 0000 0000
|
||||||
|
AX11 03 1622 7766
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- COSINUS (U) FLOAT (ARG IN RADIANS: COS(PI/2) = 0)
|
||||||
|
1
|
||||||
|
E00AV STD ERTHX AV0
|
||||||
|
AV0 NZE AV4 COS(0) IS ONE
|
||||||
|
NZU EZZTY ALARM FUNCTION ARG IS FIX BUT SHOULD BE FLOAT
|
||||||
|
SRT 0002 ARGUMENT
|
||||||
|
STU ARTHA ALARM IF PWR
|
||||||
|
RSM 8002 OVERSCALE
|
||||||
|
ALO N01 CONVERT FORTRANSIT EXP (1.0=1E51) TO IT EXP (1.0=1E50)
|
||||||
|
ALO N57 COSX EQUALS
|
||||||
|
BMI AV2 ONE IF PWR
|
||||||
|
SLO AV3 UNDERSCALE
|
||||||
|
BMI AV4
|
||||||
|
SRT 0004
|
||||||
|
ALO AV5
|
||||||
|
STL AV6
|
||||||
|
RAU ARTHA FORM
|
||||||
|
MPY AV7 AV6 FRACTIONAL
|
||||||
|
AV6 HLT AV6 AV23 AND INTGRL
|
||||||
|
AV23 STL ARTHC PARTS
|
||||||
|
RAU 8003
|
||||||
|
MPY N50 FORM S AS
|
||||||
|
STL ARTHB ONE MINUS
|
||||||
|
RSM ARTHC TWICE ABVAL
|
||||||
|
SML 8001 OF FRACTNL
|
||||||
|
ALO N999 PART
|
||||||
|
RAU 8002
|
||||||
|
STU ARTHA
|
||||||
|
MPY 8001 FORM SINE
|
||||||
|
STU ARTHC
|
||||||
|
RAU AV16 POLYNOMIAL
|
||||||
|
MPY ARTHC APPROXIMATOR
|
||||||
|
RAU 8003
|
||||||
|
AUP AV15
|
||||||
|
MPY ARTHC
|
||||||
|
RAU 8003
|
||||||
|
AUP AV14
|
||||||
|
MPY ARTHC
|
||||||
|
RAU 8003
|
||||||
|
AUP AV13
|
||||||
|
MPY ARTHC
|
||||||
|
SRT 0001
|
||||||
|
RAU 8003
|
||||||
|
AUP PIH EQUALS ONE
|
||||||
|
MPY ARTHA
|
||||||
|
SCT 0000
|
||||||
|
BOV AV19
|
||||||
|
STL ARTHA
|
||||||
|
RAL 8003 ROUND
|
||||||
|
SRT 0002 AND
|
||||||
|
STL ARTHC ADJUST
|
||||||
|
RSU ARTHA POWER
|
||||||
|
SRT 0002
|
||||||
|
BMI AV25
|
||||||
|
SUP 8003
|
||||||
|
ALO N50 AV24
|
||||||
|
AV24 AUP ARTHC
|
||||||
|
SLT 0002 AV22
|
||||||
|
AV22 STU ARTHA DETERMINE
|
||||||
|
RAU ARTHB SIGN OF
|
||||||
|
NZU AV20 RESULT
|
||||||
|
RSL ARTHA AV26
|
||||||
|
AV20 RAL ARTHA AV26
|
||||||
|
AV25 SUP 8003
|
||||||
|
SLO N50 AV24
|
||||||
|
AV2 RAU ARTHB OVERSCALE
|
||||||
|
LDD ERTHX DISPLAY
|
||||||
|
HLT 0013 8001 ALARM RADIAN ARG TOO BIG
|
||||||
|
AV26 RAU 8002
|
||||||
|
BMI AV27
|
||||||
|
AUP ONE ERTHX
|
||||||
|
AV27 SUP ONE ERTHX
|
||||||
|
AV4 RAL AV21 AV26 COSX IS ONE
|
||||||
|
AV19 RAL 8002 COSX IS ZERO
|
||||||
|
SLO 8001 AV26
|
||||||
|
AV17 RAU AV21 AV22 COSX IS PLUS
|
||||||
|
AV3 11 0000 0000 OR MINUS 1
|
||||||
|
AV5 SRD 0011 AV23
|
||||||
|
AV7 31 8309 8862
|
||||||
|
PIH 15 7079 6327 PI / 2 INTEGER
|
||||||
|
AV13 - 64 5963 7111
|
||||||
|
AV14 07 9689 6793
|
||||||
|
AV15 - 00 4673 7656
|
||||||
|
AV16 00 0151 4842
|
||||||
|
AV21 10 0000 0050
|
||||||
|
N999 99 9999 9999
|
||||||
|
N50 50 0000 0000
|
||||||
|
ONE 00 0000 0001
|
||||||
|
N01 01 0000 0000
|
||||||
|
N57 57 0000 0000
|
||||||
|
1
|
||||||
|
1 (U) FLOAT <- SINUS (U) FLOAT (ARG IN RADIANS: SIN(PI/2) = 1)
|
||||||
|
1
|
||||||
|
E00AW NZE 8001 SIN(0) IS ZERO
|
||||||
|
NZU EZZTY ALARM FUNCTION ARG IS FIX BUT SHOULD BE FLOAT
|
||||||
|
STD ERTHX
|
||||||
|
STU ARTHA
|
||||||
|
RAU PIHF
|
||||||
|
FSB ARTHA AV0 SIN A = COS(PI/2 - A)
|
||||||
|
PIHF 15 7079 6351 PI / 2 FLOAT
|
||||||
|
1
|
||||||
|
1 END OF FORTRAN PACKAGE
|
||||||
|
1
|
||||||
|
|
21
I650/sw/fortransit/pack_res1.txt
Normal file
21
I650/sw/fortransit/pack_res1.txt
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
1
|
||||||
|
1 fortran
|
||||||
|
1 package reservation
|
||||||
|
1 for package build
|
||||||
|
1
|
||||||
|
1 includes
|
||||||
|
1 - float fix conversions
|
||||||
|
1 - fortran read punch statemens
|
||||||
|
1 - fortran power operator
|
||||||
|
1 - fortran functions
|
||||||
|
1 excludes
|
||||||
|
1 - nothing
|
||||||
|
1
|
||||||
|
regy0002 0002 fortransit
|
||||||
|
1 vars start addr
|
||||||
|
blr 0000 1400 reserve all
|
||||||
|
1 drum except
|
||||||
|
1 pack space
|
||||||
|
1
|
||||||
|
1 end of package reservation
|
||||||
|
1
|
21
I650/sw/fortransit/pack_res2.txt
Normal file
21
I650/sw/fortransit/pack_res2.txt
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
1
|
||||||
|
1 fortran
|
||||||
|
1 package reservation
|
||||||
|
1 for package use
|
||||||
|
1
|
||||||
|
1 includes
|
||||||
|
1 - float fix conversions
|
||||||
|
1 - fortran read punch statemens
|
||||||
|
1 - fortran power operator
|
||||||
|
1 - fortran functions
|
||||||
|
1 excludes
|
||||||
|
1 - nothing
|
||||||
|
1
|
||||||
|
regp1951 1960 read band
|
||||||
|
regj1977 1986 punch band
|
||||||
|
regw1988 1998 storage band
|
||||||
|
blr 1401 1999 reserve
|
||||||
|
1 pack space
|
||||||
|
1
|
||||||
|
1 end of package reservation
|
||||||
|
1
|
684
I650/sw/fortransit/pack_src.txt
Normal file
684
I650/sw/fortransit/pack_src.txt
Normal file
|
@ -0,0 +1,684 @@
|
||||||
|
1
|
||||||
|
1 fortran package
|
||||||
|
1 source code
|
||||||
|
1
|
||||||
|
blr 1945 1950 entry power subr total reservation
|
||||||
|
regp1951 1960 read band 1947 - 1999, 0000
|
||||||
|
blr 1961 1968 entry built-in subr (54 words)
|
||||||
|
blr 1969 1976 entry func subr
|
||||||
|
regj1977 1986 punch band
|
||||||
|
blr 1987 1987
|
||||||
|
regw1988 1998 storage band
|
||||||
|
1
|
||||||
|
1 save index registers
|
||||||
|
1
|
||||||
|
ezzzastdezzzx
|
||||||
|
ldd 8005
|
||||||
|
stdezzia
|
||||||
|
ldd 8006
|
||||||
|
stdezzib
|
||||||
|
ldd 8007
|
||||||
|
stdezzic ezzzx
|
||||||
|
1
|
||||||
|
1 restore saved index registers and return to erthx
|
||||||
|
1
|
||||||
|
ezzzblddezzia
|
||||||
|
raa 8001
|
||||||
|
lddezzib
|
||||||
|
rab 8001
|
||||||
|
lddezzic
|
||||||
|
rac 8001 erthx
|
||||||
|
ezzzx 00 0000 0000
|
||||||
|
ezzia 00 0000 0000
|
||||||
|
ezzib 00 0000 0000
|
||||||
|
ezzic 00 0000 0000
|
||||||
|
1
|
||||||
|
1 overflow checking
|
||||||
|
1
|
||||||
|
e00aabov 8001
|
||||||
|
hlt 0100 8001 alarm arithmetic overflow
|
||||||
|
1
|
||||||
|
1 (l) fixed point <- (u) float
|
||||||
|
1
|
||||||
|
e00thstderthx float upper
|
||||||
|
srt 0002 to fix lower
|
||||||
|
stuartha save mantissa
|
||||||
|
ram 8002 test exp
|
||||||
|
slon51 store zero
|
||||||
|
bmiad1 if less than
|
||||||
|
slon10 51 alarm
|
||||||
|
bmi ad3 if grtr than
|
||||||
|
srt 0004 60
|
||||||
|
aloonet
|
||||||
|
lddad2a modify
|
||||||
|
sdaad2 shift
|
||||||
|
ralartha
|
||||||
|
slt 0002 ad2
|
||||||
|
ad1 ral 8003 erthx store zero
|
||||||
|
ad2 srt 0000 erthx shift const
|
||||||
|
ad2a srt 0000 erthx
|
||||||
|
ad3 ldderthx
|
||||||
|
hlt 0501 8001 alarm float >= 10e10 thus cannot be converted to fix
|
||||||
|
n10 10 0000 0000
|
||||||
|
n51 51 0000 0000
|
||||||
|
onet 00 0001 0000
|
||||||
|
erthx 00 0000 0000
|
||||||
|
artha 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (u) and (acc) float <- (l) fixed point
|
||||||
|
1
|
||||||
|
e00afstdartha float to up
|
||||||
|
ldd e00ae and acc
|
||||||
|
stuacc artha
|
||||||
|
1
|
||||||
|
1 (u) float <- (l) fixed point
|
||||||
|
1
|
||||||
|
e00aestderthx float to up
|
||||||
|
rau 8002 ae0 only
|
||||||
|
ae0 sct 0000 normalize
|
||||||
|
stlarthb
|
||||||
|
bovad1 zero check
|
||||||
|
ral 8003
|
||||||
|
srd 0002 round for
|
||||||
|
slt 0002 placing exp
|
||||||
|
nzu ae6 check round
|
||||||
|
ldd 8003 overflow
|
||||||
|
srt 0001
|
||||||
|
alo 8001 ae6
|
||||||
|
ae6 bmiae2 insert
|
||||||
|
aloaj3 ae5 exponent
|
||||||
|
ae2 sloaj3 ae5
|
||||||
|
ae5 sloarthb
|
||||||
|
rau 8002 erthx
|
||||||
|
aj3 00 0000 0060
|
||||||
|
arthb 00 0000 0000
|
||||||
|
1
|
||||||
|
1 punch card
|
||||||
|
1
|
||||||
|
e00arstderthx punch out
|
||||||
|
lddj0008
|
||||||
|
siaj0008 store stmnt
|
||||||
|
lddonet
|
||||||
|
sdanvars and nvars to pch
|
||||||
|
slo 8001 if stmt zero
|
||||||
|
nzear3 punch if
|
||||||
|
ral 8000 8000 is neg
|
||||||
|
bmiar3 erthx else exit
|
||||||
|
ar3 lddar3a ar5 init pch card
|
||||||
|
ar3a ralnvars dec nvars
|
||||||
|
sloonet
|
||||||
|
bmiar8 test word
|
||||||
|
stlnvars count
|
||||||
|
alo 8002 get nword addr
|
||||||
|
ralw0002 in lower
|
||||||
|
lddnword
|
||||||
|
sdanword store num of words to punch
|
||||||
|
slt 0004
|
||||||
|
lddadwrd
|
||||||
|
sdaadwrd ar4 store addr of word to punch
|
||||||
|
ar4 ralnpch is card full
|
||||||
|
sloarn7
|
||||||
|
bmiar4a
|
||||||
|
pchj0001 yes punch and
|
||||||
|
lddar4a ar5 call init card
|
||||||
|
ar4a ralnpch incr no of
|
||||||
|
aloonet punched words npch
|
||||||
|
stlnpch
|
||||||
|
raladwrd indr adwrd
|
||||||
|
aloonet
|
||||||
|
stladwrd
|
||||||
|
sloonet
|
||||||
|
alo 8002 get adwrd
|
||||||
|
raly0000 contents
|
||||||
|
stldatwd store in datwd
|
||||||
|
raudatld
|
||||||
|
alonpch store at
|
||||||
|
alo 8003 j0000 plus
|
||||||
|
stdj0000 npch
|
||||||
|
ralnword decr var nwords
|
||||||
|
sloonet to be punched
|
||||||
|
nze ar3a
|
||||||
|
bmiar3a
|
||||||
|
stlnword ar4
|
||||||
|
ar5 stdar5x sub init pch card
|
||||||
|
ralj0008 incr card
|
||||||
|
aloonet number
|
||||||
|
stlj0008
|
||||||
|
stunpch card with zero
|
||||||
|
stdj0001 punched words
|
||||||
|
stdj0002 set punch
|
||||||
|
stdj0003 band to
|
||||||
|
stdj0004 zeroes
|
||||||
|
stdj0005
|
||||||
|
stdj0006
|
||||||
|
stdj0007 ar5x
|
||||||
|
ar8 pchj0001 erthx punch
|
||||||
|
onet 00 0001 0000
|
||||||
|
arn7 00 0007 0000
|
||||||
|
j0008 00 0000 0000 card counter
|
||||||
|
j0010 80 0000 0080 control cnst
|
||||||
|
ar5x 00 0000 0000 exit for sub init pch card
|
||||||
|
nvars 00 0000 0000 num of vars to pch
|
||||||
|
nword 00 0000 0000 num of words per var to pch
|
||||||
|
adwrd 00 0000 0000 addr of word to pch
|
||||||
|
npch 00 0000 0000 num of words punched in chard
|
||||||
|
datwd 00 0000 0000 data word to be punched
|
||||||
|
1
|
||||||
|
1 read card
|
||||||
|
1
|
||||||
|
e00aqstderthx read in
|
||||||
|
lddonet
|
||||||
|
sdanvars nvars to read
|
||||||
|
stunpch aq3a init to zero
|
||||||
|
aq3a ralnvars dec nvars
|
||||||
|
sloonet
|
||||||
|
bmierthx exit if zero
|
||||||
|
stlnvars
|
||||||
|
alo 8002 get nword addr
|
||||||
|
ralw0002 in lower
|
||||||
|
lddnword
|
||||||
|
sdanword store num of words to rd
|
||||||
|
slt 0004
|
||||||
|
lddadwrd
|
||||||
|
sdaadwrd aq4 store addr of word to rd
|
||||||
|
aq4 ralnpch check if should rd new card
|
||||||
|
nzeaq4a
|
||||||
|
rcdp0001 yes read card
|
||||||
|
lddarn7
|
||||||
|
stdnpch aq4a
|
||||||
|
aq4a ralnpch decr no of available
|
||||||
|
sloonet punched words npch in read card
|
||||||
|
stlnpch
|
||||||
|
ralarn7
|
||||||
|
slonpch get word at
|
||||||
|
alo 8002 p0000 plus
|
||||||
|
lddp0000 npch in dist
|
||||||
|
stddatwd store it in datwd
|
||||||
|
raudatld
|
||||||
|
aloadwrd incr adwrd
|
||||||
|
aloonet
|
||||||
|
stladwrd
|
||||||
|
sloonet
|
||||||
|
alo 8003 set adwrd
|
||||||
|
stdy0000 contents from upper
|
||||||
|
ralnword decr var nwords
|
||||||
|
sloonet to be read
|
||||||
|
nze aq3a
|
||||||
|
bmiaq3a
|
||||||
|
stlnword aq4
|
||||||
|
onet 00 0001 0000
|
||||||
|
datldldddatwd 8002 load card word into dist and jump to lower
|
||||||
|
1
|
||||||
|
1 alarm if try to use a not defined subroutine
|
||||||
|
1
|
||||||
|
e00akhlt 9010 8001 alarm fix ** fix undef
|
||||||
|
e00alhlt 9011 8001 alarm float ** fix undef
|
||||||
|
e00lqhlt 9302 8001 alarm float ** float undef
|
||||||
|
e00abhlt 9001 8001 alarm logf undef
|
||||||
|
e00achlt 9002 8001 alarm expf undef
|
||||||
|
e00lohlt 9300 8001 alarm lnf undef
|
||||||
|
e00lphlt 9301 8001 alarm expnf undef
|
||||||
|
e00avhlt 9021 8001 alarm cosf undef
|
||||||
|
e00awhlt 9022 8001 alarm sinf undef
|
||||||
|
e00axhlt 9023 8001 alarm sqrtf undef
|
||||||
|
e00ayhlt 9024 8001 alarm absf undef
|
||||||
|
e00azhlt 9025 8001 alarm intf undef
|
||||||
|
e00bahlt 9026 8001 alarm maxf undef
|
||||||
|
ezztyhlt 9099 8001 alarm function arg is fix but should be float
|
||||||
|
1
|
||||||
|
1 start of subroutines
|
||||||
|
1
|
||||||
|
1
|
||||||
|
1 (l) and (acc) fixed <- (l) fixed ** (acc) fixed
|
||||||
|
1
|
||||||
|
e00akstderthx power fix fix. m ** p
|
||||||
|
stlartha ak1 m is argmnt
|
||||||
|
ak1 ramacc p equals
|
||||||
|
stlarthb abval power
|
||||||
|
ralone h is result
|
||||||
|
stlarthc ak3 init to one
|
||||||
|
ak3 rauarthb p is gtst
|
||||||
|
mpyn50 intgr in
|
||||||
|
stuarthb p over two
|
||||||
|
ral 8002 is remainder
|
||||||
|
nze ak5 zero
|
||||||
|
rauarthc if not h is
|
||||||
|
mpyartha h times m
|
||||||
|
nzuak12
|
||||||
|
stlarthc ak5
|
||||||
|
ak5 rauarthb
|
||||||
|
nzu ak6 is p zero
|
||||||
|
rauartha if not
|
||||||
|
mpy 8001 m equals
|
||||||
|
nzuak12
|
||||||
|
stlartha ak3 m squared
|
||||||
|
ak6 rauacc is power neg
|
||||||
|
bmi ak7 if so is h
|
||||||
|
ramarthc zero
|
||||||
|
nze ak8 if not is h
|
||||||
|
sloone one
|
||||||
|
nzeak10 ak7
|
||||||
|
ak7 ralarthc ak11 exhibit h
|
||||||
|
ak10 ral 8003 ak11
|
||||||
|
ak11 stlacc erthx
|
||||||
|
ak12 ldderthx
|
||||||
|
hlt 0003 8001 alarm overflow. fix**fix results in value >= 10e10
|
||||||
|
ak8 ldderthx
|
||||||
|
hlt 0010 8001 alarm zero raised to neg
|
||||||
|
n50 50 0000 0000
|
||||||
|
one 00 0000 0001
|
||||||
|
arthc 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (u) and (acc) float <- (u) float ** (acc) fixed
|
||||||
|
1
|
||||||
|
e00alstderthx power float fix. m ** p
|
||||||
|
stuartha al1 m is argmnt
|
||||||
|
al1 ramacc p equals
|
||||||
|
stlarthb abval power
|
||||||
|
ralfp1 h is result
|
||||||
|
stlarthc al3 init to float one
|
||||||
|
al3 rauarthb p is gtst
|
||||||
|
mpyn50 intgr in
|
||||||
|
stuarthb p over two
|
||||||
|
ral 8002 is remainder
|
||||||
|
nze al5 zero
|
||||||
|
rauarthc if not h is
|
||||||
|
fmpartha h times m
|
||||||
|
boval12
|
||||||
|
stuarthc al5
|
||||||
|
al5 rauarthb
|
||||||
|
nzu al6 is p zero
|
||||||
|
rauartha if not
|
||||||
|
fmp 8001 m equals
|
||||||
|
boval12
|
||||||
|
stuartha al3 m squared
|
||||||
|
al6 rauacc is power neg
|
||||||
|
bmi al7 if so is h
|
||||||
|
ramarthc zero
|
||||||
|
nze al8 if not calc
|
||||||
|
raufp1 h reciprocal
|
||||||
|
fdvarthc al11
|
||||||
|
al7 rauarthc al11 exhibit h
|
||||||
|
al11 stuacc erthx
|
||||||
|
al12 ldderthx
|
||||||
|
hlt 0049 8001 alarm overflow. float**fix results in value >= 10e49
|
||||||
|
al8 ldderthx
|
||||||
|
hlt 0011 8001 alarm zero raised to neg
|
||||||
|
n50 50 0000 0000
|
||||||
|
fp1 10 0000 0051
|
||||||
|
1
|
||||||
|
1 (u) float <- 10 ** (u) float
|
||||||
|
1
|
||||||
|
e00acstderthx exponential
|
||||||
|
nze ac5 is argument
|
||||||
|
nzu ezzty alarm function arg is fix but should be float
|
||||||
|
srt 0002 zero
|
||||||
|
stuarthc if not let
|
||||||
|
rsm 8002 n be mantsa
|
||||||
|
alon52 x be power
|
||||||
|
bmiac4 is x grtr
|
||||||
|
slt 0001 than ten
|
||||||
|
nzuac5 or less than
|
||||||
|
srt 0005 minus eight
|
||||||
|
aloac6 if x within
|
||||||
|
stlarthb bounds gen
|
||||||
|
rauarthc int and
|
||||||
|
srt 0006 arthb fract parts
|
||||||
|
n52 52 0000 0000 of argument
|
||||||
|
ac6 srt 0000 is arg neg
|
||||||
|
bmiac8 if so int is
|
||||||
|
stuarthb ac1 int minus 1
|
||||||
|
ac8 supone and fract is
|
||||||
|
stuarthb fract plus 1
|
||||||
|
ral 8002
|
||||||
|
alon999 ac1
|
||||||
|
ac1 stlarthc arthc is frac part
|
||||||
|
rau 8002 arthb is int part
|
||||||
|
mpyac18 generate
|
||||||
|
rau 8003
|
||||||
|
aupac17 polynomial
|
||||||
|
mpyarthc
|
||||||
|
rau 8003 approximation
|
||||||
|
aupac16
|
||||||
|
mpyarthc
|
||||||
|
rau 8003 for
|
||||||
|
aupac15
|
||||||
|
mpyarthc exponential
|
||||||
|
rau 8003
|
||||||
|
aupac14
|
||||||
|
mpyarthc
|
||||||
|
rau 8003
|
||||||
|
aupac13
|
||||||
|
mpyarthc
|
||||||
|
rau 8003
|
||||||
|
aupac12
|
||||||
|
mpyarthc square
|
||||||
|
rau 8003 result
|
||||||
|
aupn10 scale and
|
||||||
|
mpy 8003 float then
|
||||||
|
srt 0001 exit
|
||||||
|
stuartha
|
||||||
|
rauac19
|
||||||
|
auparthb
|
||||||
|
bmiac20
|
||||||
|
srt 0002
|
||||||
|
nzuac21
|
||||||
|
aupartha
|
||||||
|
srt 0008 ac20
|
||||||
|
ac4 ralarthc
|
||||||
|
bmi ac21
|
||||||
|
rau 8003 erthx result zero
|
||||||
|
ac5 raufp1 erthx result 1 because argmnt is zero
|
||||||
|
ac20 rau 8002 erthx result in upper
|
||||||
|
ac21 ldderthx
|
||||||
|
hlt 0049 8001 alarm overflow. 10**float results in value >= 10e49
|
||||||
|
ac12 11 5129 2776
|
||||||
|
ac13 06 6273 0884
|
||||||
|
ac14 02 5439 3575
|
||||||
|
ac15 00 7295 1737
|
||||||
|
ac16 00 1742 1120
|
||||||
|
ac17 00 0255 4918
|
||||||
|
ac18 00 0093 2643
|
||||||
|
ac19 00 0000 0051
|
||||||
|
n999 99 9999 9999
|
||||||
|
n10 10 0000 0000
|
||||||
|
one 00 0000 0001
|
||||||
|
fp1 10 0000 0051
|
||||||
|
arthc 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (u) float <- log 10 (u) float
|
||||||
|
1
|
||||||
|
e00abnze ab10 if log arg zero
|
||||||
|
nzu ezzty alarm function arg is fix but should be float
|
||||||
|
bmiab10 or neg alarm
|
||||||
|
stderthx
|
||||||
|
srt 0002
|
||||||
|
stlarthb store power
|
||||||
|
rau 8003 form z
|
||||||
|
aupab1 equal arg
|
||||||
|
stuarthc minus root
|
||||||
|
supab2 ten over arg
|
||||||
|
dvrarthc plus root
|
||||||
|
stlartha ten
|
||||||
|
rau 8002
|
||||||
|
mpy 8001 z square
|
||||||
|
stuarthc
|
||||||
|
rau 8003 generate
|
||||||
|
mpyab7
|
||||||
|
rau 8003 polynomial
|
||||||
|
aupab6
|
||||||
|
mpyarthc approximatn
|
||||||
|
rau 8003
|
||||||
|
aupab5
|
||||||
|
mpyarthc
|
||||||
|
rau 8003
|
||||||
|
aupab4
|
||||||
|
mpyarthc
|
||||||
|
rau 8003
|
||||||
|
aupab3
|
||||||
|
mpyartha
|
||||||
|
ral 8003
|
||||||
|
alon50
|
||||||
|
srt 0002
|
||||||
|
aloarthb add power
|
||||||
|
slon50
|
||||||
|
srd 0002 round
|
||||||
|
rau 8002
|
||||||
|
sct 0000 normalize
|
||||||
|
bovab12
|
||||||
|
bmi ab13
|
||||||
|
supab9 ab11 adjust
|
||||||
|
ab11 sup 8002 ab12 power
|
||||||
|
ab12 rau 8003
|
||||||
|
fsbfp1 erthx
|
||||||
|
ab13 aupab9 ab11
|
||||||
|
ab10 hlt 0001 8001 alarm log (zero or negavive)
|
||||||
|
ab1 00 3162 2780
|
||||||
|
ab2 00 6324 5560
|
||||||
|
ab3 86 8591 7180
|
||||||
|
ab4 28 9335 5240
|
||||||
|
ab5 17 7522 0710
|
||||||
|
ab6 09 4376 4760
|
||||||
|
ab7 19 1337 7140
|
||||||
|
n50 50 0000 0000
|
||||||
|
fp1 10 0000 0051
|
||||||
|
ab9 00 0000 0054
|
||||||
|
arthc 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (u) and (acc) float <- (u) float ** (acc) float
|
||||||
|
1 u**acc = 10**(log10(u)*acc)
|
||||||
|
1 = exp(log10(u)*acc)
|
||||||
|
1
|
||||||
|
e00lqstdlq1
|
||||||
|
ldd e00ab log 10 (u)
|
||||||
|
fmpacc mult by acc
|
||||||
|
lddlq1 e00ac 10 ** u
|
||||||
|
lq1 00 0000 0000
|
||||||
|
1
|
||||||
|
1 (u) float <- log e (u) float
|
||||||
|
1 ln(u) = log(u) / log(e)
|
||||||
|
1 log10(e)=0.4342944819
|
||||||
|
1
|
||||||
|
e00lostdlq1
|
||||||
|
ldd e00ab log 10 (u)
|
||||||
|
fdvloge lq1 div by log(e) const
|
||||||
|
lq1 00 0000 0000
|
||||||
|
loge 43 4294 4850
|
||||||
|
1
|
||||||
|
1 (u) float <- e ** (u) float
|
||||||
|
1 expn(u) = e ** u = exp(log10(e)*u)
|
||||||
|
1 e=2.71828182846
|
||||||
|
1
|
||||||
|
e00lpstdlq1
|
||||||
|
fmploge mult by log(e) const
|
||||||
|
lddlq1 e00ac 10 ** u
|
||||||
|
lq1 00 0000 0000
|
||||||
|
loge 43 4294 4850
|
||||||
|
1
|
||||||
|
1 (u) float <- absolute value (u) float
|
||||||
|
1
|
||||||
|
e00aynze 8001 exit if zero
|
||||||
|
nzu ezzty alarm function arg is fix but should be float
|
||||||
|
stderthx
|
||||||
|
ram 8003 remove sgn
|
||||||
|
rau 8002 erthx result in upper and exit
|
||||||
|
1
|
||||||
|
1 (u) float <- integer part (u) float
|
||||||
|
1
|
||||||
|
e00aznze 8001 exit if zero
|
||||||
|
nzu ezzty alarm function arg is fix but should be float
|
||||||
|
stderthx
|
||||||
|
stuarthc save arg
|
||||||
|
srt 0002 exp in lower
|
||||||
|
stuartha mant in h
|
||||||
|
rsm 8002 make exp neg
|
||||||
|
alon57
|
||||||
|
bmiaz4 big num so no fract part to remove
|
||||||
|
alon01
|
||||||
|
slt 0001
|
||||||
|
nzuaz5 small num so no int part
|
||||||
|
srt 0005 set as right
|
||||||
|
aloaz6 shifts to do
|
||||||
|
stlarthb
|
||||||
|
rauartha arthb
|
||||||
|
n57 57 0000 0000
|
||||||
|
n01 01 0000 0000
|
||||||
|
az6 srt 0000
|
||||||
|
rau 8003 ae0 go to fix to float conversion routine
|
||||||
|
az5 rau 8002
|
||||||
|
rau 8002 erthx return zero
|
||||||
|
az4 rauarthc erthx return the arg unchanged
|
||||||
|
1
|
||||||
|
1 (u) float <- max (float, float, ...)
|
||||||
|
1 should have two or more float parameters
|
||||||
|
1
|
||||||
|
e00bastderthx
|
||||||
|
stuartha arg is max
|
||||||
|
ralerthx ba0
|
||||||
|
ba0 sloba10
|
||||||
|
bmiba9 no more args
|
||||||
|
ralerthx set arg addr
|
||||||
|
lddba1 to be read
|
||||||
|
sdaba1 ba1
|
||||||
|
ba1 rau 0000 read arg
|
||||||
|
stuarthb
|
||||||
|
fsbartha is grtr than
|
||||||
|
bmiba2 current result
|
||||||
|
rauarthb yes store as
|
||||||
|
stuartha ba2 new result
|
||||||
|
ba2 ralerthx select next
|
||||||
|
sloonet arg
|
||||||
|
stlerthx ba0
|
||||||
|
ba9 rauartha erthx result in upper
|
||||||
|
ba10 00p0000 0000 fist arg addr
|
||||||
|
1
|
||||||
|
1 (u) float <- square root (u) float
|
||||||
|
1
|
||||||
|
e00axnze 8001 exit if zero
|
||||||
|
nzu ezzty alarm function arg is fix but should be float
|
||||||
|
bmiax1 alarm sqrt(neg)
|
||||||
|
stderthx
|
||||||
|
srt 0002
|
||||||
|
nzu ax2 test for zro
|
||||||
|
slon01 convert fortransit exp (1.0=1e51) to it exp (1.0=1e50)
|
||||||
|
stlarthb break up exp
|
||||||
|
ral 8003 and mantissa
|
||||||
|
slt 0002 calculate
|
||||||
|
stlartha initial x
|
||||||
|
aupone ax3
|
||||||
|
ax4 rauartha calculate
|
||||||
|
dvrarthc next x
|
||||||
|
slo 8001 value
|
||||||
|
nze ax5
|
||||||
|
bmi ax5 test for end
|
||||||
|
alo 8001
|
||||||
|
alo 8001 ax3
|
||||||
|
ax3 dvrtwo recycle
|
||||||
|
stlarthc ax4
|
||||||
|
ax5 ralarthb modify
|
||||||
|
alon49 exponent
|
||||||
|
srt 0008
|
||||||
|
divtwo
|
||||||
|
alo 8003
|
||||||
|
stlarthb test even or
|
||||||
|
nzu ax6 odd exp
|
||||||
|
rauarthc exp odd
|
||||||
|
srt 0001
|
||||||
|
mpyax11 mpy by sqrt
|
||||||
|
srd 0010 ax7 of 10
|
||||||
|
ax7 slt 0002
|
||||||
|
aloarthb
|
||||||
|
aloone exp 50 to 51
|
||||||
|
rau 8002 erthx go to exit
|
||||||
|
ax6 ralarthc exp even
|
||||||
|
srd 0002 ax7
|
||||||
|
ax2 rau 8003 erthx result zero
|
||||||
|
ax1 hlt 0012 8001 alarm sqrt with negative argument
|
||||||
|
one 00 0000 0001 constants
|
||||||
|
two 00 0000 0002
|
||||||
|
n49 49 0000 0000
|
||||||
|
ax11 03 1622 7766
|
||||||
|
1
|
||||||
|
1 (u) float <- cosinus (u) float (arg in radians: cos(pi/2) = 0)
|
||||||
|
1
|
||||||
|
e00avstderthx av0
|
||||||
|
av0 nze av4 cos(0) is one
|
||||||
|
nzu ezzty alarm function arg is fix but should be float
|
||||||
|
srt 0002 argument
|
||||||
|
stuartha alarm if pwr
|
||||||
|
rsm 8002 overscale
|
||||||
|
alon01 convert fortransit exp (1.0=1e51) to it exp (1.0=1e50)
|
||||||
|
alon57 cosx equals
|
||||||
|
bmiav2 one if pwr
|
||||||
|
sloav3 underscale
|
||||||
|
bmi av4
|
||||||
|
srt 0004
|
||||||
|
aloav5
|
||||||
|
stlav6
|
||||||
|
rauartha form
|
||||||
|
mpyav7 av6 fractional
|
||||||
|
av6 hltav6 av23 and intgrl
|
||||||
|
av23 stlarthc parts
|
||||||
|
rau 8003
|
||||||
|
mpyn50 form s as
|
||||||
|
stlarthb one minus
|
||||||
|
rsmarthc twice abval
|
||||||
|
sml 8001 of fractnl
|
||||||
|
alon999 part
|
||||||
|
rau 8002
|
||||||
|
stuartha
|
||||||
|
mpy 8001 form sine
|
||||||
|
stuarthc
|
||||||
|
rauav16 polynomial
|
||||||
|
mpyarthc approximator
|
||||||
|
rau 8003
|
||||||
|
aupav15
|
||||||
|
mpyarthc
|
||||||
|
rau 8003
|
||||||
|
aupav14
|
||||||
|
mpyarthc
|
||||||
|
rau 8003
|
||||||
|
aupav13
|
||||||
|
mpyarthc
|
||||||
|
srt 0001
|
||||||
|
rau 8003
|
||||||
|
auppih equals one
|
||||||
|
mpyartha
|
||||||
|
sct 0000
|
||||||
|
bovav19
|
||||||
|
stlartha
|
||||||
|
ral 8003 round
|
||||||
|
srt 0002 and
|
||||||
|
stlarthc adjust
|
||||||
|
rsuartha power
|
||||||
|
srt 0002
|
||||||
|
bmi av25
|
||||||
|
sup 8003
|
||||||
|
alon50 av24
|
||||||
|
av24 auparthc
|
||||||
|
slt 0002 av22
|
||||||
|
av22 stuartha determine
|
||||||
|
rauarthb sign of
|
||||||
|
nzu av20 result
|
||||||
|
rslartha av26
|
||||||
|
av20 ralartha av26
|
||||||
|
av25 sup 8003
|
||||||
|
slon50 av24
|
||||||
|
av2 rauarthb overscale
|
||||||
|
ldderthx display
|
||||||
|
hlt 0013 8001 alarm radian arg too big
|
||||||
|
av26 rau 8002
|
||||||
|
bmiav27
|
||||||
|
aupone erthx
|
||||||
|
av27 supone erthx
|
||||||
|
av4 ralav21 av26 cosx is one
|
||||||
|
av19 ral 8002 cosx is zero
|
||||||
|
slo 8001 av26
|
||||||
|
av17 rauav21 av22 cosx is plus
|
||||||
|
av3 11 0000 0000 or minus 1
|
||||||
|
av5 srd 0011 av23
|
||||||
|
av7 31 8309 8862
|
||||||
|
pih 15 7079 6327 pi / 2 integer
|
||||||
|
-av13 64 5963 7111
|
||||||
|
av14 07 9689 6793
|
||||||
|
-av15 00 4673 7656
|
||||||
|
av16 00 0151 4842
|
||||||
|
av21 10 0000 0050
|
||||||
|
n999 99 9999 9999
|
||||||
|
n50 50 0000 0000
|
||||||
|
one 00 0000 0001
|
||||||
|
n01 01 0000 0000
|
||||||
|
n57 57 0000 0000
|
||||||
|
1
|
||||||
|
1 (u) float <- sinus (u) float (arg in radians: sin(pi/2) = 1)
|
||||||
|
1
|
||||||
|
e00awnze 8001 sin(0) is zero
|
||||||
|
nzu ezzty alarm function arg is fix but should be float
|
||||||
|
stderthx
|
||||||
|
stuartha
|
||||||
|
raufpih
|
||||||
|
fsbartha av0 sin a = cos(pi/2 - a)
|
||||||
|
fpih 15 7079 6351 pi / 2 float
|
||||||
|
1
|
||||||
|
1 end of fortran package
|
||||||
|
1
|
58
I650/sw/it/00_readme.txt
Normal file
58
I650/sw/it/00_readme.txt
Normal file
|
@ -0,0 +1,58 @@
|
||||||
|
|
||||||
|
Restoration comments May/2018
|
||||||
|
|
||||||
|
Internal Translator (IT Compiler)
|
||||||
|
|
||||||
|
From Bitsavers Manual CarnegieInternalTranslator.pdf
|
||||||
|
|
||||||
|
The run_it.ini script uses P1 run-time package that
|
||||||
|
provides floating point +,-,/,* PUNCH and READ, that's
|
||||||
|
all. In particular, it does not provides power functions
|
||||||
|
so using power operator in IT program will crash the
|
||||||
|
object program in run-time.
|
||||||
|
|
||||||
|
To allow the use of IT power operator, replace _P1
|
||||||
|
package by _P2, _P3 or _P4 (depending on what is needed)
|
||||||
|
|
||||||
|
In the original listing found in manual, some opcodes has
|
||||||
|
a different name of the standard SOAP II ones.
|
||||||
|
They have been changed to regular SOAP names
|
||||||
|
|
||||||
|
Mnemonic in Standard SOAP
|
||||||
|
original listing equivalent mnemonic
|
||||||
|
|
||||||
|
AAB -> AML
|
||||||
|
SAB -> SML
|
||||||
|
NZA -> NZE
|
||||||
|
RAB -> RAM
|
||||||
|
RSB -> RSM
|
||||||
|
RDS -> RD1
|
||||||
|
|
||||||
|
IT compiler generates also these opcodes in object
|
||||||
|
program, to be assembled by IT modified y SOAP I. As
|
||||||
|
SOAP I is not available, the IT compiler has been
|
||||||
|
modified to produce standard SOAP II opcodes.
|
||||||
|
|
||||||
|
These modifications are done in lines 394-410, file
|
||||||
|
it_compiler_listing.txt with a comment to signal it.
|
||||||
|
|
||||||
|
Also all the correction to the listing stated in the
|
||||||
|
manual has been applied. They are stated at the
|
||||||
|
end of it_compiler_listing.txt file.
|
||||||
|
|
||||||
|
Original listing in manual describes the modifications
|
||||||
|
to apply to standard SOAP I deck in order to assemble
|
||||||
|
IT compiler produced SOAP code (soap_patch_listing.txt).
|
||||||
|
|
||||||
|
As SOAP I is not available, an equivalent set of modifications
|
||||||
|
has been written to be applies to SOAP II in order to
|
||||||
|
allow to assemble IT produced compiled code (soapII_patch.txt)
|
||||||
|
|
||||||
|
Floating point numbers are encoded as
|
||||||
|
|
||||||
|
2300000049 = 0.23
|
||||||
|
1000000050 = 1.0
|
||||||
|
1500000052 = 150.0
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1754,7 +1754,7 @@ A794 LDD NGLFT 1752 69 1144 0947
|
||||||
4 5
|
4 5
|
||||||
5 5 ERRATA BUGFIX
|
5 5 ERRATA BUGFIX
|
||||||
6 5
|
6 5
|
||||||
1442X STU OPSGN 1334 21 0524 1902
|
1442 STU OPSGN 1334 21 0524 1902
|
||||||
1442A STD V1 1384 1902 24 0488 1384
|
1442A STD V1 1384 1902 24 0488 1384
|
||||||
1 5
|
1 5
|
||||||
2 5 CARNEGIE TECH COMPILER IT
|
2 5 CARNEGIE TECH COMPILER IT
|
||||||
|
@ -1762,26 +1762,26 @@ A794 LDD NGLFT 1752 69 1144 0947
|
||||||
4 5
|
4 5
|
||||||
5 5 ERRATA BUGFIX
|
5 5 ERRATA BUGFIX
|
||||||
6 5
|
6 5
|
||||||
341X SUP A0001 OUT IF JAY 1065 11 0383 1137
|
341 SUP A0001 OUT IF JAY 1065 11 0383 1137
|
||||||
A341X STU NEWAB 0887 1137 21 0845 0887
|
A341 STU NEWAB 0887 1137 21 0845 0887
|
||||||
603X BS LDD DROPU DCRMNT U 0987 69 0690 0893
|
603 BS LDD DROPU DCRMNT U 0987 69 0690 0893
|
||||||
A603X RAL NEWAB 0690 65 0845 0298
|
A603 RAL NEWAB 0690 65 0845 0298
|
||||||
B603X NZE BSA 0640 0298 45 0786 0640
|
B603 NZE BSA 0640 0298 45 0786 0640
|
||||||
606X STL A0001 BSA 1485 20 0383 0786
|
606 STL A0001 BSA 1485 20 0383 0786
|
||||||
607X BSA RAU N BN1 0786 60 0484 1039
|
607 BSA RAU N BN1 0786 60 0484 1039
|
||||||
650X LDD 1377 LDSR COMPILE 1413 69 1377 1038
|
650 LDD 1377 LDSR COMPILE 1413 69 1377 1038
|
||||||
X NEWAB 00 0000 0000 0845 00 0000 0000
|
NEWAB 00 0000 0000 0845 00 0000 0000
|
||||||
1 5
|
1 5
|
||||||
2 5 CARNEGIE TECH COMPILER IT
|
2 5 CARNEGIE TECH COMPILER IT
|
||||||
3 5 NO DATE
|
3 5 NO DATE
|
||||||
4 5
|
4 5
|
||||||
5 5 ERRATA BUGFIX
|
5 5 ERRATA BUGFIX
|
||||||
6 5
|
6 5
|
||||||
793X LDD ML1A TKNZ1 TKNZ1AND ML1 0940 69 1802 1094
|
793 LDD ML1A TKNZ1 TKNZ1AND ML1 0940 69 1802 1094
|
||||||
799X MY1 LDD ML1A TKNZ2 1178 69 1802 1194
|
799 MY1 LDD ML1A TKNZ2 1178 69 1802 1194
|
||||||
A793X ML1A SLO 8002 1802 16 8002 1852
|
A793 ML1A SLO 8002 1802 16 8002 1852
|
||||||
B793X STL ABVAL ML1 1852 20 0366 1291
|
B793 STL ABVAL ML1 1852 20 0366 1291
|
||||||
804X LDD 1971 GENN RAL AJAY 1139 69 1971 1681
|
804 LDD 1971 GENN RAL AJAY 1139 69 1971 1681
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -23,7 +23,11 @@
|
||||||
prime number generator using the sieve of eratosthenes
|
prime number generator using the sieve of eratosthenes
|
||||||
converted to ibm 650 IT compliler
|
converted to ibm 650 IT compliler
|
||||||
|
|
||||||
IT system syntax IT notation in manual c-like equivalent syntax
|
note: ibm 650 terminates card reading on "ff" statement (numbered as 10), so
|
||||||
|
it is safe to add text and comments below that
|
||||||
|
|
||||||
|
|
||||||
|
IT syntax IT notation in manual c-like equivalent syntax
|
||||||
|
|
||||||
1+ 2k i1k 1k 1k 50k 1: 2,i1,1,1,50, for(num=1,num<=50;num++)
|
1+ 2k i1k 1k 1k 50k 1: 2,i1,1,1,50, for(num=1,num<=50;num++)
|
||||||
2+ ci1 z 1j 2: ci1 <- 1. prime(num) = 1.0
|
2+ ci1 z 1j 2: ci1 <- 1. prime(num) = 1.0
|
|
@ -3,7 +3,7 @@
|
||||||
5 PLUS THE FOLLOWING
|
5 PLUS THE FOLLOWING
|
||||||
5 ROUTINES
|
5 ROUTINES
|
||||||
5 E00AK POWER FIX FIX
|
5 E00AK POWER FIX FIX
|
||||||
5 E00Am POWER FIX FIX REVERSE
|
5 E00AM POWER FIX FIX REVERSE
|
||||||
5 E00AL POWER FLOAT FIX
|
5 E00AL POWER FLOAT FIX
|
||||||
5 E00AN POWER FLOAT FIX REVERSE
|
5 E00AN POWER FLOAT FIX REVERSE
|
||||||
1 E00AI STD ARTHX AI1 ADD 1833 24 1786 1789
|
1 E00AI STD ARTHX AI1 ADD 1833 24 1786 1789
|
|
@ -3,7 +3,7 @@
|
||||||
5 PLUS THE FOLLOWING
|
5 PLUS THE FOLLOWING
|
||||||
5 ROUTINES
|
5 ROUTINES
|
||||||
5 E00AC EXPONENTIAL SUBROUTINE
|
5 E00AC EXPONENTIAL SUBROUTINE
|
||||||
5 E00A8 L0G SUBROUTINE
|
5 E00AB LOG SUBROUTINE
|
||||||
1 E00AI STD ARTHX AI1 ADD 1833 24 1786 1789
|
1 E00AI STD ARTHX AI1 ADD 1833 24 1786 1789
|
||||||
2 AI1 STL ARTHG 1789 20 1794 1799
|
2 AI1 STL ARTHG 1789 20 1794 1799
|
||||||
3 LDD ARTHB 1799 69 1802 1805
|
3 LDD ARTHB 1799 69 1802 1805
|
|
@ -1,12 +1,12 @@
|
||||||
5 SUBROUTINE 21 COSINE
|
5 SUBROUTINE 21 COSINE
|
||||||
E00AV STO ARTHX BEGIN CISINE
|
E00AV STD ARTHX BEGIN COSINE
|
||||||
SLT 0008 ARGUMENT
|
SLT 0008 ARGUMENT
|
||||||
STU ARTHF ALARM IF PWR
|
STU ARTHF ALARM IF PWR
|
||||||
RSM 8002 OVERSCALE
|
RSM 8002 OVERSCALE
|
||||||
ALO AV1 COSX EQUALS
|
ALO AV1 COSX EQUALS
|
||||||
BMI AV2 ONE IF PWR
|
BMI AV2 ONE IF PWR
|
||||||
SLO AV3 UNDERSCALE
|
SLO AV3 UNDERSCALE
|
||||||
BMI AV4
|
BMI AV4
|
||||||
SRT 0004
|
SRT 0004
|
||||||
ALO AV5
|
ALO AV5
|
||||||
STL AV6
|
STL AV6
|
||||||
|
@ -22,13 +22,13 @@
|
||||||
ALO AV9 PART
|
ALO AV9 PART
|
||||||
RAU 8002
|
RAU 8002
|
||||||
STU ARTHF
|
STU ARTHF
|
||||||
MPY 8001 FORM SINE
|
MPY 8001 FORM SINE
|
||||||
STU ARTHG
|
STU ARTHG
|
||||||
RAU AV16 POLYNOMIAL
|
RAU AV16 POLYNOMIAL
|
||||||
MPY ARTHG APPROXIMATOR
|
MPY ARTHG APPROXIMATOR
|
||||||
RAU 8003
|
RAU 8003
|
||||||
AUP AV15
|
AUP AV15
|
||||||
MPY AR7HG
|
MPY ARTHG
|
||||||
RAU 8003
|
RAU 8003
|
||||||
AUP AV14
|
AUP AV14
|
||||||
MPY ARTHG
|
MPY ARTHG
|
||||||
|
@ -37,27 +37,27 @@
|
||||||
MPY ARTHG
|
MPY ARTHG
|
||||||
SRT 0001
|
SRT 0001
|
||||||
RAU 8003
|
RAU 8003
|
||||||
AUP AV12 EQUALS ONE
|
AUP AV12 EQUALS ONE
|
||||||
MPY ARTHF
|
MPY ARTHF
|
||||||
SCT 0000
|
SCT 0000
|
||||||
BOV AV19
|
BOV AV19
|
||||||
STL AR7HF
|
STL ARTHF
|
||||||
RAL 8003 ROUND
|
RAL 8003 ROUND
|
||||||
SRT 0002 AND
|
SRT 0002 AND
|
||||||
STL ARTHG ADJUST
|
STL ARTHG ADJUST
|
||||||
RSU ARTHF POWER
|
RSU ARTHF POWER
|
||||||
SRT 0002
|
SRT 0002
|
||||||
BMI AV25
|
BMI AV25
|
||||||
SUP 8003
|
SUP 8003
|
||||||
ALO AV8 AV24
|
ALO AV8 AV24
|
||||||
AV24 AUP ARTHG
|
AV24 AUP ARTHG
|
||||||
SLT 0002 AV22
|
SLT 0002 AV22
|
||||||
AV22 STU ARTHF DETERMINE
|
AV22 STU ARTHF DETERMINE
|
||||||
RAU ARTHE SIGN OF
|
RAU ARTHE SIGN OF
|
||||||
NZU AV20 RESULT
|
NZU AV20 RESULT
|
||||||
AV20 RSL ARTHF ARTHX
|
RSL ARTHF ARTHX
|
||||||
AV25 RAL ARTHF ARTHX
|
AV20 RAL ARTHF ARTHX
|
||||||
SUP 8003
|
AV25 SUP 8003
|
||||||
SLO AV8 AV24
|
SLO AV8 AV24
|
||||||
AV2 RAL ARTHE OVERSCALE
|
AV2 RAL ARTHE OVERSCALE
|
||||||
LDD ARTHX 3211 DISPLAY
|
LDD ARTHX 3211 DISPLAY
|
1400
I650/sw/it/soapII.dck
Normal file
1400
I650/sw/it/soapII.dck
Normal file
File diff suppressed because it is too large
Load diff
|
@ -1,6 +1,7 @@
|
||||||
|
|
||||||
; These are the patches needed to make
|
; These are the patches needed to make
|
||||||
; SOAP II to run with IT
|
; SOAP II to run with IT
|
||||||
|
; (patches on original listing are for SOAP I)
|
||||||
|
|
||||||
; free address 1993, using 1945 instead
|
; free address 1993, using 1945 instead
|
||||||
dep 0954 65 1986 1945
|
dep 0954 65 1986 1945
|
|
@ -1,87 +0,0 @@
|
||||||
5 SUBROUTINE 22 SINE
|
|
||||||
E00AW STD ARTHX BEGIN SINE
|
|
||||||
STL ARTHE SUBROUTINE
|
|
||||||
SLT 0008 STORE
|
|
||||||
STU ARTHF ARGUMENT
|
|
||||||
RSM 8002 IS POWER
|
|
||||||
ALO AW1 OVERSCALE
|
|
||||||
BMI AW2 IF SO ALARM
|
|
||||||
SLO AW3 IS P0WER
|
|
||||||
BMI AW4 UNDERSCALE
|
|
||||||
SRT 0004 IF SO SINX
|
|
||||||
ALO AW5 EQUALS X
|
|
||||||
STL AW6
|
|
||||||
RAU ARTHF F0RM FRACTL
|
|
||||||
MPY AW7 AW6 PART
|
|
||||||
AW6 HLT AW6 AW23
|
|
||||||
AW23 STL ARTHG
|
|
||||||
RAU 8003 IS INTGRAL
|
|
||||||
MPY AW8 PAR7 0DD
|
|
||||||
RAL 8002
|
|
||||||
NZE AW9 IF SO FLIP
|
|
||||||
RSL ARTHE SGN OF X
|
|
||||||
STL ARTHE AW9
|
|
||||||
AW9 RSM ARTHG FORM S AS 2
|
|
||||||
SML 8001 MINUS 2 ALPH
|
|
||||||
NZU AW10 IF 2 ALPH
|
|
||||||
AUP AW11 GRTG 1 OR 2
|
|
||||||
NZU AW17 AW10 ALPH OTHER
|
|
||||||
AU10 RAM 8002 WISE
|
|
||||||
STL ARTHF FORM SINE
|
|
||||||
RAU 8002 POLYNOMIAL
|
|
||||||
MPY 8001
|
|
||||||
STU ARTHG APPROXIMATOR
|
|
||||||
RAU AW16
|
|
||||||
MPY ARTHG
|
|
||||||
RAU 8003
|
|
||||||
AUP AW15
|
|
||||||
MPY ARTHG
|
|
||||||
RAU 8003
|
|
||||||
AUP AW14
|
|
||||||
MPY ARTHG
|
|
||||||
RAU 8003
|
|
||||||
AUP AW13
|
|
||||||
MPY ARTHG
|
|
||||||
SRT 0001
|
|
||||||
RAU 8003
|
|
||||||
AUP AW12
|
|
||||||
MPY ARTHF
|
|
||||||
SCT 0000
|
|
||||||
BOV AW19
|
|
||||||
STL ARTHF SINE TO 0
|
|
||||||
RAL 8003
|
|
||||||
SRT 0002 ROUND
|
|
||||||
STL ARTHG
|
|
||||||
RSU ARTHF
|
|
||||||
SRT 0002 ADJUST POWER
|
|
||||||
BMI AW25
|
|
||||||
SUP 8003
|
|
||||||
ALO AW8 AW24
|
|
||||||
AW24 AUP ARTHG
|
|
||||||
SLT 0002 AW22
|
|
||||||
AW25 SUP 8003
|
|
||||||
SLO AW8 AW24
|
|
||||||
AW22 STU ARTHF DETERMINE
|
|
||||||
RAL ARTHE PROPER SIGN
|
|
||||||
BMI AW20 OF RESULT
|
|
||||||
RSL ARTHF ARTHX EXIT
|
|
||||||
AW20 RAL ARTHF ARTHX EXIT
|
|
||||||
AW4 RAL ARTHE ARTHX SINX IS X
|
|
||||||
AW17 RAU AW21 AW22 SINX IS ONE
|
|
||||||
AW19 RAL 8002 SINX IS ZERO
|
|
||||||
SLO 8001 ARTHX
|
|
||||||
AW1 57 0000 0000 CONSTANTS
|
|
||||||
AW3 09 0000 0000
|
|
||||||
AW5 SRT 0009 AW23
|
|
||||||
AW7 31 8309 8862
|
|
||||||
AW8 50 0000 0000
|
|
||||||
AW11 00 0000 0002
|
|
||||||
AW12 15 7079 6318
|
|
||||||
AW13 - 64 5963 7111
|
|
||||||
AW14 07 9689 6793
|
|
||||||
AW15 - 00 4673 7656
|
|
||||||
AW16 00 0151 4842
|
|
||||||
AW21 10 0000 0050
|
|
||||||
AW2 RAL ARTHE ALARM FOR
|
|
||||||
LDD ARTHX 3221 SINE
|
|
||||||
5 LAST CARD SUBROUTINE 22
|
|
247
I650/sw/run_fortransit.ini
Normal file
247
I650/sw/run_fortransit.ini
Normal file
|
@ -0,0 +1,247 @@
|
||||||
|
|
||||||
|
; set console -n log=log.txt
|
||||||
|
; set debug -n debug.txt
|
||||||
|
; set debug stdout
|
||||||
|
; set cpu debug=cmd;data;detail
|
||||||
|
|
||||||
|
|
||||||
|
; params: %1 source program card deck to compile
|
||||||
|
; %2 input program data card deck (if empty, do not attach input card)
|
||||||
|
; %3 output program data card deck (if empty, attach deck_out.dck file)
|
||||||
|
|
||||||
|
set cpu 2k
|
||||||
|
set cpu StorageUnit
|
||||||
|
|
||||||
|
att cdp0 -n -q print.txt
|
||||||
|
|
||||||
|
; print FORTRANSIT source program
|
||||||
|
|
||||||
|
echo
|
||||||
|
carddeck -q print %1
|
||||||
|
|
||||||
|
; load FORTRANSIT translator but do not execute it
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Load FORTRANSIT translator deck into drum
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
att cdr1 -q -l fortransit/fortransit_translator.dck
|
||||||
|
|
||||||
|
d csw 70 1951 9999
|
||||||
|
d ar 8000
|
||||||
|
go
|
||||||
|
|
||||||
|
; attach and load reconstructed add function title deck
|
||||||
|
|
||||||
|
att cdr1 -q -l fortransit/fortransit_addfn.dck
|
||||||
|
|
||||||
|
d csw 70 1951 9999
|
||||||
|
d ar 8000
|
||||||
|
go
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Run FORTRANSIT translator
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
; Now put source cards in reader and start translator (phase I)
|
||||||
|
|
||||||
|
att cdr1 -q %1
|
||||||
|
set cdr1 wiring=fortransit
|
||||||
|
|
||||||
|
att cdp1 -n -q deck_it.dck
|
||||||
|
set cdp1 echo, print, wiring=fortransit
|
||||||
|
|
||||||
|
d csw 00 0000 1999
|
||||||
|
d ar 8000
|
||||||
|
go
|
||||||
|
|
||||||
|
; check if programed stop because an error is detected
|
||||||
|
if not prop=01 goto translate_ok1
|
||||||
|
|
||||||
|
echo
|
||||||
|
echo *** (translation error code in Address Register AR)
|
||||||
|
echo
|
||||||
|
|
||||||
|
ex ar
|
||||||
|
|
||||||
|
echo
|
||||||
|
echo *** (show last three source fortransit cards processed)
|
||||||
|
echo
|
||||||
|
carddeck -q echolast 3 cdr1
|
||||||
|
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:translate_ok1
|
||||||
|
|
||||||
|
; check if programed stop because normal termination
|
||||||
|
if prop=70 if ar=1951 goto translate_ok2
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:translate_ok2
|
||||||
|
|
||||||
|
; separate last card (header card), and put it in the
|
||||||
|
; top of deck
|
||||||
|
|
||||||
|
carddeck -q split -1 cdp1 deck_it.dck deck_it_header.dck
|
||||||
|
carddeck -q join deck_it_header.dck deck_it.dck as deck_it.dck
|
||||||
|
det cdr1
|
||||||
|
|
||||||
|
; load IT compiler but do not execute it
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Load IT compiler deck into drum
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
att cdr1 -q -l fortransit/it_compiler.dck
|
||||||
|
|
||||||
|
d csw 70 1951 9999
|
||||||
|
d ar 8000
|
||||||
|
go
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Run IT compiler
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
; Now put IT source cards in reader and start compiler (phase II)
|
||||||
|
|
||||||
|
att cdr1 -q deck_it.dck
|
||||||
|
att cdp1 -n -q deck_out.dck
|
||||||
|
|
||||||
|
d csw 00 0000 1999
|
||||||
|
d ar 8000
|
||||||
|
go
|
||||||
|
|
||||||
|
; check if programed stop because an error is detected
|
||||||
|
if not prop=01 if not ar=1234 goto compile_ok1
|
||||||
|
|
||||||
|
echo
|
||||||
|
echo *** (compilation error code in Upper ACC)
|
||||||
|
echo
|
||||||
|
|
||||||
|
ex accup
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:compile_ok1
|
||||||
|
|
||||||
|
; check if programed stop because normal termination
|
||||||
|
if prop=70 if ar=1951 goto compile_ok2
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:compile_ok2
|
||||||
|
|
||||||
|
; separate first card (reservation card), from
|
||||||
|
; generated soap source code deck
|
||||||
|
|
||||||
|
carddeck -q split 1 cdp1 deck_res.dck deck_soap.dck
|
||||||
|
det cdr1
|
||||||
|
|
||||||
|
; Load soap deck into drum (1 word per card format), but does not execute it
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Load SOAP deck into drum
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
att cdr1 -q -l fortransit/soapII.dck
|
||||||
|
|
||||||
|
d csw 7019519999
|
||||||
|
d ar 8000
|
||||||
|
go
|
||||||
|
|
||||||
|
; create the phase III deck with
|
||||||
|
; - entry point cards for subroutines
|
||||||
|
; - reservation cards from phase II
|
||||||
|
; - package reservation cards
|
||||||
|
; - subroutines in symbolic SOAP format (if any)
|
||||||
|
; - rest of compilation output from phase II
|
||||||
|
|
||||||
|
carddeck -q join fortransit/pack_entry_src.txt deck_res.dck fortransit/pack_res2.txt deck_soap.dck as deck_soap.dck
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Run SOAP assembler
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
att cdr1 deck_soap.dck
|
||||||
|
set cdr1 wiring=soap
|
||||||
|
|
||||||
|
att cdp1 -n -q deck_out.dck
|
||||||
|
set cdp1 echo, print, wiring=soap
|
||||||
|
|
||||||
|
d ar 1000
|
||||||
|
go
|
||||||
|
|
||||||
|
; check if programed stop because an error is detected
|
||||||
|
if not prop=01 goto assemble_ok1
|
||||||
|
|
||||||
|
echo
|
||||||
|
echo *** (assembling error code in AR)
|
||||||
|
echo
|
||||||
|
|
||||||
|
ex ar
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:assemble_ok1
|
||||||
|
|
||||||
|
; check if programed stop because normal termination
|
||||||
|
if prop=70 if ar=1951 goto assemble_ok2
|
||||||
|
goto end
|
||||||
|
|
||||||
|
:assemble_ok2
|
||||||
|
|
||||||
|
det cdr1
|
||||||
|
det cdp1
|
||||||
|
|
||||||
|
; create object program deck with
|
||||||
|
; - package cards
|
||||||
|
; - assembled program cards from phase III
|
||||||
|
|
||||||
|
carddeck -q join fortransit/pack.dck deck_out.dck as deck_out.dck
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Read Object Program Deck
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
; Load assembled deck into drum
|
||||||
|
; -l switch allows to load the symbolic info so debug cmd info will show
|
||||||
|
; soap source code read from card.
|
||||||
|
|
||||||
|
set cdr1 wiring=8WORD
|
||||||
|
att cdr1 -l deck_out.dck
|
||||||
|
|
||||||
|
d csw 7019519999
|
||||||
|
d ar 8000
|
||||||
|
go
|
||||||
|
|
||||||
|
; attach input and output data deck
|
||||||
|
|
||||||
|
det cdr1
|
||||||
|
|
||||||
|
if "%2" == "" goto run1
|
||||||
|
att cdr1 -q %2
|
||||||
|
set cdr1 wiring=fortransit
|
||||||
|
:run1
|
||||||
|
|
||||||
|
if "%3" != "" att cdp1 -n -q %3
|
||||||
|
if "%3" == "" att cdp1 -n -q deck_out.dck
|
||||||
|
set cdp1 echo, print, wiring=fortransit
|
||||||
|
|
||||||
|
; Now execute the loaded program object deck
|
||||||
|
|
||||||
|
echo ***
|
||||||
|
echo *** Run Program
|
||||||
|
echo ***
|
||||||
|
|
||||||
|
; set csw negative to activate conditional punch statement
|
||||||
|
; normal program termination will halt cpu at AR=9999
|
||||||
|
|
||||||
|
d csw -01 0000 9999
|
||||||
|
d ar 1999
|
||||||
|
go
|
||||||
|
|
||||||
|
; clean up
|
||||||
|
|
||||||
|
del deck_it_header.dck
|
||||||
|
del deck_it.dck
|
||||||
|
del deck_res.dck
|
||||||
|
del deck_soap.dck
|
||||||
|
|
||||||
|
:end
|
|
@ -16,7 +16,7 @@ echo ***
|
||||||
echo *** Load is main deck into drum
|
echo *** Load is main deck into drum
|
||||||
echo ***
|
echo ***
|
||||||
|
|
||||||
att cdr1 -q is.dck
|
att cdr1 -q bell/is.dck
|
||||||
|
|
||||||
d csw 7019519999
|
d csw 7019519999
|
||||||
d ar 8000
|
d ar 8000
|
||||||
|
@ -27,7 +27,7 @@ go
|
||||||
carddeck -q join %1 as deck_in.dck
|
carddeck -q join %1 as deck_in.dck
|
||||||
if "%2" != "" carddeck -q join deck_in.dck %2 as deck_in.dck
|
if "%2" != "" carddeck -q join deck_in.dck %2 as deck_in.dck
|
||||||
|
|
||||||
att cdr1 deck_in.dck
|
att cdr1 -q deck_in.dck
|
||||||
set cdr1 wiring=is
|
set cdr1 wiring=is
|
||||||
|
|
||||||
att cdp1 -n -q deck_out_run.dck
|
att cdp1 -n -q deck_out_run.dck
|
|
@ -5,9 +5,9 @@
|
||||||
; set cpu debug=cmd;data;detail
|
; set cpu debug=cmd;data;detail
|
||||||
|
|
||||||
|
|
||||||
; params: %1 source progrma card deck to compile with it
|
; params: %1 source program card deck to compile with it
|
||||||
; %2 input program data card deck (if empty, do not attach input card)
|
; %2 input program data card deck (if empty, do not attach input card)
|
||||||
; %3 output program data card deck (if empty, do not attach input card)
|
; %3 output program data card deck (if empty, attach deck_out.dck file)
|
||||||
|
|
||||||
set cpu 2k
|
set cpu 2k
|
||||||
att cdp0 -n -q print.txt
|
att cdp0 -n -q print.txt
|
||||||
|
@ -23,7 +23,7 @@ echo ***
|
||||||
echo *** Load IT compiler deck into drum
|
echo *** Load IT compiler deck into drum
|
||||||
echo ***
|
echo ***
|
||||||
|
|
||||||
att cdr1 -q -l it_compiler.dck
|
att cdr1 -q -l it/it_compiler.dck
|
||||||
|
|
||||||
d csw 70 1951 3000
|
d csw 70 1951 3000
|
||||||
d ar 8000
|
d ar 8000
|
||||||
|
@ -69,7 +69,7 @@ det cdr1
|
||||||
; 2) package used reservation deck
|
; 2) package used reservation deck
|
||||||
; 3) rest of compilation output
|
; 3) rest of compilation output
|
||||||
|
|
||||||
carddeck -q join deck_res.dck it_reservation_p1.dck deck_soap.dck as deck_pit.dck
|
carddeck -q join deck_res.dck it/it_reservation_p1.dck deck_soap.dck as deck_pit.dck
|
||||||
|
|
||||||
; Load soap deck into drum (1 word per card format), but does not execute it
|
; Load soap deck into drum (1 word per card format), but does not execute it
|
||||||
|
|
||||||
|
@ -78,7 +78,7 @@ echo ***
|
||||||
echo *** Load soap deck into drum
|
echo *** Load soap deck into drum
|
||||||
echo ***
|
echo ***
|
||||||
|
|
||||||
att cdr1 -q -l soapII.dck
|
att cdr1 -q -l it/soapII.dck
|
||||||
|
|
||||||
d csw 7019519999
|
d csw 7019519999
|
||||||
d ar 8000
|
d ar 8000
|
||||||
|
@ -88,7 +88,7 @@ echo ***
|
||||||
echo *** Apply IT modifications to soap deck
|
echo *** Apply IT modifications to soap deck
|
||||||
echo ***
|
echo ***
|
||||||
|
|
||||||
att cdr1 -q -l it_soapII_patch.dck
|
att cdr1 -q -l it/soapII_patch.dck
|
||||||
|
|
||||||
d csw 7019519999
|
d csw 7019519999
|
||||||
d ar 8000
|
d ar 8000
|
||||||
|
@ -101,7 +101,7 @@ echo ***
|
||||||
echo *** Assemble PIT deck
|
echo *** Assemble PIT deck
|
||||||
echo ***
|
echo ***
|
||||||
|
|
||||||
att cdr1 deck_pit.dck
|
att cdr1 -q deck_pit.dck
|
||||||
set cdr1 wiring=soap
|
set cdr1 wiring=soap
|
||||||
|
|
||||||
att cdp1 -n -q deck_out.dck
|
att cdp1 -n -q deck_out.dck
|
||||||
|
@ -119,7 +119,7 @@ go
|
||||||
det cdr1
|
det cdr1
|
||||||
det cdp1
|
det cdp1
|
||||||
|
|
||||||
carddeck -q join it_package_p1.dck deck_out.dck as deck_spit.dck
|
carddeck -q join it/it_package_p1.dck deck_out.dck as deck_spit.dck
|
||||||
|
|
||||||
; Load deck into drum (1 word per card format), but does not execute it
|
; Load deck into drum (1 word per card format), but does not execute it
|
||||||
|
|
||||||
|
@ -132,7 +132,7 @@ echo ***
|
||||||
; soap source code read from card.
|
; soap source code read from card.
|
||||||
|
|
||||||
set cdr1 wiring=8WORD
|
set cdr1 wiring=8WORD
|
||||||
att cdr1 -l deck_spit.dck
|
att cdr1 -q -l deck_spit.dck
|
||||||
|
|
||||||
|
|
||||||
d csw 7019519999
|
d csw 7019519999
|
||||||
|
@ -148,10 +148,9 @@ att cdr1 -q %2
|
||||||
set cdr1 wiring=it
|
set cdr1 wiring=it
|
||||||
:run1
|
:run1
|
||||||
|
|
||||||
if "%3" == "" goto run2
|
if "%3" != "" att cdp1 -n -q %3
|
||||||
att cdp1 -n -q %3
|
if "%3" == "" att cdp1 -n -q deck_out.dck
|
||||||
set cdp1 echo, print, wiring=it
|
set cdp1 echo, print, wiring=it
|
||||||
:run2
|
|
||||||
|
|
||||||
; Now execute the loaded deck
|
; Now execute the loaded deck
|
||||||
|
|
|
@ -7,13 +7,13 @@
|
||||||
|
|
||||||
; params: %1 source card deck to assemble with soap
|
; params: %1 source card deck to assemble with soap
|
||||||
; %2 start address to run program (If empty, program not run)
|
; %2 start address to run program (If empty, program not run)
|
||||||
; %3 input card deck (if empty, do not attach input card
|
; %3 input card deck (if empty, do not attach input card)
|
||||||
|
|
||||||
set cpu 2k
|
set cpu 2k
|
||||||
|
|
||||||
; Load soap deck into drum (1 word per card format), but does not execute it
|
; Load soap deck into drum (1 word per card format), but does not execute it
|
||||||
|
|
||||||
att cdr1 -q -l soapII.dck
|
att cdr1 -q -l soap/soapII.dck
|
||||||
|
|
||||||
echo ***
|
echo ***
|
||||||
echo *** Load soap deck into drum
|
echo *** Load soap deck into drum
|
||||||
|
@ -25,7 +25,7 @@ go
|
||||||
|
|
||||||
; Now put source cards in reader and start soap assembler
|
; Now put source cards in reader and start soap assembler
|
||||||
|
|
||||||
att cdr1 %1
|
att cdr1 -q %1
|
||||||
set cdr1 wiring=soap
|
set cdr1 wiring=soap
|
||||||
|
|
||||||
att cdp1 -n -q deck_out.dck
|
att cdp1 -n -q deck_out.dck
|
||||||
|
@ -47,7 +47,7 @@ if "%2" == "" goto end
|
||||||
|
|
||||||
det cdp1
|
det cdp1
|
||||||
set cdr1 wiring=8WORD
|
set cdr1 wiring=8WORD
|
||||||
att cdr1 -l deck_out.dck
|
att cdr1 -q -l deck_out.dck
|
||||||
|
|
||||||
att cdp1 -n -q deck_out_run.dck
|
att cdp1 -n -q deck_out_run.dck
|
||||||
set cdp1 echo, print, wiring=8WORD
|
set cdp1 echo, print, wiring=8WORD
|
||||||
|
@ -64,7 +64,7 @@ go
|
||||||
; attach input deck
|
; attach input deck
|
||||||
if "%3" == "" goto run
|
if "%3" == "" goto run
|
||||||
|
|
||||||
att cdr1 %3
|
att cdr1 -q %3
|
||||||
|
|
||||||
; Now execute the loaded deck
|
; Now execute the loaded deck
|
||||||
:run
|
:run
|
11
I650/sw/soap/00_readme.txt
Normal file
11
I650/sw/soap/00_readme.txt
Normal file
|
@ -0,0 +1,11 @@
|
||||||
|
|
||||||
|
Restoration comments May/2018
|
||||||
|
|
||||||
|
SOAP II
|
||||||
|
From Bitsavers Manual 24-4000-0_SOAPII.pdf
|
||||||
|
|
||||||
|
It can assemble itself, but the generated code is not the same
|
||||||
|
as the one in the source code listing
|
||||||
|
|
||||||
|
This is the result of a probable manual tuning/patch of
|
||||||
|
assembled code.
|
1400
I650/sw/soap/soapII.dck
Normal file
1400
I650/sw/soap/soapII.dck
Normal file
File diff suppressed because it is too large
Load diff
BIN
doc/i650_doc.doc
BIN
doc/i650_doc.doc
Binary file not shown.
Loading…
Add table
Reference in a new issue