folkert/simh-testsetgenerator
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

I650: Release 3

Browse source 
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:
Roberto Sancho Villa 2018-05-18 21:58:24 +02:00
parent b51d250598
commit 13cb294274
79 changed files with 16830 additions and 803 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
I650/650_test.ini
View file

@ -10,20 +10,39 @@ cd sw
; set throttle 11k
; set throttle 55/5
do build_soap_from_source.ini
set env -P "Press Enter to continue . . . "
do Build_soap_from_source.ini
set env -P "Press enter to continue . . . "
do run_soap.ini soap/soap_example_1_src.txt 1000
set env -P "Press Enter to continue . . . "
do soap_and_run.ini soap_example_1_src.txt 1000
set env -P "Press enter to continue . . . "
do build_is_from_decks.ini ntr lbox
set env -P "Press Enter to continue . . . "
do Build_is_from_decks.ini ntr lbox
set env -P "Press enter to continue . . . "
do run_is.ini bell/is_example_1_src.txt
set env -P "Press Enter to continue . . . "
do is_run.ini is_example_1_src.txt
set env -P "Press enter to continue . . . "
do run_it.ini it/it_example_1_src.txt it/it_example_1_data.txt
set env -P "Press Enter to continue . . . "
do it_run.ini it_example_1_src.txt it_example_1_data.txt deck_out.dck
set env -P "Press enter to continue . . . "
do run_it.ini it/it_example_2_src.txt nul
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
View file

@ -137,6 +137,8 @@ void encode_lpt_num(t_int64 d, int l)
#define wf_sN_NNNNNNN_NN 3
#define wf_sN_NNN_NNN_NNN 4
#define wf_nnnnnnnnnNs 5
#define wf_nnnnnnnnnH 6
#define wf_NNNNNNNNNN 7
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) {
encode_lpt_num(d,-10); // replace leading zeroes by spaces
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
encode_lpt_num(d,10);
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
// get the decoded data from drum at addr
// get the decoded data from IOSync
int i, NegZero;
t_int64 d;
char pch_word[20];
// punch card
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);
encode_pch_str(pch_word);
}
@ -227,13 +240,14 @@ void encode_8word_wiring(int addr)
// print out card contents
// 8 words in format NN NNNN NNNN+
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_spc(1);
}
}
void encode_soap_wiring(int addr)
void encode_soap_wiring(void)
{
// 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
@ -279,19 +293,19 @@ void encode_soap_wiring(int addr)
int i, sv_card_nbuf, n;
int pat1, pat2;
word_to_ascii(loc, 1, 5, DRUM[addr + 0]);
word_to_ascii(data_addr, 1, 5, DRUM[addr + 1]);
word_to_ascii(inst_addr, 1, 5, DRUM[addr + 2]);
word_to_ascii(OpCode, 1, 3, DRUM[addr + 3]);
word_to_ascii(Data_Tag, 4, 1, DRUM[addr + 3]);
word_to_ascii(Instr_Tag, 5, 1, DRUM[addr + 3]);
word_to_ascii(rem1, 1, 5, DRUM[addr + 4]);
word_to_ascii(rem2, 1, 5, DRUM[addr + 5]);
instr = DRUM[addr + 6];
location = (int) ((DRUM[addr + 7] / D4) % D4);
ty = (int) ( DRUM[addr + 7] % 10);
CardNum = (int) ( DRUM[addr + 8] % D4);
d = DRUM[addr + 9];
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(Data_Tag, 4, 1, IOSync[3]);
word_to_ascii(Instr_Tag, 5, 1, IOSync[3]);
word_to_ascii(rem1, 1, 5, IOSync[4]);
word_to_ascii(rem2, 1, 5, IOSync[5]);
instr = IOSync[6];
location = (int) ((IOSync[7] / D4) % D4);
ty = (int) ( IOSync[7] % 10);
CardNum = (int) ( IOSync[8] % D4);
d = IOSync[9];
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_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;
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
if (b_pch_b) {
// punch availability table (pat pseudo-op output)
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);
}
} else {
@ -353,10 +367,10 @@ void encode_soap_wiring(int addr)
if (b_pch_b) {
// print availability table (pat pseudo-op output)
for(i=0; i<4; i++) {
d = DRUM[addr + i*2];
d = IOSync[i*2];
pat1 = (int) ((d / D4) % D4);
pat2 = (int) ( d % D4);
d = DRUM[addr + i*2 + 1];
d = IOSync[i*2 + 1];
encode_lpt_num(pat1, 4);
encode_lpt_spc(2);
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
// 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];
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);
CardNum = (int) ((DRUM[addr+9] / D4) % D4);
wc = (int) ((DRUM[addr+1] / D4) % D4);
PrNum = (int) ( DRUM[addr+8]);
bTraceCard = (DRUM[addr] / D8) > 0 ? 1 : 0; // if to higher digits are nonzero -> is a trace card
loc = (int) ((IOSync[0] / D4) % D4);
CardNum = (int) ((IOSync[9] / D4) % D4);
wc = (int) ((IOSync[1] / D4) % D4);
PrNum = (int) ( IOSync[8]);
bTraceCard = (IOSync[0] / D8) > 0 ? 1 : 0; // if to higher digits are nonzero -> is a trace card
if (bSetHiPunch) {
// punch a load card
for(i=0;i<8;i++) {
ReadDrum(addr + i, &d, &NegZero);
if ((i==0) && (d < 0)) d = -d; // get absolute value for DRUM[addr + 0]
d = IOSync[i];
NegZero = IOSync_NegativeZeroFlag[i];
if ((i==0) && (d < 0)) d = -d; // get absolute value for IOSync[0]
sprintf_word(pch_word, d, NegZero, bSetHiPunch);
if (bSetHiPunch==2) bSetHiPunch = 1; // if bSetHiPunch is 2 change it to bSetHiPunch = 1
encode_pch_str(pch_word);
@ -481,7 +496,8 @@ void encode_is_wiring(int addr)
encode_pch_str(pch_word);
for(i=0;i<6;i++) {
if (i<wc) {
ReadDrum(addr + i + 2, &d, &NegZero);
d = IOSync[i+2];
NegZero = IOSync_NegativeZeroFlag[i+2];
if ((d < 0) || ((d==0) && (NegZero))) {
encode_pch_str("-");
d = -d;
@ -517,7 +533,8 @@ void encode_is_wiring(int addr)
}
for(i=2;i<2+wc;i++) {
encode_lpt_spc(2);
ReadDrum(addr + i, &d, &NegZero);
d = IOSync[i];
NegZero = IOSync_NegativeZeroFlag[i];
if ((bTraceCard) && (i<5)) {
// 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);
@ -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
// 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 i;
word_to_ascii(loc, 1, 5, DRUM[addr + 0]);
word_to_ascii(OpCode, 1, 3, DRUM[addr + 1]);
word_to_ascii(data_addr, 1, 5, DRUM[addr + 2]);
word_to_ascii(inst_addr, 1, 5, DRUM[addr + 3]);
word_to_ascii(rem1, 1, 5, DRUM[addr + 4]);
word_to_ascii(rem2, 1, 5, DRUM[addr + 5]);
CardNum = (int) ((DRUM[addr + 8] / D4) % D4);
d = DRUM[addr + 9];
word_to_ascii(loc, 1, 5, IOSync[0]);
word_to_ascii(OpCode, 1, 3, IOSync[1]);
word_to_ascii(data_addr, 1, 5, IOSync[2]);
word_to_ascii(inst_addr, 1, 5, IOSync[3]);
word_to_ascii(rem1, 1, 5, IOSync[4]);
word_to_ascii(rem2, 1, 5, IOSync[5]);
CardNum = (int) ((IOSync[8] / D4) % D4);
d = IOSync[9];
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;
@ -618,17 +635,17 @@ void encode_it_wiring(int addr)
b_reg = ((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
if (b_data) {
// punch type 1 data out card
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);
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);
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 {
// punch SOAP source instruction
@ -663,11 +680,11 @@ void encode_it_wiring(int addr)
if (b_data) {
// print type 1 data out card. replace leading zeroes by spaces on each word
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_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);
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 {
// 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 */
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) {
// encode soap card simulating soap control panel wiring for 533 (gasp!)
encode_soap_wiring(addr);
encode_soap_wiring();
} else if (wiring == WIRING_IS) {
// encode floating point interpretive system (bell interpreter) card
encode_is_wiring(addr);
encode_is_wiring();
} else if (wiring == WIRING_IT) {
// 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) {
// encode 8 words per card
encode_8word_wiring(addr);
encode_8word_wiring();
} else {
// 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)) {

308
I650/i650_cdr.c
View file

@ -74,16 +74,20 @@ DEVICE cdr_dev = {
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
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
// input card
// NNNNNNNNNN ... 8 times
// 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
// 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
uint16 c1,c2;
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
c2 = data->hol_to_ascii[c1]; // convert to ascii again
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;
}
// 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
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;
}
// load soap symbolic info, This is a facility to help debugging of soap programs into SimH
// 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;
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;
// 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
// 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
da = Shift_Digits(&d, 4); // addr of data
ia = Shift_Digits(&d, 4); // addr of next instr
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
// 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
// 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
DRUM[addr + 0] = decode_alpha_word(&buf[42], 5); // Location (5 chars)
DRUM[addr + 1] = decode_alpha_word(&buf[50], 5); // Data Addr (5 chars)
DRUM[addr + 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)
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)
DRUM[addr + 4] = decode_alpha_word(&buf[62], 5); // Remarks
DRUM[addr + 5] = decode_alpha_word(&buf[67], 5); // Remarks
IOSync[0] = decode_alpha_word(&buf[42], 5); // Location (5 chars)
IOSync[1] = decode_alpha_word(&buf[50], 5); // Data Addr (5 chars)
IOSync[2] = decode_alpha_word(&buf[56], 5); // Inst Addr (5 chars)
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[61], 1); // Instr Addr Tag (1 char only)
IOSync[4] = decode_alpha_word(&buf[62], 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
DRUM[addr + 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[6] = decode_num_word(&buf[43], 4, 0); // Absolute Part of location
IOSync[7] = decode_num_word(&buf[51], 4, 0); // Absolute Part of Data Addr
IOSync[8] = decode_num_word(&buf[57], 4, 0); // Absolute Part of Instr Addr
ty = buf[40] - '0';
if ((ty < 0) || (ty > 9)) ty = 0;
neg = (buf[41] == '-') ? 8:0;
DRUM[addr + 9] = ty * 100 +
(ty ? 80:0) +
neg; // |T b n| T=Type (0 if Blank), b=0/8 (for non blank type), n=0/8 (for negative)
IOSync[9] = ty * 100 +
(ty ? 80:0) +
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)
@ -293,7 +300,7 @@ int sformat(char * buf, const char * match)
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
// 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 |
// +-------------------+
//
// put the decoded data in drum at addr (if addr < 0 -> do not store in drum)
// card number is ignored on reading
int wc,neg,i;
@ -360,15 +366,15 @@ void decode_is_wiring(struct _card_data * data, int addr)
if ( sformat(&buf[6], " ")) {
// 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
DRUM[addr + 1] = 1 * D4; // word count
IOSync[1] = 1 * D4; // word count
} else if ( sformat(&buf[5], " NNN ")) {
// alternate format for loading IT program (IT transfer card)
DRUM[addr + 0] = decode_num_word(&buf[6], 3, 0) * D4; // start location (3 digits)
DRUM[addr + 1] = 0; // word count = 0
IOSync[0] = decode_num_word(&buf[6], 3, 0) * D4; // start location (3 digits)
IOSync[1] = 0; // word count = 0
} else if ( sformat(&buf[5], " NNN +N NNN NNN NNN ")) {
// alternate format for loading IT program (IT instruction)
DRUM[addr + 0] = decode_num_word(&buf[6], 3, 0) * D4; // location (3 digits)
DRUM[addr + 1] = 1 * D4; // word count
IOSync[0] = decode_num_word(&buf[6], 3, 0) * D4; // location (3 digits)
IOSync[1] = 1 * D4; // word count
NegZero = 0;
neg = (buf[10] == '-') ? 1:0;
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;
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 ")) {
// 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)
DRUM[addr + 1] = 1 * D4; // word count
IOSync[0] = decode_num_word(&buf[6], 3, 0) * D4; // location (3 digits)
IOSync[1] = 1 * D4; // word count
NegZero = 0;
neg = (buf[10] == '-') ? 1:0;
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;
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 ")) ||
(sformat(&buf[6], " NNNN NN NNNN ")) ||
(sformat(&buf[6], " NNNN NN NNNN ")) ||
(sformat(&buf[6], " NNNN NN "))
) {
// alternate format for loading main IT system deck
DRUM[addr + 0] = decode_num_word(&buf[7], 4, 0) * D4; // location (4 digits)
DRUM[addr + 1] = 1 * D4; // word count = 1
DRUM[addr + 2] = decode_num_word(&buf[12], 2, 1) * D8 + // op
decode_num_word(&buf[15], 4, 1) * D4 + // data address
decode_num_word(&buf[20], 4, 1); // instr addr, no negative zero allowed
IOSync[0] = decode_num_word(&buf[7], 4, 0) * D4; // location (4 digits)
IOSync[1] = 1 * D4; // word count = 1
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[20], 4, 1); // instr addr, no negative zero allowed
} else {
// 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);
if (wc > 6) wc = 6;
DRUM[addr + 1] = wc * D4; // word count
IOSync[1] = wc * D4; // word count
for (i=0;i<wc;i++) {
NegZero = 0;
neg = (buf[10 + 11*i] == '-') ? 1:0;
@ -419,13 +427,14 @@ void decode_is_wiring(struct _card_data * data, int addr)
d=-d;
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
// 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] == '+') {
// type 1 data card
// re-read as 8 word per card
decode_8word_wiring(data, addr);
decode_8word_wiring(data, 0);
return;
}
DRUM[addr + 0] = decode_alpha_word(&buf[42], 5); // Statement (5 chars)
DRUM[addr + 1] = decode_alpha_word(&buf[47], 5); // Statement (5 chars)
DRUM[addr + 2] = decode_alpha_word(&buf[52], 5); // Statement (5 chars)
DRUM[addr + 3] = decode_alpha_word(&buf[57], 5); // Statement (5 chars)
DRUM[addr + 4] = decode_alpha_word(&buf[62], 5); // Statement (5 chars)
DRUM[addr + 5] = decode_alpha_word(&buf[67], 3); // Statement (3 chars)
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], 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.
*/
@ -510,13 +640,17 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
uint32 wiring;
int i;
char cbuf[81];
int ncdr, ic;
/* Are we currently tranfering? */
if (uptr->u5 & URCSTA_BUSY)
return SCPE_BUSY;
// clear read buffer in drum (where words read from cards will be stored)
for (i=0;i<10;i++) WriteDrum(addr + i, 0, 0);
// clear IO Sync buffer (where words read from cards will be stored)
for (i=0;i<10;i++) {
IOSync [i]=0;
IOSync_NegativeZeroFlag[i]=0;
}
/* Test ready */
if ((uptr->flags & UNIT_ATT) == 0) {
@ -553,29 +687,40 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
cbuf[80] = 0; // terminate string
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
// using this codification:
//
// Row Name value in image[] comments
//
// Y 0x800 Hi Punch Y(12)
// X 0x400 Minus Punch X(11)
// 0 0x200 also called T (Ten, 10)
// 1 0x100
// 2 0x080
// 3 0x040
// 4 0x020
// 5 0x010
// 6 0x008
// 7 0x004
// 8 0x002
// 9 0x001
// Y 0x800 Hi Punch Y(12)
// X 0x400 Minus Punch X(11)
// 0 0x200 also called T (Ten, 10)
// 1 0x100
// 2 0x080
// 3 0x040
// 4 0x020
// 5 0x010
// 6 0x008
// 7 0x004
// 8 0x002
// 9 0x001
//
// 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
// 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;
} else {
uptr->u5 &= ~URCSTA_LOAD;
@ -583,27 +728,30 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
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.
if (uptr->u5 & URCSTA_LOAD) {
// load card -> use 8 words per card encoding
decode_8word_wiring(data, addr);
decode_8word_wiring(data, 0);
if (uptr->u5 & URCSTA_SOAPSYMB) {
// requested to load soap symb info
decode_soap_symb_info(data, addr);
decode_soap_symb_info(data);
}
} else if (wiring == WIRING_SOAP) {
// 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) {
// decode floating point interpretive system (bell interpreter) card
decode_is_wiring(data, addr);
decode_is_wiring(data);
} else if (wiring == WIRING_IT) {
// 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 {
// 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;
@ -656,6 +804,7 @@ t_stat
cdr_attach(UNIT * uptr, CONST char *file)
{
t_stat r;
int ncdr, ic1, ic2, i;
if (uptr->flags & UNIT_ATT) // remove current deck in read hopper before attaching
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? */
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;
}

1163
I650/i650_cpu.c
View file

File diff suppressed because it is too large Load diff

247
I650/i650_defs.h
View file

@ -36,17 +36,28 @@
/* Memory */
#define MAXMEMSIZE (4000)
#define MEMSIZE cpu_unit.capac /* actual memory size */
#define MEMMASK (MEMSIZE - 1) /* Memory bits */
#define MAXDRUMSIZE (4000)
#define DRUMSIZE ((int)(cpu_unit.capac % 10) * 1000) /* actual drum memory size */
#define MEM_ADDR_OK(x) (((uint32) (x)) < MEMSIZE)
extern t_int64 DRUM[MAXMEMSIZE];
extern int DRUM_NegativeZeroFlag[MAXMEMSIZE];
extern char DRUM_Symbolic_Buffer[MAXMEMSIZE * 80];
extern t_int64 DRUM[MAXDRUMSIZE];
extern int DRUM_NegativeZeroFlag[MAXDRUMSIZE];
extern char DRUM_Symbolic_Buffer[MAXDRUMSIZE * 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 */
#define D10 (10000000000LL) // ten digits (10 zeroes)
@ -86,10 +97,16 @@ extern DEBTAB crd_debug[];
extern DEVICE cp_dev;
#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 DEVICE cdr_dev;
extern uint32 cdr_cmd(UNIT *, uint16, uint16);
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 DEVICE cdp_dev;
@ -103,58 +120,6 @@ extern UNIT cdp_unit[4];
#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 {
uint32 mode;
const char *name;
@ -178,6 +143,7 @@ extern int cycle_time;
extern const char *cpu_description(DEVICE *dptr);
/* Opcodes */
// Instructions on Basic machine
#define OP_AABL 17 // Add absolute to lower accumulator
#define OP_AL 15 // Add to lower 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_BRD9 99
#define OP_BRD10 90
#define OP_DIV 14 // Divide
#define OP_DIVRU 64 // Divide and reset upper accumulator
#define OP_LD 69 // Load distributor
#define OP_MULT 19 // Multiply
#define OP_NOOP 00 // No operation
#define OP_PCH 71 // Punch a card
#define OP_RD 70 // Read a card
#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_RAU 60 // Reset accumulator and add to upper 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_RSU 61 // Reset accumulator and subtract from upper accumulator
#define OP_SLT 35 // Shift accumulator left
#define OP_SCT 36 // Shift accumulator left and count
#define OP_SRT 30 // Shift accumulator right
#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_STD 24 // 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_STL 20 // Store lower accumulator into memory
#define OP_STU 21 // Store upper accumulator into memory
#define OP_SABL 18 // Subtract absolute from lower accumulator
#define OP_SL 16 // Subtract from lower accumulator
#define OP_SU 11 // Subtract from upper accumulator
#define OP_TLU 84 // Table lookup
#define OP_DIV 14 // Divide
#define OP_DIVRU 64 // Divide and reset upper accumulator
#define OP_LD 69 // Load distributor
#define OP_MULT 19 // Multiply
#define OP_NOOP 00 // No operation
#define OP_PCH 71 // Punch a card
#define OP_RD 70 // Read a card
#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_RAU 60 // Reset accumulator and add to upper 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_RSU 61 // Reset accumulator and subtract from upper accumulator
#define OP_SLT 35 // Shift accumulator left
#define OP_SCT 36 // Shift accumulator left and count
#define OP_SRT 30 // Shift accumulator right
#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_STD 24 // 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_STL 20 // Store lower accumulator into memory
#define OP_STU 21 // Store upper accumulator into memory
#define OP_SABL 18 // Subtract absolute from lower accumulator
#define OP_SL 16 // Subtract from lower accumulator
#define OP_SU 11 // Subtract from upper accumulator
#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 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_IS ( 0x200 << 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_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);

412
I650/i650_sys.c
View file

@ -98,10 +98,11 @@ DEBTAB crd_debug[] = {
// simulator available IBM 533 wirings
struct card_wirings wirings[] = {
{WIRING_8WORD, "8WORD"},
{WIRING_SOAP, "SOAP"},
{WIRING_IS, "IS"},
{WIRING_IT, "IT"},
{WIRING_8WORD, "8WORD"},
{WIRING_SOAP, "SOAP"},
{WIRING_IS, "IS"},
{WIRING_IT, "IT"},
{WIRING_FORTRANSIT, "FORTRANSIT"},
{0, 0},
};
@ -177,7 +178,9 @@ void
vm_init(void) {
int i;
// 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
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 */
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 */
t_opcode base_ops[] = {
{OP_AABL, "AABL", 1},
{OP_AL, "AL", 1},
{OP_AU, "AU", 1},
{OP_BRNZ, "BRNZ", 0},
{OP_BRMIN, "BRMIN", 0},
{OP_BRNZU, "BRNZU", 0},
{OP_BROV, "BROV", 0},
{OP_BRD1, "BRD1", 0},
{OP_BRD2, "BRD2", 0},
{OP_BRD3, "BRD3", 0},
{OP_BRD4, "BRD4", 0},
{OP_BRD5, "BRD5", 0},
{OP_BRD6, "BRD6", 0},
{OP_BRD7, "BRD7", 0},
{OP_BRD8, "BRD8", 0},
{OP_BRD9, "BRD9", 0},
{OP_BRD10, "BRD10", 0},
{OP_DIV, "DIV", 1},
{OP_DIVRU, "DIVRU", 1},
{OP_LD, "LD", 1},
{OP_MULT, "MULT", 1},
{OP_NOOP, "NOOP", 0},
{OP_PCH, "PCH", 0},
{OP_RD, "RD", 0},
{OP_RAABL, "RAABL", 1},
{OP_RAL, "RAL", 1},
{OP_RAU, "RAU", 1},
{OP_RSABL, "RSABL", 1},
{OP_RSL, "RSL", 1},
{OP_RSU, "RSU", 1},
{OP_SLT, "SLT", 0},
{OP_SCT, "SCT", 0},
{OP_SRT, "SRT", 0},
{OP_SRD, "SRD", 0},
{OP_STOP, "STOP", 0},
{OP_STD, "STD", 0},
{OP_STDA, "STDA", 0},
{OP_STIA, "STIA", 0},
{OP_STL, "STL", 0},
{OP_STU, "STU", 0},
{OP_SABL, "SABL", 1},
{OP_SL, "SL", 1},
{OP_SU, "SU", 1},
{OP_TLU, "TLU", 0},
{0, NULL, 0}
t_opcode base_ops[100] = {
// opcode name soap name R/W? option Valid Data Address
{OP_NOOP, "NOOP", "NOP", 0, 0, vda_DAITS},
{OP_STOP, "STOP", "HLT", 0, 0, vda_DAITS},
{OP_UFA, "FASN", "UFA", opReadDA, opStorUnit, vda_DAIS},
{OP_RTC, "RCT", "RTC", 0, opCntrlUnit, vda_T},
{OP_RTN, "RT", "RTN", 0, opCntrlUnit, vda_T},
{OP_RTA, "RTA", "RTA", 0, opCntrlUnit, vda_T},
{OP_WTN, "WT", "WTN", 0, opCntrlUnit, vda_T},
{OP_WTA, "WTA", "WTA", 0, opCntrlUnit, vda_T},
{OP_LIB, "LBB", "LIB", opReadDA, opStorUnit, vda_D, IL_IAS},
{OP_LDI, "LB", "LDI", opReadDA, opStorUnit, vda_D, IL_IAS},
{OP_AU, "AU", "AUP", opReadDA, 0, vda_DAIS},
{OP_SU, "SU", "SUP", opReadDA, 0, vda_DAIS},
{12, NULL, NULL, 0, 0, 0},
{13, NULL, NULL, 0, 0, 0},
{OP_DIV, "DIV", "DIV", opReadDA, 0, vda_DAIS},
{OP_AL, "AL", "ALO", opReadDA, 0, vda_DAIS},
{OP_SL, "SL", "SLO", opReadDA, 0, vda_DAIS},
{OP_AABL, "AABL", "AML", opReadDA, 0, vda_DAIS},
{OP_SABL, "SABL", "SML", opReadDA, 0, vda_DAIS},
{OP_MULT, "MULT", "MPY", opReadDA, 0, vda_DAIS},
{OP_STL, "STL", "STL", opWriteDA, 0, vda_DS},
{OP_STU, "STU", "STU", opWriteDA, 0, vda_DS},
{OP_STDA, "STDA", "SDA", opWriteDA, 0, vda_DS},
{OP_STIA, "STIA", "SIA", opWriteDA, 0, vda_DS},
{OP_STD, "STD", "STD", opWriteDA, 0, vda_DS},
{OP_NTS, "BNTS", "NTS", 0, opCntrlUnit, vda_DAIS},
{OP_BIN, "BIN", "BIN", 0, opCntrlUnit, vda_D},
{OP_SET, "SET", "SET", 0, opStorUnit, vda_S, IL_IAS},
{OP_SIB, "STBB", "SIB", 0, opStorUnit, vda_D, IL_IAS},
{OP_STI, "STB", "STI", 0, opStorUnit, vda_D, IL_IAS},
{OP_SRT, "SRT", "SRT", 0, 0, vda_DAITS},
{OP_SRD, "SRD", "SRD", 0, 0, vda_DAITS},
{OP_FAD, "FA", "FAD", opReadDA, opStorUnit, vda_DAIS},
{OP_FSB, "FS", "FSB", opReadDA, opStorUnit, vda_DAIS},
{OP_FDV, "FD", "FDV", opReadDA, opStorUnit, vda_DAIS},
{OP_SLT, "SLT", "SLT", 0, 0, vda_DAITS},
{OP_SCT, "SCT", "SCT", 0, 0, vda_DAITS},
{OP_FAM, "FAAB", "FAM", opReadDA, opStorUnit, vda_DAIS},
{OP_FSM, "FSAB", "FSM", opReadDA, opStorUnit, vda_DAIS},
{OP_FMP, "FM", "FMP", opReadDA, opStorUnit, vda_DAIS},
{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 */
void
print_opcode(FILE * of, t_int64 val, t_opcode * tab)
print_opcode(FILE * of, t_int64 val)
{
int sgn;
@ -262,25 +322,21 @@ print_opcode(FILE * of, t_int64 val, t_opcode * tab)
int DA;
int op;
int n;
CONST char * opname;
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) {
if (tab->opbase == op) {
fputs(tab->name, of);
n = strlen(tab->name);
while (n++<6) fputc(' ', of);
fprintf(of, "%04d ", DA);
fputc(' ', of);
fprintf(of, "%04d ", IA);
return;
}
tab++;
opname = DecodeOpcode(val, &op, &DA, &IA);
if (opname == NULL) {
fprintf(of, " %d Unknown opcode", op);
return;
}
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
@ -298,7 +354,7 @@ print_opcode(FILE * of, t_int64 val, t_opcode * tab)
t_stat
fprint_sym(FILE * of, t_addr addr, t_value * val, UNIT * uptr, int32 sw)
{
t_int64 inst;
t_int64 d, inst;
int NegZero;
int ch;
@ -318,9 +374,10 @@ fprint_sym(FILE * of, t_addr addr, t_value * val, UNIT * uptr, int32 sw)
if (sw & SWMASK('C') ) {
int i;
d = inst;
fputs(" '", of);
for (i=0;i<5;i++) {
ch = Shift_Digits(&inst, 2);
ch = Shift_Digits(&d, 2);
fputc(mem_to_ascii[ch], 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')) {
fputs(" ", of);
inst = AbsWord(inst);
print_opcode(of, inst, base_ops);
print_opcode(of, inst);
}
return SCPE_OK;
}
t_opcode *
find_opcode(char *op, t_opcode * tab)
int
find_opcode(char *op)
{
while (tab->name != NULL) {
if (*tab->name != '\0' && strcmp(op, tab->name) == 0)
return tab;
tab++;
int i;
if (op == NULL) return -1;
for (i=0;i<100;i++) {
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[+|-]
@ -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_int64 d;
int da, ia;
int op, da, ia;
char ch, opcode[100];
t_opcode *op;
int i;
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);
op = find_opcode(opcode, base_ops);
if (op == 0) return STOP_UUO;
op = find_opcode(opcode);
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++;
/* 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);
ia = (int) d;
// 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')) {
d = 0;
if ((*cptr == 34) || (*cptr == 39)) cptr++; // skip double or single quotes if present
for(i=0; i<5;i++) {
d = d * 100;
ch = *cptr;
if (ch == '\0') continue;
if ((*cptr == 34) || (*cptr == 39)) continue; // double or single quotes mark end of text
cptr++;
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;
}
// 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 */
// 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
<count> number of cards in each splitted deck.
If count >= 0, indicates the cards on first destination deck file
remaining cards go to the second destination deck
If count < 0, indicates the cards on second destination deck file
(so deck 2 contains lasts count cards from source)
If count > 0, indicates the cards on first destination deck file
remaining cards go to the second destination deck
If count < 0, indicates the cards on second destination deck file
(so deck 2 contains lasts count cards from source)
<file1> first destination deck file
<file2> second destination deck file
@ -602,14 +653,20 @@ int Shift_Digits(t_int64 * d, int nDigits)
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
-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
// DeckImage array, up to a max of nMaxCards
// 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;
}
// 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>
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
nCards1 = (int32) get_uint (gbuf, 10, 10000, &r);
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)) ||
(gbuf[3] < '1') || (gbuf[3] > '3') ) {
// is a file
strcpy(fn0, gbuf);
} else {
// is cpd1 cpd2 or cpd3 device
// is cdp1 cdp2 or cdp3 device
dptr = find_unit (gbuf, &uptr); /* locate unit */
if (dptr == NULL) /* found dev? */
return SCPE_NXDEV;
@ -742,6 +833,7 @@ static t_stat deck_split_cmd(CONST char *cptr)
return SCPE_NXUN;
if ((uptr->flags & UNIT_ATT) == 0) /* attached? */
return SCPE_NOTATT;
// get the file name
strcpy(fn0, uptr->filename);
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)
{
char fn[4*CBUFSIZE];
char line[81];
t_stat r;
uint16 DeckImage[80 * MAX_CARDS_IN_DECK];
int i,c,nc,nCards;
int nCards;
while (sim_isspace (*cptr)) cptr++; // trim leading spc
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);
if (r != SCPE_OK) return sim_messagef (r, "Cannot read deck to print (%s)\n", fn);
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)
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);
}
}
deck_print_echo(DeckImage, nCards, 1,1);
if ((sim_switches & SWMASK ('Q')) == 0) {
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;
}
// 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)
{
char gbuf[4*CBUFSIZE];
@ -907,6 +1032,9 @@ static t_stat ibm650_deck_cmd(int32 arg, CONST char *buf)
if (strcmp(gbuf, "PRINT") == 0) {
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");
}

18
I650/sw/Build_is_from_decks.ini
View file

@ -14,7 +14,7 @@
set cpu 2k
att cdr1 -q soapII.dck
att cdr1 -q soap/soapII.dck
echo ***
echo *** Load soap deck into drum
@ -24,9 +24,9 @@ d csw 7019519999
d ar 8000
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
att cdp1 -n -q deck_out.dck
@ -45,7 +45,7 @@ echo *** Read interpretive system loader into drum
echo ***
det cdp1
att cdr1 deck_out.dck
att cdr1 -q deck_out.dck
d csw 7019519999
d ar 8000
@ -53,19 +53,19 @@ go
; 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
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" == "LBOX" carddeck -q join deck_in.dck is_set_loopbox.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 bell/is_set_loopbox.txt as deck_in.dck
shift
goto add_extra_decks
:run
att cdr1 deck_in.dck
att cdr1 -q deck_in.dck
set cdr1 wiring=is
; 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 ***
att cdp1 -n -q is.dck
att cdp1 -n -q bell/is.dck
set cdp1 echo, print, wiring=is
d ar 0801

7
I650/sw/Build_soap_from_source.ini
View file

@ -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
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
set cdp1 echo, print, wiring=soap
att cdp0 -n -q print.txt
@ -23,6 +23,9 @@ d csw 7019511951
d ar 8000
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

26
I650/sw/bell/00_readme.txt Normal file
View 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

4
I650/sw/is.dck → I650/sw/bell/is.dck
View file

@ -1049,8 +1049,8 @@
6I1954195C000000104I241948800?101963197?000000000?000000000?000000000?000000000?
6I1954195C000000105?241949800?441973109E000000000?000000000?000000000?000000000?
6I1954195C000000105A241950800?151977198G000000000?000000000?000000000?000000000?
6I1954195C000000105B241951800?000000000?000000000?000000000?000000000?000000000?
6I1954195C000000105C241952800?000000000?000000000?000000000?000000000?000000000?
6I1954195C000000105B241951800?000989000?000000000?000000000?000000000?000000000?
6I1954195C000000105C241952800?000001000?000000000?000000000?000000000?000000000?
6I1954195C000000105D241953800?000000000?000000000?000000000?000000000?000000000?
6I1954195C000000105E241954800?000000000?000000000?000000000?000000000?000000000?
6I1954195C000000105F241955800?000000000?000000000?000000000?000000000?000000000?

0
I650/sw/is_example_1_src.txt → I650/sw/bell/is_example_1_src.txt
View file

0
I650/sw/is_main_src.txt → I650/sw/bell/is_main_src.txt
View file

0
I650/sw/is_set_loopbox.txt → I650/sw/bell/is_set_loopbox.txt
View file

0
I650/sw/is_sys_load_src.txt → I650/sw/bell/is_sys_load_src.txt
View file

0
I650/sw/is_trace_src.txt → I650/sw/bell/is_trace_src.txt
View file

106
I650/sw/build_fortransit_pack.ini Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View file

File diff suppressed because it is too large Load diff

1729
I650/sw/fortransit/fortransit_translator_listing.txt Normal file
View file

File diff suppressed because it is too large Load diff

1724
I650/sw/fortransit/fortransit_translator_src.txt Normal file
View file

File diff suppressed because it is too large Load diff

1691
I650/sw/fortransit/it_compiler.dck Normal file
View file

File diff suppressed because it is too large Load diff

1841
I650/sw/fortransit/it_compiler_listing.txt Normal file
View file

File diff suppressed because it is too large Load diff

749
I650/sw/fortransit/pack.dck Normal file
View 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
View 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
View 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
View 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
View 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
View 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

0
I650/sw/soapII.dck → I650/sw/fortransit/soapII.dck
View file

58
I650/sw/it/00_readme.txt Normal file
View 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

0
I650/sw/it_compiler.dck → I650/sw/it/it_compiler.dck
View file

30
I650/sw/it_compiler_listing.txt → I650/sw/it/it_compiler_listing.txt
View file

@ -1754,7 +1754,7 @@ A794 LDD NGLFT 1752 69 1144 0947
4 5
5 5 ERRATA BUGFIX
6 5
1442X STU OPSGN 1334 21 0524 1902
1442 STU OPSGN 1334 21 0524 1902
1442A STD V1 1384 1902 24 0488 1384
1 5
2 5 CARNEGIE TECH COMPILER IT
@ -1762,26 +1762,26 @@ A794 LDD NGLFT 1752 69 1144 0947
4 5
5 5 ERRATA BUGFIX
6 5
341X SUP A0001 OUT IF JAY 1065 11 0383 1137
A341X STU NEWAB 0887 1137 21 0845 0887
603X BS LDD DROPU DCRMNT U 0987 69 0690 0893
A603X RAL NEWAB 0690 65 0845 0298
B603X NZE BSA 0640 0298 45 0786 0640
606X STL A0001 BSA 1485 20 0383 0786
607X BSA RAU N BN1 0786 60 0484 1039
650X LDD 1377 LDSR COMPILE 1413 69 1377 1038
X NEWAB 00 0000 0000 0845 00 0000 0000
341 SUP A0001 OUT IF JAY 1065 11 0383 1137
A341 STU NEWAB 0887 1137 21 0845 0887
603 BS LDD DROPU DCRMNT U 0987 69 0690 0893
A603 RAL NEWAB 0690 65 0845 0298
B603 NZE BSA 0640 0298 45 0786 0640
606 STL A0001 BSA 1485 20 0383 0786
607 BSA RAU N BN1 0786 60 0484 1039
650 LDD 1377 LDSR COMPILE 1413 69 1377 1038
NEWAB 00 0000 0000 0845 00 0000 0000
1 5
2 5 CARNEGIE TECH COMPILER IT
3 5 NO DATE
4 5
5 5 ERRATA BUGFIX
6 5
793X LDD ML1A TKNZ1 TKNZ1AND ML1 0940 69 1802 1094
799X MY1 LDD ML1A TKNZ2 1178 69 1802 1194
A793X ML1A SLO 8002 1802 16 8002 1852
B793X STL ABVAL ML1 1852 20 0366 1291
804X LDD 1971 GENN RAL AJAY 1139 69 1971 1681
793 LDD ML1A TKNZ1 TKNZ1AND ML1 0940 69 1802 1094
799 MY1 LDD ML1A TKNZ2 1178 69 1802 1194
A793 ML1A SLO 8002 1802 16 8002 1852
B793 STL ABVAL ML1 1852 20 0366 1291
804 LDD 1971 GENN RAL AJAY 1139 69 1971 1681

0
I650/sw/it_example_1_data.txt → I650/sw/it/it_example_1_data.txt
View file

0
I650/sw/it_example_1_out.txt → I650/sw/it/it_example_1_out.txt
View file

0
I650/sw/it_example_1_src.txt → I650/sw/it/it_example_1_src.txt
View file

6
I650/sw/it_example_2_src.txt → I650/sw/it/it_example_2_src.txt
View file

@ -23,7 +23,11 @@
prime number generator using the sieve of eratosthenes
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++)
2+ ci1 z 1j 2: ci1 <- 1. prime(num) = 1.0

0
I650/sw/it_package_p1.dck → I650/sw/it/it_package_p1.dck
View file

0
I650/sw/it_package_p1_listing.txt → I650/sw/it/it_package_p1_listing.txt
View file

0
I650/sw/it_package_p2.dck → I650/sw/it/it_package_p2.dck
View file

2
I650/sw/it_package_p2_listing.txt → I650/sw/it/it_package_p2_listing.txt
View file

@ -3,7 +3,7 @@
5 PLUS THE FOLLOWING
5 ROUTINES
5 E00AK POWER FIX FIX
5 E00Am POWER FIX FIX REVERSE
5 E00AM POWER FIX FIX REVERSE
5 E00AL POWER FLOAT FIX
5 E00AN POWER FLOAT FIX REVERSE
1 E00AI STD ARTHX AI1 ADD 1833 24 1786 1789

0
I650/sw/it_package_p3.dck → I650/sw/it/it_package_p3.dck
View file

2
I650/sw/it_package_p3_listing.txt → I650/sw/it/it_package_p3_listing.txt
View file

@ -3,7 +3,7 @@
5 PLUS THE FOLLOWING
5 ROUTINES
5 E00AC EXPONENTIAL SUBROUTINE
5 E00A8 L0G SUBROUTINE
5 E00AB LOG SUBROUTINE
1 E00AI STD ARTHX AI1 ADD 1833 24 1786 1789
2 AI1 STL ARTHG 1789 20 1794 1799
3 LDD ARTHB 1799 69 1802 1805

0
I650/sw/it_package_p4.dck → I650/sw/it/it_package_p4.dck
View file

0
I650/sw/it_package_p4_listing.txt → I650/sw/it/it_package_p4_listing.txt
View file

0
I650/sw/it_reservation_p1.dck → I650/sw/it/it_reservation_p1.dck
View file

0
I650/sw/it_reservation_p1_listing.txt → I650/sw/it/it_reservation_p1_listing.txt
View file

0
I650/sw/it_reservation_p2.dck → I650/sw/it/it_reservation_p2.dck
View file

0
I650/sw/it_reservation_p2_listing.txt → I650/sw/it/it_reservation_p2_listing.txt
View file

0
I650/sw/it_reservation_p3.dck → I650/sw/it/it_reservation_p3.dck
View file

0
I650/sw/it_reservation_p3_listing.txt → I650/sw/it/it_reservation_p3_listing.txt
View file

0
I650/sw/it_reservation_p4.dck → I650/sw/it/it_reservation_p4.dck
View file

0
I650/sw/it_reservation_p4_listing.txt → I650/sw/it/it_reservation_p4_listing.txt
View file

34
I650/sw/it_subr_cos_listing.txt → I650/sw/it/it_subr_cos_listing.txt
View file

@ -1,12 +1,12 @@
5 SUBROUTINE 21 COSINE
E00AV STO ARTHX BEGIN CISINE
E00AV STD ARTHX BEGIN COSINE
SLT 0008 ARGUMENT
STU ARTHF ALARM IF PWR
RSM 8002 OVERSCALE
ALO AV1 COSX EQUALS
BMI AV2 ONE IF PWR
SLO AV3 UNDERSCALE
BMI AV4
BMI AV4
SRT 0004
ALO AV5
STL AV6
@ -22,13 +22,13 @@
ALO AV9 PART
RAU 8002
STU ARTHF
MPY 8001 FORM SINE
MPY 8001 FORM SINE
STU ARTHG
RAU AV16 POLYNOMIAL
MPY ARTHG APPROXIMATOR
RAU 8003
AUP AV15
MPY AR7HG
MPY ARTHG
RAU 8003
AUP AV14
MPY ARTHG
@ -37,27 +37,27 @@
MPY ARTHG
SRT 0001
RAU 8003
AUP AV12 EQUALS ONE
AUP AV12 EQUALS ONE
MPY ARTHF
SCT 0000
BOV AV19
STL AR7HF
RAL 8003 ROUND
SRT 0002 AND
STL ARTHG ADJUST
RSU ARTHF POWER
STL ARTHF
RAL 8003 ROUND
SRT 0002 AND
STL ARTHG ADJUST
RSU ARTHF POWER
SRT 0002
BMI AV25
BMI AV25
SUP 8003
ALO AV8 AV24
ALO AV8 AV24
AV24 AUP ARTHG
SLT 0002 AV22
SLT 0002 AV22
AV22 STU ARTHF DETERMINE
RAU ARTHE SIGN OF
NZU AV20 RESULT
AV20 RSL ARTHF ARTHX
AV25 RAL ARTHF ARTHX
SUP 8003
NZU AV20 RESULT
RSL ARTHF ARTHX
AV20 RAL ARTHF ARTHX
AV25 SUP 8003
SLO AV8 AV24
AV2 RAL ARTHE OVERSCALE
LDD ARTHX 3211 DISPLAY

0
I650/sw/it_subr_sqrt_listing.txt → I650/sw/it/it_subr_sqrt_listing.txt
View file

1400
I650/sw/it/soapII.dck Normal file
View file

File diff suppressed because it is too large Load diff

0
I650/sw/it_soapII_patch.dck → I650/sw/it/soapII_patch.dck
View file

1
I650/sw/it_soapII_patch.txt → I650/sw/it/soapII_patch.txt
View file

@ -1,6 +1,7 @@
; These are the patches needed to make
; SOAP II to run with IT
; (patches on original listing are for SOAP I)
; free address 1993, using 1945 instead
dep 0954 65 1986 1945

0
I650/sw/it_soapIIA_patch_listing.txt → I650/sw/it/soap_patch_listing.txt
View file

87
I650/sw/it_subr_sin_listing.txt
View file

@ -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
View 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

4
I650/sw/is_run.ini → I650/sw/run_is.ini
View file

@ -16,7 +16,7 @@ echo ***
echo *** Load is main deck into drum
echo ***
att cdr1 -q is.dck
att cdr1 -q bell/is.dck
d csw 7019519999
d ar 8000
@ -27,7 +27,7 @@ go
carddeck -q join %1 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
att cdp1 -n -q deck_out_run.dck

23
I650/sw/it_run.ini → I650/sw/run_it.ini
View file

@ -5,9 +5,9 @@
; 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)
; %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
att cdp0 -n -q print.txt
@ -23,7 +23,7 @@ echo ***
echo *** Load IT compiler deck into drum
echo ***
att cdr1 -q -l it_compiler.dck
att cdr1 -q -l it/it_compiler.dck
d csw 70 1951 3000
d ar 8000
@ -69,7 +69,7 @@ det cdr1
; 2) package used reservation deck
; 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
@ -78,7 +78,7 @@ echo ***
echo *** Load soap deck into drum
echo ***
att cdr1 -q -l soapII.dck
att cdr1 -q -l it/soapII.dck
d csw 7019519999
d ar 8000
@ -88,7 +88,7 @@ echo ***
echo *** Apply IT modifications to soap deck
echo ***
att cdr1 -q -l it_soapII_patch.dck
att cdr1 -q -l it/soapII_patch.dck
d csw 7019519999
d ar 8000
@ -101,7 +101,7 @@ echo ***
echo *** Assemble PIT deck
echo ***
att cdr1 deck_pit.dck
att cdr1 -q deck_pit.dck
set cdr1 wiring=soap
att cdp1 -n -q deck_out.dck
@ -119,7 +119,7 @@ go
det cdr1
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
@ -132,7 +132,7 @@ echo ***
; soap source code read from card.
set cdr1 wiring=8WORD
att cdr1 -l deck_spit.dck
att cdr1 -q -l deck_spit.dck
d csw 7019519999
@ -148,10 +148,9 @@ att cdr1 -q %2
set cdr1 wiring=it
:run1
if "%3" == "" goto run2
att cdp1 -n -q %3
if "%3" != "" att cdp1 -n -q %3
if "%3" == "" att cdp1 -n -q deck_out.dck
set cdp1 echo, print, wiring=it
:run2
; Now execute the loaded deck

10
I650/sw/soap_and_run.ini → I650/sw/run_soap.ini
View file

@ -7,13 +7,13 @@
; params: %1 source card deck to assemble with soap
; %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
; 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 *** Load soap deck into drum
@ -25,7 +25,7 @@ go
; Now put source cards in reader and start soap assembler
att cdr1 %1
att cdr1 -q %1
set cdr1 wiring=soap
att cdp1 -n -q deck_out.dck
@ -47,7 +47,7 @@ if "%2" == "" goto end
det cdp1
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
set cdp1 echo, print, wiring=8WORD
@ -64,7 +64,7 @@ go
; attach input deck
if "%3" == "" goto run
att cdr1 %3
att cdr1 -q %3
; Now execute the loaded deck
:run

11
I650/sw/soap/00_readme.txt Normal file
View 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
View file

File diff suppressed because it is too large Load diff

0
I650/sw/soapII_condensed_card.dck → I650/sw/soap/soapII_condensed_card.dck
View file

0
I650/sw/soap_example_1_src.txt → I650/sw/soap/soap_example_1_src.txt
View file

0
I650/sw/soap_listing.txt → I650/sw/soap/soap_listing.txt
View file

0
I650/sw/soap_src.txt → I650/sw/soap/soap_src.txt
View file

BIN
doc/i650_doc.doc
View file

Binary file not shown.