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

I650: Update IBM 650 simulator to Release 4

Browse source 
- Integration with updated sim_card API
- Addition of MT (Mag Tape) device
- Addition of DSK (Disk) device
- Build time simulator test
This commit is contained in:
Roberto Sancho Villa 2020-05-15 05:57:01 -07:00 • committed by Mark Pizzolato
parent 275cc417fe
commit 08027162ca
69 changed files with 22549 additions and 441 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitattributes vendored
View file

@ -10,5 +10,6 @@
*.tap binary
*.dsk binary
*.vhd binary
*.crd binary
sim_rev.h export-subst

2
.travis.yml
View file

@ -10,7 +10,7 @@ env:
- SIM="microvax3100m80 vaxstation4000vlc infoserver1000 nova eclipse hp2100 hp3000 i1401 i1620 s3 altair altairz80 gri i7094 ibm1130"
- SIM="id16 id32 sds lgp h316 cdc1700 swtp6800mp-a swtp6800mp-a2 tx-0 ssem b5500 isys8010 isys8020 isys8030 isys8024"
- SIM="besm6 imds-210 imds-220 imds-225 imds-230 imds-800 imds-810"
- SIM="scelbi 3b2 i701 i704 i7010 i7070 i7080 i7090 sigma uc15"
- SIM="scelbi 3b2 i701 i704 i7010 i7070 i7080 i7090 sigma uc15 i650"
sudo: required
install: sh -ex .travis/deps.sh
script: make $SIM

207
I650/650_demo_all.ini Normal file
View file

@ -0,0 +1,207 @@
; demo all .ini scripts
cd sw
set console -n log=console.txt
set debug -q stdout
set debug -q -n debug.txt
set cpu debug=cmd;data;detail
set mt debug=cmd;data;detail;exp
set dsk debug=cmd;data;detail;exp
; uncomment any of them to simulate ibm 650 real speed
; set throttle 11k
; set throttle 55/5
echo
echo ===========================================================
echo test build_soap_from_source.ini
echo ===========================================================
echo generates soap assembly listing
echo ===========================================================
echo
do build_soap_from_source.ini
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_soap.ini
echo ===========================================================
echo example from manual
echo should print 0100 lines
echo ===========================================================
echo
do run_soap.ini soap/soap_example_1_src.txt 1000
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test build_soap4_tap_lib.ini
echo ===========================================================
echo generate a library tape, assemble and run a prog that calls it
echo should display 38 0100 up to 38 6600
echo then assemble example
echo ===========================================================
echo
; build_soap4_tap_lib.ini calls run_soap4.ini, so no need to test it again
do build_soap4_tap_lib.ini
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test build_ssoap_ramac_from_decks.ini
echo ===========================================================
echo builds supersoap on ramac disk, then assemble example prog
echo ===========================================================
echo
do build_ssoap_ramac_from_decks.ini
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test assemble ssoap from source
echo ===========================================================
echo assemble original supersoap source
echo ===========================================================
echo
do run_supersoap_ramac.ini supersoap/ssoap_main_core_src.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fds.ini
echo ===========================================================
echo generates 9 lines (numberes 1-9) with 3 colums of numbers
echo integer (1..9), float (1..9), sqrt (1..9)
echo last line is: 00 0000 0009 50 9000 0000 50 3000 0000
echo ===========================================================
echo
do run_fds.ini fds\example.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_ra.ini
echo ===========================================================
echo regional assembler assembles and run aprog to list on one column 5-word cards
echo listing is one column, words from 0900-0925, some 1960, 0990,
echo more 1960s, 0401-0411. echo last line is: 0411 00 0000 0900
echo ===========================================================
echo
do run_ra.ini regional\print_five_field_ctrl_cards.txt regional\print_five_field_src.txt 0900 deck_in.dck
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo build_is_from_decks.ini
echo ===========================================================
echo build is from source deck
echo ===========================================================
echo
do build_is_from_decks.ini ntr lbox
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_is.ini
echo ===========================================================
echo sieve of eratosthenes - print prime numbers < 50 (last one is 47)
echo ===========================================================
echo
do run_is.ini bell/is_example_1_src.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_it.ini
echo ===========================================================
echo example from manual
echo should print one line: 200020005 6400000051 100050005 11
echo ===========================================================
echo
do run_it.ini it/it_example_1_src.txt it/it_example_1_data.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_it.ini
echo ===========================================================
echo sieve of eratosthenes - print prime numbers < 50 (last one is 47)
echo ===========================================================
echo
do run_it.ini it/it_example_2_src.txt nul
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test build_fortransit_pack.ini
echo ===========================================================
echo build fortransit funcion packs
echo ===========================================================
echo
do build_fortransit_pack.ini
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fortransit.ini
echo ===========================================================
echo example from manual - matrix multiplication
echo ===========================================================
echo
do run_fortransit.ini fortransit/fortransit_example_2_src.txt fortransit/fortransit_example_2_data.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fortransit.ini
echo ===========================================================
echo sieve of eratosthenes - print prime numbers < 50 (last one is 47)
echo ===========================================================
echo
do run_fortransit.ini fortransit/fortransit_example_1_src.txt nul
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fortransit.ini
echo ===========================================================
echo test fortran functions (each one identified by a 1111 to 9999)
echo ===========================================================
echo
do run_fortransit.ini fortransit/fortransit_example_4_src.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fortransit.ini
echo ===========================================================
echo list a fortran graphic!
echo ===========================================================
echo
do run_fortransit.ini fortransit/fortransit_example_5_src.txt
set env -P "Press Enter to continue . . . " dummy=cont
quit
goto end
:end

48
I650/650_test.ini
View file

@ -1,48 +0,0 @@
cd sw
; set console -n log=console.txt
; set debug stdout
; set debug -n debug.txt
; set cpu debug=cmd;data;detail
; uncomment any of them to simulate ibm 650 real speed
; set throttle 11k
; set throttle 55/5
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 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 run_it.ini it/it_example_1_src.txt it/it_example_1_data.txt
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 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

491
I650/i650_cdp.c
View file

@ -139,6 +139,7 @@ void encode_lpt_num(t_int64 d, int l)
#define wf_nnnnnnnnnNs 5
#define wf_nnnnnnnnnH 6
#define wf_NNNNNNNNNN 7
#define wf_sNNNNNNNNNN 8
void encode_lpt_word(t_int64 d, int NegZero, int wFormat)
{
@ -175,6 +176,9 @@ void encode_lpt_word(t_int64 d, int NegZero, int wFormat)
encode_char(0, (n==0) ? '+':'A'+n-1); // hi punch on last digit
} else if (wFormat == wf_NNNNNNNNNN) {
encode_lpt_num(d,10);
} else if (wFormat == wf_sNNNNNNNNNN) {
encode_char(0, neg ? '-':'+');
encode_lpt_num(d,10);
} else { // default: wFormat == wf_NNNNNNNNNNs
encode_lpt_num(d,10);
encode_char(0, neg ? '-':' ');
@ -247,7 +251,7 @@ void encode_8word_wiring(void)
}
}
void encode_soap_wiring(void)
void encode_soap_wiring(int bMultiPass)
{
// 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
@ -265,7 +269,8 @@ void encode_soap_wiring(void)
// +-+-|-+-+-+-|-+-+-|-|
// 1984: | |N N N N| |T| N N N N=Location, T=Type (0 if Blank)
// 1985: | |N N N N| N N N N=Card Number
// 1986: |a|b|c|d|e|f|g|h|i|j| a = 0/8 (for non blank type)
// 1986: |a|b|c|d|e|f|g|h|i|j| punch control word
// a = 0/8 (for non blank type) =0 -> bank LOC,OP etc
// b = 0/8 (negative)
// c = 0/8 (bypass)
// d = 0/8 (punch a) =8 -> do not print Loc op da ir
@ -275,22 +280,39 @@ void encode_soap_wiring(void)
// h = 0/8 (blank out D)
// i = 0/8 (blank out I)
// j = 0/8 (blank out OP)
//
//
// SOAP printout format
// | Sg | Location | OpCode | Data Addr | Tg | Instr Addr | Tg | Remarks | Drum Addr | NN NNNN NNNN[-] (signed word value at this drum addr)
// SOAP punch format (load card, 1 word per card)
// simulates punching over prepunched 1-word load card
// | word1 | nnnn | 24 addr 800? | NNNNNNNNNN[-] | source soap line
// | word1 | nnnn | 24 addr 800? | NNNNNNNNNN | source soap line
// nnnn=card number
// addr=drum address where the word is loaded
// NNNNNNNNNN=word to be loaded at addr, with sign
// NNNNNNNNNN=word to be loaded at addr, with sign in last digit
//
// If MultiPass flag set,
// e = 0/8 (punch b) =8 -> punch availability table OR punch 5/CD card
// if word1 start by 01 is 5/CD card
// if word1 start by 00 is an availability card
//
// SOAPIIA 5 word per card (5/CD) punch format
// | word 1 | word 2 | word 3 | word 4 | word 5 | word 6 | word 7 | word 8 |
// | 01 AAAA NNNN | first | second | third | fourth | fifth | location of intructions |
// | instruction | instruction | instruction | instruction | instruction | 1 2 3 | 4 5 |
// AAAA=ident | NNNN NNNN NN|NN NNNN NNNN |
// NNNN=card num
//
// SOAPIIA 5 word per card printout format
// | 01 | AAAA | NNNN | word 1 | word 2 | word 3 | word 4 | word 5 | NNNN | NNNN | NNNN | NNNN | NNNN |
// word1 word2 word3 word4 word5 location
//
char loc[6], data_addr[6], inst_addr[6], OpCode[6], Data_Tag[6], Instr_Tag[6], rem1[6], rem2[6];
char pch_word[20];
t_int64 d, instr;
int location, CardNum, ty;
int b_non_blank, neg, b_blk_op, b_blk_i, b_blk_d, b_blk_l, b_800X, b_pch_b, b_pch_a, b_bypass; // punch control flags
int i, sv_card_nbuf, n;
int b_non_blank, neg, b_blk_op, b_blk_i, b_blk_d, b_blk_l, b_800X, b_pch_b, b_pch_a, b_bypass, b_5cd; // punch control flags
int i, sv_card_nbuf, n, NegZero;
int pat1, pat2;
word_to_ascii(loc, 1, 5, IOSync[0]);
@ -319,8 +341,17 @@ void encode_soap_wiring(void)
// printf("bits %06d%04d%c ", printfw(IOSync[9])); // to echo the control word of punched card
if ((bMultiPass) && (b_pch_b) && (IOSync[0] / D8 == 01)) {
b_5cd = 1;
} else {
b_5cd = 0;
}
if ((ty==1) || (ty==2)) b_pch_a=1; // card types 1 or 2 punch non generating code card
// generate card
if (b_pch_b) {
// punch 5 words per card format or
// punch availability table (pat pseudo-op output)
for(i=0;i<8;i++) {
sprintf_word(pch_word, IOSync[i], 0, 1);
@ -334,7 +365,6 @@ void encode_soap_wiring(void)
encode_pch_str(pch_word);
encode_pch_str(" "); // two blank words
encode_pch_str(" ");
if (b_non_blank) encode_pch_str("1"); else encode_pch_str(" ");
} else {
// punch generating code card
if (b_800X) {
@ -348,9 +378,9 @@ void encode_soap_wiring(void)
encode_pch_str(pch_word);
sprintf_word(pch_word, AbsWord(instr) * (neg ? -1:1), ((neg) && (instr == 0)) ? 1:0, 1);
encode_pch_str(pch_word);
encode_char(ty == 0 ? ' ' : '0'+ty, 0);
}
encode_pch_str(" ");
encode_char(ty == 0 ? ' ' : '0'+ty, 0);
encode_char(neg ? '-' : ' ', 0);
sv_card_nbuf = card_nbuf; // save pch bufer current pos
encode_pch_str(loc); encode_pch_str(OpCode);
encode_pch_str(data_addr); encode_pch_str(Data_Tag);
@ -365,21 +395,50 @@ void encode_soap_wiring(void)
// generate printout
if (b_pch_b) {
// print availability table (pat pseudo-op output)
for(i=0; i<4; i++) {
d = IOSync[i*2];
if (b_5cd) {
// print 5 words per card format or
d = IOSync[0];
pat1 = (int) ((d / D4) % D4);
pat2 = (int) ( d % D4);
d = IOSync[i*2 + 1];
encode_lpt_num(pat1, 4);
encode_lpt_spc(2);
encode_lpt_num(d, 10);
encode_lpt_spc(2);
encode_lpt_num(pat2, 4);
encode_lpt_spc(5);
encode_lpt_num(01, 2); // print 01
encode_lpt_spc(1);
encode_lpt_num(pat1, 4); // print AAAA
encode_lpt_spc(1);
encode_lpt_num(pat2, 4); // print NNNN
encode_lpt_spc(1);
for(i=1;i<=5;i++) { // print 5 words as NNNNNNNNNs
d = IOSync[i];
NegZero = IOSync_NegativeZeroFlag[i];
encode_lpt_word(d, NegZero, wf_NNNNNNNNNNs);
}
encode_lpt_spc(1); // print locations of words as NNNN NNNN NNNN NNNN NNNN
d = IOSync[6];
for(i=1;i<=5;i++) {
n = Shift_Digits(&d, 4);
if (i==3) {
d = IOSync[7];
n = n + Shift_Digits(&d, 2);
}
encode_lpt_num(n, 4);
encode_lpt_spc(1);
}
} else {
// print availability table (pat pseudo-op output)
for(i=0; i<4; i++) {
d = IOSync[i*2];
pat1 = (int) ((d / D4) % D4);
pat2 = (int) ( d % D4);
d = IOSync[i*2 + 1];
encode_lpt_num(pat1, 4);
encode_lpt_spc(2);
encode_lpt_num(d, 10);
encode_lpt_spc(2);
encode_lpt_num(pat2, 4);
encode_lpt_spc(5);
}
}
} else if ((ty == 1) || (ty == 5)) {
// print coment for card type 1 (SOAP II) or type 5 (SOAP modified for IT)
// print comment for card type 1 (SOAP II) or type 5 (SOAP modified for IT)
encode_char(0, '0' + ty);
encode_lpt_spc(14);
encode_lpt_str(loc); encode_lpt_str(OpCode);
@ -426,6 +485,265 @@ void encode_soap_wiring(void)
}
}
void encode_supersoap_wiring()
{
// encode soap card simulating soap control panel wiring for 533
// storage in output block (one card format)
// +-------------------+
// Word 9040: | <- Location -> | Alphabetic
// 9041: | <- Data Addr -> | Alphabetic
// 9042: | <- Inst Addr -> | Alphabetic
// +-+-+-|-+-+-|-+-|-+-|
// 9043: | Op Code |DTg|ITg| Alphabetic
// +-+-+-|-+-+-|-+-|-+-|
// 9044: | <- Remarks -> | Alphabetic
// 9045: | <- Remarks -> | Alphabetic
// 9046: |<-Assembled Instr->|
// +-+-|-+-+-+-|-+-+-|-|
// 9047: | |N N N N| |T| N N N N=Location, T=Type (0 if Blank)
// 9048: | n n n n |N N N N| N N N N=Card Number, n n n n = location2
// 9049: |a| | |d|e| |g| | |j| punch control word
// a =8 -> bank LOC OP etc, =0 -> punch LOC2 LOC1 OP etc =7 -> PAT card
// b
// c =8 -> 8 words
// d =8 -> five words per card
// e =9 -> positive, =8 -> negative
// f
// g =8 -> ???
// h
// i
// j =4 -> punch 8004
//
// SOAP printout format
// | Sg | Location | OpCode | Data Addr | Tg | Instr Addr | Tg | Remarks | Drum Addr | NN NNNN NNNN[-] (signed word value at this drum addr)
// SOAP punch format (load card, 1 word per card)
// simulates punching over prepunched 1-word load card
// | word1 | nnnn | 24 addr 800? | NNNNNNNNNN | source soap line
// nnnn=card number
// addr=drum address where the word is loaded
// NNNNNNNNNN=word to be loaded at addr, with sign in last digit
//
// SuperSoap five word per card (FIV) punch format
// | word 1 | word 2 | word 3 | word 4 | word 5 | word 6 | word 7 | word 8 |
// | 888888 NNNN | fifth | fourth | third | second | first | location of intructions |
// | instruction | instruction | instruction | instruction | instruction | 5 4 3 | 2 1 |
// NNNN=card num | NNNN NNNN NN|NN NNNN NNNN |
//
//
// SuperSoap five word per card printout format
// | 88888 | NNNN | word 5 | word 4 | word 3 | word 2 | word 1 | NNNN | NNNN | NNNN | NNNN | NNNN |
// word5 word4 word3 word2 word1 location
//
char loc[6], data_addr[6], inst_addr[6], OpCode[6], Data_Tag[6], Instr_Tag[6], rem1[6], rem2[6];
char pch_word[20];
t_int64 d, instr;
int location, location2, CardNum, ty, opcodeNum;
int b_blank, neg, b4, fiv, b_8word; // punch control flags
int i, sv_card_nbuf, n, NegZero;
int pat1, pat2;
char cardtype;
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);
location2 = (int) ( (IOSync[8] / (10*D4)) % D4);
d = IOSync[9];
b4 = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
i = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
i = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
i = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
i = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
neg = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
fiv = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
b_8word = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
i = ((int) (d % 10) == 8) ? 1:0; d = d / 10;
b_blank = (int) (d % 10); d = d / 10;
opcodeNum = (int) (IOSync[3] / D4); // origina ibm650 char opcode
if (b_blank==7) {
cardtype = 'P'; // punch availability table card PAT
} else if (fiv) {
cardtype = '5'; // punch five words per card
} else if (b_8word) {
cardtype = '8'; // punch 8-words load binary card
} else if ((b_blank) || (ty==1) || (ty==3)) {
//XXX missing PAL output,
cardtype = 'A'; // comment card
} else if ((ty==2) || (ty==4) || ((location >= 8000) && (location <= 8009))) {
cardtype = 'B'; // 800X card
} else {
//XXX missing PLR, FIL in one-per-card form, FIL in five-per-card form, DEK
cardtype = 'C'; // regular code card
}
// generate card
if (cardtype=='P') {
// punch availability table (pat pseudo-op output)
for(i=0;i<8;i++) {
sprintf_word(pch_word, IOSync[i], 0, 1);
encode_pch_str(pch_word);
}
} else if (cardtype=='8') {
// punch 8-words load binary card
for(i=0;i<8;i++) {
d = IOSync[i];
NegZero = IOSync_NegativeZeroFlag[i];
sprintf_word(pch_word, d, NegZero, 1);
encode_pch_str(pch_word);
}
} else if (cardtype=='5') {
// punch five-per-card per card format
sprintf(pch_word, "888888%04d", (int)(IOSync[8] % D4)); // punch six 8's, then the card number
encode_pch_str(pch_word);
for(i=1;i<6;i++) {
sprintf_word(pch_word, IOSync[i], 0, 1); // sign on units
encode_pch_str(pch_word);
}
sprintf_word(pch_word, IOSync[6], 0, 0); // locations -> no sign
encode_pch_str(pch_word);
sprintf_word(pch_word, IOSync[7], 0, 0);
encode_pch_str(pch_word);
} else {
// cardtype A, B or C
if (cardtype=='A') {
encode_pch_str("?000008000"); // punch non generating code card
} else if (cardtype=='B') {
encode_pch_str("F919548000"); // punch for 800X locations
} else {
encode_pch_str("F919541953"); // punch for load card
}
if ((ty!=1) && (ty!=3) && ((opcodeNum==647963) || (opcodeNum==637664))) {
sprintf(pch_word, " %s%04d", loc, CardNum); // card DRC or COD
} else {
sprintf(pch_word, " %04d", CardNum); // consecutive card count
}
encode_pch_str(pch_word);
if (cardtype=='A') {
encode_pch_str(" ");
encode_pch_str(" ");
} else {
sprintf(pch_word, "24%04d800?", location);// addr to place the loaded word
encode_pch_str(pch_word);
sprintf_word(pch_word, AbsWord(instr) * (neg ? -1:1), ((neg) && (instr == 0)) ? 1:0, 1);
encode_pch_str(pch_word);
}
// input reproduced
encode_char(ty == 0 ? ' ' : '0'+ty, 0);
encode_char(neg ? '-' : ' ', 0);
sv_card_nbuf = card_nbuf; // save pch bufer current pos
encode_pch_str(loc); encode_pch_str(OpCode);
encode_pch_str(data_addr); encode_pch_str(Data_Tag);
encode_pch_str(inst_addr); encode_pch_str(Instr_Tag);
encode_pch_str(rem1); encode_pch_str(rem2);
// convert to lowercase for punching
for (i=sv_card_nbuf;i<card_nbuf;i++)
if ((card_buf[i] >= 'A') && (card_buf[i] <= 'Z'))
card_buf[i] = card_buf[i] - 'A' + 'a';
}
card_buf[card_nbuf] = 0;
// generate printout
if (cardtype=='5') {
// print five words per card format
encode_lpt_str("888888 ");
encode_lpt_num((int)(IOSync[8] % D4), 4); // card number
encode_lpt_spc(1);
for(i=1;i<=5;i++) { // print 5 words as NNNNNNNNNs
d = IOSync[i];
NegZero = IOSync_NegativeZeroFlag[i];
encode_lpt_word(d, NegZero, wf_NNNNNNNNNNs);
}
encode_lpt_spc(1); // print locations of words as NNNN NNNN NNNN NNNN NNNN
d = IOSync[6];
for(i=1;i<=5;i++) {
n = Shift_Digits(&d, 4);
if (i==3) {
d = IOSync[7];
n = n + Shift_Digits(&d, 2);
}
encode_lpt_num(n, 4);
encode_lpt_spc(1);
}
} else if (cardtype=='8') {
// punch 8-words load binary card
// print out card contents 8 words in format NN NNNN NNNN+
for(i=0;i<8;i++) {
d = IOSync[i];
NegZero = IOSync_NegativeZeroFlag[i];
encode_lpt_word(d, NegZero, wf_sNNNNNNNNNN);
encode_lpt_spc(2);
}
} else if (cardtype=='P') {
// print availability table (pat pseudo-op output)
for(i=0; i<4; i++) {
d = IOSync[i*2];
pat1 = (int) ((d / D4) % D4);
pat2 = (int) ( d % D4);
d = IOSync[i*2 + 1];
encode_lpt_num(pat1, 4);
encode_lpt_spc(2);
encode_lpt_num(d, 10);
encode_lpt_spc(2);
encode_lpt_num(pat2, 4);
encode_lpt_spc(5);
}
} else {
encode_lpt_num(CardNum, 4);
encode_lpt_spc(3);
if (ty == 1) {
// print comment card type 1
encode_lpt_str("1 ");
encode_lpt_str(loc); encode_lpt_str(OpCode);
encode_lpt_str(data_addr); encode_lpt_str(Data_Tag);
encode_lpt_str(inst_addr); encode_lpt_str(Instr_Tag);
encode_lpt_str(rem1); encode_lpt_str(rem2);
} else {
if (ty == 0) {
encode_lpt_spc(1);
} else {
encode_char(0, '0' + ty);
}
encode_lpt_spc(2); encode_char(0, neg ? '-':' '); encode_lpt_spc(1);
encode_lpt_str(loc); encode_lpt_spc(2);
encode_lpt_str(OpCode); encode_lpt_spc(2);
encode_lpt_str(data_addr); encode_lpt_str(Data_Tag); encode_lpt_spc(1);
encode_lpt_str(inst_addr); encode_lpt_str(Instr_Tag); encode_lpt_spc(3);
encode_lpt_str(rem1); encode_lpt_str(rem2); encode_lpt_spc(4);
if (b_blank) {
// blank loc opcode data_addr instr_addr
} else {
if (location2!=location) {
encode_lpt_num(location2, 4);
} else {
encode_lpt_spc(4);
}
encode_lpt_spc(1);
encode_lpt_num(location, 4); encode_lpt_spc(2);
encode_char(0, neg ? '-':'+');
d = instr;
n = Shift_Digits(&d, 2); // operation code (2 digits)
encode_lpt_num(n, 2); encode_lpt_spc(1);
n = Shift_Digits(&d, 4); // data addr (4 digits)
encode_lpt_num(n, 4); encode_lpt_spc(1);
n = Shift_Digits(&d, 4); // instr addr (4 digits)
encode_lpt_num(n, 4);
}
}
}
}
void encode_is_wiring(void)
{
// encode Floationg Decimal Interpretive System (IS) card simulating control panel wiring for 533 as described
@ -702,6 +1020,113 @@ void encode_it_wiring(void)
}
}
void encode_ra_wiring(void)
{
// encode card for Missile Systems Division, Lockheed Aircraft Corporation
// regional assembly card - five load cards
// storage in output block
// +-------------------+
// Word 0977: | XX AAAA XXXX | Address A1 (X=don't care)
// 0978: | NN NNNN NNNN | word 1
// 0979: | XX AAAA XXXX | Address A2
// 0980: | NN NNNN NNNN | word 2
// 0981: | XX AAAA XXXX | Address A3
// 0982: | NN NNNN NNNN | word 3
// 0983: | XX AAAA XXXX | Address A4
// 0984: | NN NNNN NNNN | word 4
// 0985: | XX AAAA XXXX | Address A5
// 0986: | NN NNNN NNNN | word 5
// +-------------------+
//
// punch card format
//
// Column: | 1 2 3 4 - 10 | 11 - 14 | 15 16 | 17 - 20 | 21 - 24 | 25 - 28 | 29 30 | 31 - 34 | 35 - 38 | 39 - 42 | 43 44 | 45 - 48 | 49 - 52 | 53 - 56 | 57 58 | 59 - 62 | 63 - 66 | 67 - 70 | 71 72 | 73 - 76 | 77 - 80 |
// | + | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N |
// | Addr | Op | Data | Instr | Addr | Op | Data | Instr | Addr | Op | Data | Instr | Addr | Op | Data | Instr | Addr | Op | Data | Instr |
// | Location| Code | Addr | Addr | Location| Code | Addr | Addr | Location| Code | Addr | Addr | Location| Code | Addr | Addr | Location| Code | Addr | Addr |
// | (A1) (O1) (D1) (I1) | (A2) (O2) (D2) (I2) | (A3) (O3) (D3) (I3) | (A4) (O4) (D4) (I4) | (A5) (O5) (D5) (I5) |
// | Word 1 | Word 2 | Word 3 | Word 4 | Word 5 |
//
// printout of five load card (only prints words 1, 2 and 3)
//
// Column: | 1 2 | 3 - 6 | 7 8 | 9 10 | 11 | 12 - 15 | 16 | 17 - 20 | 21 | 22 - 25 | 26 - 29 | 30 31 | 32 33 | 34 | 35 - 38 | 39 | 40 - 43 | 44 | 45 - 48 | 49 - 52 | 53 54 | 55 56 | 57 | 58 - 61 | 62 | 63 - 66 | 67 |
// | | N N N N | | N N | | N N N N | | N N N N | s | | N N N N | | N N | | N N N N | | N N N N | s | | N N N N | | N N | | N N N N | | N N N N | s |
// | Addr | | Op | | Data | | Instr | sign | Addr | | Op | | Data | | Instr | sign | Addr | | Op | | Data | | Instr | sign
// | Location| | Code | | Addr | | Addr | | Location| | Code | | Addr | | Addr | | Location| | Code | | Addr | | Addr |
// | (A1) | (O1) | | (D1) | | (I1) | | (A2) | (O2) | | (D2) | | (I2) | | (A3) | (O3) | | (D3) | | (I3) |
// | Word 1 | | Word 2 | | Word 3 |
char pch_word[20];
t_int64 d;
int n;
encode_pch_str(" + ");
d = IOSync[0]; Shift_Digits(&d, 2); n=Shift_Digits(&d, 4);
sprintf_word(pch_word, n, 0, 0); // A1
encode_pch_str(&pch_word[6]);
sprintf_word(pch_word, IOSync[1], 0, 0); // word 1
encode_pch_str(pch_word);
d = IOSync[2]; Shift_Digits(&d, 2); n=Shift_Digits(&d, 4);
sprintf_word(pch_word, n, 0, 0); // A2
encode_pch_str(&pch_word[6]);
sprintf_word(pch_word, IOSync[3], 0, 0); // word 2
encode_pch_str(pch_word);
d = IOSync[4]; Shift_Digits(&d, 2); n=Shift_Digits(&d, 4);
sprintf_word(pch_word, n, 0, 0); // A3
encode_pch_str(&pch_word[6]);
sprintf_word(pch_word, IOSync[5], 0, 0); // word 3
encode_pch_str(pch_word);
d = IOSync[6]; Shift_Digits(&d, 2); n=Shift_Digits(&d, 4);
sprintf_word(pch_word, n, 0, 0); // A4
encode_pch_str(&pch_word[6]);
sprintf_word(pch_word, IOSync[7], 0, 0); // word 4
encode_pch_str(pch_word);
d = IOSync[8]; Shift_Digits(&d, 2); n=Shift_Digits(&d, 4);
sprintf_word(pch_word, n, 0, 0); // A5
encode_pch_str(&pch_word[6]);
sprintf_word(pch_word, IOSync[9], 0, 0); // word 5
encode_pch_str(pch_word);
encode_lpt_str(" ");
d = IOSync[0];
Shift_Digits(&d, 2); n = Shift_Digits(&d, 4);
encode_lpt_num(n, 4);
encode_lpt_spc(2);
d = IOSync[1];
encode_lpt_word(d, 0, wf_NN_NNNN_NNNNs);
encode_lpt_spc(4);
d = IOSync[2];
Shift_Digits(&d, 2); n = Shift_Digits(&d, 4);
d = IOSync[3];
if ((n==0) && (d==0)) {
encode_lpt_spc(4+2+13+4);
} else {
encode_lpt_num(n, 4);
encode_lpt_spc(2);
encode_lpt_word(d, 0, wf_NN_NNNN_NNNNs);
encode_lpt_spc(4);
}
d = IOSync[4];
Shift_Digits(&d, 2); n = Shift_Digits(&d, 4);
d = IOSync[5];
if ((n==0) && (d==0)) {
encode_lpt_spc(4+2+13+4);
} else {
encode_lpt_num(n, 4);
encode_lpt_spc(2);
encode_lpt_word(d, 0, wf_NN_NNNN_NNNNs);
encode_lpt_spc(4);
}
}
void encode_fortransit_wiring(void)
{
// encode card for FORTRANSIT modified IT compiler
@ -897,7 +1322,7 @@ void encode_fortransit_wiring(void)
uint32 cdp_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
{
int i,c,h;
struct _card_data *data;
uint16 image[80];
uint32 wiring;
/* Are we currently tranfering? */
@ -906,7 +1331,7 @@ uint32 cdp_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
/* Test ready */
if ((uptr->flags & UNIT_ATT) == 0) {
sim_debug(DEBUG_CMD, &cdp_dev, "No cards (no file attached)\n");
sim_debug(DEBUG_EXP, &cdp_dev, "No cards (no file attached)\n");
return SCPE_NOCARDS;
}
@ -918,13 +1343,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();
encode_soap_wiring(0);
} else if (wiring == WIRING_SOAPA) {
// encode soap card for multipass sopa IIA
encode_soap_wiring(1);
} else if (wiring == WIRING_SUPERSOAP) {
// encode super soap card
encode_supersoap_wiring();
} else if (wiring == WIRING_IS) {
// encode floating point interpretive system (bell interpreter) card
encode_is_wiring();
} else if (wiring == WIRING_IT) {
// encode Carnegie Internal Translator compiler card
encode_it_wiring();
} else if (wiring == WIRING_RA) {
// endecode Missile Systems Division Lockheed Aircraft Corporation - regional assembly card
encode_ra_wiring();
} else if (wiring == WIRING_FORTRANSIT) {
// encode Fortransit translator card
encode_fortransit_wiring();
@ -958,7 +1392,6 @@ uint32 cdp_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
sim_debug(DEBUG_DETAIL, &cpu_dev, "Punch Card: %s\n", card_buf);
/* punch the cards */
data = (struct _card_data *)uptr->up7;
for (i=0; i<80; i++) {
if (i >= card_nbuf) {
c = 32;
@ -967,14 +1400,14 @@ uint32 cdp_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
}
if (c == 32) {
// no punch
data->image[i] = 0;
image[i] = 0;
} else {
// punch char
h = ascii_to_hol[c & 127];
data->image[i] = h;
h = sim_ascii_to_hol(c);
image[i] = h;
}
}
sim_punch_card(uptr, NULL);
sim_punch_card(uptr, image);
sim_debug(DEBUG_CMD, &cdp_dev, "PUNCH\n");
uptr->u5 |= URCSTA_BUSY;
uptr->u6++; // incr number of punched cards

672
I650/i650_cdr.c
View file

@ -76,11 +76,12 @@ DEVICE cdr_dev = {
// 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];
uint16 ReadStaker[3 * MAX_CARDS_IN_READ_STAKER_HOPPER * 80];
int ReadStakerLast[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 bCheckForHiPunch)
// get 10 digits word with sign from card buf (the data struct).
// return the first column where HiPunch set (first column is 1; 0 is no HiPunch set)
int decode_8word_wiring(uint16 image[80], int bCheckForHiPunch)
{
// decode up to 8 numerical words per card
// input card
@ -88,21 +89,21 @@ int decode_8word_wiring(struct _card_data * data, int bCheckForHiPunch)
// 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 IO Sync buffer (if bCheckForHiPunch = 1 -> do not store in IO Sync Buffer)
// return 1 if any colum has Y(12) hi-punch set
// return first colum with Y(12) hi-punch set (1 to 80)
uint16 c1,c2;
int wn,iCol,iDigit;
int HiPunch, NegPunch, NegZero;
t_int64 d;
NegZero = 0; // flag set if negative zero is read
HiPunch = 0; // set to 1 if Y(12) high punch found
HiPunch = 0; // set if Y(12) high punch found
iCol = 0; // current read colum in card
for (wn=0;wn<8;wn++) { // one card generates 8 words in drum mem
d = NegPunch = 0;
// read word digits
for (iDigit=0;iDigit<10;iDigit++) {
c1 = data->image[iCol++];
c2 = data->hol_to_ascii[c1]; // convert to ascii
c1 = image[iCol++];
c2 = sim_hol_to_ascii(c1); // convert to ascii
if ((c1 == 0xA00) || (c2 == '?')) {
c1 = 0xA00; c2 = '?'; // the punched value +0 should be represented by ascii ?
}
@ -112,12 +113,16 @@ int decode_8word_wiring(struct _card_data * data, int bCheckForHiPunch)
if (strchr(digits_ascii, c2) == NULL) { // scan digits ascii to check if this is a valid numeric digit with Y or X punch
c1 = 0; // nondigits chars interpreted as blank
}
if (c1 & 0x800) HiPunch = 1; // if column has Hi Punch Y(12) set, signal it
NegPunch = (c1 & 0x400) ? 1:0; // if column has minus X(11) set, signal it
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 (((c1 & 0x800)!=0) && (HiPunch == 0)) {
HiPunch = iCol; // HiPunch=first column that has Hi Punch Y(12) set
}
NegPunch = (c1 & 0x400) ? 1:0; // if column has minus X(11) set, signal it
if ((iCol==10) &&
(c2 == '-')) NegPunch= 1; // allow a minus on col 10
c1 = c1 & 0x3FF; // remove X and Y punches
c2 = sim_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
d = d * 10 + c2;
}
// end of word. set sign
@ -130,18 +135,20 @@ int decode_8word_wiring(struct _card_data * data, int bCheckForHiPunch)
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)
void decode_soap_symb_info(uint16 image[80])
{
t_int64 d;
int op,da,ia,i,i2,p;
int op,da,ia,i,i2;
char buf[81];
uint16 c1,c2;
char *Symbolic_Buffer;
// check soap 1-word load card initial word
d = IOSync[0];
@ -153,32 +160,30 @@ void decode_soap_symb_info(struct _card_data * data)
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)DRUMSIZE) return; // symbolic info can only be associated to drum addrs
if (da < (int)DRUMSIZE) {
// symbolic info to be associated to drum addrs
Symbolic_Buffer = &DRUM_Symbolic_Buffer[da * 80];
} else if ((da >= 9000) && (da < 9060)) {
// symbolic info to be associated to IAS addrs
Symbolic_Buffer = &IAS_Symbolic_Buffer[(da - 9000) * 80];
} else {
return; // symbolic info can only be associated to drum or IAS addrs
}
// convert card image punches to ascii buf for processing, starting at col 40
// keep 026 fortran charset
i2=0;
for (i=40;i<80;i++) {
c1 = data->image[i];
c2 = data->hol_to_ascii[c1];
c1 = image[i];
c2 = sim_hol_to_ascii(c1);
c2 = (strchr(mem_to_ascii, toupper(c2))) ? c2:' ';
if (c2 == '~') c2 = ' ';
buf[i] = (char) c2;
if ((i==47) || (i==50) || (i==56)) buf[i2++] = ' '; // add space separation between op, da, ia fields
buf[i2++] = (char) c2;
}
buf[80] = 0; // terminate string
buf[i2++] = 0; // terminate string
// copy soap symbolic info
i2 = 80;
while (1) { // calc i2 = last non space char to copy
if (--i2 < 41) return; // noting to copy
if (buf[i2] > 32) break;
}
p = da * 80;
for (i=0;i<80;i++)
DRUM_Symbolic_Buffer[p+i] = 0; // clear drum[da] symbolic info
for (i=41;i<=i2;i++) {
if ((i==47) || (i==50) || (i==55)) DRUM_Symbolic_Buffer[p++] = 32; // add space separation between op, da, ia fields
DRUM_Symbolic_Buffer[p++] = buf[i];
}
memset(Symbolic_Buffer, 0, 80); // clear drum/ias symbolic info
sim_strlcpy(Symbolic_Buffer, buf, i2);
}
t_int64 decode_num_word(char * buf, int nDigits, int bSpaceIsZero)
@ -217,7 +222,7 @@ t_int64 decode_alpha_word(char * buf, int n)
}
void decode_soap_wiring(struct _card_data * data)
void decode_soap_wiring(uint16 image[80], int bMultiPass)
{
// 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
@ -228,6 +233,7 @@ void decode_soap_wiring(struct _card_data * data)
// Ty = Type = blank, 1 or 2
// Sg = sign = blank or -
// Tg = Tag =
//
// storage in input block
// +-------------------+
// Word 1951: | <- Location -> | Alphabetic
@ -243,9 +249,16 @@ void decode_soap_wiring(struct _card_data * data)
// 1958: | |N N N N| D Absolute Part
// 1959: | |N N N N| I Absolute Part
// 1960: | |T b n| T=Type (0 if Blank), b=0/8 (for non blank type), n=0/8 (for negative)
// +-------------------+
//
int ty,neg;
// +-------------+-----+
//
// If MultiPass flag set, colum 80 contains multipass punches
//
// And sets additional flags in 1960 input block
//
// +-+-----+-----+-----+
// 1960: | |N N N| |T b n| T=Type (0 if Blank), b=0/8 (for non blank type), n=0/8 (for negative)
// +-+-----+-----+-----+
int ty,neg,col80;
char buf[81];
int i;
uint16 c1,c2;
@ -253,8 +266,8 @@ void decode_soap_wiring(struct _card_data * data)
// 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];
c1 = image[i];
c2 = sim_hol_to_ascii(c1);
c2 = (strchr(mem_to_ascii, toupper(c2))) ? c2:' ';
if (c2 == '~') c2 = ' ';
buf[i] = (char) c2;
@ -277,12 +290,97 @@ void decode_soap_wiring(struct _card_data * data)
ty = buf[40] - '0';
if ((ty < 0) || (ty > 9)) ty = 0;
neg = (buf[41] == '-') ? 8:0;
col80 = buf[79];
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)
neg; // |T b n| T=Type (0 if Blank), b=0/8 (for non blank type), n=0/8 (for negative)
if (bMultiPass) {
IOSync[9] += 9 * ((t_int64) D8 ) + // Loc addr digit 9
9 * ((t_int64) D8 / 10 ) + // Data addr digit 8
9 * ((t_int64) D8 / 100) ; // Instr addr digit 7
}
}
void decode_supersoap_wiring(uint16 image[80])
{
// decode supersoap card simulating soap control panel wiring for 533
// educated guess based on supersoap program listing at http://archive.computerhistory.org/resources/access/text/2018/07/102784987-05-01-acc.pdf
// input card
// Column: | 23 24 25 26 | 27 .. 32 | 33 34 35 36 | 37 38 39 40 | 41 | 42 | 43 44 45 46 47 | 48 49 50 | 51 52 53 54 55 | 56 | 57 58 59 60 61 | 62 | 63 64 65 66 67 68 69 70 71 72
// | LH | | DH | IH | Ty | Sg | Location | OpCode | Data Addr | Tg | Instr Addr | Tg | Remarks
//
// Ty = Type = blank, or 0 to 9
// Sg = sign = blank or -
// Tg = Tag A to D
// LH, DH, IH can be bank or set (for hand optimization of input card)
//
// storage in input block
// +-------------------+
// Word 1951: | <- Location -> | Alphabetic
// 1952: | <- Data Addr -> | Alphabetic
// 1953: | <- Inst Addr -> | Alphabetic
// +-+-+-+-+-+-+-+-|-+-|
// 1954: | Op Code |DTg|ITg| Alphabetic
// +-+-+-|-+-+-|-+-|-+-|
// 1955: | <- Remarks -> | Alphabetic
// 1956: | <- Remarks -> | Alphabetic
// +-+-+-+-+-+-|-+-+-+-|
// 1957: | |D D D D|I I I I| DH, IH field for hand optimization
// 1958: | |N N N N| | LH field for hand optimization
// 1959: | |
// 1960: |x x x n 8 T| T=card type
// +-+-+-+-+-+-+-+-+-+-+
//
// T=card type: 0=assembler source, 1=comment,
// 2/4=non generating code, 3=no_DUP 8 (manual page 40)
// n=9 -> positive value, =8 -> negative
// x=don't care
//
// +-------------+-----+
//
int ty,neg,col80;
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 = image[i];
c2 = sim_hol_to_ascii(c1);
c2 = (strchr(mem_to_ascii, toupper(c2))) ? c2:' ';
if (c2 == '~') c2 = ' ';
buf[i] = (char) c2;
}
buf[80] = 0; // terminate string
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
IOSync[6] = decode_num_word(&buf[32], 4, 1) * D4 +
decode_num_word(&buf[36], 4, 1); // DH & IH
IOSync[7] = decode_num_word(&buf[22], 4, 1); // LH
IOSync[8] = 0;
ty = buf[40] - '0';
if ((ty < 0) || (ty > 9)) ty = 0;
neg = (buf[41] == '-') ? 8:9;
col80 = buf[79];
IOSync[9] = ty +
neg * 100000 + // 8=negative, 9=positive XXX
8 * 1000;
}
int sformat(char * buf, const char * match)
{
char m,c;
@ -300,7 +398,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)
void decode_is_wiring(uint16 image[80])
{
// 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
@ -357,8 +455,8 @@ void decode_is_wiring(struct _card_data * data)
// convert card image punches to ascii buf for processing
// keep 0..9,+,-,<space>, replace anything else by <space>
for (i=0;i<80;i++) {
c1 = data->image[i];
c2 = data->hol_to_ascii[c1];
c1 = image[i];
c2 = sim_hol_to_ascii(c1);
buf[i] = (strchr("+-0123456789", c2)) ? ((char) (c2)):' ';
}
buf[80] = 0; // terminate string
@ -434,7 +532,7 @@ void decode_is_wiring(struct _card_data * data)
}
}
void decode_it_wiring(struct _card_data * data)
void decode_it_wiring(uint16 image[80])
{
// decode IT compiler card simulating control panel wiring for 533
// from IT manual at http://www.bitsavers.org/pdf/ibm/650/CarnegieInternalTranslator.pdf
@ -483,8 +581,8 @@ void decode_it_wiring(struct _card_data * data)
// 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];
c1 = image[i];
c2 = sim_hol_to_ascii(c1);
c2 = (strchr(mem_to_ascii, toupper(c2))) ? c2:' ';
if (c2 == '~') c2 = ' ';
buf[i] = (char) c2;
@ -494,7 +592,7 @@ void decode_it_wiring(struct _card_data * data)
if (buf[2] == '+') {
// type 1 data card
// re-read as 8 word per card
decode_8word_wiring(data, 0);
decode_8word_wiring(image, 0);
return;
}
IOSync[0] = decode_alpha_word(&buf[42], 5); // Statement (5 chars)
@ -508,7 +606,378 @@ void decode_it_wiring(struct _card_data * data)
}
void decode_fortransit_wiring(struct _card_data * data)
// convert RrNNNN to word
// R can be A to I (equivalent to 1 to 9). r and N can be 0 to 9
// any other char assumed to be zero
t_int64 decode_regional_addr(char * buf, char * nbuf)
{
int c;
t_int64 w;
c = *buf++;
if ((c >= 'A') && (c <= 'I')) {
w=(c-'A'+1); // convert region letter A-I to digit 1-9
} else if ((c >= '1') && (c <= '9')) {
w=(c-'1'+1);
} else {w=0;}
c = *buf++;
if ((c >= '0') && (c <= '9')) {
w = w * 10 + c - '0';
} else {
w = w * 10;
}
return w * 10000 + decode_num_word(nbuf, 4, 1);
}
int decode_ra_wiring(uint16 image[80], int HiPunch)
{
// decode REGIONAL ASSEMBLY card simulating control panel wiring for 533
// return 1 if it is a load card that makes RD inst continue to DA addr instead of IA addr
// card format in Appl_Sci_tech_Newsletter_10_Oct55.pdf (bitsavers) page p33
//
// the 533 is used as numeric device. Letters does not means alpha chars, but instead are
// used as digit+HiPunch Y(12) (0123456789 -> +ABCDEFGHI) or digit+X(11) (0123456789->-JKLMNOPQR)
//
// there are 4 formats allowed. Each format is marked con card by a HiPunch on col 3,5 9 or 11
//
// the formats are
// HiPunch on column 3 -> five field card: this is standard 650 card from format number [1]
// 5 -> machine languaje trace: this is standard 650 card from format number [2]
// 7 -> flair trace: this is standard 650 card from format number [3]
// 11 -> regional instruction: this is standard 650 card from format number [4]
// note that this format allows a characte "A" to "I" on column 11. The Hi Punch is
//
// On RA wiring, simulated 533 supports:
//
// Format Is Load Apply
// card type number Card? 533 format
// -----------------:------- --------- --------- ----------
// five field card [1] NO YES <- RD inst continue to DA addr instead of IA addr
// regional instruction [4] NO YES <- RD inst continue to IA addr
// normal card none NO NO <- RD inst continue to IA addr
// normal load card any other YES NO <- RD inst continue to DA addr instead of IA addr
//
// regional assembler source program input card (regional instruction) - standard 650 card from format number [4]
//
// Column: | 1 - 5 | 6 - 10 | 11 12 | 13 - 16 | 17 18 | 19 20 | 21 - 24 | 25 26 | 27 - 30 |
// | NNNNN | NNNNN | r r | N N N N | N N | r r | N N N N | r r | N N N N |
// Deck | Seq | Regional Addr | Op | Regional Addr | Regional Addr |
// Numb. | for location | Code | for Data Addr | for Instr Addr
//
// N is digit 0-9. Blank is interpreted as 0 digit
// if rr is blank, value 00
// rr can be numeric or Alfa. If alfa, 1=a, 2=b ... 9=i, so "A2" -> RR=12 and "I9" -> RR=99
// rr can be "A0" .. "I9". Any other char is interpreted as '0'
// OpCode, DA or IA can be negative by setting X(11) necative punch
//
//
// storage in input block for card format [4] and [4b]
// +-------------------+
// Word 0401: | rr NNNN 0000 | Regional addr for location
// 0402: | rr NNNN 0000 | Regional addr for Data Addr
// 0403: | rr NNNN 0000 | Regional addr for Instr Addr
// 0404: | NN 0000 0000 | if OpCode is numeric (Can be positive or negative) else zero
// 0405: | N | if OpCode is numeric and negative is -1, else zero
// 0406: | <- OpCode -> | if OpCode is Alphabetic, the char codes (5 chars), Else zero
// +-------------------+
// 0407: | | Not used
// 0408: | | Not used
// 0409: | | Not used
// 0410: | | Not used
// +-------------------+
//
//
// five field card - standard 650 card from format number [1]
//
// Column: | 1 - 5 | 6 - 10 | 11 - 14 | 15 16 | 17 - 20 | 21 - 24 | 25 - 28 | 29 30 | 31 - 34 | 35 - 38 | 39 - 42 | 43 44 | 45 - 48 | 49 - 52 | 53 - 56 | 57 58 | 59 - 62 | 63 - 66 | 67 - 70 | 71 72 | 73 - 76 | 77 - 80 |
// | NNhNN | NNNNN | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N |
// Deck | Seq | Addr | Op | Data | Instr | Addr | Op | Data | Instr | Addr | Op | Data | Instr | Addr | Op | Data | Instr | Addr | Op | Data | Instr |
// Numb. | Location| Code | Addr | Addr | Location| Code | Addr | Addr | Location| Code | Addr | Addr | Location| Code | Addr | Addr | Location| Code | Addr | Addr |
// | (A1) (O1) (D1) (I1) | (A2) (O2) (D2) (I2) | (A3) (O3) (D3) (I3) | (A4) (O4) (D4) (I4) | (A5) (O5) (D5) (I5) |
// | Word 1 | Word 2 | Word 3 | Word 4 | Word 5 |
//
// h is digit 0-9 with HiPunch set
// if HiPunch is set on last digit of a An, the program will autoexecute at this address
//
//
// storage in input block for card format [1]
// +-------------------+
// Word 1951: | 24 (A1) 1903 | Note: if A1 has HiPunch on last digit (Y(12) in col 14), the word generated
// 1952: | O1 (D1) (I1) | at 1951 will be 24 (A1) (A1)
// 1953: | 24 (A2) 1904 | if A2 has HiPunch on last digit (Y(12) in col 28), the word generated
// 1954: | O2 (D2) (I2) | at 1953 will be 24 (A2) (A2)
// 1955: | 24 (A3) 1905 | if A3 has HiPunch on last digit (Y(12) in col 42), the word generated
// 1956: | O3 (D3) (I3) | at 1955 will be 24 (A3) (A3)
// 1957: | 24 (A4) 1906 | if A4 has HiPunch on last digit (Y(12) in col 56), the word generated
// 1958: | O4 (D4) (I4) | at 1957 will be 24 (A4) (A4)
// 1959: | 24 (A5) 1901 | if A5 has HiPunch on last digit (Y(12) in col 70), the word generated
// 1960: | O5 (D5) (I5) | at 1959 will be 24 (A5) (A5)
// +-------------------+
//
char buf[81];
int hbuf[81];
int wsgn[5]; // store sgn of words
int i, IsLoadCard, IsNeg, NegPunch;
uint16 c1,c2;
t_int64 A,I;
IsLoadCard = NegPunch = 0;
// init sgn to positive
for (i=0;i<5;i++) wsgn[i]=1;
// convert card image punches to ascii buf for processing
for (i=0;i<80;i++) {
IsNeg = hbuf[i]=0;
c1 = image[i];
c2 = sim_hol_to_ascii(c1);
c2 = toupper(c2);
if ((c1 == 0xA00) || (c2 == '?') || c2 == '+') {
hbuf[i]=1; c2='0'; // '0' or blank + HiPunch Y(12)
} else if ((c2 == '!') || (c2 == '-')) {
IsNeg = 1; c2= '0'; // '0' or blank + X(11)
} else if ((c2 >= 'A') && (c2 <= 'I')) {
hbuf[i]=1; c2=c2-'A'+'1'; // A..I means '1'..'9' + HiPunch Y(12) set
} else if ((c2 >= 'J') && (c2 <= 'R')) {
IsNeg = 1; c2=c2-'J'+'1'; // J..R means '1'..'9' + X(11) set
} else if ((c2 >= '1') && (c2 <= '9')) {
// digit '0'..'9'
} else {
c2='0'; // any other is zero
}
if (IsNeg) { // if column has minus X(11) mark sign of the word n
if (i<10) { // none
} else if (i<24) {wsgn[0]=-1; // word 1 negative
} else if (i<38) {wsgn[1]=-1; // word 2 negative
} else if (i<52) {wsgn[2]=-1; // word 3 negative
} else if (i<66) {wsgn[3]=-1; // word 4 negative
} else {wsgn[4]=-1;} // word 5 negative
if ((i>=10) && (NegPunch==0)) NegPunch = i;
}
buf[i] = (char) c2;
}
buf[80] = 0; // terminate string
if (hbuf[10]) {
// regional instruction: this is standard 650 card from format number [4]
// Column: | 1 - 5 | 6 - 10 | 11 12 | 13 - 16 | 17 18 | 19 20 | 21 - 24 | 25 26 | 27 - 30 |
// | NNNNN | NNNNN | r r | N N N N | N N | r r | N N N N | r r | N N N N |
IsNeg = ((NegPunch >=10) && (NegPunch < 30)) ? -1:1;
IOSync[0] = decode_regional_addr(&buf[10], &buf[12]) * 10000; // Regional Location
IOSync[3] = decode_num_word(&buf[16], 2, 1) * 10000 * 10000 * IsNeg; // opcode numeric
IOSync[1] = decode_regional_addr(&buf[18], &buf[20]) * 10000; // Regional DA
IOSync[2] = decode_regional_addr(&buf[24], &buf[26]) * 10000; // Regional IA
IOSync[4] = IsNeg; // check if word OP DA IA is negative
IOSync[5] = 0;
if (IOSync[4] < 0) IOSync[3] = -IOSync[3]; // make opcode negative if word negative
} else if (hbuf[2]) {
// five field card - standard 650 card from format number [1]
// Column: | 1 - 5 | 6 - 10 | 11 - 14 | 15 16 | 17 - 20 | 21 - 24 | 25 - 28 | 29 30 | 31 - 34 | 35 - 38 | 39 - 42 | 43 44 | 45 - 48 | 49 - 52 | 53 - 56 | 57 58 | 59 - 62 | 63 - 66 | 67 - 70 | 71 72 | 73 - 76 | 77 - 80 |
// | NNhNN | NNNNN | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N | N N N N | N N | N N N N | N N N N |
// | (A1) (O1) (D1) (I1) | (A2) (O2) (D2) (I2) | (A3) (O3) (D3) (I3) | (A4) (O4) (D4) (I4) | (A5) (O5) (D5) (I5) |
// | Word 1 | Word 2 | Word 3 | Word 4 | Word 5 |
//
A = decode_num_word(&buf[10], 4, 1);
I = (hbuf[13]) ? A : 1903; // if HiPunch on (A1) last digit, replace 1903 with (A1) value
IOSync[0] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[1] = decode_num_word(&buf[14], 10, 1) * wsgn[0];
A = decode_num_word(&buf[24], 4, 1);
I = (hbuf[27]) ? A : 1904; // if HiPunch on (A2) last digit, replace 1904 with (A1) value
IOSync[2] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[3] = decode_num_word(&buf[28], 10, 1) * wsgn[1];
A = decode_num_word(&buf[38], 4, 1);
I = (hbuf[41]) ? A : 1905; // if HiPunch on (A3) last digit, replace 1905 with (A3) value
IOSync[4] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[5] = decode_num_word(&buf[42], 10, 1) * wsgn[2];
A = decode_num_word(&buf[52], 4, 1);
I = (hbuf[55]) ? A : 1906; // if HiPunch on (A4) last digit, replace 1906 with (A4) value
IOSync[6] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[7] = decode_num_word(&buf[56], 10, 1) * wsgn[3];
A = decode_num_word(&buf[66], 4, 1);
I = (hbuf[69]) ? A : 1901; // if HiPunch on (A5) last digit, replace 1901 with (A5) value
IOSync[8] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[9] = decode_num_word(&buf[70], 10, 1) * wsgn[4];
} else {
decode_8word_wiring(image, 0);
if (HiPunch > 0) IsLoadCard=1;
}
return IsLoadCard;
}
int decode_fds_wiring(uint16 image[80], int HiPunch)
{
// decode Interpretive Floating Decimal System card
// return 1 if it is a load card that makes RD inst continue to DA addr instead of IA addr
// no card format defined in Appl_Sci_tech_Newsletter_08_Oct54.pdf (bitsavers) page p18
// guesswork based on bitsavers deck format 5440.2009_INTERPRETIVE_FDS.crd
// two formats are defined. One that match the 5440.2009_INTERPRETIVE_FDS.crd deck, and a second one
// that allows to load a single word, used to enter a FDS program on a friendly way
//
// FDS program input card - five word card
//
// Column: | 1 2 | 3 - 6 | 7 8 | 9 - 12 | 13 - 16 | 17 18 | 19 - 22 | 23 24 | 25 - 28 | 29 - 32 | 33 34 | 35 - 38 | 39 40 | 41 - 44 | 45 - 48 | 49 50 | 51 - 54 | 55 56 | 57 - 60 | 61 - 64 | 65 66 | 67 - 70 | 71 72 | 73 - 76 | 77 - 80 |
// | 8 8 | n n n N | n n | n n n n | n n n N | 8 8 | n n n N | n n | n n n n | n n n N | 8 8 | n n n N | n n | n n n n | n n n N | 8 8 | n n n N | n n | n n n n | n n n N | 8 8 | n n n N | n n | n n n n | n n n N |
// | Addr | Op | Data | Instr | | Addr | Op | Data | Instr | | Addr | Op | Data | Instr | | Addr | Op | Data | Instr | | Addr | Op | Data | Instr |
// | Location| Code | Addr | Addr | | Location| Code | Addr | Addr | | Location| Code | Addr | Addr | | Location| Code | Addr | Addr | | Location| Code | Addr | Addr |
// | (A1) (O1) (D1) (I1) | | (A2) (O2) (D2) (I2) | | (A3) (O3) (D3) (I3) | | (A4) (O4) (D4) (I4) | | (A5) (O5) (D5) (I5) |
// | Word 1 | | Word 2 | | Word 3 | | Word 4 | | Word 5 |
//
// n is digit 0-9
// H is digit 0-9 with HiPunch set
//
//
// storage in input block
// +-------------------+
// Word 1951: | 24 (A1) 1903 |
// 1952: | O1 (D1) (I1) |
// 1953: | 24 (A2) 1904 |
// 1954: | O2 (D2) (I2) |
// 1955: | 24 (A3) 1905 |
// 1956: | O3 (D3) (I3) |
// 1957: | 24 (A4) 1906 |
// 1958: | O4 (D4) (I4) |
// 1959: | 24 (A5) 1901 |
// 1960: | O5 (D5) (I5) |
// +-------------------+
//
// FDS program input card - one word card
//
// Column: | 1 2 3 | 4 - 7 | 8 9 | 10 11 | 12 | 13 - 16 | 17 | 18 - 21 | 22 23 | 24 - 80
// | + g | n n n n | | n n | | n n n n | | n n n n | s | comments
// | Addr | | Op | | Data | | Instr | |
// | Location| | Code | | Addr | | Addr | |
// | (A1) | | (O1) | | (D1) | | (I1) | |
// | Word 1 |
//
// n is digit 0-9
// + is digit 0 with HiPunch set
// s is sign. Can be +,- or blank
// g can be "G" (7+HiPunch) or blank, If G this is a transfer card to A1 address
//
// storage in input block
// +-------------------+
// Word 1951: | 24 (A1) 1903 | if is a transfer card (G present), then this word is: 00 (A1) (A1)
// 1952: | O1 (D1) (I1) |
// 1953: | 24 0000 1904 |
// 1954: | 00 0000 0000 |
// 1955: | 24 0000 1905 |
// 1956: | 00 0000 0000 |
// 1957: | 24 0000 1906 |
// 1958: | 00 0000 0000 |
// 1959: | 24 0000 1901 |
// 1960: | 00 0000 0000 |
// +-------------------+
//
char buf[81];
int i, IsLoadCard, IsNeg, NegPunch, IsGo, IsSgn;
uint16 c1,c2;
t_int64 A,I;
IsLoadCard = NegPunch = IsGo = IsSgn = 0;
// init sgn to positive
// convert card image punches to ascii buf for processing
for (i=0;i<80;i++) {
IsNeg =0;
c1 = image[i];
c2 = sim_hol_to_ascii(c1);
c2 = toupper(c2);
if ((c1 == 0xA00) || (c2 == '?') || c2 == '+') {
c2='0'; // '0' or blank + HiPunch Y(12)
if (i==1) HiPunch=2;
} else if ((c2 == '!') || (c2 == '-')) {
IsNeg = 1; c2= '0'; // '0' or blank + X(11)
if (i==21) IsSgn=1; // '-' in column 22
} else if ((c2 >= 'A') && (c2 <= 'I')) {
if ((c2 == 'G') && (i==2)) IsGo=1; // g or G in column 3
c2=c2-'A'+'1'; // A..I means '1'..'9' + HiPunch Y(12) set
} else if ((c2 >= 'J') && (c2 <= 'R')) {
IsNeg = 1; c2=c2-'J'+'1'; // J..R means '1'..'9' + X(11) set
} else if ((c2 >= '1') && (c2 <= '9')) {
// digit '0'..'9'
} else {
c2='0'; // any other is zero
}
buf[i] = (char) c2;
}
buf[80] = 0; // terminate string
if (HiPunch==6) {
// five word card
// Column: | 1 2 | 3 - 6 | 7 8 | 9 - 12 | 13 - 16 | 17 18 | 19 - 22 | 23 24 | 25 - 28 | 29 - 32 | 33 34 | 35 - 38 | 39 40 | 41 - 44 | 45 - 48 | 49 50 | 51 - 54 | 55 56 | 57 - 60 | 61 - 64 | 65 66 | 67 - 70 | 71 72 | 73 - 76 | 77 - 80 |
// | 8 8 | n n n N | n n | n n n n | n n n N | 8 8 | n n n N | n n | n n n n | n n n N | 8 8 | n n n N | n n | n n n n | n n n N | 8 8 | n n n N | n n | n n n n | n n n N | 8 8 | n n n N | n n | n n n n | n n n N |
// | (A1) (O1) (D1) (I1) | | (A2) (O2) (D2) (I2) | | (A3) (O3) (D3) (I3) | | (A4) (O4) (D4) (I4) | | (A5) (O5) (D5) (I5) |
// | Word 1 | | Word 2 | | Word 3 | | Word 4 | | Word 5 |
//
A = decode_num_word(&buf[2], 4, 1);
I = 1903;
IOSync[0] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[1] = decode_num_word(&buf[6], 10, 1);
A = decode_num_word(&buf[18], 4, 1);
I = 1904;
IOSync[2] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[3] = decode_num_word(&buf[22], 10, 1);
A = decode_num_word(&buf[34], 4, 1);
I = 1905;
IOSync[4] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[5] = decode_num_word(&buf[38], 10, 1);
A = decode_num_word(&buf[50], 4, 1);
I = 1906;
IOSync[6] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[7] = decode_num_word(&buf[54], 10, 1);
A = decode_num_word(&buf[66], 4, 1);
I = 1901;
IOSync[8] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[9] = decode_num_word(&buf[70], 10, 1);
} else if (HiPunch==2) {
// Column: | 1 2 3 | 4 - 7 | 8 9 | 10 11 | 12 | 13 - 16 | 17 | 18 - 21 | 22 23 | 24 - 80
// | + g | n n n n | | n n | | n n n n | | n n n n | s | comments
// | (A1) | | (O1) | | (D1) | | (I1) | |
A = decode_num_word(&buf[3], 4, 1);
I = 1903;
IOSync[0] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
if (IsGo) IOSync[0] = A;
IOSync[1] = decode_num_word(&buf[ 9], 2, 1) * 10000 * 10000 +
decode_num_word(&buf[12], 4, 1) * 10000 +
decode_num_word(&buf[17], 4, 1);
if (IsSgn) IOSync[1] = -IOSync[1];
A = 0; I = 1904;
IOSync[2] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[3] = 0;
A = 0; I = 1905;
IOSync[4] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[5] = 0;
A = 0; I = 1906;
IOSync[6] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[7] = 0;
A = 0; I = 1901;
IOSync[8] = (t_int64) 24 * 10000 * 10000 + A * 10000 + I;
IOSync[9] = 0;
} else {
decode_8word_wiring(image, 0);
if (HiPunch > 0) IsLoadCard=1;
}
return IsLoadCard;
}
void decode_fortransit_wiring(uint16 image[80])
{
// 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
@ -593,8 +1062,8 @@ void decode_fortransit_wiring(struct _card_data * data)
// 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];
c1 = image[i];
c2 = sim_hol_to_ascii(c1);
c2 = toupper(c2);
c2 = (strchr(mem_to_ascii, c2)) ? c2:' ';
if (c2 == '~') c2 = ' ';
@ -605,7 +1074,7 @@ void decode_fortransit_wiring(struct _card_data * data)
if (buf[72] == '+') {
// read data card input for READ fortransit command
// re-read as 8 word per card
decode_8word_wiring(data, 0);
decode_8word_wiring(image, 0);
return;
} else if (buf[4] == '+') {
// it source statement
@ -631,14 +1100,16 @@ void decode_fortransit_wiring(struct _card_data * data)
( decode_num_word(&buf[1], 4, 1) ); // statement number
}
}
/*
* Device entry points for card reader.
*/
uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
{
struct _card_data *data;
uint32 wiring;
int i;
uint16 image[80];
int i, HiPunch;
char cbuf[81];
int ncdr, ic;
@ -654,7 +1125,7 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
/* Test ready */
if ((uptr->flags & UNIT_ATT) == 0) {
sim_debug(DEBUG_CMD, &cdr_dev, "No cards (no file attached)\n");
sim_debug(DEBUG_EXP, &cdr_dev, "No cards (no file attached)\n");
return SCPE_NOCARDS;
}
@ -662,28 +1133,30 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
sim_debug(DEBUG_CMD, &cdr_dev, "READ\n");
uptr->u5 |= URCSTA_BUSY;
switch(sim_read_card(uptr)) {
case SCPE_EOF:
sim_debug(DEBUG_DETAIL, &cdr_dev, "EOF\n");
switch(sim_read_card(uptr, image)) {
case CDSE_EOF:
sim_debug(DEBUG_EXP, &cdr_dev, "EOF\n");
uptr->u5 = 0;
return SCPE_NOCARDS;
case CDSE_EMPTY:
sim_debug(DEBUG_EXP, &cdr_dev, "Input Hopper Empty\n");
uptr->u5 = 0;
return SCPE_NOCARDS;
case SCPE_UNATT:
sim_debug(DEBUG_DETAIL, &cdr_dev, "Not Attached\n");
sim_debug(DEBUG_EXP, &cdr_dev, "Not Attached\n");
uptr->u5 = 0;
return SCPE_NOCARDS;
case SCPE_IOERR:
sim_debug(DEBUG_DETAIL, &cdr_dev, "ERR\n");
case CDSE_ERROR:
sim_debug(DEBUG_EXP, &cdr_dev, "IO ERR\n");
uptr->u5 = 0;
return SCPE_NOCARDS;
case SCPE_OK:
case CDSE_OK:
break;
}
data = (struct _card_data *)uptr->up7;
// make local copy of card for debug output
for (i=0; i<80; i++)
cbuf[i] = data->hol_to_ascii[data->image[i]];
cbuf[i] = sim_hol_to_ascii(image[i]);
cbuf[80] = 0; // terminate string
sim_debug(DEBUG_DETAIL, &cpu_dev, "Read Card: %s\n", sim_trim_endspc(cbuf));
@ -692,10 +1165,12 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
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;
ReadStakerLast[ncdr] = (ReadStakerLast[ncdr] + 1) % MAX_CARDS_IN_READ_STAKER_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];
ic = (ncdr * MAX_CARDS_IN_READ_STAKER_HOPPER + ReadStakerLast[ncdr]) * 80;
for (i=0; i<80; i++) {
ReadStaker[ic + i] = image[i];
}
}
// uint16 data->image[] array that holds the actual punched rows on card
@ -719,39 +1194,58 @@ uint32 cdr_cmd(UNIT * uptr, uint16 cmd, uint16 addr)
// 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)) {
uptr->u5 |= URCSTA_LOAD;
} else {
uptr->u5 &= ~URCSTA_LOAD;
}
wiring = (uptr->flags & UNIT_CARD_WIRING);
HiPunch = decode_8word_wiring(image, 1);
wiring = (uptr->flags & UNIT_CARD_WIRING);
// check if it is a load card (Y(12) = HiPunch set on any column of card) signales it
// Regional Assembler /FDS should process format of Load Cards
if ((HiPunch > 0) &&
(wiring != WIRING_RA) &&
(wiring != WIRING_FDS)) {
uptr->u5 |= URCSTA_LOAD;
} else {
uptr->u5 &= ~URCSTA_LOAD;
}
// 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, 0);
decode_8word_wiring(image, 0);
if (uptr->u5 & URCSTA_SOAPSYMB) {
// requested to load soap symb info
decode_soap_symb_info(data);
decode_soap_symb_info(image);
}
} else if (wiring == WIRING_SOAP) {
// decode soap card simulating soap control panel wiring for 533 (gasp!)
decode_soap_wiring(data);
decode_soap_wiring(image, 0);
} else if (wiring == WIRING_SOAPA) {
// decode soap card for multipass sopa IIA
decode_soap_wiring(image, 1);
} else if (wiring == WIRING_SUPERSOAP) {
// decode super soap card
decode_supersoap_wiring(image);
} else if (wiring == WIRING_IS) {
// decode floating point interpretive system (bell interpreter) card
decode_is_wiring(data);
decode_is_wiring(image);
} else if (wiring == WIRING_RA) {
// decode Missile Systems Division Lockheed Aircraft Corporation - regional assembly card
if (decode_ra_wiring(image, HiPunch)) {
uptr->u5 |= URCSTA_LOAD;
}
} else if (wiring == WIRING_FDS) {
// decode Floating Decimal Systems
if (decode_fds_wiring(image, HiPunch)) {
uptr->u5 |= URCSTA_LOAD;
}
} else if (wiring == WIRING_IT) {
// decode Carnegie Internal Translator compiler card
decode_it_wiring(data);
decode_it_wiring(image);
} else if (wiring == WIRING_FORTRANSIT) {
// decode Fortransit translator card
decode_fortransit_wiring(data);
decode_fortransit_wiring(image);
} else {
// default wiring: decode up to 8 numerical words per card. Can be a load card
decode_8word_wiring(data, 0);
decode_8word_wiring(image, 0);
}
uptr->u5 &= ~URCSTA_BUSY;
@ -822,11 +1316,11 @@ cdr_attach(UNIT * uptr, CONST char *file)
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;
ReadStakerLast[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;
ic1 = (ncdr * MAX_CARDS_IN_READ_STAKER_HOPPER) * 80;
ic2 = ic1 + MAX_CARDS_IN_READ_STAKER_HOPPER * 80;
for (i=ic1; i<ic2; i++) ReadStaker[i] = 0;
}
return SCPE_OK;

630
I650/i650_cpu.c
View file

File diff suppressed because it is too large Load diff

117
I650/i650_defs.h
View file

@ -28,7 +28,15 @@
#define STOP_HALT 1 /* HALT */
#define STOP_IBKPT 2 /* breakpoint */
#define STOP_UUO 3 /* invalid opcode */
#define STOP_CARD 4 /* Stop on card reader/punch error (no card in hopper, read/punch failure, no cards, stop pressed on cdr/cdp*/
#define STOP_IO 4 /* Stop on IO:
card reader/punch error:
no card in hopper, read/punch failure, no cards, stop pressed on cdr/cdp
only simulated no card in hopper situation when all cards from attached file has been read
tape:
executed tape opcode and got non handled by indicator error
disk:
selected arm or unit out of range
*/
#define STOP_PROG 5 /* Programmed stop */
#define STOP_OV 6 /* Overflow stop */
#define STOP_ERRO 7 /* Error in opcode execution: BRD in witch position tested not 8 or 9, TLU failure */
@ -42,22 +50,24 @@
extern t_int64 DRUM[MAXDRUMSIZE];
extern int DRUM_NegativeZeroFlag[MAXDRUMSIZE];
extern char DRUM_Symbolic_Buffer[MAXDRUMSIZE * 80];
extern char IAS_Symbolic_Buffer[60 * 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)
#define STOR ((uint32)cpu_unit.flags & OPTION_STOR) // return non zero if set cpu storage option set
#define CNTRL ((uint32)cpu_unit.flags & OPTION_CNTRL) // return non zero if set cpu cntrl option set
#define FAST ((uint32)(cpu_unit.flags & OPTION_FAST) ? 1:0) // return non zero if set cpu fast option set
#define DRUM4K ((uint32)cpu_unit.flags & MEMAMOUNT(2)) // return 0 if drum size < 4k, non zero if = 4k
extern t_int64 IAS[60];
extern int IAS_NegativeZeroFlag[60];
extern int IAS_TimingRing;
extern int InterLockCount[8];
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 void vm_init(void);
/* digits contants */
@ -65,10 +75,12 @@ extern void vm_init(void);
#define D8 (100000000L) // eight digits (8 zeroes)
#define D4 (10000L) // four digits (4 zeroes)
// increment umber of word counts elapsed from starting of simulator -> this is the global time measurement
extern t_int64 GlobalWordTimeCount;
/* Device information block */
struct dib {
uint8 upc; /* Units per channel */
uint8 upc; // Number of Units in device
uint32 (*cmd)(UNIT *up, uint16 cmd, uint16 dev);/* Issue command. */
void (*ini)(UNIT *up, t_bool f);
};
@ -84,62 +96,89 @@ typedef struct dib DIB;
extern DEBTAB dev_debug[];
extern DEBTAB crd_debug[];
/* Returns from read/write */
#define DATA_OK 0 /* Data transfered ok */
#define TIME_ERROR 1 /* Channel did not transfer last operation */
#define END_RECORD 2 /* End of record */
/* Returns from device commands */
#define SCPE_BUSY (1) /* Device is active */
#define SCPE_NOCARDS (2) /* No cards to read or ti write */
#define SCPE_BUSY (1) // Device is active
#define SCPE_NOCARDS (2) // No cards to read or to write
#define SCPE_OK_INPROGRESS (3) // Operation in progress
/* Global device definitions */
#ifdef CPANEL
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
#define MAX_CARDS_IN_DECK 10000 // max number of cards in deck for carddeck internal command
#define MAX_CARDS_IN_READ_STAKER_HOPPER 10 // max number of cards in card reader take
// staker that can be viewev with carddeck echolast
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 uint16 ReadStaker[3 * MAX_CARDS_IN_READ_STAKER_HOPPER * 80];
extern int ReadStakerLast[3];
extern DIB cdp_dib;
extern DEVICE cdp_dev;
extern uint32 cdp_cmd(UNIT *, uint16, uint16);
extern UNIT cdp_unit[4];
/* Device status information stored in u5 */
/* Card read-punch device status information stored in u5 */
#define URCSTA_ERR 0002 /* Error reading record */
#define URCSTA_BUSY 0010 /* Device is busy */
#define URCSTA_BUSY 0010 /* Device unit is busy */
#define URCSTA_LOAD 01000 /* Load flag for 533 card reader */
#define URCSTA_SOAPSYMB 02000 /* Get soap symbolic info when reading the card */
extern DIB mt_dib;
extern DEVICE mt_dev;
extern uint32 mt_cmd(UNIT *, uint16, uint16);
extern UNIT mt_unit[6];
extern int LastTapeSelected;
extern int LastTapeIndicator;
extern const char * TapeIndicatorStr[11];
extern int mt_ready(int n);
extern void mt_ini(UNIT * uptr, t_bool f);
/* Tape Indicator status */
#define MT_IND_WRT_PROT 1 // attempting to write to a write protected tape
#define MT_IND_IOCHECK 2 // host os i/o error on tape file
#define MT_IND_EOF 3 // found Tape Mark in current record while reading
#define MT_IND_EOT 4 // found End of Tape Mark while reading/writing
#define MT_IND_LONG_REC 5 // record begin read from tape does not fit in record defined at IAS storage
#define MT_IND_SHORT_REC 6 // record begin read from tape does not fill record defined at IAS storage
#define MT_IND_DIS 7 // no tape has this address (tape unit is disabled)
#define MT_IND_NOATT 8 // no reel load on tape (no tape file attached)
#define MT_IND_NOTRDY 9 // tape not ready
#define MT_IND_BADCHAR 10 // tape not ready
extern DIB dsk_dib;
extern DEVICE dsk_dev;
extern uint32 dsk_cmd(int, int32, uint16);
extern UNIT dsk_unit[4];
extern int dsk_ready(int n, int arm);
extern void dsk_ini(UNIT * uptr, t_bool f);
/* Disk Indicator status */
#define DSK_IND_BADADDR 1 // invalid unit/arm/disk plate/track accessed
#define DSK_IND_IOCHECK 2 // host os i/o error on disk file
#define DSK_IND_DIS 7 // no disk has this address (disk unit is disabled)
#define DIS_IND_NOATT 8 // no disk file attached
#define DIS_IND_NOTRDY 9 // disk arm not ready
extern struct card_wirings {
uint32 mode;
const char *name;
} wirings[];
extern char digits_ascii[31];
extern char mem_to_ascii[101];
extern int ascii_to_NN(int ch);
extern uint16 ascii_to_hol[128];
extern uint16 sim_ascii_to_hol(char c);
extern char sim_hol_to_ascii(uint16 hol);
/* Generic devices common to all */
extern DEVICE cpu_dev;
extern UNIT cpu_unit;
extern REG cpu_reg[];
extern int cycle_time;
/* I/O Command codes */
#define IO_RDS 1 /* Read record */
#define IO_WRS 4 /* Write one record */
extern const char *cpu_description(DEVICE *dptr);
@ -189,6 +228,7 @@ extern const char *cpu_description(DEVICE *dptr);
#define OP_SL 16 // Subtract from lower accumulator
#define OP_SU 11 // Subtract from upper accumulator
#define OP_TLU 84 // Table lookup
#define OP_TLE 63 // Table lookup on equal
// Instructions on Storage Unit
// opcodes for indexing
#define OP_AXA 50 // Add to index register A
@ -269,13 +309,24 @@ extern const char *cpu_description(DEVICE *dptr);
#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 opTLE 3 // opcode available if Table Lookup on equal feature installed
#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
#define IL_Tape 6 // interlock on tape control circuits
#define IL_RamacUnit 7 // interlock on ramac unit control circuits
#define IL_Tape_and_Unit_and_IAS 100 // interlock IAS + Tape control + Tape Unit
#define IL_Tape_and_Unit 101 // interlock Tape control + Tape Unit
#define IL_RamacUnit_and_Arm_and_IAS 102 // interlock IAS + Ramac unit control + Unit Access Arm
#define IL_RamacUnit_and_Arm 103 // interlock + Ramac unit control + Unit Access Arm
#define msec_to_wordtime(n) ((int)(n / 0.096)) // convert time in msec to number of word times
#define msec_elapsed(n) ((int)((GlobalWordTimeCount - (n)) * 0.096)) // return msec elapsed from a give wordtime stamp
/* Symbol tables */
typedef struct
@ -305,9 +356,13 @@ extern t_opcode base_ops[100];
#define UNIT_CARD_WIRING ( 0xF00 << UNIT_V_CARD_MODE)
#define WIRING_8WORD ( 0x000 << UNIT_V_CARD_MODE)
#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 WIRING_SOAPA ( 0x200 << UNIT_V_CARD_MODE)
#define WIRING_IS ( 0x300 << UNIT_V_CARD_MODE)
#define WIRING_IT ( 0x400 << UNIT_V_CARD_MODE)
#define WIRING_FORTRANSIT ( 0x500 << UNIT_V_CARD_MODE)
#define WIRING_RA ( 0x600 << UNIT_V_CARD_MODE)
#define WIRING_FDS ( 0x700 << UNIT_V_CARD_MODE)
#define WIRING_SUPERSOAP ( 0x800 << UNIT_V_CARD_MODE)
#define UNIT_CARD_ECHO ( 0x1000 << UNIT_V_CARD_MODE)
#define UNIT_CARD_PRINT ( 0x2000 << UNIT_V_CARD_MODE)

494
I650/i650_dsk.c Normal file
View file

@ -0,0 +1,494 @@
/* i650_dsk.c: IBM 650 RAMAC Disk Dotrage
Copyright (c) 2018, Roberto Sancho
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
ROBERTO SANCHO BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*/
#include "i650_defs.h"
#define UNIT_DSK UNIT_ATTABLE | UNIT_DISABLE | UNIT_FIX
#define DISK_SIZE (12*60*100) // a physical disk plate size: 12 bytes per word x 60 words per track x 100 tracks per disk
// there are 100 like this in each unit
#define UPDATE_RAMAC 10 // update ramac arm movement each 10 msec of simulted time
// time pregress as drum wordcount progresses
/* Definitions */
uint32 dsk_cmd(int opcode, int32 addr, uint16 fast);
t_stat dsk_srv(UNIT *);
void dsk_ini(UNIT *, t_bool f);
t_stat dsk_reset(DEVICE *);
t_stat dsk_attach(UNIT *, CONST char *);
t_stat dsk_detach(UNIT *);
t_stat dsk_help (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, const char *cptr);
const char *dsk_description (DEVICE *dptr);
UNIT dsk_unit[4] = {
{UDATA(&dsk_srv, UNIT_DSK, 0), 0}, /* 0 */
{UDATA(&dsk_srv, UNIT_DSK, 0), 0}, /* 1 */
{UDATA(&dsk_srv, UNIT_DSK, 0), 0}, /* 2 */
{UDATA(&dsk_srv, UNIT_DSK, 0), 0}, /* 3 */
};
DEVICE dsk_dev = {
"DSK", dsk_unit, NULL, NULL,
4, 8, 15, 1, 8, 8,
NULL, NULL, &dsk_reset, NULL, &dsk_attach, &dsk_detach,
&dsk_dib, DEV_DISABLE | DEV_DEBUG, 0, dev_debug,
NULL, NULL, &dsk_help, NULL, NULL, &dsk_description
};
// array for disc units (4) arm's positions (3 arms per unit)
struct armrec {
int current_disk, current_track; // current disk plate/track where the arm is positioned
int dest_disk, dest_track; // destination position where the arm should go
int cmd; // opcode being executed (OP_SDS, OP_RDS, OP_WDS)
t_int64 InitTime; // timestamp using global wordTime counter when operation starts
struct armmov {
int disk, track; // disk plate/track where the arm is positioned in this point of movement sequence
int msec; // time in msec arm stay in this position
} seq[1+100+50+100+1]; // sequeece of arm movement. If =0 -> end of sequence
} Arm[4][3];
int dsk_read_numeric_word(char * buf, t_int64 * d, int * ZeroNeg)
{
int i, neg;
char c;
neg = 0;
*d = 0;
if (ZeroNeg != NULL) *ZeroNeg = 0;
for (i=0;i<10;i++) {
c = *buf++;
if ((c < '0') || (c > '9')) c='0';
*d = *d * 10 + (c - '0');
}
if (*buf++ == '-') neg=1;
if (neg) *d = -*d;
if (ZeroNeg != NULL) *ZeroNeg = ((neg) && (*d == 0)) ? 1:0;
return 0;
}
void dsk_write_numeric_word(char * buf, t_int64 d, int ZeroNeg)
{
int i, neg;
char c;
neg = 0;
if (d < 0) {neg=1; d=-d;}
if (ZeroNeg) neg=1;
for (i=0;i<10;i++) {
c = Shift_Digits(&d,1) + '0';
*buf++ = c;
}
*buf++ = neg ? '-':'+';
}
// perform the operation (Read, Write) on RAMAC unit file
// init file if len=0 (flat format)
//
t_stat dsk_operation(int cmd, int unit, int arm, int disk, int track)
{
FILE *f;
int flen, i, ic, ZeroNeg;
char buf[DISK_SIZE+1];
t_int64 d;
char s[6];
// buf holds a full disk
if ((unit < 0) || (unit > 3)) return 0;
if ((arm < 0) || (arm > 2) ) return 0;
if ((disk < 0) || (disk > 99)) return 0;
if ((track < 0) || (track > 99)) return 0;
f = dsk_unit[unit].fileref; // get disk file from unit;
flen = sim_fsize(f);
if (flen == 0) {
// new file, fill it with blanks
memset(buf, 32, sizeof(buf)); // fill with space
for (i=1;i<1000;i++) buf[i*12*6-1]=13; // ad some cr lo allow text editor to vire ramac file
buf[sizeof(buf)-1]=0; // add string terminator
for(i=0;i<100;i++) sim_fwrite(buf, 1, DISK_SIZE, f);
}
sim_fseek(f, DISK_SIZE * disk, SEEK_SET);
sim_fread(buf, 1, DISK_SIZE, f); // read the entire disc (100 tracks)
ic = 12 * 60 * track; // ic is char at beginning of track
sim_debug(DEBUG_DETAIL, &cpu_dev, "... RAMAC file at fseek %d, ic %d\n", DISK_SIZE * disk, ic);
if (cmd==OP_RDS) {
for(i=0;i<60;i++) {
dsk_read_numeric_word(&buf[ic], &d, &ZeroNeg);
ic += 12; // 12 bytes per word
// store into IAS
IAS[i] = d;
IAS_NegativeZeroFlag[i] = ZeroNeg;
sim_debug(DEBUG_DETAIL, &cpu_dev, "... RAMAC to IAS %04d: %06d%04d%c '%s'\n",
i+9000, printfw(d,ZeroNeg),
word_to_ascii(s, 1, 5, d));
}
// set IAS_TimingRing. Nothing said in RAMAC manual, but needed to make supersoap CDD pseudo op work properly
IAS_TimingRing=0;
} else if (cmd==OP_WDS) {
for(i=0;i<60;i++) {
// read IAS
d = IAS[i];
ZeroNeg = IAS_NegativeZeroFlag[i];
sim_debug(DEBUG_DETAIL, &cpu_dev, "... IAS %04d to RAMAC: %06d%04d%c '%s'\n",
i+9000, printfw(d,ZeroNeg),
word_to_ascii(s, 1, 5, d));
// write numeric to disk buf
dsk_write_numeric_word(&buf[ic], d, ZeroNeg);
ic += 12;
}
// set IAS_TimingRing. Nothing said in RAMAC manual, but needed to make supersoap CDD pseudo op work properly
IAS_TimingRing=0;
// write back disk to ramac unit file
sim_fseek(f, DISK_SIZE * disk, SEEK_SET);
sim_fwrite(buf, 1, DISK_SIZE, f); // write the entire disc (100 tracks)
}
// don't know if Seek Opcode (SDS) also sets TimingRing to zero
return SCPE_OK;
}
// return 1 if disk unit n (0..3) and arm (0..2) is ready to receive a command
int dsk_ready(int unit, int arm)
{
if ((unit < 0) || (unit > 3)) return 0;
if ((arm < 0) || (arm > 2) ) return 0;
if (Arm[unit][arm].cmd == 0) return 1; // arm has no cmd to execute -> it is ready to receive new command
return 0;
}
void dsk_set_mov_seq(int unit,int arm)
{
// set arm movement sequence to its destination
//
// arm timing
// seek: 50 msec setup time
// on same disk:
// 2 msec per track in same disk (0-99)
// 25 msec sensing track gap (that identifies the start of track pos) a mean between 0-50 msec or
// to extract arm outside disk for arm to go to another disk
// going to another physical disk:
// 200 msec start arm vertical motion
// 9 msec per physical disk (0 to 49)
// 200 msec stop arm vertical motion
//
// read: 110 msec
// write: 135 msec
//
int cmd, nseq, i, d1, d2, dy, tr;
cmd = Arm[unit][arm].cmd;
nseq = 0;
// seek or read/write but current arm pos not the addr selected for
// read/write -> must do a seek cycle
if ((cmd == OP_SDS) ||
(Arm[unit][arm].current_disk != Arm[unit][arm].dest_disk) ||
(Arm[unit][arm].current_track != Arm[unit][arm].dest_track)) {
// start seek sequence at current arm pos
Arm[unit][arm].seq[nseq].disk = Arm[unit][arm].current_disk;
Arm[unit][arm].seq[nseq].track = tr = Arm[unit][arm].current_track;
Arm[unit][arm].seq[nseq++].msec = 50; // msec needed for seek setup time
// is arm already accessing physical destination disk?
if ((d1=(Arm[unit][arm].current_disk % 50)) != (d2=(Arm[unit][arm].dest_disk % 50))) {
// not yet, should move arm up or down
// is arm outside physical disk stack?
if (Arm[unit][arm].current_track >= 0) {
// not yet, should move arm outside physical disk (up to -1)
// move out arm track to track until outside of physical disk
for (i=Arm[unit][arm].current_track;i>=0;i--) {
Arm[unit][arm].seq[nseq].disk = Arm[unit][arm].current_disk;
Arm[unit][arm].seq[nseq].track = i;
Arm[unit][arm].seq[nseq++].msec = 2; // msec needed for horizontal arm movement of 1 track
}
}
// now arm is outside disk stack, can move up and down
Arm[unit][arm].seq[nseq].disk = Arm[unit][arm].current_disk;
Arm[unit][arm].seq[nseq].track = -1;
Arm[unit][arm].seq[nseq++].msec = 200; // msec needed to setup vertical arm movement
// move out up/down on disk stack up to destination disk
dy = (d1 < d2) ? +1:-1;
i = Arm[unit][arm].current_disk;
for (;;) {
if (i % 50 == d2) break;
Arm[unit][arm].seq[nseq].disk = i;
Arm[unit][arm].seq[nseq].track = -1;
Arm[unit][arm].seq[nseq++].msec = 9; // msec needed for vertical arm movement of 1 physical disk
i=i+dy;
}
// stop motion and select destination disk (not physical disk)
Arm[unit][arm].seq[nseq].disk = Arm[unit][arm].dest_disk;
Arm[unit][arm].seq[nseq].track = tr = -1;
Arm[unit][arm].seq[nseq++].msec = 200; // msec needed to stop vertical arm movement
}
// now arm accessing physical destination disk
// is arm at destination track?
if (tr != (d2=Arm[unit][arm].dest_track)) {
// not yet, should move arm horizontally
dy = (tr < d2) ? +1:-1;
for (;;) {
if (tr == d2) break;
Arm[unit][arm].seq[nseq].disk = Arm[unit][arm].dest_disk;
Arm[unit][arm].seq[nseq].track = tr;
Arm[unit][arm].seq[nseq++].msec = 2; // msec needed for horizontal arm movement of 1 track
tr=tr+dy;
}
}
// now arm is positioned on destination track, disk
// sense the track gap to finish seek operation
Arm[unit][arm].seq[nseq].disk = Arm[unit][arm].dest_disk;
Arm[unit][arm].seq[nseq].track = Arm[unit][arm].dest_track;
Arm[unit][arm].seq[nseq++].msec = 25; // msec needed for sensing track gap
}
// read operation
if (cmd == OP_RDS) {
Arm[unit][arm].seq[nseq].disk = Arm[unit][arm].dest_disk;
Arm[unit][arm].seq[nseq].track = Arm[unit][arm].dest_track;
Arm[unit][arm].seq[nseq++].msec = 110; // msec needed for reading entire track
} else if (cmd == OP_WDS) {
Arm[unit][arm].seq[nseq].disk = Arm[unit][arm].dest_disk;
Arm[unit][arm].seq[nseq].track = Arm[unit][arm].dest_track;
Arm[unit][arm].seq[nseq++].msec = 135; // msec needed for writing entire track
}
// set end of sequence
Arm[unit][arm].seq[nseq].disk = Arm[unit][arm].dest_disk;
Arm[unit][arm].seq[nseq].track = Arm[unit][arm].dest_track;
Arm[unit][arm].seq[nseq++].msec = 0; // end of sequence mark
}
/* Start off a RAMAC command */
uint32 dsk_cmd(int cmd, int32 addr, uint16 fast)
{
DEVICE *dptr;
UNIT *uptr;
int unit, disk, track, arm;
int time;
int bFastMode;
unit =(addr / 100000) % 10;
disk =(addr / 1000) % 100,
track=(addr / 10) % 100,
arm =(addr % 10);
time = 0;
/* Make sure addr unit number */
if ((unit > 3) || (unit < 0)) return STOP_ADDR;
if ((arm > 2) || (arm < 0)) return STOP_ADDR;
uptr = &dsk_unit[unit];
dptr = find_dev_from_unit(uptr);
// init IBM 652 Control Unit internal registers
bFastMode = fast;
/* If disk unit disabled return error */
if (uptr->flags & UNIT_DIS) {
sim_debug(DEBUG_EXP, dptr, "RAMAC command attempted on disabled unit %d\n", unit);
// not stated in manual: what happends if command to non existant disk?
// option 1 -> cpu halt (used this)
// option 2 -> indictor flag set
return STOP_IO;
}
/* If disk unit has no file attached return error */
if ((uptr->flags & UNIT_ATT) == 0) {
sim_debug(DEBUG_EXP, dptr, "RAMAC command attempted on unit %d that has no file attached\n", unit);
return STOP_IO;
}
// init arm operation
Arm[unit][arm].cmd = cmd; // the command to execute: can be OP_SDS, OP_RDS, OP_WDS
Arm[unit][arm].dest_disk = disk; // the destination address
Arm[unit][arm].dest_track = track;
sim_debug(DEBUG_CMD, dptr, "RAMAC unit %d, arm %d: %s on disk %d, track %d started\n",
unit, arm,
(cmd == OP_SDS) ? "SEEK" : (cmd == OP_RDS) ? "READ" : "WRITE",
Arm[unit][arm].dest_disk, Arm[unit][arm].dest_track);
if (bFastMode) {
time = 0; // no movement sequence. Just go to destination pos inmediatelly and exec command
Arm[unit][arm].InitTime = -1;
} else {
time = msec_to_wordtime(UPDATE_RAMAC); // sampling disk arm movement sequence each 10 msec
Arm[unit][arm].InitTime = GlobalWordTimeCount; // when the movement sequence starts (in word time counts)
// calculate the movement seqnece
dsk_set_mov_seq(unit,arm);
}
// schedule command execution
sim_cancel(uptr);
sim_activate(uptr, time);
return SCPE_OK_INPROGRESS;
}
/* Handle processing of disk requests. */
t_stat dsk_srv(UNIT * uptr)
{
DEVICE *dptr = find_dev_from_unit(uptr);
int unit = (uptr - dptr->units);
int time, msec, arm, cmd, nseq;
t_int64 InitTime;
int bSequenceInProgress=0;
int bFastMode;
t_stat r;
// init IBM 652 Control Unit internal registers
bFastMode = 0;
// update arm movement for this unit
for (arm=0;arm<3;arm++) {
cmd = Arm[unit][arm].cmd;
if (cmd == 0) continue; // RAMAC arm for this disk unit is stoped (=ready).
// continue to Process next arm of this unit
// arm in movement (=busy)
// calc time in msec elapsed from start of comand execution
InitTime=Arm[unit][arm].InitTime;
if (InitTime<0) {
bFastMode=1;
} else {
time=msec_elapsed(Arm[unit][arm].InitTime);
// examine sequence of arm movements to determine what is the current position
// or arm at this point of time
nseq=0;
for(;;) {
msec=Arm[unit][arm].seq[nseq].msec;
if (msec==0) break; // exit beacuse end of sequence
time=time-msec;
if (time<0) break; // exit beacuse we are at this point of sequence
nseq++;
}
if (time <0) {
// sequence not finisehd: set current arm pos
Arm[unit][arm].current_disk=Arm[unit][arm].seq[nseq].disk;
Arm[unit][arm].current_track=Arm[unit][arm].seq[nseq].track;
bSequenceInProgress=1; // there is an arm in movement
// arm not arrived to its destination yet. contiinue proceed with next arm
sim_debug(DEBUG_CMD, dptr, "RAMAC unit %d, arm %d: now at disk %d, track %d\n",
unit, arm,
Arm[unit][arm].current_disk, Arm[unit][arm].current_track);
continue;
}
}
// arm arrived to its destination position
Arm[unit][arm].current_disk=Arm[unit][arm].dest_disk;
Arm[unit][arm].current_track=Arm[unit][arm].dest_track;
// execute command
sim_debug(DEBUG_DETAIL, &cpu_dev, "... RAMAC unit %d, arm %d: %s on disk %d, track %d start execution \n",
unit, arm,
(cmd == OP_SDS) ? "SEEK" : (cmd == OP_RDS) ? "READ" : "WRITE",
Arm[unit][arm].dest_disk, Arm[unit][arm].dest_track);
r = dsk_operation(cmd, unit, arm, Arm[unit][arm].dest_disk, Arm[unit][arm].dest_track);
if (r != SCPE_OK) return STOP_IO;
// cmd execution finished, can free IAS interlock
sim_debug(DEBUG_DETAIL, &cpu_dev, "... RAMAC unit %d, arm %d: %s on disk %d, track %d finished\n",
unit, arm,
(cmd == OP_SDS) ? "SEEK" : (cmd == OP_RDS) ? "READ" : "WRITE",
Arm[unit][arm].dest_disk, Arm[unit][arm].dest_track);
if (((cmd==OP_RDS) || (cmd==OP_WDS)) && (InterLockCount[IL_IAS])) {
// remove IAS Interlock
InterLockCount[IL_IAS] = 0;
sim_debug(DEBUG_CMD, dptr, "RAMAC unit %d, arm %d: free IAS interlock\n", unit, arm);
}
// set arm as ready, so it can accept new commands
Arm[unit][arm].cmd = 0;
sim_debug(DEBUG_CMD, dptr, "RAMAC unit %d, arm %d READY\n", unit, arm);
}
// if there is any arm in movement, re-schedulle event
sim_cancel(uptr);
if (bSequenceInProgress) {
if (bFastMode) {
time = 0; // no movement sequence. Just go to destination pos inmediatelly and exec command
} else {
time = msec_to_wordtime(UPDATE_RAMAC); // sampling disk arm movement sequence each 10 msec
}
sim_activate(uptr, time);
}
return SCPE_OK;
}
void dsk_ini(UNIT * uptr, t_bool f)
{
DEVICE *dptr = find_dev_from_unit(uptr);
int unit = (uptr - dptr->units);
memset(&Arm[unit], 0, sizeof(Arm[unit])); // zeroes arm info for this unit
}
t_stat dsk_reset(DEVICE * dptr)
{
int i;
for (i = 0; i < 4; i++) {
dsk_ini(&dsk_unit[i], 0);
}
return SCPE_OK;
}
t_stat dsk_attach(UNIT * uptr, CONST char *file)
{
DEVICE *dptr = find_dev_from_unit(uptr);
int unit = (uptr - dptr->units);
t_stat r;
int flen;
if ((r = attach_unit(uptr, file)) != SCPE_OK) return r;
flen=sim_fsize(uptr->fileref);
if ((flen > 0) && (flen != DISK_SIZE * 100)) {
sim_messagef (SCPE_IERR, "Invalid RAMAC Unit file size\n");
detach_unit (uptr);
}
dsk_ini(uptr, 0);
return SCPE_OK;
}
t_stat dsk_detach(UNIT * uptr)
{
sim_cancel(uptr); // cancel any pending command
dsk_ini(uptr, 0);
return detach_unit (uptr); /* detach unit */
}
t_stat
dsk_help(FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, const char *cptr)
{
fprintf (st, "%s\n\n", dsk_description(dptr));
fprintf (st, "RAMAC Magnetic storage disk.\n\n");
fprint_set_help(st, dptr);
fprint_show_help(st, dptr);
return SCPE_OK;
}
const char *
dsk_description(DEVICE *dptr)
{
return "IBM 355 RAMAC Disk Storage Unit";
}

665
I650/i650_mt.c Normal file
View file

@ -0,0 +1,665 @@
/* i650_mt.c: IBM 650 Magnetic tape
Copyright (c) 2018, Roberto Sancho
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
ROBERTO SANCHO BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Magnetic tapes are represented as a series of variable records
of the form:
32b byte count
byte 0
byte 1
:
byte n-2
byte n-1
32b byte count
If the byte count is odd, the record is padded with an extra byte
of junk. File marks are represented by a byte count of 0.
*/
#include "i650_defs.h"
#include "sim_tape.h"
#define UNIT_MT UNIT_ATTABLE | UNIT_ROABLE | UNIT_DISABLE
/* in u3 is tape medium length used on current position */
/* in u4 is tape medium max length (28800 for 2400 ft reel) */
/* in u5 holds the command being executed by tape unit */
#define MT_CMDMSK 0x00FF /* Command being run */
#define MT_RDY 0x0100 /* Unit is ready for command */
#define MT_IND 0x0200 /* Unit has Indicator light on */
/* u6 holds the current buffer position */
/* Definitions */
uint32 mt_cmd(UNIT *, uint16, uint16);
t_stat mt_srv(UNIT *);
void mt_ini(UNIT *, t_bool);
t_stat mt_reset(DEVICE *);
t_stat mt_attach(UNIT *, CONST char *);
t_stat mt_detach(UNIT *);
t_stat mt_rew(UNIT * uptr, int32 val, CONST char *cptr,void *desc);
t_stat mt_set_len (UNIT *uptr, int32 val, CONST char *cptr, void *desc);
t_stat mt_show_len (FILE *st, UNIT *uptr, int32 val, CONST void *desc);
t_stat mt_help (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, const char *cptr);
const char *mt_description (DEVICE *dptr);
UNIT mt_unit[6] = {
{UDATA(&mt_srv, UNIT_MT, 0), 0}, /* 0 */
{UDATA(&mt_srv, UNIT_MT, 0), 0}, /* 1 */
{UDATA(&mt_srv, UNIT_MT, 0), 0}, /* 2 */
{UDATA(&mt_srv, UNIT_MT, 0), 0}, /* 3 */
{UDATA(&mt_srv, UNIT_MT, 0), 0}, /* 4 */
{UDATA(&mt_srv, UNIT_MT, 0), 0}, /* 5 */
};
MTAB mt_mod[] = {
{MTUF_WLK, 0, "write enabled", "WRITEENABLED", NULL, NULL, NULL, "Write ring in place"},
{MTUF_WLK, MTUF_WLK, "write locked", "LOCKED", NULL, NULL, NULL, "No write ring in place"},
{MTAB_XTD | MTAB_VUN, 0, "FORMAT", "FORMAT", &sim_tape_set_fmt, &sim_tape_show_fmt, NULL,
"Set/Display tape format (SIMH, E11, TPC, P7B)"},
{MTAB_XTD | MTAB_VUN, 0, "LENGTH", "LENGTH", &mt_set_len, &mt_show_len, NULL,
"Set tape medium length (50 to 10000 foot)" },
{MTAB_XTD | MTAB_VUN, 0, NULL, "REWIND", &mt_rew, NULL, NULL, "Rewind tape"},
{0}
};
DEVICE mt_dev = {
"MT", mt_unit, NULL, mt_mod,
6, 8, 15, 1, 8, 8,
NULL, NULL, &mt_reset, NULL, &mt_attach, &mt_detach,
&mt_dib, DEV_DISABLE | DEV_DEBUG, 0, dev_debug,
NULL, NULL, &mt_help, NULL, NULL, &mt_description
};
// IBM 652 Control Unit internal state
int LastTapeSelected = -1; // last tape selected. =0 to 5, -1=none yet
int LastTapeIndicator = 0; // last tape operation has some indication to tell to program/operator
int bFastMode = 0; // =1 for FAST operation
const char * TapeIndicatorStr[11] = { "OK",
"WRITE PROTECTED",
"IO CHECK",
"END OF FILE",
"END OF TAPE",
"LONG RECORD",
"SHORT RECORD",
"NO TAPE UNIT AT THIS ADDRESS",
"NO REEL LOADED",
"NOT READY",
"BAD CHAR"};
// return 1 if tape unit n (0..5) is ready to receive a command
int mt_ready(int n)
{
if ((n < 0) || (n > 5)) return 0;
if (mt_unit[n].u5 & MT_RDY) return 1;
return 0;
}
/* Rewind tape drive */
t_stat mt_rew(UNIT * uptr, int32 val, CONST char *cptr, void *desc)
{
/* If drive is offline or not attached return not ready */
if ((uptr->flags & UNIT_ATT) == 0)
return SCPE_NOATT;
uptr->u3 = 0; // tape at begin of medium
uptr->u5 = MT_RDY; // clear indicator flag, clear last command, set ready flag
return sim_tape_rewind(uptr);
}
int mt_read_numeric_word(uint8 * buf, t_int64 * d, int * ZeroNeg)
{
int i, neg;
char c;
neg = 0;
*d = 0;
if (ZeroNeg != NULL) *ZeroNeg = 0;
for (i=0;i<10;i++) {
c = *buf++;
if (i==9) { // is last word digit
if ((c >= '0') && (c <= '9')) return MT_IND_BADCHAR; // last digit should have sign
if (c == '?') c = '0'; // +0
if ((c >= 'A') && (c <= 'I')) c = c - 'A' + '1'; // +1 to +9
if ((c >= 'J') && (c <= 'R')) {c = c - 'J' + '1'; neg=1;} // -1 to -9
if (c == '!') {c = '0'; neg=1;} // -0
}
if ((c < '0') || (c > '9')) return MT_IND_BADCHAR;
*d = *d * 10 + (c - '0');
}
if (neg) *d = -*d;
if (ZeroNeg != NULL) *ZeroNeg = ((neg) && (*d == 0)) ? 1:0;
return 0;
}
int mt_read_alpha_word(uint8 * buf, t_int64 * d)
{
int i, n;
char c;
*d = 0;
for (i=0;i<5;i++) {
c = *buf++;
n = ascii_to_NN(c);
if ((n==0) && (c != ' ')) return MT_IND_BADCHAR;
*d = *d * 100 + n;
}
return 0;
}
int mt_transfer_tape_rec_to_IAS(uint8 * buf, t_mtrlnt reclen, char mode)
{
int n,ic,r, ZeroNeg;
t_int64 d, CtrlWord;
char s[6];
t_mtrlnt expected_reclen;
if (mode == 'N') {
// numeric mode
expected_reclen = (60 - IAS_TimingRing) * 10; // record len expected
// does expected record len match read record from tape?
if (expected_reclen != reclen) {
return (reclen > expected_reclen) ? MT_IND_LONG_REC : MT_IND_SHORT_REC;
}
// yes, record length match -> load IAS with tape record data
ic = 0;
while (1) {
// read numeric word from tape
r = mt_read_numeric_word(&buf[ic], &d, &ZeroNeg);
if (r) return r;
ic += 10;
// store into IAS
IAS[IAS_TimingRing] = d;
IAS_NegativeZeroFlag[IAS_TimingRing] = ZeroNeg;
sim_debug(DEBUG_DETAIL, &cpu_dev, "... Tape to IAS %04d: %06d%04d%c '%s'\n",
IAS_TimingRing+9000, printfw(d,ZeroNeg),
word_to_ascii(s, 1, 5, d));
// incr IAS_TimingRing, exit if arrived to end of IAS
IAS_TimingRing = (IAS_TimingRing + 1) % 60;
if (IAS_TimingRing == 0) break;
}
return 0;
}
// alphabetic mode
// check tape record size limits
if (reclen < 10 + 9*5) return MT_IND_SHORT_REC;
if (reclen > 10 + 9*10) return MT_IND_LONG_REC;
ic = 0;
while(1) {
// get control word
if (ic + 10 > (int)reclen) return MT_IND_SHORT_REC;
r = mt_read_numeric_word(&buf[ic], &CtrlWord, NULL);
if (r) return r;
ic += 10;
// store it in IAS[nnn9]
n = (IAS_TimingRing / 10) * 10 + 9;
IAS[n] = CtrlWord;
IAS_NegativeZeroFlag[n] = 0;
// load rest of words
for (n=0;n<9;n++) {
if ((CtrlWord % 10) != 8) {
// read a numeric word form tape
if (ic + 10 > (int)reclen) return MT_IND_SHORT_REC;
r = mt_read_numeric_word(&buf[ic], &d, &ZeroNeg);
if (r) return r;
ic += 10;
} else {
// read alphanumeric word from tape
if (ic + 5 > (int)reclen) return MT_IND_SHORT_REC;
r = mt_read_alpha_word(&buf[ic], &d); ZeroNeg=0;
if (r) return r;
ic += 5;
}
CtrlWord = CtrlWord / 10;
// store into IAS
IAS[IAS_TimingRing] = d;
IAS_NegativeZeroFlag[IAS_TimingRing] = ZeroNeg;
sim_debug(DEBUG_DETAIL, &cpu_dev, "... Tape to IAS %04d: %06d%04d%c '%s'\n",
IAS_TimingRing+9000, printfw(d,ZeroNeg),
word_to_ascii(s, 1, 5, d));
// incr IAS_TimingRing, exit if arrived to end of IAS
IAS_TimingRing = (IAS_TimingRing + 1) % 60;
if (IAS_TimingRing == 0) return MT_IND_LONG_REC;
}
IAS_TimingRing = (IAS_TimingRing + 1) % 60; // skip control word
if ((IAS_TimingRing == 0) && (ic != reclen)) return MT_IND_LONG_REC;
if (ic == reclen) {
if (IAS_TimingRing != 0) return MT_IND_SHORT_REC;
break;
}
}
return 0;
}
void mt_write_numeric_word(uint8 * buf, t_int64 d, int ZeroNeg)
{
int i, neg;
char c;
neg = 0;
if (d < 0) {neg=1; d=-d;}
if (ZeroNeg) neg=1;
for (i=0;i<10;i++) {
c = Shift_Digits(&d,1) + '0';
if (i==9) {
if (neg==0) { // last digit has sign
if (c == '0') c = '?'; // +0
if ((c >= '1') && (c <= '9')) c = c - '1' + 'A'; // +1 to +9
} else {
if ((c >= '1') && (c <= '9')) {c = c - '1' + 'J';} // -1 to -9
if (c == '0') {c = '!';} // -0
}
}
*buf++ = c;
}
}
void mt_write_alpha_word(uint8 * buf, t_int64 d)
{
int i, n;
char c;
for (i=0;i<5;i++) {
n = Shift_Digits(&d,2);
c = mem_to_ascii[n];
*buf++ = c;
}
}
void mt_transfer_IAS_to_tape_rec(uint8 * buf, t_mtrlnt * reclen, char mode)
{
int n,ic,ZeroNeg;
t_int64 d, CtrlWord;
char s[6];
if (mode == 'N') {
// numeric mode
ic = 0;
while (1) {
// read IAS
d = IAS[IAS_TimingRing];
ZeroNeg = IAS_NegativeZeroFlag[IAS_TimingRing];
sim_debug(DEBUG_DETAIL, &cpu_dev, "... IAS %04d to Tape: %06d%04d%c '%s'\n",
IAS_TimingRing+9000, printfw(d,ZeroNeg),
word_to_ascii(s, 1, 5, d));
// write numeric to tape buf
mt_write_numeric_word(&buf[ic], d, ZeroNeg);
ic += 10;
// incr IAS_TimingRing, exit if arrived to end of IAS
IAS_TimingRing = (IAS_TimingRing + 1) % 60;
if (IAS_TimingRing == 0) break;
}
*reclen = (t_mtrlnt) ic;
return;
}
// alphabetic mode
ic = 0;
while(1) {
// get control word form IAS[nnn9]
n = (IAS_TimingRing / 10) * 10 + 9;
CtrlWord = IAS[n];
// write control word in tape buf
mt_write_numeric_word(&buf[ic], CtrlWord, 0);
ic += 10;
// write rest of words
for (n=0;n<9;n++) {
// read from IAS
d = IAS[IAS_TimingRing];
ZeroNeg = IAS_NegativeZeroFlag[IAS_TimingRing];
if ((CtrlWord % 10) != 8) {
// write a numeric word to tape buf
mt_write_numeric_word(&buf[ic], d, ZeroNeg);
ic += 10;
} else {
// write alphanumeric word to tape buf
mt_write_alpha_word(&buf[ic], d);
ic += 5;
}
CtrlWord = CtrlWord / 10;
// incr IAS_TimingRing, exit if arrived to end of IAS
IAS_TimingRing = (IAS_TimingRing + 1) % 60;
if (IAS_TimingRing == 0) break;
}
if (IAS_TimingRing == 0) break;
IAS_TimingRing = (IAS_TimingRing + 1) % 60; // skip control word
if (IAS_TimingRing == 0) break;
}
*reclen = (t_mtrlnt) ic;
}
/* Start off a mag tape command */
uint32 mt_cmd(UNIT * uptr, uint16 cmd, uint16 fast)
{
DEVICE *dptr = find_dev_from_unit(uptr);
int unit = uptr - &mt_unit[0];
int i, ic, time;
t_stat r;
uint8 buf[1024];
char cbuf[100];
t_mtrlnt reclen;
time = 0;
/* Make sure valid drive number */
if ((unit > 5) || (unit < 0)) return STOP_ADDR;
// init IBM 652 Control Unit internal registers
LastTapeSelected = unit;
LastTapeIndicator = 0;
bFastMode = fast;
/* If tape unit disabled return error */
if (uptr->flags & UNIT_DIS) {
sim_debug(DEBUG_EXP, dptr, "Tape %d: command %02d attempted on disabled tape\n", unit, cmd);
LastTapeIndicator = MT_IND_DIS;
// not stated in manual: what happends if command to non existant tape?
// option 1 -> cpu halt
// option 2 -> tape indictor flag set (used this)
return SCPE_OK;
}
/* If tape has no file attached return error */
if ((uptr->flags & UNIT_ATT) == 0) {
sim_debug(DEBUG_EXP, dptr, "Tape %d: command %02d attempted on tape without file attached\n", unit, cmd);
LastTapeIndicator = MT_IND_NOATT;
uptr->u5 |= MT_IND; // turn on tape indicator light to signal to operator the faulting tape
return SCPE_OK;
}
uptr->u5 &= ~(MT_CMDMSK | MT_RDY | MT_IND); // remove last command sent to tape, remove ready flag, remove tape indicator flag
uptr->u5 |= cmd; // set current command in execution
switch (cmd) {
case OP_RTC:
case OP_RTA:
case OP_RTN:
sim_debug(DEBUG_DATA, dptr, "Tape unit %d: init read\n", unit);
// actual simulated tape read
reclen = 0;
r = sim_tape_rdrecf(uptr, buf, &reclen, sizeof(buf));
// calc tape pos:
// each char uses 0,005 inches. at the end of record the IRG (inter gap record) uses 3/4 inchs (0.75)
// scaled x1000 to use integer values
uptr->u3 += (int32) ((reclen * 0.005 + 0.75) * 1000);
// process result conditions
if (r == MTSE_TMK) {
sim_debug(DEBUG_EXP, dptr, "Tape unit %d: tape mark sensed\n", unit);
LastTapeIndicator = MT_IND_EOF;
uptr->u5 |= MT_IND;
} else if ((r == MTSE_EOM) || (uptr->u3 > uptr->u4*1000)) {
sim_debug(DEBUG_EXP, dptr, "Tape unit %d: end of tape sensed\n", unit);
LastTapeIndicator = MT_IND_EOT;
uptr->u5 |= MT_IND;
} else if (r == MTSE_RECE) {
// record header contains error flag
sim_debug(DEBUG_EXP, dptr, "Tape unit %d: longitudinal or vertical check error\n", unit);
LastTapeIndicator = MT_IND_IOCHECK;
uptr->u5 |= MT_IND;
} else if (r != MTSE_OK) {
sim_debug(DEBUG_EXP, dptr, "Tape unit %d: read error %d\n", unit, r);
return STOP_IO;
}
// debug output: display buf as 50 chars per line
sim_debug(DEBUG_DETAIL, dptr, "Read record (%d chars) from tape:\n", (int) reclen);
ic = 0;
while (1) {
for (i=0;i<50;i++) {
cbuf[i] = 0;
if (ic == reclen) break;
cbuf[i] = buf[ic++];
}
sim_debug(DEBUG_DETAIL, dptr, "... '%s'\n", cbuf);
if (ic == reclen) break;
}
// calc wordcount time needed to finish tape operation
time = msec_to_wordtime(11 + reclen * 0.068);
// transfer read data to IAS
if ((cmd != OP_RTC) && (LastTapeIndicator == 0)) {
LastTapeIndicator = mt_transfer_tape_rec_to_IAS(buf, reclen, (cmd == OP_RTN) ? 'N':'A');
if (LastTapeIndicator) {
sim_debug(DEBUG_EXP, dptr, "Tape unit %d: decode error %s\n", unit, TapeIndicatorStr[LastTapeIndicator]);
uptr->u5 |= MT_IND;
}
}
break;
case OP_WTM:
case OP_WTA:
case OP_WTN:
sim_debug(DEBUG_CMD, dptr, "Tape unit %d: init write\n", unit);
if (cmd == OP_WTM) {
r = sim_tape_wrtmk(uptr);
// calc tape pos:
uptr->u3 += (int32) ((1 * 0.005 + 0.75) * 1000);
sim_debug(DEBUG_DETAIL, dptr, "Write Tape Mark\n");
} else {
sim_debug(DEBUG_DETAIL, dptr, "IAS TimingRing is %d\n", IAS_TimingRing+9000);
mt_transfer_IAS_to_tape_rec(buf, &reclen, (cmd == OP_WTN) ? 'N':'A');
// actual simulated tape write
r = sim_tape_wrrecf(uptr, buf, reclen);
// calc tape pos:
uptr->u3 += (int32) ((reclen * 0.005 + 0.75) * 1000);
// debug output: display buf as 50 chars per line
sim_debug(DEBUG_DETAIL, dptr, "Write record (%d chars) to tape:\n", (int) reclen);
ic = 0;
while (1) {
for (i=0;i<50;i++) {
cbuf[i] = 0;
if (ic == reclen) break;
cbuf[i] = buf[ic++];
}
sim_debug(DEBUG_DETAIL, dptr, "... '%s'\n", cbuf);
if (ic == reclen) break;
}
sim_debug(DEBUG_DETAIL, dptr, " IAS TimingRing is %d\n", IAS_TimingRing+9000);
}
// process result conditions
if (r == MTSE_WRP) {
LastTapeIndicator = MT_IND_WRT_PROT;
uptr->u5 |= MT_IND;
} else if ((r == MTSE_EOM) || (uptr->u3 > uptr->u4*1000)) {
LastTapeIndicator = MT_IND_EOT;
uptr->u5 |= MT_IND;
} else if (r != MTSE_OK) {
sim_debug(DEBUG_EXP, dptr, "Tape unit %d: write error %d\n", unit, r);
return STOP_IO;
}
// calc wordcount time needed
time = msec_to_wordtime(11 + reclen * 0.068); // time to remove Tape Control interlock
break;
case OP_BST:
case OP_RWD:
/* Check if at load point, quick return if so */
if (sim_tape_bot(uptr)) {
sim_debug(DEBUG_CMD, dptr, "Tape unit %d: at BOT\n", unit);
uptr->u5 |= MT_RDY;
uptr->u3 = 0;
return SCPE_OK;
}
if (cmd == OP_RWD) {
sim_debug(DEBUG_CMD, dptr, "Tape unit %d: init rewind\n", unit);
sim_tape_rewind(uptr);
uptr->u3 = 0;
time = msec_to_wordtime(35); // 35 msec to remove Tape Control interlock
}
if (cmd == OP_BST) {
sim_debug(DEBUG_CMD, dptr, "Tape unit %d: init backstep record\n", unit);
r = sim_tape_sprecr(uptr, &reclen);
if ((r != MTSE_OK) && (r != MTSE_TMK)) {
return r;
}
uptr->u3 -= (int32) ((reclen * 0.005 + 0.75) * 1000);
time = msec_to_wordtime(38.5 + reclen * 0.068); // time to remove Tape Control interlock
}
break;
default:
sim_debug(DEBUG_EXP, dptr, "Tape %d: unknown command %02d\n", unit, cmd);
// should never occurs. just to catch it if so.
}
if (bFastMode) time = 0;
sim_cancel(uptr);
sim_activate(uptr, time);
return SCPE_OK_INPROGRESS;
}
/* Handle processing of tape requests. */
t_stat mt_srv(UNIT * uptr)
{
DEVICE *dptr = find_dev_from_unit(uptr);
int unit = (uptr - dptr->units);
int cmd = uptr->u5 & MT_CMDMSK;
int time;
switch (cmd) {
case OP_RTC:
case OP_RTA:
case OP_RTN:
case OP_WTM:
case OP_WTA:
case OP_WTN:
if (InterLockCount[IL_Tape]) {
// remove Tape Control Interlock
InterLockCount[IL_Tape] = 0;
sim_debug(DEBUG_CMD, dptr, "Tape unit %d: free TCI interlock\n", unit);
}
if (InterLockCount[IL_IAS]) {
// remove IAS Interlock
InterLockCount[IL_IAS] = 0;
sim_debug(DEBUG_CMD, dptr, "Tape unit %d: free IAS interlock\n", unit);
}
// command finished
goto tape_done;
break;
case OP_BST:
case OP_RWD:
if (InterLockCount[IL_Tape]) {
// remove Tape Control Interlock
InterLockCount[IL_Tape] = 0;
sim_debug(DEBUG_CMD, dptr, "Tape unit %d: free TCI interlock\n", unit);
// calculate end of backspace/rew time
if (cmd == OP_BST) {
time = msec_to_wordtime(38.5 + 22);
} else {
// max time to rew is 1.2 minutes.
// get a rought aprox on % medium used (not exacta as not taking into account Hi/low speed rew)
time = (int) ((uptr->u3 / (uptr->u4*1000.0))*1.2*60+1); // number of seconds
time = msec_to_wordtime(time * 1000); // number of word times
}
if (bFastMode) time = 0;
sim_cancel(uptr);
sim_activate(uptr, time);
} else {
// command finished
goto tape_done;
}
break;
default:
return SCPE_ARG; // should never occurs. just to catch it if so.
tape_done:
sim_debug(DEBUG_CMD, dptr, "Tape unit %d: ready\n", unit);
sim_debug(DEBUG_DETAIL, &cpu_dev, "... Tape %d done, used %4.2f%% of medium\n",
unit,
(uptr->u3 / (uptr->u4*1000.0))*100.0
);
// set unit ready to accept new commands
uptr->u5 |= MT_RDY;
break;
}
return SCPE_OK;
}
void mt_ini(UNIT * uptr, t_bool f)
{
if (uptr->flags & UNIT_ATT) {
uptr->u5 = MT_RDY;
} else {
uptr->u5 = 0;
}
uptr->u3 = 0;
if (uptr->u4 == 0) uptr->u4 = 28800; // default 2400 ft reel; 1 foot = 12 inches; 2400 ft = 28800 inches
}
t_stat mt_reset(DEVICE * dptr)
{
int i;
for (i = 0; i < 6; i++) {
mt_ini(&mt_unit[i], 0);
}
return SCPE_OK;
}
t_stat mt_attach(UNIT * uptr, CONST char *file)
{
t_stat r;
if ((r = sim_tape_attach(uptr, file)) != SCPE_OK)
return r;
uptr->u3 = 0;
uptr->u5 = MT_RDY;
return SCPE_OK;
}
t_stat mt_detach(UNIT * uptr)
{
uptr->u3 = 0;
uptr->u5 = 0;
sim_cancel(uptr); // cancel any pending command
return sim_tape_detach(uptr);
}
/* Set tape length */
t_stat mt_set_len (UNIT *uptr, int32 val, CONST char *cptr, void *desc)
{
int len;
t_stat r;
if ((cptr == NULL) || (*cptr == 0)) return SCPE_ARG;
len = (int) get_uint (cptr, 10, 10000, &r);
if (r != SCPE_OK) return SCPE_ARG;
if (len < 50) return SCPE_ARG;
uptr->u4 = 28800 * len / 2400;
return SCPE_OK;
}
/* Show tape length */
t_stat mt_show_len (FILE *st, UNIT *uptr, int32 val, CONST void *desc)
{
fprintf (st, "length %d foot", uptr->u4 * 2400 / 28800);
return SCPE_OK;
}
t_stat
mt_help(FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, const char *cptr)
{
fprintf (st, "%s\n\n", mt_description(dptr));
fprintf (st, "The magnetic tape assumes that all tapes are 7 track\n");
fprintf (st, "with valid parity. Tapes are assumed to be 200 characters per\n");
fprintf (st, "inch. \n\n");
sim_tape_attach_help (st, dptr, uptr, flag, cptr);
fprint_set_help(st, dptr);
fprint_show_help(st, dptr);
return SCPE_OK;
}
const char *
mt_description(DEVICE *dptr)
{
return "IBM 727 Magnetic tape unit";
}

264
I650/i650_sys.c
View file

@ -45,15 +45,17 @@ DEVICE *sim_devices[] = {
&cpu_dev,
&cdr_dev,
&cdp_dev,
//XXX &mta_dev,
&mt_dev,
&dsk_dev,
NULL
};
/* Device addressing words */
DIB cdr_dib = { 1, &cdr_cmd, NULL };
DIB cdr_dib = { 3, &cdr_cmd, NULL };
DIB cdp_dib = { 3, &cdp_cmd, NULL };
//XXX DIB mt_dib = { CH_TYP_76XX, NUM_UNITS_MT, 0000, 0000, &mt_cmd, &mt_ini };
DIB mt_dib = { 5, &mt_cmd, &mt_ini };
DIB dsk_dib = { 4, &mt_cmd, &dsk_ini };
/* Simulator stop codes */
const char *sim_stop_messages[] = {
@ -61,7 +63,7 @@ const char *sim_stop_messages[] = {
"HALT instruction",
"Breakpoint",
"Unknown Opcode",
"Card Read/Punch Error",
"I/O Error",
"Programmed Stop",
"Overflow",
"Opcode Execution Error",
@ -99,7 +101,11 @@ DEBTAB crd_debug[] = {
// simulator available IBM 533 wirings
struct card_wirings wirings[] = {
{WIRING_8WORD, "8WORD"},
{WIRING_RA, "RA"},
{WIRING_FDS, "FDS"},
{WIRING_SOAP, "SOAP"},
{WIRING_SOAPA, "SOAPA"},
{WIRING_SUPERSOAP, "SUPERSOAP"},
{WIRING_IS, "IS"},
{WIRING_IT, "IT"},
{WIRING_FORTRANSIT, "FORTRANSIT"},
@ -169,19 +175,40 @@ uint16 ascii_to_hol[128] = {
0xC04, 0xC02, 0xC01, 0x680, 0x640, 0x620, 0x610, 0x608,
/* x y z { | } ~ del */
/* Y78 X78 78 79 */
0x604, 0x602, 0x601, 0x406, 0x806,0x0006,0x0005,0xf000
0x604, 0x602, 0x601, 0x406, 0x806, 0x006, 0x005,0xf000
};
uint16 sim_ascii_to_hol(char c)
{
return ascii_to_hol[c & 127];
}
char sim_hol_to_ascii(uint16 hol)
{
int c;
hol = hol & 0x0fff; // ignore extra high bits, if any
if (hol == 0xa00) return '?'; // +0
if (hol == 0x600) return '!'; // -0
for (c=31;c<127;c++) {
if (ascii_to_hol[c] == hol) {
// take in consideration the aliases between hol and ascii to return
// char as for 026 FORT charset
// hol = 0x022 -> 8-4 punches -> "-" or "'" or "@". Must be "-"
// hol = 0x222 -> 0-8-4 punches -> "(" or "%". Must be "("
if (c == '%') {c = '(';} else
if (c == '@') {c = '-';} else
if (c == '\'') {c = '-';};
return c;
}
}
return '~';
}
/* Initialize vm */
void
vm_init(void) {
int i;
static int initialized = 0;
if (initialized)
return;
initialized = 1;
// Initialize vm memory to all plus zero
for(i = 0; i < MAXDRUMSIZE; i++) DRUM[i] = DRUM_NegativeZeroFlag[i] = 0;
for(i = 0; i < 60; i++) IAS[i] = IAS_NegativeZeroFlag[i] = 0;
@ -191,6 +218,8 @@ vm_init(void) {
}
void (*sim_vm_init) (void) = &vm_init;
/* Load a card image file into memory. */
t_stat
@ -203,17 +232,17 @@ sim_load(FILE * fileref, CONST char *cptr, CONST char *fnam, int flag)
/* Opcodes */
t_opcode base_ops[100] = {
// opcode name soap name R/W? option Valid Data Address
// opcode name soap name R/W? option Valid Data Address Interlock
{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_RTC, "RCT", "RTC", 0, opCntrlUnit, vda_T, IL_Tape_and_Unit},
{OP_RTN, "RT", "RTN", 0, opCntrlUnit, vda_T, IL_Tape_and_Unit_and_IAS},
{OP_RTA, "RAT", "RTA", 0, opCntrlUnit, vda_T, IL_Tape_and_Unit_and_IAS},
{OP_WTN, "WT", "WTN", 0, opCntrlUnit, vda_T, IL_Tape_and_Unit_and_IAS},
{OP_WTA, "WAT", "WTA", 0, opCntrlUnit, vda_T, IL_Tape_and_Unit_and_IAS},
{OP_LIB, "LBB", "LIB", 0, opStorUnit, vda_D, IL_IAS},
{OP_LDI, "LB", "LDI", 0, opStorUnit, vda_D, IL_IAS},
{OP_AU, "AU", "AUP", opReadDA, 0, vda_DAIS},
{OP_SU, "SU", "SUP", opReadDA, 0, vda_DAIS},
@ -231,7 +260,7 @@ t_opcode base_ops[100] = {
{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_NTS, "BNTS", "NTS", 0, opCntrlUnit, vda_DAIS, IL_Tape},
{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},
@ -263,17 +292,17 @@ t_opcode base_ops[100] = {
{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_NEF, "BRNEF", "NEF", 0, opCntrlUnit, vda_DAIS, IL_Tape},
{OP_RWD, "RWD", "RWD", 0, opCntrlUnit, vda_T, IL_Tape_and_Unit},
{OP_WTM, "WTM", "WTM", 0, opCntrlUnit, vda_T, IL_Tape_and_Unit},
{OP_BST, "BSP", "BST", 0, opCntrlUnit, vda_T, IL_Tape_and_Unit},
{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_TLE, "TLE", "TLE", 0, opTLE, vda_DS},
{OP_DIVRU, "DIVRU", "DVR", opReadDA, 0, vda_DAIS},
{OP_RAL, "RAL", "RAL", opReadDA, 0, vda_DAIS},
{OP_RSL, "RSL", "RSL", opReadDA, 0, vda_DAIS},
@ -287,9 +316,9 @@ t_opcode base_ops[100] = {
{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_RD3, "RDPRT", "RD3", 0, opStorUnit, vda_DS, IL_RD23},
{OP_WR3, "PRT", "WR3", 0, opStorUnit, vda_DS, IL_WR23},
{OP_RC3, "RCPRT", "RC3", 0, opStorUnit, vda_DS, IL_RD23},
{OP_RPY, "RPY", "RPY", 0, opCntrlUnit, vda_D},
{OP_RAA, "RAA", "RAA", 0, opStorUnit, vda_DAS},
@ -297,9 +326,9 @@ t_opcode base_ops[100] = {
{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_SDS, "SDS", "SDS", 0, opCntrlUnit, vda_9000, IL_RamacUnit_and_Arm},
{OP_RDS, "RDS", "RDS", 0, opCntrlUnit, vda_9000, IL_RamacUnit_and_Arm_and_IAS},
{OP_WDS, "WDS", "WDS", 0, opCntrlUnit, vda_9000, IL_RamacUnit_and_Arm_and_IAS},
{OP_RAC, "RAC", "RAC", 0, opStorUnit, vda_DAS},
{OP_RSC, "RSC", "RSC", 0, opStorUnit, vda_DAS},
@ -626,6 +655,8 @@ int Shift_Digits(t_int64 * d, int nDigits)
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 cound is 5cd, file2 received 5 words-per-load-card deck
if file2 has no cards, it is deleted.
<file1> first destination deck file
<file2> second destination deck file
@ -677,18 +708,11 @@ int Shift_Digits(t_int64 * d, int nDigits)
t_stat deck_load(CONST char *fn, uint16 * DeckImage, int * nCards)
{
UNIT * uptr = &cdr_unit[0];
struct _card_data *data;
uint16 image[80];
t_stat r, r2;
int i, convert_to_ascii;
int i;
uint16 c;
if (*nCards < 0) {
*nCards = 0;
convert_to_ascii = 1;
} else {
convert_to_ascii = 0;
}
// set flags for read only
uptr->flags |= UNIT_RO;
@ -698,20 +722,21 @@ t_stat deck_load(CONST char *fn, uint16 * DeckImage, int * nCards)
// read all cards from file
while (1) {
if (*nCards >= MAX_CARDS_IN_DECK) {
r = sim_messagef (SCPE_IERR, "Too many cards\n");
break;
}
r = sim_read_card(uptr);
if (r == SCPE_EOF) {
r = SCPE_OK; break; // normal termination on card file read finished
} else if (r != SCPE_OK) break; // abnormal termination on error
data = (struct _card_data *)uptr->up7;
r = sim_read_card(uptr, image);
if ((r == CDSE_EOF) || (r == CDSE_EMPTY)) {
r = SCPE_OK; break; // normal termination on card file read finished
} else if (r != CDSE_OK) {
break; // abnormal termination on error
}
// add card read to deck
for (i=0; i<80; i++) {
c = data->image[i];
if (convert_to_ascii) c = data->hol_to_ascii[c];
DeckImage[*nCards * 80 + i] = c;
c = image[i];
DeckImage[*nCards * 80 + i] = c & 0xFFF;
}
*nCards = *nCards + 1;
}
@ -729,7 +754,7 @@ t_stat deck_load(CONST char *fn, uint16 * DeckImage, int * nCards)
t_stat deck_save(CONST char *fn, uint16 * DeckImage, int card, int nCards)
{
UNIT * uptr = &cdr_unit[0];
struct _card_data *data;
uint16 image[80];
t_stat r;
int i,nc;
@ -748,12 +773,11 @@ t_stat deck_save(CONST char *fn, uint16 * DeckImage, int card, int nCards)
break;
}
data = (struct _card_data *)uptr->up7;
// read card from deck
for (i=0; i<80; i++) data->image[i] = DeckImage[(nc + card) * 80 + i];
for (i=0; i<80; i++) image[i] = DeckImage[(nc + card) * 80 + i];
r = sim_punch_card(uptr, NULL);
if (r != SCPE_OK) break; // abnormal termination on error
r = sim_punch_card(uptr, image);
if (r != CDSE_OK) break; // abnormal termination on error
}
// deattach file from cdr unit 0
@ -768,11 +792,13 @@ void deck_print_echo(uint16 * DeckImage, int nCards, int bPrint, int bEcho)
{
char line[81];
int i,c,nc;
uint16 hol;
for (nc=0; nc<nCards; nc++) {
// read card, check and, store in line
for (i=0;i<80;i++) {
c = DeckImage[nc * 80 + i];
hol = DeckImage[nc * 80 + i];
c = sim_hol_to_ascii(hol);
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
@ -795,6 +821,8 @@ void deck_print_echo(uint16 * DeckImage, int nCards, int bPrint, int bEcho)
}
// carddeck split <count> <dev|file0> <file1> <file2>
// carddeck split 5CD <dev|file0> <file1> <file2>
// carddeck split PAT <dev|file0> <file1> <file2>
static t_stat deck_split_cmd(CONST char *cptr)
{
char fn0[4*CBUFSIZE];
@ -805,6 +833,8 @@ static t_stat deck_split_cmd(CONST char *cptr)
DEVICE *dptr;
UNIT *uptr;
t_stat r;
int bSplit5CD = 0;
int bSplitPAT = 0;
uint16 DeckImage[80 * MAX_CARDS_IN_DECK];
int nCards, nCards1, tail;
@ -816,10 +846,20 @@ static t_stat deck_split_cmd(CONST char *cptr)
} else {
tail = 0;
}
nCards1 = 0;
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");
if ((tail == 0) && (strlen(gbuf) == 3) && (strncmp(gbuf, "5CD", 3) == 0)) {
// split 5-words per card load cards fron deck
bSplit5CD = 1;
} else if ((tail == 0) && (strlen(gbuf) == 3) && (strncmp(gbuf, "PAT", 3) == 0)) {
// split availability table load cards fron deck
bSplitPAT = 1;
} else {
//
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");
}
get_glyph (cptr, gbuf, 0); // get dev param
cptr = get_glyph_quoted (cptr, fn0, 0); // re-read using get_glyph_quoted to do not
@ -861,6 +901,104 @@ static t_stat deck_split_cmd(CONST char *cptr)
cptr = get_glyph_quoted (cptr, fn2, 0); // get next param: filename 2
if (fn2[0] == 0) return sim_messagef (SCPE_ARG, "Missing second filename\n");
if (bSplit5CD ) {
// separate 5cd deck
uint16 DeckImage1[80 * MAX_CARDS_IN_DECK];
uint16 DeckImage2[80 * MAX_CARDS_IN_DECK];
int i, nc, nc1, nc2, bFound;
uint16 hol;
nc1 = nc2 = 0;
for (nc=0; nc<nCards; nc++) {
// determnine type of load card: is regular 1 word per card or 5 words per card
bFound = 0; // soap4 5cd cards have non blanks cols 11 to 17
for (i=10;i<16;i++) { // soap4 5cd also col 1 = "0" and col2 = "1"
hol = DeckImage[nc * 80 + i];
if (hol != 0) bFound++;
}
if (bSplit5CD) {
if ((DeckImage[nc * 80 + 0] != 0x200) || (DeckImage[nc * 80 + 1] != 0x100)) bFound = 0;
} else {
if ((DeckImage[nc * 80 + 0] != 0x200) || (DeckImage[nc * 80 + 1] != 0x200)) bFound = 0;
}
hol=0;
for (i=0;i<6;i++) {
if (DeckImage[nc * 80 + i] == 0x002) hol++;
}
if (hol==6) bFound = 6; // supersoap fiv cards starts with six 8's
bFound = (bFound == 6) ? 1:0; // is a 5 words-per-card load card?
// store in appropiate output deck
for (i=0;i<80;i++) {
hol = DeckImage[nc * 80 + i];
if (bFound==0) {
DeckImage1[nc1 * 80 + i] = hol;
} else {
DeckImage2[nc2 * 80 + i] = hol;
}
}
if (bFound==0) {
nc1++;
} else {
nc2++;
}
}
// save output decks
r = deck_save(fn1, DeckImage1, 0, nc1);
if (r != SCPE_OK) return sim_messagef (r, "Cannot write destination deck1 (%s)\n", fn0);
r = deck_save(fn2, DeckImage2, 0, nc2);
if (r != SCPE_OK) return sim_messagef (r, "Cannot write destination deck2 (%s)\n", fn0);
if (nc2 == 0) remove(fn2); // delete file2 if empty
if ((sim_switches & SWMASK ('Q')) == 0) {
sim_messagef (SCPE_OK, "Deck with 5 words-per-card splitted %d/%d cards\n", nc1, nc2);
}
return SCPE_OK;
}
if (bSplitPAT) {
// separate pat deck
uint16 DeckImage1[80 * MAX_CARDS_IN_DECK];
uint16 DeckImage2[80 * MAX_CARDS_IN_DECK];
int i, nc, nc1, nc2, bFound;
uint16 hol;
nc1 = nc2 = 0;
for (nc=0; nc<nCards; nc++) {
// PAT table has 8 words with hi punch on last digit
bFound = 0;
for (i=1;i<=8;i++) {
hol = DeckImage[nc * 80 + i*10-1];
if (hol & 0x800) bFound++;
}
bFound = (bFound == 8) ? 1:0; // is an availability table load card?
// store in appropiate output deck
for (i=0;i<80;i++) {
hol = DeckImage[nc * 80 + i];
if (bFound==0) {
DeckImage1[nc1 * 80 + i] = hol;
} else {
DeckImage2[nc2 * 80 + i] = hol;
}
}
if (bFound==0) {
nc1++;
} else {
nc2++;
}
}
// save output decks
r = deck_save(fn1, DeckImage1, 0, nc1);
if (r != SCPE_OK) return sim_messagef (r, "Cannot write destination deck1 (%s)\n", fn0);
r = deck_save(fn2, DeckImage2, 0, nc2);
if (r != SCPE_OK) return sim_messagef (r, "Cannot write destination deck2 (%s)\n", fn0);
if (nc2 == 0) remove(fn2); // delete file2 if empty
if ((sim_switches & SWMASK ('Q')) == 0) {
sim_messagef (SCPE_OK, "Deck with availability-card splitted %d/%d cards\n", nc1, nc2);
}
return SCPE_OK;
}
// split based on card count
r = deck_save(fn1, DeckImage, 0, nCards1);
if (r != SCPE_OK) return sim_messagef (r, "Cannot write destination deck1 (%s)\n", fn0);
@ -948,7 +1086,7 @@ static t_stat deck_print_cmd(CONST char *cptr)
if (*cptr) return sim_messagef (SCPE_ARG, "Extra unknown parameters after filename\n");
// read deck to be printed (-1 to convert to ascii value, not hol)
nCards = -1;
nCards = 0;
r = deck_load(fn, DeckImage, &nCards);
if (r != SCPE_OK) return sim_messagef (r, "Cannot read deck to print (%s)\n", fn);
@ -973,7 +1111,7 @@ static t_stat deck_echolast_cmd(CONST char *cptr)
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);
nCards = (int32) get_uint (gbuf, 10, MAX_CARDS_IN_READ_STAKER_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");
@ -996,14 +1134,14 @@ static t_stat deck_echolast_cmd(CONST char *cptr)
// 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;
nh = ReadStakerLast[ncdr] - (nCards-1);
nh = nh % MAX_CARDS_IN_READ_STAKER_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];
ic = (ncdr * MAX_CARDS_IN_READ_STAKER_HOPPER + nh) * 80;
for (i=0;i<80;i++) DeckImage[nc * 80 + i] = ReadStaker[ic + i];
// get previous read card
nh = (nh + 1) % MAX_CARDS_IN_READ_TAKE_HOPPER;
nh = (nh + 1) % MAX_CARDS_IN_READ_STAKER_HOPPER;
}
deck_print_echo(DeckImage, nCards, 0,1);

3
I650/sw/Build_is_from_decks.ini
View file

@ -14,10 +14,11 @@
set cpu 2k
set cdr1 wiring=8word
att cdr1 -q soap/soapII.dck
echo ***
echo *** Load soap deck into drum
echo *** Load SOAP deck into drum
echo ***
d csw 7019519999

2
I650/sw/bell/00_readme.txt
View file

@ -1,5 +1,7 @@
Restoration comments May/2018
By Roberto Sancho
Floating Point Interpretive System (BELL interpreter)
From Bitsavers Manual 28-4024_FltDecIntrpSys.pdf

11
I650/sw/build_fortransit_pack.ini
View file

@ -9,6 +9,7 @@
set cpu 2k
set cdr1 wiring=8word
att cdr1 -q soap/soapII.dck
echo ***
@ -29,7 +30,7 @@ echo ***
echo *** Run SOAP assembler
echo ***
att cdr1 deck_soap.dck
att cdr1 -q deck_soap.dck
set cdr1 wiring=soap
att cdp1 -n -q fortransit/fortransit_addfn.dck
@ -39,7 +40,7 @@ d ar 1000
go
; check if programed stop because an error is detected
if not prop=01 goto assemble_ok0
if not prop=01 goto assemble_ok0;
echo
echo *** (assembling error code in AR)
@ -61,7 +62,7 @@ echo ***
echo *** Run SOAP assembler
echo ***
att cdr1 deck_soap.dck
att cdr1 -q deck_soap.dck
set cdr1 wiring=soap
att cdp1 -n -q fortransit/pack.dck
@ -71,7 +72,7 @@ d ar 1000
go
; check if programed stop because an error is detected
if not prop=01 goto assemble_ok1
if not prop=01 goto assemble_ok1;
echo
echo *** (assembling error code in AR)
@ -83,7 +84,7 @@ goto end
:assemble_ok1
; check if programed stop because normal termination
if prop=70 if ar=1951 goto assemble_ok2
if ((PROP==70) && (AR==1951)) goto assemble_ok2;
goto end
:assemble_ok2

23
I650/sw/build_soap4_tap_lib.ini Normal file
View file

@ -0,0 +1,23 @@
; set console -n log=log.txt
; set debug -n debug.txt
; set debug stdout
; set cpu debug=cmd;data;detail
; create new SOAP-4000 library tape
at mt2 -q -n soaplib.tap
det mt2
; assemble librarian program (soap4_lib.txt) and run it (starts at addr 1000)
; the librarian program reads from cdpr cards (soap4_lib_routines.txt) to be loaded in library tape
; must use SOAPA wiring on card read and punch
do run_soap4.ini soap/soap4_lib.txt 1000 soap/soap4_example_lib_routines.txt SOAPA SOAPA
; now test library tape usage
do run_soap4.ini soap/soap4_example_tap.txt 1000
:end

24
I650/sw/build_ssoap_ramac_from_decks.ini Normal file
View file

@ -0,0 +1,24 @@
; set console -n log=log.txt
; set debug -n debug.txt
; set debug stdout
; set cpu debug=cmd;data;detail
; assemble ramac loader that loads tracks 00-33 to drum
; the loader is called by ssoap_calling_card.dck
do run_supersoap.ini supersoap/ssoap_loader_src.txt
; prepare the deck to be copied to ramac, tracks 00-66
carddeck -q join deck_out.dck supersoap/ssoap_main.dck supersoap/ssoap_core.dck as deck_in.dck
; assemble and run the build program that read decks and writes them to ramac
do run_supersoap.ini supersoap/build_ssoap_ramac_src.txt 1000 deck_in.dck 8word
; test all is working by assembling the example program
do run_supersoap_ramac.ini supersoap/ssoap_example_src.txt
:end

BIN
I650/sw/fds/5440.2009_INTERPRETIVE_FDS.crd Normal file
View file

Binary file not shown.

63
I650/sw/fds/example.txt Normal file
View file

@ -0,0 +1,63 @@
+ A accumulator is address 0037
+ B accumulator is address 0089
+ K accumulator is address 0057
+ branch to address 0026 to resume execution of FDS operations on next address
+
+ Floating point format EE mmmm mmmm
+ FDS instruction: + AAAA OP AAAA BBBB-
+ IBM 650 instruction: + AAAA OP (DA) (IA)
+
+ constants
+ 0500 50 0000 0000 0.0 floating point
+ 0501 50 1000 0000 1.0 floating point
+ 0502 00 0000 0001 decimal 1
+ 0503 00 0000 0010 decimal 10 max number of results
+ 0504 00 0000 0000 decimal zero
+ 0505 00 1100 0000 start of interpretive FDS program
+
+ variables
+ 0510 00 0000 0000 N float
+ 0511 00 0000 0000 sqrt(n)
+ 0512 00 0000 0000 iteration count
+
+ Main FDS program
+
+ 1100 01 0510 0501- FDS A(N=0510) + B(1.0=0501) -> K
+ 1101 69 0057 1201 ld dist<-K
+ 1201 24 0510 1202 std 0510 N<-K
+ 1202 60 0512 1203 rau 0512 acc=iteration count
+ 1203 10 0502 1204 au 0502 acc=acc+1
+ 1204 21 0512 1205 stu 0512 interation count=acc
+ 1205 11 0503 1206 su 0503 compare with max num of iterations
+ 1206 46 0026 9999 brmin continue interpretation, else stop
+ 1102 16 0510 0511- FDS sqrt(A(N=0510)) -> B (0511)
+ 1103 69 0512 1210 ld iteration count
+ 1210 24 0977 1211 std word1 punch area
+ 1211 69 0510 1212 ld N float
+ 1212 24 0978 1213 std word2 punch area
+ 1213 69 0511 1214 ld sqrt(N) float
+ 1214 24 0979 1215 std word3 punch area
+ 1215 71 0977 0026 pch Iteration num N float sqrt(N) float, then continue interpretation
+ 1104 12 1100 0000- FDS BR A(=1100)
+
+ 1000 69 0504 1001 ld dist=0 decimal
+ 1001 24 0512 1002 std iteration count
+ 1002 69 0500 1003 ld dist=0 float
+ 1003 24 0510 1004 std N
+ 1004 65 0505 0420 ral acc=start of interpretive program, start interpretation
+
+ should print
+
+ 00 0000 0001 50 1000 0000 50 1000 0000
+ 00 0000 0002 50 2000 0000 50 1414 2135
+ 00 0000 0003 50 3000 0000 50 1732 0508
+ 00 0000 0004 50 4000 0000 50 2000 0000
+ 00 0000 0005 50 5000 0000 50 2236 0679
+ 00 0000 0006 50 6000 0000 50 2449 4897
+ 00 0000 0007 50 7000 0000 50 2645 7513
+ 00 0000 0008 50 8000 0000 50 2828 4271
+ 00 0000 0009 50 9000 0000 50 3000 0000
+
+ iteration num N=1..9 float sqrt(N) float
+
+g1000 transfer card. Start execution at addr 1000

2
I650/sw/fds/load_card.dck Normal file
View file

@ -0,0 +1,2 @@
G0195119026919521951691954195369195619556919581957691960195910800119653500011966 Load FDS 5 word Card
F919541952241961195370196119610000001901 ignore first load card of fds deck

21
I650/sw/fortransit/00_readme.txt
View file

@ -1,5 +1,6 @@
Restoration comments May/2018
By Roberto Sancho
Fortransit
From Bitsavers Manual CarnegieInternalTranslator.pdf (listings)
@ -46,16 +47,16 @@ 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
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

4
I650/sw/fortransit/pack.dck
View file

@ -724,9 +724,9 @@
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 0727241912800?645963711J -av13 64 5963 7111
6I1954195C 0728241910800?079689679C av14 07 9689 6793
6I1954195C 0729241804800?004673765O av15 00 4673 7656
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

205
I650/sw/i650_demo_all.ini Normal file
View file

@ -0,0 +1,205 @@
; demo all .ini scripts
set console -n log=console.txt
set debug -q stdout
set debug -q -n debug.txt
set cpu debug=cmd;data;detail
set mt debug=cmd;data;detail;exp
set dsk debug=cmd;data;detail;exp
; uncomment any of them to simulate ibm 650 real speed
; set throttle 11k
; set throttle 55/5
echo
echo ===========================================================
echo test build_soap_from_source.ini
echo ===========================================================
echo generates soap assembly listing
echo ===========================================================
echo
do build_soap_from_source.ini
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_soap.ini
echo ===========================================================
echo example from manual
echo should print 0100 lines
echo ===========================================================
echo
do run_soap.ini soap/soap_example_1_src.txt 1000
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test build_soap4_tap_lib.ini
echo ===========================================================
echo generate a library tape, assemble and run a prog that calls it
echo should display 38 0100 up to 38 6600
echo then assemble example
echo ===========================================================
echo
; build_soap4_tap_lib.ini calls run_soap4.ini, so no need to test it again
do build_soap4_tap_lib.ini
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test build_ssoap_ramac_from_decks.ini
echo ===========================================================
echo builds supersoap on ramac disk, then assemble example prog
echo ===========================================================
echo
do build_ssoap_ramac_from_decks.ini
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test assemble ssoap from source
echo ===========================================================
echo assemble original supersoap source
echo ===========================================================
echo
do run_supersoap_ramac.ini supersoap/ssoap_main_core_src.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fds.ini
echo ===========================================================
echo generates 9 lines (numberes 1-9) with 3 colums of numbers
echo integer (1..9), float (1..9), sqrt (1..9)
echo last line is: 00 0000 0009 50 9000 0000 50 3000 0000
echo ===========================================================
echo
do run_fds.ini fds/example.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_ra.ini
echo ===========================================================
echo regional assembler assembles and run aprog to list on one column 5-word cards
echo listing is one column, words from 0900-0925, some 1960, 0990,
echo more 1960s, 0401-0411. echo last line is: 0411 00 0000 0900
echo ===========================================================
echo
do run_ra.ini regional/print_five_field_ctrl_cards.txt regional/print_five_field_src.txt 0900 deck_in.dck
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo build_is_from_decks.ini
echo ===========================================================
echo build is from source deck
echo ===========================================================
echo
do build_is_from_decks.ini ntr lbox
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_is.ini
echo ===========================================================
echo sieve of eratosthenes - print prime numbers < 50 (last one is 47)
echo ===========================================================
echo
do run_is.ini bell/is_example_1_src.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_it.ini
echo ===========================================================
echo example from manual
echo should print one line: 200020005 6400000051 100050005 11
echo ===========================================================
echo
do run_it.ini it/it_example_1_src.txt it/it_example_1_data.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_it.ini
echo ===========================================================
echo sieve of eratosthenes - print prime numbers < 50 (last one is 47)
echo ===========================================================
echo
do run_it.ini it/it_example_2_src.txt nul
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test build_fortransit_pack.ini
echo ===========================================================
echo build fortransit funcion packs
echo ===========================================================
echo
do build_fortransit_pack.ini
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fortransit.ini
echo ===========================================================
echo example from manual - matrix multiplication
echo ===========================================================
echo
do run_fortransit.ini fortransit/fortransit_example_2_src.txt fortransit/fortransit_example_2_data.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fortransit.ini
echo ===========================================================
echo sieve of eratosthenes - print prime numbers < 50 (last one is 47)
echo ===========================================================
echo
do run_fortransit.ini fortransit/fortransit_example_1_src.txt nul
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fortransit.ini
echo ===========================================================
echo test fortran functions (each one identified by a 1111 to 9999)
echo ===========================================================
echo
do run_fortransit.ini fortransit/fortransit_example_4_src.txt
set env -P "Press Enter to continue . . . " dummy=cont
echo
echo ===========================================================
echo test run_fortransit.ini
echo ===========================================================
echo list a fortran graphic!
echo ===========================================================
echo
do run_fortransit.ini fortransit/fortransit_example_5_src.txt
set env -P "Press Enter to continue . . . " dummy=cont
quit
goto end
:end

1
I650/sw/it/00_readme.txt
View file

@ -1,5 +1,6 @@
Restoration comments May/2018
By Roberto Sancho
Internal Translator (IT Compiler)

2
I650/sw/it/it_package_p4_listing.txt
View file

@ -1,4 +1,4 @@
5 PACKAGE 4 IS
5 PACKAGE 4 IS
5 PACKAGE 2
5 PLUS
5 LOG AND EXPONENTIAL

1
I650/sw/ramac0.dsk Normal file
View file

File diff suppressed because one or more lines are too long

1
I650/sw/regional/load_id_card.dck Normal file
View file

@ -0,0 +1 @@
G0195119026919521951691954195369195619556919581957691960195910800119653500011966 Load Identification Card

18
I650/sw/regional/print_five_field_ctrl_cards.txt Normal file
View file

@ -0,0 +1,18 @@
+
+ regional assembler sample control cards
+
+ this is a five-field card because the '+' in column 3
+ stores 0 at word 0, so no worries. allow comments past col 80
+
+ regions are defined by letter a-h plus digit 0-9
+ first region is empty (00) used to define absolute addresses
+ region start address and len is given
+ regions should be stored on addr 1000 onwards, on ascending order
+
+ region start
+ Addr name len addr comment
? 1000a020000000 1000 a0 2000 0000 region for all drum absolute address
? 1001c001000900 1001 c0 0100 0900 region for program code
? 1002d000100990 1002 d0 0010 0990 region for program data (variables)
? 1003h000100977 1003 h0 0010 0977 punch area
? 1004h100110401 1004 h1 0011 0401 read area

73
I650/sw/regional/print_five_field_src.txt Normal file
View file

@ -0,0 +1,73 @@
c0000070h10010c00001 c0.0000 rd h1.0010 read card at addr 0401, jmp to 0410 if load card
c0000165h10000c00002 ral h1.0000 ral 0401 addr word 1
c0000220h00000c00003 stl h0.0000 stl 0777 addr word 1 for punch out
c0000365h10001c00004 ral h1.0001 ral 0402 word 1 contents
c0000420h00001c00005 stl h0.0001 stl 0778 word 1 for punch
c0000571h00000c00006 pch h0.0000 punch 0777
c0000665h10002c00007 ral h1.0002 ral 0403 addr word 2
c0000720h00000c00008 stl h0.0000 stl 0777 addr word 2 for punch out
c0000865h10003c00009 ral h1.0003 ral 0404 word 2 contents
c0000920h00001c00010 stl h0.0001 stl 0778 word 2 for punch
c0001071h00000c00011 pch h0.0000 punch 0777
c0001165h10004c00012 ral h1.0004 ral 0405 addr word 3
c0001220h00000c00013 stl h0.0000 stl 0777 addr word 3 for punch out
c0001365h10005c00014 ral h1.0005 ral 0406 word 3 contents
c0001420h00001c00015 stl h0.0001 stl 0778 word 3 for punch
c0001571h00000c00016 pch h0.0000 punch 0777
c0001665h10006c00017 ral h1.0006 ral 0407 addr word 4
c0001720h00000c00018 stl h0.0000 stl 0777 addr word 4 for punch out
c0001865h10007c00019 ral h1.0007 ral 0408 word 4 contents
c0001920h00001c00020 stl h0.0001 stl 0778 word 4 for punch
c0002071h00000c00021 pch h0.0000 punch 0777
c0002165h10008c00022 ral h1.0008 ral 0408 addr word 5
c0002220h00000c00023 stl h0.0000 stl 0777 addr word 5 for punch out
c0002365h10009c00024 ral h1.0009 ral 0409 word 5 contents
c0002420h00001c00025 stl h0.0001 stl 0778 word 5 for punch
c0002571h00000c00000 pch h0.0000 c0.0000 punch 0777 goto start
d0 0 variables for program
h1 000a00000a00000 initialize punch area
h1 200a00000a00000 initialize punch area
h1 300a00000a00000 initialize punch area
h1 400a00000a00000 initialize punch area
h1 500a00000a00000 initialize punch area
h1 600a00000a00000 initialize punch area
h1 700a00000a00000 initialize punch area
h1 800a00000a00000 initialize punch area
h1 900a00000a00000 initialize punch area
h1 1000a00000c00000 nop 0000 c0.0000 jmp back to read next card if this card is a load card (thus ignore reads cards)
i0 end of program
RRaaaaOOrrAAAArraaaa comment
RRaaaa = regional addr for location
OO = opcode
rrAAAA = regional addr for DA
RRaaaa = regional addr for IA
rr is A0-H9 and mst match with a control card
regional assembly sample program
prints contents of input deck (in five-filed card format)
load cards are skiped
regional formatted source code card are indetified because the 'a'..'i' char in col 11
allow comments past col 31
this program needs the following regions, defined by control cards
region start
Addr name len addr comment
1000 a0 2000 0000 region for all drum absolute address
1001 c0 0100 0900 region for program code
1002 d0 0010 0990 region for program data (variables)
1003 h0 0010 0977 punch area
1004 h1 0010 0401 read area
program starts at c0.0000 (gives absolute address 0900)
no mnemonics! it is not a symbolic assembler!
i0 marks the end of source program. assembler stops with (stop 0000 0500)
put next deck on read hopper (mount deck file on cdr1), and press start to
assemble it (sim> go)

18
I650/sw/regional/punch_drum_a_to_b.dck Normal file
View file

@ -0,0 +1,18 @@
+ 1910678000191119116919461912191235000419131913221910191419143500021943 deck 033.02 punch drum from a to b
+ 1943608003191519153500041916191615194719171917101948800319182419281919
+ 1919211927194519202419301921192121192919451922241932192319232119311945 this routine punches words from drum sequential from a to b on five-field format
+ 1924241934192519252119331945192624193619441944211935193719377119271938 to operatoe this routine
+ 1938111910193919394619401941194010800119421942101949800319410100000000 1. set 8000 to 70 1901 xxxx
+ 1945108002800319466900000000194700000100021948690000191819490000009992 2. put load-identification card in front and load deck 033.01
+ 190+0100001910 3. on halt, set 8000 to 00 aaaa bbbb
4. press start

8
I650/sw/regional/punch_eighths_drum.dck Normal file
View file

@ -0,0 +1,8 @@
? 0997018000800009126980030913091323099109140914168001091509151509900916 deck 033.01 punch b eighths of the drum
? 0916100992800209172409780918091822097709190919158003800209202409800921
? 0921220979091909232409820924092422098109190926240984092709272209830919 this routine punches b eigh of the drum in such a fashion that the list is
? 0929240986093009302209850931093710800109380938350008093909394409460940 representative that the list is representative of drum layout. b may vary
? 0940650991094109411609940942094245094309970943200991094409446509960945 from 1 to 8. punching starts with contents of a.
? 0945150995091609466509950916099069000009170992000050000309930001990012 to operate this routine
? 0994000000000109960002000000093171097709320932160993093309332009950934 1. set 8000 to 70 1901 xxxx 2. put load-identification card in front and load deck 033.01
? 093430000409360936608002093709116580000912091?0100000911 3. on halt, set 8000 to 00 a b 4. press start

30
I650/sw/regional/ra.dck Normal file
View file

@ -0,0 +1,30 @@
+ 0500650807050105013500010502050220081705030503200818050405042108190505 deck 033.06
+ 0505650803050605062005590508050870040105090509650401051005103500020511
+ 0511210816051205123000010513051311080705140514460515061505156508170516 regional assembly routine
+ 0516160816051705174505800518051865081805190519160401052005204505210525
+ 0521460522064105222408180523052365080205240524210819052805256508190526
+ 0526150806052705272008190528052865080805290529690401053005308410008002
+ 0531698003053205322308110533053365080905340534690402053005366980030537
+ 0537230812053805386508100539053969040305300541698003054205422308130543
+ 0543650812054405443500040545054515040205460546698003054705472208210548
+ 0548650403054905493000040550055015081305510551698003055205522308220553
+ 0553650811055405543500040555055515040105560556150819055705576980030558
+ 0558220820055905592407770560056065055905610561150806056205626905700563
+ 0563220570056405646504050565056546056605680566660821056705671608220642
+ 0568650821056905691508220642057020077805710571650570057205721608040573
+ 0573450574057705741508050575057569055905760576220559050805777107770578
+ 0578650803057905792005590508058024081705810581690401058205822408180583
+ 0583650559058405842108190585058516080305860586450587052805871608020588
+ 0588450589059305891608020590059045059105970591160802059205924506050601
+ 0593650801059405941008000595059521077905960596200780059905976508010598
+ 0598100800059905992107810600060020078206030601650801060206021008000603
+ 0603210783060406042007840607060565080106060606100800060706072107850608
+ 0608200786060906097107770610061065080306110611200559052806156505590616
+ 0616160803061706174506180641061816080206190619450620062406201608020621
+ 0621450622062806221608020623062345063606320624650801062506251008000626
+ 0626210779062706272007800630062865080106290629100800063006302107810631
+ 0631200782063406326508010633063310080006340634210783063506352007840638
+ 0636650801063706371008000638063821078506390639200786064006407107770641
+ 0641010000050006421504040570080000196000000801999999999908020000020000
+ 0803240777056008042007860571080520078705710806000001000008070000000009
+ 080865100005310809651000053608106510000541

1
I650/sw/regional/ra_starter_card.dck Normal file
View file

@ -0,0 +1 @@
? 050?6508070501 regional assembler starter card

33
I650/sw/run_fds.ini Normal file
View file

@ -0,0 +1,33 @@
; set console -n log=log.txt
; set debug -n debug.txt
; set debug stdout
; set cpu debug=cmd;data;detail
; params: %1 FDS program deck
; %2 input card deck (if empty, do not attach input card)
set cpu 2k
; prepare input deck
carddeck -q join fds/load_card.dck fds/5440.2009_INTERPRETIVE_FDS.crd %1 %2 AS deck_in.dck
; Now put input deck in reader
att cdr1 -q deck_in.dck
set cdr1 wiring=fds
att cdp1 -n -q deck_out.dck
set cdp1 echo, print, wiring=8word
att cdp0 -n -q print.txt
; uncomment this debug to get trace of how assembled source deck is executed
; set debug -n debug.txt
d csw 70 1901 9999
d ar 8000
go
:end

22
I650/sw/run_fortransit.ini
View file

@ -25,6 +25,7 @@ echo ***
echo *** Load FORTRANSIT translator deck into drum
echo ***
set cdr1 wiring=8word
att cdr1 -q -l fortransit/fortransit_translator.dck
d csw 70 1951 9999
@ -56,7 +57,7 @@ d ar 8000
go
; check if programed stop because an error is detected
if not prop=01 goto translate_ok1
if not prop==01 goto translate_ok1;
echo
echo *** (translation error code in Address Register AR)
@ -74,7 +75,7 @@ goto end
:translate_ok1
; check if programed stop because normal termination
if prop=70 if ar=1951 goto translate_ok2
if ((PROP==70) && (AR==1951)) goto translate_ok2;
goto end
:translate_ok2
@ -112,7 +113,8 @@ d ar 8000
go
; check if programed stop because an error is detected
if not prop=01 if not ar=1234 goto compile_ok1
if not ar==1234 goto compile_ok1;
echo
echo *** (compilation error code in Upper ACC)
@ -124,7 +126,7 @@ goto end
:compile_ok1
; check if programed stop because normal termination
if prop=70 if ar=1951 goto compile_ok2
if ((PROP==70) && (AR==1951)) goto compile_ok2;
goto end
:compile_ok2
@ -160,7 +162,7 @@ echo ***
echo *** Run SOAP assembler
echo ***
att cdr1 deck_soap.dck
att cdr1 -q deck_soap.dck
set cdr1 wiring=soap
att cdp1 -n -q deck_out.dck
@ -170,7 +172,7 @@ d ar 1000
go
; check if programed stop because an error is detected
if not prop=01 goto assemble_ok1
if not prop==01 goto assemble_ok1;
echo
echo *** (assembling error code in AR)
@ -182,7 +184,7 @@ goto end
:assemble_ok1
; check if programed stop because normal termination
if prop=70 if ar=1951 goto assemble_ok2
if ((PROP==70) && (AR==1951)) goto assemble_ok2;
goto end
:assemble_ok2
@ -205,7 +207,7 @@ echo ***
; soap source code read from card.
set cdr1 wiring=8WORD
att cdr1 -l deck_out.dck
att cdr1 -q -l deck_out.dck
d csw 7019519999
d ar 8000
@ -220,8 +222,8 @@ 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
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

5
I650/sw/run_is.ini
View file

@ -13,9 +13,10 @@
set cpu 2k
echo ***
echo *** Load is main deck into drum
echo *** Load IS main deck into drum
echo ***
set cdr1 wiring=8word
att cdr1 -q bell/is.dck
d csw 7019519999
@ -35,7 +36,7 @@ set cdp1 echo, print, wiring=is
att cdp0 -n -q print.txt
echo ***
echo *** Read and run is program
echo *** Read and run IS program
echo ***
d csw 7019511333

7
I650/sw/run_it.ini
View file

@ -23,6 +23,7 @@ echo ***
echo *** Load IT compiler deck into drum
echo ***
set cdr1 wiring=8word
att cdr1 -q -l it/it_compiler.dck
d csw 70 1951 3000
@ -47,7 +48,7 @@ go
; check if compilation ok
if accup=0 goto compile_ok
if accup==0 goto compile_ok
echo
echo *** (compilation error code in Upper ACC)
@ -75,7 +76,7 @@ carddeck -q join deck_res.dck it/it_reservation_p1.dck deck_soap.dck as deck_pit
echo ***
echo *** Load soap deck into drum
echo *** Load SOAP deck into drum
echo ***
att cdr1 -q -l it/soapII.dck
@ -85,7 +86,7 @@ d ar 8000
go
echo ***
echo *** Apply IT modifications to soap deck
echo *** Apply IT modifications to SOAP deck
echo ***
att cdr1 -q -l it/soapII_patch.dck

78
I650/sw/run_ra.ini Normal file
View file

@ -0,0 +1,78 @@
; set console -n log=log.txt
; set debug -n debug.txt
; set debug stdout
; set cpu debug=cmd;data;detail
; params: %1 control cards for regional program
; %2 regional assembly source card deck
; %3 start address to run program (If empty, program not run)
; %4 input card deck (if empty, do not attach input card)
set cpu 2k
; prepare input deck
carddeck -q join regional/load_id_card.dck regional/ra.dck %1 regional/ra_starter_card.dck %2 AS deck_in.dck
; Now put input deck in reader
att cdr1 -q deck_in.dck
set cdr1 wiring=ra
att cdp1 -n -q deck_out.dck
set cdp1 echo, print, wiring=ra
att cdp0 -n -q print.txt
echo ***
echo *** Regional Assembler source deck
echo ***
; uncomment this debug to get trace of how source deck is assembled
; set debug -n debug.txt
d csw 70 1901 0000
d ar 8000
go
; this generates deck_out.dck as program in five-field card format
if "%3" == "" goto end
; Load five-field card deck into drum
carddeck -q join regional/load_id_card.dck deck_out.dck AS deck_in.dck
; Now put input deck in reader
att cdr1 -q deck_in.dck
set cdr1 wiring=ra
att cdp1 -n -q deck_out.dck
set cdp1 echo, print, wiring=ra
att cdp0 -n -q print.txt
d csw 70 1901 0000
d ar 8000
go
echo ***
echo *** Run Assembled program
echo ***
; attach input deck
if "%4" == "" goto run1
att cdr1 -q %4
; Now execute the loaded deck
:run1
; uncomment this debug to get trace of how assembled source deck is executed
; set debug -n debug.txt
d ar %3
go
:end

3
I650/sw/run_soap.ini
View file

@ -13,10 +13,11 @@ set cpu 2k
; Load soap deck into drum (1 word per card format), but does not execute it
set cdr1 wiring=8word
att cdr1 -q -l soap/soapII.dck
echo ***
echo *** Load soap deck into drum
echo *** Load SOAP deck into drum
echo ***
d csw 7019519999

117
I650/sw/run_soap4.ini Normal file
View file

@ -0,0 +1,117 @@
; set console -n log=log.txt
; set debug -n debug.txt
; set debug stdout
set cpu debug=cmd;data;detail
set mt debug=cmd;data;detail;exp
; 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)
; %4 input card deck wiring (if empty, uses 8WORD)
; %5 output card deck wiring (if empty, uses 8WORD)
set cpu 4k
set cpu soapmne
; if TAP pseudo-op is to be used in SOAP source program, this section must be uncommented
; start of TAP pseudocode enable section
set cpu CntrlUnit
set cpu StorageUnit
at mt2 soaplib.tap
; end of TAP pseudocode enable section
; Load soap deck into drum (1 word per card format), but does not execute it
set cdr1 wiring=8word
att cdr1 -q -l soap/soap4.dck
echo ***
echo *** Load SOAP4 deck into drum
echo ***
d csw 7019519999
d ar 8000
go
; Now put source cards in reader and start soap assembler
att cdr1 -q %1
set cdr1 wiring=soapa
att cdp1 -n -q deck_out.dck
set cdp1 echo, print, wiring=soapa
att cdp0 -n -q print.txt
echo ***
echo *** Assemble source deck
echo ***
; uncomment this debug to get trace of how source deck is assembled
; set debug -n debug.txt
d ar 1000
go
; separate 5 words per card deck if any generated
carddeck -q split 5cd cdp1 deck_out.dck deck_out_5cd.dck
; discard availability card generated if any
carddeck -q split pat deck_out.dck deck_out.dck nul
if "%2" == "" goto end
; 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 -q -l deck_out.dck
att cdp1 -n -q deck_out_run.dck
set cdp1 echo, print, wiring=8WORD
echo ***
echo *** Read assembled program deck
echo ***
d csw 7019519999
d ar 8000
go
; attach input deck
if "%3" == "" goto run1
if "%4" == "" goto run2
set cdr1 wiring=%4
:run2
if "%5" == "" goto run3
set cdp1 wiring=%5
:run3
att cdr1 -q %3
; Now execute the loaded deck
:run1
echo ***
echo *** Run assembled program
echo ***
; uncomment this debug to get trace of how assembled source deck is executed
; set debug -n debug.txt
d ar %2
go
det all
:end

134
I650/sw/run_supersoap.ini Normal file
View file

@ -0,0 +1,134 @@
; set console -n log=log.txt
; set debug -n debug.txt
; set debug stdout
; set cpu debug=cmd;data;detail
; set mt debug=cmd;data;detail;exp
; set dsk debug=cmd;data;detail;exp
; 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)
; %4 input card deck wiring (if empty, uses 8WORD)
; %5 output card deck wiring (if empty, uses 8WORD)
; Assembles using SuperSoap card deck. Do not need ramac if only outputs 1-word
; format cards, and does not uses the following pseudo operatios:
; CDD, DSK, TAP, DEK, SKP, FIL, DON, FIV, PLR, PAL. PDL, LAT, SAT, LST, SST
set cpu 2k
set cpu soapmne
set cpu CntrlUnit
set cpu StorageUnit
; SuperSoap needed the Table lookup feature installed (to provide TLE opcode)
set cpu tle
at mt2 soaplib.tap
at dsk0 ramac0.dsk
; Load soap deck into drum (1 word per card format), but does not execute it
set cdr1 wiring=8word
att cdr1 -q -l supersoap/ssoap_main.dck
echo ***
echo *** Load SuperSoap main deck into drum
echo ***
d csw 7019518282
d ar 8000
go
; Now put source cards in reader and start soap assembler
att cdr1 -q %1
set cdr1 wiring=supersoap
att cdp1 -n -q deck_out.dck
set cdp1 echo, print, wiring=supersoap
att cdp0 -n -q print.txt
echo ***
echo *** Assemble source deck
echo ***
; uncomment this debug to get trace of how source deck is assembled
; set debug -n debug.txt
; use transfer card for main program (line 1552 of supersoap listing),
; RD1 1999 1998 8004 +70 1999 1998
; we store in distrib (addr 8001) and exec from it
dep dist 70 1999 1998
dep ar 8001
go
if ar==9898 goto noasmerr
echo *** Error in last read card:
carddeck -q echolast 1 cdr1
echo *** Error in PR register:
ex pr
goto end
:noasmerr
; separate 5 words per card deck if any generated
carddeck -q split 5cd cdp1 deck_out.dck deck_out_5cd.dck
; discard availability card generated if any
carddeck -q split pat deck_out.dck deck_out.dck deck_out_pat.dck
if "%2" == "" goto end
; 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 -q -l deck_out.dck
att cdp1 -n -q deck_out_run.dck
set cdp1 echo, print, wiring=8WORD
echo ***
echo *** Read assembled program deck
echo ***
d csw 7019519999
d ar 8000
go
; attach input deck
if "%3" == "" goto run1
if "%4" == "" goto run2
set cdr1 wiring=%4
:run2
if "%5" == "" goto run3
set cdp1 wiring=%5
:run3
att cdr1 -q %3
; Now execute the loaded deck
:run1
echo ***
echo *** Run assembled program
echo ***
; uncomment this debug to get trace of how assembled source deck is executed
; set debug -n debug.txt
d ar %2
go
:end

119
I650/sw/run_supersoap_ramac.ini Normal file
View file

@ -0,0 +1,119 @@
; set console -n log=log.txt
; set debug -n debug.txt
; set debug stdout
; set cpu debug=cmd;data;detail
; set mt debug=cmd;data;detail;exp
; set dsk debug=cmd;data;detail;exp
; 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)
; %4 input card deck wiring (if empty, uses 8WORD)
; %5 output card deck wiring (if empty, uses 8WORD)
; Assembles using SuperSoap stored in ramac. Needs ramac disk with supersoap already
; built in it. Allows the use of following pseudo operations (that uses ramac):
; CDD, DSK, TAP, DEK, SKP, FIL, DON, FIV, PLR, PAL. PDL, LAT, SAT, LST, SST
set cpu 2k
set cpu soapmne
set cpu CntrlUnit
set cpu StorageUnit
; SuperSoap needed the Table lookup feature installed (to provide TLE opcode)
set cpu tle
at mt2 soaplib.tap
at dsk0 ramac0.dsk
; prepare input deck: supersoap calling card followe by assembly deck
carddeck -q join supersoap/ssoap_calling_card.dck %1 as deck_in.dck
att cdr1 -q -l deck_in.dck
set cdr1 wiring=supersoap
att cdp1 -n -q deck_out.dck
set cdp1 echo, print, wiring=supersoap
att cdp0 -n -q print.txt
echo ***
echo *** Load SuperSoap from RAMAC and assemble source deck
echo ***
; uncomment this debug to get trace of how source deck is assembled
; set debug -n debug.txt
d csw 7019518282
d ar 8000
go
if ar==9898 goto noasmerr
echo *** Error in last read card:
carddeck -q echolast 1 cdr1
echo *** Error in PR register:
ex pr
goto end
:noasmerr
; separate 5 words per card deck if any generated
carddeck -q split 5cd cdp1 deck_out.dck deck_out_5cd.dck
; discard availability card generated if any
carddeck -q split pat deck_out.dck deck_out.dck deck_out_pat.dck
if "%2" == "" goto end
; 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 -q -l deck_out.dck
att cdp1 -n -q deck_out_run.dck
set cdp1 echo, print, wiring=8WORD
echo ***
echo *** Read assembled program deck
echo ***
d csw 7019519999
d ar 8000
go
; attach input deck
if "%3" == "" goto run1
if "%4" == "" goto run2
set cdr1 wiring=%4
:run2
if "%5" == "" goto run3
set cdp1 wiring=%5
:run3
att cdr1 -q %3
; Now execute the loaded deck
:run1
echo ***
echo *** Run assembled program
echo ***
; uncomment this debug to get trace of how assembled source deck is executed
; set debug -n debug.txt
d ar %2
go
:end

1
I650/sw/soap/00_readme.txt
View file

@ -1,5 +1,6 @@
Restoration comments May/2018
By Roberto Sancho
SOAP II
From Bitsavers Manual 24-4000-0_SOAPII.pdf

1804
I650/sw/soap/soap4.dck Normal file
View file

File diff suppressed because it is too large Load diff

12
I650/sw/soap/soap4_example_lib_routines.txt Normal file
View file

@ -0,0 +1,12 @@
1 sub1 soap tape library
1 routine
1
0 sub1 nop 0000 comment
0 hlt 0001
1
?
sub2 nop 0002 comment
0 hlt 0002
1
?
?

8
I650/sw/soap/soap4_example_tap.txt Normal file
View file

@ -0,0 +1,8 @@
1 soap test tap
1
0 equsub1 1000
1
0 sub1 nop 0000 sub2 comment
0 sub2 tap
0 hlt 0001
0 pst

198
I650/sw/soap/soap4_lib.txt Normal file
View file

@ -0,0 +1,198 @@
1 soap 4000
1
1 symbolic optimal assembly prog
1
1 for the
1
1 ibm 650 model 4
1
1 data processing system
1
1 librarian
1
1 written by Roberto Sancho
1 March 2020
1
0 blr 1000 1000 entry
0 regh1100 1109 tap header
0 synzero h0001
0 synreadc 1950
0 blr 1951 1967 17wd buffr
0 regp1977 1986 punch area
0 blr 1998 1999
1
1 check library tape
1 first record
1
1000rwd 8012 read tape
set 9050 first
rtn 8012 record
nts initp jmp if err
rau 9050 check
aup 9051 header
suph0002 record
aup 9052 if record
suph0003 not match
aup 9053 then
suph0004 jump to
nzuinitp inittp
rtn 8012 if not eof
ntsinitp then initp
nefinitp r1ok else r1ok
1 soap tape library
1 header card
1 as read with rd1
h0001 00 0000 0000
h0002 77 0083 6177
h0003 00 7369 6279
h0004 82 7661 6561
h0005 79 8800 0000
h0006 00 0000 0000
h0007 00 0000 9999
h0008 00 0000 9999
h0009 00 0000 9999
h0010 09 9800 0000
1
1 library tape first record
1 does not match expected
1 create a new lib tape
1 with expected first recod
1 (the library header)
1
initprwd 8012 wrt header
set 9050 rec in tap
ldih0001
set 9050
wtn 8012
ntswhok
wrhlthlt 0999 9999 hlt if wr err
whok wtm 8012 write double
wtm 8012 tape mark
ntsr1ok wrhlt
1
1 read first card and
1 scan tape lib for routine
1
r1ok rwd 8012
rd1 1999 bb817
bb817lddh0010 init empty
stdemflg file flag
rau set test 1st
ral 1951 al is rdc loc
stuemflg file not empry
slo 9050 cmp with tap loc
nzepass found no yes
setblset 9050 trsfr tape
sib 1951 1998 to cd area
set set 9050 read tape
rtn 8012 nts
nts nts 8001
nef exit
nze halt
slt 0001 reread
bst 8012 set routine
halt hlt 0888 9999
pass rau 8001 bypass
rtc 8012 nts routine
exit ralemflg if file not empty
nze bb817 try next file
bst 8012 nfnd
emflg 00 0000 0000 empty file flag
1
1 card routine found into
1 library tape
1
foundhlt 0777 9999
1
1 card routine not found
1 add it to library tape
1
nfnd set 9050
ldi 1951
set 9050
wtn 8012 wrt crd
nts wrhlt to tape
rd1 1998 nfnd
1998wtm 8012 load card
wtm 8012 is eof
ntsr1ok wrhlt
1
1 if first card is load card
1 then willprint list of
1 routines in tape.
1 punch routine location
1 (first record of file)
1 and number of routine
1
i1xxx 00 0001 0000
pchfm 80 0000 0000 pch format
1999rwd 8012 rewind tape
lddzero
stdp0002
stdp0003
stdp0004
stdp0005
stdp0006
stdp0007
stdp0008
stdp0009
raupchfm
stup0010 set2
set2 set 9050 read tape
rtn 8012 1st rec
ntsrdok2
nef endf
nze halt
slt 0001 reread
bst 8012 set2 routine
rdok2ldd 9050 routine
stdp0001 location
wr1 1977 skp2 punch
skp2 rtc 8012 skip routine
ntsskp2
nefhalt
ralp0008 incr
aloi1xxx routine
stlp0008 set2 number
wr1 1977 set2
endf rwd 8012
hlt 0000 r1ok
1
1 Librarian program adds routines from
1 cards to library tape so they can be
1 used with TAP presudo command available
1 with SOAP-IIA 4000
1
1 entry points
1 1000 input
1 routine 1 deck card
1 blank card with HiPunch
1 (a load card)
1 routine 2 deck card
1 blank card with HiPunch
1 (a load card)
1 ...
1 routine n deck card
1 blank card with HiPunch
1 (a load card)
1 blank card with HiPunch
1 (a second load card)
1 add routines to library tape
1 then print list of routines
1 in library tape
1 if last repeated load card is
1 removed, no printout is issued
1
1 1998
1 put a double Tape Mark (end of
1 file) to close the lib tape
1
1 1999
1 print list of routines
1 in library tape
1
1 stops
1 0999 write error
1 0888 read error
1 0777 routine already in library
1

2247
I650/sw/soap/soap4_listing.txt Normal file
View file

File diff suppressed because it is too large Load diff

2248
I650/sw/soap/soap4_src.txt Normal file
View file

File diff suppressed because it is too large Load diff

BIN
I650/sw/soaplib.tap Normal file
View file

Binary file not shown.

695
I650/sw/supersoap/00_readme.txt Normal file
View file

@ -0,0 +1,695 @@
Restoration comments May/2020
By Roberto Sancho
SuperSoap
From Computer History Museum archive
SuperSoap manual: 102784983-05-01-acc.pdf and
SuperSoap Listing: 102784987-05-01-acc.pdf
After OCR'ing the listing (ssoap.txt), we generates two 1-word format decks
using the assembler output for lines 1 to 1553 (locafier 3800-33). This is
the main program that executes from drum (address 0000-1999) This deck allows
to assemble a supersoap source prog that does not uses fancy pseudo-ops, and
will be called ssoap_main.dck deck
To allow main deck to run standalone, the FIL pseudo op must be manually
expanded to its values
with supersoap listing, lines 1554 up to the end another 1-word card is
generated. These deck contains pseudo ops that are executed in core mem when
loaded from ramac under the control of main deck. This deck will be
called ssoap_core.dck deck.
To build supersoap in ramac, a loader routine is necessary. There is one in
manual (p52-p53), but should be adapted to be assembled by ssoap main deck.
Then a build program should be developed from scratch. This program is
build_ssoap_ramac_src.txt and reads
- load routine 1-word assembled deck
- ssoap_main 1-word format deck
- ssoap_core 1-word format deck
And saves it into ramac disc at proper place
- load routine: at disk 38, track 00, words 00-40 (out of 60 available
in track)
- ssoap_main 1-word format deck (words 41-60 at track 00 disk 38, up to
track 33 in disk 38)
- ssoap_core 1-word format deck (tracks 34 up to 66. the cdd pseudo op
indicates the track where the routine
should be stored)
Now supersoap is available in ramac, all the pseudo-ops can be used.
On testing supersoap, some bugs should be fixed:
3196 SDS 9000 9001 +85 9000 9017
RSB 1 9017 +83 0001 9003
3197 STL 9000 9002 +20 9000 9003
should be
3196 SDS 9000 9001 +85 9000 9017
RSB 1 9017 +83 0001 9002
3197 STL 9000 9002 +20 9000 9003
this bug was preventing PLR to work
2577 9001 RAB 49 1F 9001 +82 0049 9001
should be
2577F 9000 RAB 49 1F 9000 +82 0049 9001
this bug was preventing DEK to work.
Also, supersoap relies on some cpu opcode features that are not well
documented in ibm manuals. These features should be implemented in order to
make supersoap to work properly
RDS/WDS sets IAS to 0 (not stated in ramac manual)
index arithmetic sets distributor only when DA >= 8000 (not stated in
cpu extension manual)
Now it is possible to create from ssoap.txt supersoap OCR'd listing a source
deck ssoap_example_src.txt
Some changes should be applied:
- apply supersoap fixes for PLR and DEK
- remove fil output
- remove pal output
- comment line 8 (pseudo op hmo) as this will not be a hand optimized
source code
Now it is possible to assemble ssoap_example_src.txt with supersoap.
Note that the assembling does not generates same address as in ssoap.txt listing
because it is not hand optimized
===============
Annotated execution of supersoap processing (assembling) the card
1221rau aa
end
Produces this output
1221 RAU AA 1221 60 0024 0029
END
8001: 70 RD1 1999 1998
... Read Card Unit CDR1 1221rau aa
... Read Card 1951: 0091929291+ ' 1221' location
... Read Card 1952: 0000000000+ ' ' DA
... Read Card 1953: 6161000000+ 'AA ' IA
... Read Card 1954: 7961840000+ 'RAU ' op.co.de.TD.TI TD=tag DA, TI=tag TI
... Read Card 1955: 0000000000+ ' '
... Read Card 1956: 0000000000+ ' '
... Read Card 1957: 0000001221+ ' ~~'
... Read Card 1958: 0000009999+ ' 99'
... Read Card 1959: 0000009999+ ' 99'
... Read Card 1960: 0000908000+ ' 0~ ' control word: T000908000+, T=card type
1998: 60 RAU 1960 0015 symb: start rau 1960 0127-start of processing the read card
0085: 20 STL 0046 0249 symb: 1 stl 533tl 0129-set 533tl=0
0249: 30 SRT 0009 0055 symb: srt 9 0130-AccUp=card type (=0)
0055: 80 RAA 8003 0077 symb: raa 8003 0131-set IRA=Card Type=0
0077: 51 SXA 0005 0084 symb: sxa 5 0132-
0084: 41 BMA 2005 0000 symb: bma 5 a 0 0133-depending on card type jmp to addr 0,1,2,3,4 (5..9 jmp to 0)
init processing type 0 card
0000: 60 RAU 1954 0009 symb: 0 rau 1954 1f 0134-AccUp=opcode 'RAU', OV=0
0009: 80 RAA 0000 0014 symb: 1 raa 0 0141-Set IRA=0
process Tag for DA and IA
0014: 82 RAB 0001 0019 symb: rab 1 0f 0142-Set IRB=1 -> process IA tag
0019: 30 SRT 0002 0075 symb: 0 srt 2 0143-AccLo=TI 0000 0000 -> tag IA, Now ACC: 0079618400 0000000000+, OV: 0 (00.RR.AA.UU.TD TI 0000 0000)
0075: 11 SUP 8003 0083 symb: sup 8003 0144-clear AccUp
0083: 45 NZE 0086 0237 symb: nze 9f 0145-jmp to 237 if NO tag, continue if tag
0237: 10 AUP 8001 0095 symb: 9 aup 8001 4f 0156-Load again AccUp=00.op.co.de.TD, Now ACC: 0079618400 0000000000+, OV: 0
0095: 69 LDD 0248 0051 symb: 4 lod ldi41 3f 0158-DIST=load code in IAS, jmp to 9006
0051: 23 SIA 4307 0061 symb: 3 sia dtaggb 0162-store in dtagg+IRB=0307+0001 the tag processed (Write 0308: 090780 0000+) tag is 4 last digits
0061: 42 NZB 0114 0065 symb: nzb 1f 0163-jmp to 1f if IA&DA tags processed (for now, continue as IRB=1)
0114: 53 SXB 0001 0019 symb: sxb 1 0b 0164-dec IRB, Now IRB=0 -> process IA tag
loop again
0019: 30 SRT 0002 0075 symb: 0 srt 2 0143-AccLo=TD 0000 0000 -> tag DA, Now ACC: 0000796184 0000000000+, OV: 0 (00.00.RR.AA.UU TD 0000 0000)
0075: 11 SUP 8003 0083 symb: sup 8003 0144-
0083: 45 NZE 0086 0237 symb: nze 9f 0145-
0237: 10 AUP 8001 0095 symb: 9 aup 8001 4f 0156-
0095: 69 LDD 0248 0051 symb: 4 lod ldi41 3f 0158-
0051: 23 SIA 4307 0061 symb: 3 sia dtaggb 0162-store in dtagg+IRB=0307+0000 the tag processed (Write 0307: 090780 0000+) tag is 4 last digits
0061: 42 NZB 0114 0065 symb: nzb 1f 0163-IRB=0 -> Both Tad in DA&IA processed, continue
end of tag processing,
search for opcode, get instruction code NN
0065: 44 NZU 0229 0001 symb: 1 nzu 1 0165-Now AccUp=0000op.co.de. Jmp to 1 if opcode blank. Now ACC: 0000796184 0000000000+, OV: 0
0229: 30 SRT 0004 0238 symb: srt 4 0166-Now Acc=0..0.op co.de, ACC: 0000000079 6184000000+, OV: 0 (0..0RR AAUU000000)
0238: 44 NZU 0043 0094 symb: nzu 2f 0167-jmp to 2f if first char of opcode is blank (so not a mnemoci)
0043: 30 SRT 0002 0499 symb: srt 2 0168-Now ACC: 0000000000 7961840000+, OV: 0 (0..0 RR.AA.UU.00.00)
0499: 16 SLO 8002 0007 symb: slo 8002 0169-Clear Acc, DIST=Opcode
0007: 24 STD 1711 0197 symb: std otend 0170-Save as sentined at end of search table: Write 1711: 7961840000+
0197: 63 TLE 1550 0214 symb: tle o0001 0171-Search opcode table
... Search DIST: 7961840000+ 'RAU '
... Found 1610: 7961840000+ 'RAU '
... Result ACC: 0000000000 0016100000+, OV: 0 found at address 1610 (DA part of AccLo)
0214: 16 SLO 0017 0071 symb: slo obase 0172-Substract table to get index on table (Acc=1610-1650=00 0040 0000-)
0071: 46 BMI 0227 0225 symb: bmi 3f 0173-jmp to 3f if >=0 -> below 1650 (most of pseudo instr, or not found). RAU is negative
0227: 15 ALO 0393 0548 symb: 3 alo n0052 0182-use index in opcode table to lookup in n0000 optimization table: n0052=00 0100 0588 + (00 0040 0000-) = 00 0060 0588
0548: 35 SLT 0004 0059 symb: slt 4 machn 0183-set format, jmp to machine instr processing Now ACC: 0000000000 6005880000+, OV: 0 (60=opcode)
process the opcode intruction code NN get optimization L+NN
0059: 20 STL 0314 0074 symb: machn stl instr 0184-instr (addr 0314)=NN xxxx xxxx, NN=instr code. Now Write 0314: 6005880000+
0074: 10 AUP 0188 0245 symb: aup optim 0185-optim = Read 0188: 0000000000+ this is a NXT NNMM card for hand optimization
0245: 44 NZU 0100 0549 symb: nzu 3f 0186-optim=0, continue, Now ACC: 0000000000 6005880000+, OV: 0
0549: 35 SLT 0002 0105 symb: slt 2 0187-AccUp=instr code, Now ACC: 0000000060 0588000000+, OV: 0
0105: 88 RAC 8003 0013 symb: rac 8003 0188-Set IRC=60 (=Instr code for RAU)
0013: 60 RAU 6342 0012 symb: rau n0001c 0189-Use instr code as index in n0001 table to get optimization for DA and IA
n0001 (=342) + IRC (=60) = 0402
... Read 0402: 0303050499+ this is the optimization code
... ACC: 0303050499 0000000000+, OV: 0
0012: 69 LDD 8005 0020 symb: lod 8005 0190-DIST=IRA=0
0020: 24 STD 0073 0076 symb: std lincr procl 0191-lincr=0 = ???
processing of instructions
check location of instr is blank/non blank depending on prev instr
0076: 83 RSB 0001 0232 symb: procl rsb 1 0375-Set IRB=-1 (=processing location addr)
0232: 21 STU 0188 0041 symb: stu optim 0376-optim (addr 0188)=NN MM xx xxxx Optimize next word to L+NN if even, L+MM if odd (Now=0303050499+) optimization word
0041: 89 RSC 0275 0247 symb: rsc 275 0377-IRC=-275 -> set return addr to to return to lin 0388- (addr 300+(-275)=25
0247: 65 RAL 1951 0056 symb: ral 1951 0378-get soap Location from card read area = ' 1221' (Now ACC: 0000000000 0091929291+, OV: 0)
0056: 69 LDD 0460 0063 symb: lod carry 0379-Read 0460: 8888888888+ is the previous assembled instr
0063: 45 NZE 0116 0070 symb: nze 1f 0380-jmp to 1f if location is blank (Now ACC: 0000000000 0091929291+, OV: 0)
0116: 96 BD6 0069 0224 symb: bd6 mastr hlt77 0381-carry has 8-> no blank addr in prev instr -> jmp to mastr to resolve addr (if blank addr in prev instr error because references a next instr (this) that no blank location)
master address calc
for location
determine type of location
0069: 20 STL 0473 0676 symb: mastr stl temp 0480-temp=location as stated in read card (= absolute addr ' 1221' here) ACC: 0000000000 0091929291+, OV: 0
0676: 69 LDD 8007 0632 symb: lod 8007 0481-DIST=IRC= -275 -> to return to lin 0388-
0632: 24 STD 0334 0490 symb: std 00032 0482-Save IRC (value to calc return addr from master calculation)
0490: 35 SLT 0002 1149 symb: slt 2 0483-AccUp=first char of location
1149: 27 SET 9000 0106 symb: set 9000 0484-
0106: 09 LDI 0117 0103 symb: ldi q0001 0485-
... Copy 0117-0149 to 9000-9032 (33 words)
0103: 09 LDI 0556 0535 symb: ldi z0001 0486-
... Copy 0556-0582 to 9033-9059 (27 words)
0535: 45 NZE 9002 0489 symb: nze 9002 0487-jmp to 9002 if some location, continue if location is blank (ACC: 0000000000 9192929100+, OV: 0)
9002: 44 NZU 9007 9008 symb: 9002 nzu 1f 0493-jmp to 9008 if absolute (first char blank), continue if symbolic/relative/program point
absolute location
convert chars to number
9008: 11 SUP 8003 9010 symb: 1 sup 8003 0495-clear AccUp, AccLo=loc aboslute as chars (ACC: 0000000000 9192929100+, OV: 0 = '1221 '
9010: 80 RAA 8001 9011 symb: raa 8001 1f 0496-IRA=0 -> addr type: 0=absolute addr
9011: 11 SUP 8003 9012 symb: 1 sup 8003 0497-
9012: 45 NZE 9013 9014 symb: nze 1f 0498-jmp to 1f if addr is blank (conversion finished) (ACC: 0000000000 9192929100+, OV: 0)
9013: 24 STD 9006 9015 symb: std 9006 0499-addr 9006=0 (this is the addr converted to numeric result)
9015: 15 ALO 9016 9017 symb: alo 100p 0500-add 100 -> remove leadin 9 if leftmost char of acclo (Now ACC: 0000000001 0192929100+, OV: 0)
9017: 44 NZU 9018 9019 symb: nzu 2f 0501-jmp to 2f if char not number 9X
9018: 11 SUP 8003 9020 symb: sup 8003 0502-clear accup, now ACC: 0000000000 0192929100+, OV: 0
9020: 35 SLT 0001 9021 symb: slt 1 0503-Now ACC: 0000000000 1929291000+, OV: 0
9021: 10 AUP 9006 9022 symb: aup 9006 0504-load current result
9022: 35 SLT 0001 9011 symb: slt 1 1b 0505-Add digit, loop (Now ACC: 0000000001 9292910000+, OV: 0
... loop to lin 497
9014: 65 RAL 8001 9023 symb: 1 ral 8001 0506-Coversion finished in AccLo, Now ACC: 0000000000 0000001221+, OV: 0
9023: 40 NZA 9024 9005 symb: nza 9005 0507-jmp to 9005 if abs addr parsed (continue if regional addr), now IRA=0=absolute
9005: 47 BOV 1997 9000 symb: 9005 bov hlt88d 9000 0512-if OV there is an error
check if resolved addr is in drum/ias
9000: 09 LDI 0303 9029 symb: 9000 ldi 00001 9029 0518-
... Copy 0303-0349 to 9000-9046 (47 words)
9029: 88 RAC 9031 9018 symb: 9029 rac 9031 9018 0582-addr 9031 comes from addr 0334 = save value of IRC = -275 = Save IRC (value to calc return addr from master calculation)
9018: 20 STL 9050 9021 symb: 9018 stl 9050 0590-save absolute location addr Write 9050: 0000001221+
9021: 35 SLT 0006 9022 symb: slt 6 0591-Now ACC: 0000000000 1221000000+, OV: 0
9022: 16 SLO 8002 9023 symb: slo 8002 0592-AccLo to DIST, Acc=0
9023: 84 TLU 9002 9024 symb: tlu 9002 0593-Search in memory map at lines 0583-0589
... Search DIST: 1221000000+ '~~ '
... Found 9002: 1999000001- ')9 ~'
... Result ACC: 0000000000 0090020000+, OV: 0 -> AccLo = 00 ADDR 0000 addr of datafound
9024: 15 ALO 9025 8002 symb: alo 8002 0594-AccLo=AccLo+80 0000 9026=80 9002 9026=RAA 9002 9026=
8002: 80 RAA 9002 9026 execute created inst: IRA=last 4 digits of found addr=0001-
9026: 41 BMA 9016 9012 symb: bma 9016 9012 0596-jmp if IRA<0 same as found rlu word <0. <0 if aadr is in range 0000-1999 or 9000-9099
9016: 67 RAM 9404 9216 symb: 9016 ram 9004b 9016a 0597-IRB=-1 (=processing location addr), IRA=-1 (other options: =0 if < 8000, =1 if <8007, =0 if <9000, =-2 if < 9060, -3 if <= 9099, =0 <= 9999)
9003 9015 (developed addr) ... Read 9003: 7999800000+, Now ACC: 0000000000 7999800000+, OV: 0
9015: 17 AML 9050 9027 symb: 9015 aml 9050 1f 0600-add saved location (saved at lin 590-): Read 9050: 0000001221+, Now ACC: 0000000000 7999801221+, OV: 0
9027: 69 LDD 8003 9028 symb: 1 lod 8003 0602-clear distrib
9028: 23 SIA 9050 9001 symb: sia 9050 9001 0603-Write 9050: 0000001221+
9001: 65 RAL 8001 6300 symb: 9001 ral 8001 300 c 0604-Acc=location, jmp to 300+IRC, here IRC=-275 -> jmp to addr 0025 lin 388- (processing the instruction)
back to processing the instruction
0025: 20 STL 0780 2038 symb: 25 stl locus 38 a 0388-save location in locus, jmp to 26,27,28,39 depending on addr type in IRA (here IRA=-1=drum/ias), Write 0780: 0000001221+
0037: 10 AUP 8001 0545 symb: 37 aup 8001 0391-nOW ACC: 0000001221 0000001221+, OV: 0
0545: 15 ALO 0798 0320 symb: alo ddiff 1f 0392-??? posible regional offset? posible tag offset? Now ddiff=0
0320: 10 AUP 0073 0030 symb: 1 aup lincr 0397-??? Now lincr=0
0030: 21 STU 0190 0243 symb: stu basex 0398-basex=instr location as 00 0000 NNNN
0243: 35 SLT 0006 0505 symb: slt 6 0399-
0505: 20 STL 1961 0018 symb: stl locat 0400-locat=instr location as NNNN 000000
0018: 65 RAL 9011 0226 symb: ral 9011 0401-addr 9011 is copied from addr 0314=instr, set in line 0184-instr (addr 0314)=NN xxxx xxxx, NN=instr code. Now ACC: 0000000000 6005880000+, OV: 0
0226: 16 SLO 0235 0239 symb: slo sudom 0402-??? sudom (addr 0235) = 88 0200 0950+ = instr RAC 200 950
0239: 45 NZE 0443 0948 symb: nze procd alfot 0403-jmp to alfot if instr = sudom
now process Data Address of instructuon
0443: 89 RSC 0255 0649 symb: procd rsc 255 dmast 0412-IRC=-255 -> set return addr to to return to lin 0415- (addr 300+(-255)=0045)
0649: 65 RAL 1952 0614 symb: dmast ral 1952 dmst1 0413-Acc=Data Address in soap source, ACC: 0000000000 0000000000+, OV: 0
0614: 82 RAB 0000 0069 symb: dmst1 rab 0 mastr 0414-IRB=0 (=processing DA data addr)
mastr address calc
for data addr (DA)
determine type of location
0069: 20 STL 0473 0676 symb: mastr stl temp 0480-temp=location as stated in read card (= blank addr ' ' here) ACC: 0000000000 0000000000+, OV: 0
0676: 69 LDD 8007 0632 symb: lod 8007 0481-DIST=IRC= -255 -> to return to lin 0415-
0632: 24 STD 0334 0490 symb: std 00032 0482-Save IRC (value to calc return addr from master calculation)
0490: 35 SLT 0002 1149 symb: slt 2 0483-AccUp=first char of location
1149: 27 SET 9000 0106 symb: set 9000 0484-
0106: 09 LDI 0117 0103 symb: ldi q0001 0485-
... Copy 0117-0149 to 9000-9032 (33 words)
0103: 09 LDI 0556 0535 symb: ldi z0001 0486-
... Copy 0556-0582 to 9033-9059 (27 words)
0535: 45 NZE 9002 0489 symb: nze 9002 0487-jmp to 9002 if some location, continue if location is blank (ACC: 0000000000 0000000000+, OV: 0)
0489: 49 BMC 1048 9005 symb: bmc 9005 0488-IRC=-255 (processing DA), continue
blank DA addr
1048: 65 RAL 0460 0665 symb: ral carry 0489-Read 0460: 8888888888+ is the previous assembled instr
0665: 96 BD6 0068 9000 symb: bd6 9000 0490-carry has 8-> no blank addr in prev instr -> continue to resolve addr
0068: 81 RSA 0053 9040 symb: rsa 53 9040 0491-Set IRA: 0053- ???
9040: 36 SCT 0001 9001 symb: 9040 sct 1 9001 0535-Se overflow! Now ACC: 0000000008 8888888810+, OV: 1
9001: 09 LDI 0150 0202 symb: 9001 ldi 10001 d 0519-
... Copy 0150-0199 to 9001-9050 (50 words)
0202: 69 LDD 4307 0112 symb: lod dtaggb farbld 0520-read from dtagg+IRB=0307+0000 the tag processed (Read 0307: 090780 0000+) tag is 4 last digits
optimization routines
farbl = fix addr blank -> calc the addr for blank DA
0112: 96 BD6 9058 0221 symb: farbl bd6 9058 7f 0640- ??? (check DIST: 0907800000+ = tag for DA)
9058: 88 RAC 9007 9057 symb: 9058 rac 9007 0553-IRC=0, addr 9007 copies from addr 0156 = modet defined at line 1454- modet +00 0000 0000, so IRC=modet=0
9057: 48 NZC 0607 0829 symb: nzc farind 829 0554-IRC is 0 -> jmp to 829
0829: 43 BMB 0682 9005 symb: 829 bmb 9005 0656-IRB is 0 (=processing DA) so jmp 9005
9005: 65 RAL 9039 9015 symb: 9005 ral 9039 0668-Addr 9039 is copied from 0188=optim=optimization word, Now ACC: 0000000000 0303050499+, OV: 1
9015: 42 NZB 9016 9017 symb: nzb 2f 0669-IRB is 0 (=processing DA), so continue
9017: 20 STL 9058 9025 symb: 2 stl 9058 0689-Save optimization word in 9058
9025: 65 RAL 9041 9026 symb: ral 9041 0690-Addr 9041 is copied from 0190=basex=instr location as 00 0000 NNNN, now ACC: 0000000000 0000001221+, OV: 1
9026: 14 DIV 9008 0832 symb: div 9008 d 0691-Div basex by 2 (ACC: 0000000001 0000000610+, OV: 1
0832: 44 NZU 9027 9028 symb: nzu 4f 0692-continue if basex odd, jmp to 4f if basex is even
9027: 67 RAM 9058 9029 symb: ram 9058 0693-Acc=basex, now ACC: 0000000000 0303050499+, OV: 1 NN MM 000000 -> NN/MM is L+NN/MM fpr next word to select depending on L odd/even
9029: 35 SLT 0002 9030 symb: slt 2 0694-
9030: 11 SUP 8003 9031 symb: sup 8003 5f 0695-clear accup , ACC: 0000000000 0305049900+, OV: 1
9031: 30 SRT 0008 9032 symb: 5 srt 8 0697-ACC: 0000000000 0000000003+, OV: 1 -> this is the optimization offset to be added to Llocation of instr
9032: 15 ALO 9041 9004 symb: alo 9041 9004 0698-AccLo=basex+NN -> optimized word for blank address, now ACC: 0000000000 0000001224+, OV: 1
get the addr to reserve 00..49 (first band)
9004: 14 DIV 9033 0491 symb: 9004 div 50i farofd 0699-div addr by 50, Div result ACC: 0000000024 0000000024+, OV: 1 (AccLo=remainder)
reserve addr in AccUp
0491: 65 RAL 8003 9049 symb: farof ral 8003 9049 0700-Acc=24 = addr to reserve (the remainder of div by 50)
9049: 15 ALO 8002 9034 symb: 9049 alo 8002 0704-
9034: 15 ALO 8002 9035 symb: alo 8002 0705-Acc=96=24x4
9035: 69 LDD 8006 9036 symb: lod 8006 0706-DIST=IRB=0 (=0 means processing DA)
9036: 24 STD 0257 0661 symb: std 30007 d 0707-Save IRB=0 in 30007 (addr 0257)
0661: 82 RAB 0004 9613 symb: rab 4 9013c 0708-Set IRB=4, jmp 9013 (IRC=0, set at line 0554 with value of modet)
9013: 88 RAC 0000 9037 symb: 9013 rac 0 1f 0709-IRC=0
9037: 16 SLO 9033 9038 symb: 1 slo 50i 0711-Acc=96-50=46
9038: 46 BMI 9050 9040 symb: bmi 9050 0712-acc=46>0 -> continue
9040: 58 AXC 0050 9037 symb: axc 50 1b 0713-IRC=IRC+50=50, jmp to 9037 to continue subtracting
9037: 16 SLO 9033 9038 symb: 1 slo 50i 0711-Acc=46-50-4
9038: 46 BMI 9050 9040 symb: bmi 9050 0712-exit loop
9050: 09 LDI 0917 9051 symb: 9050 ldi 20001 9051 0714-Copy 0917-0926 to 9050-9059 (10 words)
9051: 35 SLT 0004 9050 symb: 9051 slt 4 9050 0730-Acc = -0004 0000
9050: 15 ALO 9053 9054 symb: 9050 alo 1f 2f 0731-Acc = TLU 9052+Acc = TLU 9048 9058
9054: 20 STL 9055 9056 symb: 2 stl hld 0732-Store TLU instr at hld=9055
9056: 69 LDD 9052 9057 symb: lod 9052 0733-DIST=1
9057: 27 SET 9002 0496 symb: set 9002 d 0734-
0496: 09 LDI 7750 9055 symb: ldi a0001c hld 0735-copy from 1750+IRC=1800 Copy 1800-1849 to 9002-9051 (50 words) = 8888888888
9055: 84 TLU 9048 9058 symb: ... Search DIST: 0000000001+ ' ~'
... Found 9048: 8888888888+ 'YYYYY' -> is equiv to 1846, availabiolity for Add 0024
... Result ACC: 0000000000 8490489058+, OV: 1
9058: 16 SLO 9053 9059 symb: 3 slo 1b 0738-Acc=acc-xx9052xxxx=-00 0004 0000: slo TLU base addr to get index on table
9059: 46 BMI 9001 0525 symb: bmi 9001 d 0739-jmp to 9001 if availability found (acc < 0)
9001: 09 LDI 0250 9001 symb: 9001 ldi 30000 9001 0723-Copy 0250-0299 to 9001-9050 (50 words)
9001: 30 SRT 0004 9016 symb: 9001 srt 4 0752-Acc=-4
9016: 58 AXC 8002 9017 symb: axc 8002 0753-IRC=50+Acc=50-4=46
9017: 58 AXC 0050 9002 symb: axc 50 9002 0754-IRC=IRC+50=56+50=96
9002: 60 RAU 7750 9018 symb: 9002 rau a0001c 0755-Now Acc=(1750+IRC)=(1846)=8888888888 0000000000+, OV: 1
9018: 36 SCT 0000 9019 symb: sct 0 0756-Now Acc=8888888888 0000000000+, OV: 1
9019: 82 RAB 8002 9020 symb: rab 8002 0757-IRB=0
9020: 35 SLT 0001 9021 symb: slt 1 0758-Now Acc=8888888880 0000000000+, OV: 1
9021: 31 SRD 4001 9022 symb: srd 1 b 0759-Now Acc=0888888888 0000000000+, OV: 1
9022: 21 STU 7750 9023 symb: stu a0001c 0760-Store Avail data with addr reserved: Write 1846: 0888888888+ this reservation for addr 00024
9023: 60 RAU 8006 9024 symb: rau 8006 0761-AccUp=IRB=0
9024: 19 MPY 9025 9026 symb: mpy 50i 0762-Acc=0x50=0
9026: 82 RAB 8002 9027 symb: rab 8002 0763-IRB=Acc -> IRB=IRB x 50
9027: 65 RAL 8007 0647 symb: ral 8007 d 0764-Acc=IRC=96
0647: 14 DIV 0750 0553 symb: div 4i d d 0765-Acc=24
0553: 19 MPY 9028 0546 symb: mpy 500i d 0766-Acc=AccUpx500+AccLo=0x500+24=24 en AccUp
0546: 15 ALO 8003 9029 symb: alo 8003 0767-Now Acc=0000000024 0000000024+, OV: 1
9029: 15 ALO 8006 9003 symb: alo 8006 9003 0768-AccLo=AccLo+B = 24+0=24
9003: 82 RAB 9008 9005 symb: 9003 rab 9008 9005 0769-IRB=0
9005: 47 BOV 9030 9004 symb: 9005 bov 1f 9004 0770-OV Set (set on line 0535- because addr blank)-> Branch Taken
9030: 43 BMB 9000 9050 symb: 1 bmb 9000 0796-IRB=0 (processing DA), continue
9050: 69 LDD 1652 0655 symb: lod o0103 d 0797-Read 1652: 6264980000+??? 0313- ALF BD8 THINK 1652 +62 6498 0000
0655: 23 SIA 2513 9000 symb: sia f0000a 9000 0798-Write 0460=carry= 626498 <0024+>: the IA part of carry is addr reserved
check if resolved addr is in drum/ias
9000: 09 LDI 0303 9029 symb: 9000 ldi 00001 9029 0518-
... Copy 0303-0349 to 9000-9046 (47 words)
9029: 88 RAC 9031 9018 symb: 9029 rac 9031 9018 0582-addr 9031 comes from addr 0334 = save value of IRC = -255 = Save IRC (value to calc return addr from master calculation)
9018: 20 STL 9050 9021 symb: 9018 stl 9050 0590-save absolute location Write 9050: 0000000024+
9021: 35 SLT 0006 9022 symb: slt 6 0591-Now ACC: 0024000000 0024000000+, OV: 0
9022: 16 SLO 8002 9023 symb: slo 8002 0592-AccLo to DIST, Acc=0
9023: 84 TLU 9002 9024 symb: tlu 9002 0593-Search in memory map at lines 0583-0589
... Search DIST: 0024000000+ '~~ '
... Found 9002: 1999000001- ')9 ~'
... Result ACC: 0024000000 0090020000+, OV: 0 -> AccLo = 00 ADDR 0000 addr of datafound
9024: 15 ALO 9025 8002 symb: alo 8002 0594-AccLo=AccLo+80 0000 9026=80 9002 9026=RAA 9002 9026=
8002: 80 RAA 9002 9026 execute created inst: IRA=last 4 digits of found addr=0001- (-> is addr in drum/ias)
9026: 41 BMA 9016 9012 symb: bma 9016 9012 0596-jmp if IRA<0 same as found rlu word <0. <0 if aadr is in range 0000-1999 or 9000-9099
9016: 67 RAM 9404 9216 symb: 9016 ram 9004b 9016a 0597-IRB=0 (=processing DA), IRA=-1 (other options: =0 if < 8000, =1 if <8007, =0 if <9000, =-2 if < 9060, -3 if <= 9099, =0 <= 9999)
9004 9015 (developed addr) ... Read 9004: 0907800000+, Now ACC: 0000000000 0907800000+, OV: 0
9015: 17 AML 9050 9027 symb: 9015 aml 9050 1f 0600-add saved location (saved at lin 590-): Read 9050: 0000000024+, Now ACC: 0000000000 0907800024+, OV: 0
9027: 69 LDD 8003 9028 symb: 1 lod 8003 0602-clear distrib
9028: 23 SIA 9050 9001 symb: sia 9050 9001 0603-Write 9050: 0000000024+
9001: 65 RAL 8001 6300 symb: 9001 ral 8001 300 c 0604-Acc=DA addr=0000000024, jmp to 300+IRC, here IRC=-255 -> jmp to addr 0045 lin 415- (processing the instruction)
back to processing the instruction
0045: 69 LDD 9011 0101 symb: 45 lod 9011 0415-addr 9011 is copied from addr 0314=instr, set in line 0184-instr (addr 0314)=NN xxxx xxxx, NN=instr code. Now DIST: 6005880000+
0101: 35 SLT 0004 0109 symb: slt 4 0416-Now ACC: 0000000000 0000240000+, OV: 0
0109: 22 SDA 0314 0022 symb: sda instr 0417-Set DA part of instr: Write 0314: 6000240000+
0022: 30 SRT 0004 2034 symb: srt 4 34 a 0418-IRA=-1 (da addr is in drum/ias). jmp to 33 if addr in drum/ias, jmp to 34 if addr < 8000, to 35 if <8007, to 34 if <9000, to 32 if < 9060, to 31 if <= 9099, to 34 if <= 9999. here, jmp to 33, ACC: 0000000000 0000000024+, OV: 0
0033: 69 LDD 0188 0091 symb: 33 lod optim 3f 0433-DIST=optim word=NN MM xxxxxx 8to optimize to L+NN/MM). Here Read 0188: 0303050499+
0091: 91 BD1 0244 0062 symb: 3 bd1 proci 0435-Last DIST digit=9 -> continue. jmp to proci If =8 (not an addr for opcode, just a value as number of shifts in SLT)
0062: 20 STL 0190 0244 symb: stl basex proci 0436-save in basex the addr for DA (Write 0190: 0000000024+)
now process Instr Address of instructuon
0244: 89 RSC 0256 0550 symb: proci rsc 256 imast 0438-IRC=-256 -> set return addr to to return to lin 0441- (addr 300+(-256)=0044)
0550: 65 RAL 1953 0664 symb: imast ral 1953 imst1 0439-Acc=inst Address in soap source, ACC: 0000000000 6161000000+, OV: 0
0664: 82 RAB 0001 0069 symb: imst1 rab 1 mastr 0440-IRB=1 (=processing IA data addr)
master address calc
for data addr (IA)
determine type of location
0069: 20 STL 0473 0676 symb: mastr stl temp 0480-temp=location as stated in read card (= symbolic addr 'AA ' here) ACC: 0000000000 6161000000+, OV: 0
0676: 69 LDD 8007 0632 symb: lod 8007 0481-DIST=IRC= -256 -> to return to lin 0441-
0632: 24 STD 0334 0490 symb: std 00032 0482-Save IRC (value to calc return addr from master calculation)
0490: 35 SLT 0002 1149 symb: slt 2 0483-AccUp=first char of location, now ACC: 0000000061 6100000000+, OV: 0
1149: 27 SET 9000 0106 symb: set 9000 0484-
0106: 09 LDI 0117 0103 symb: ldi q0001 0485-
... Copy 0117-0149 to 9000-9032 (33 words)
0103: 09 LDI 0556 0535 symb: ldi z0001 0486-
... Copy 0556-0582 to 9033-9059 (27 words)
0535: 45 NZE 9002 0489 symb: nze 9002 0487-jmp to 9002 if IA set, continue if IA is blank. Here, jmp to 9002
9002: 44 NZU 9007 9008 symb: 9002 nzu 1f 0493-jmp to 1f if abs addr, continue if symbolic/regional/program point
9007: 15 ALO 9009 9008 symb: alo 90i 1f 0494-ACC: 0000000061 6100000090+, OV: 0
9008: 11 SUP 8003 9010 symb: 1 sup 8003 0495-ACC: 0000000000 6100000090+, OV: 0
9010: 80 RAA 8001 9011 symb: raa 8001 1f 0496-Set IRA with char1 of IA (here = 0061+)
9011: 11 SUP 8003 9012 symb: 1 sup 8003 0497-ACC: 0000000000 6100000090+, OV: 0 this is a posible regional addr
9012: 45 NZE 9013 9014 symb: nze 1f 0498-jmp to 1f if absolute
9013: 24 STD 9006 9015 symb: std 9006 0499-addr 9006=0 (this is the addr converted to numeric result)
9015: 15 ALO 9016 9017 symb: alo 100p 0500-AccLo=AccLo+1000000 = 6100000090+1000000000->ACC: 0000000000 7100000090+, OV: 0
9017: 44 NZU 9018 9019 symb: nzu 2f 0501-continue if char2 is numeric -> regional addr, jmp to 2f y not regional
9019: 51 SXA 0090 9028 symb: 2 sxa 90 0513-IRA=61 (the char1 of IA)-90 (code for '0')=-29
9028: 41 BMA 0620 9029 symb: bma symbld 0514-if <0 -> char1 not numeric -> is symbolic (not prog point) -> jmp to symbl
symbolic addr
search if symbol already defined
0620: 60 RAU 0473 0230 symb: symbl rau temp symb1 0559-Acc=' AA ' symbolic addr, ACC: 6161000000 0000000000+, OV: 0
0230: 35 SLT 0008 0547 symb: symb1 slt 8 0560-ACC: 0000000000 0000000000+, OV: 0
0547: 44 NZU 0203 0204 symb: nzu 1f 0561-jmp to 1f if symbol has 5 chars. here continue
0204: 60 RAU 8001 0611 symb: rau 8001 0562-reload symb ACC: 6161000000 0000000000+, OV: 0
0611: 10 AUP 0914 0769 symb: aup 0000h 0563-Add 0 ???
0769: 11 SUP 8003 0540 symb: sup 8003 2f 0564-Clear Acc, DIST=symbol
0540: 24 STD 1493 0196 symb: 2 std s0294 0566-Save as last Symbol to act as sentinel
0196: 63 TLE 1200 0617 symb: tle s0001 0567-
... Search DIST: 6161000000+ 'AA '
... Found 1493: 6161000000+ 'AA '
... Result ACC: 0000000000 0014930000+, OV: 0
0617: 16 SLO 0120 0475 symb: slo q0004 0568-q0004 is last addr of symb table (defined at lin 0579- Q0004 00 S0294 0): Acc=Acc-00 1493 0000 -> Acc=0
0475: 47 BOV 0590 0530 symb: bov equsy 0569- ???
0530: 46 BMI 0233 0534 symb: bmi 3f 0570-if <0 -> symb found -> jmp to 3f
0534: 49 BMC 9001 0538 symb: bmc 9001 0571-IRC=-0256 (= processing IA) -> jmp to 9001
9001: 09 LDI 0150 0202 symb: 9001 ldi 10001 d 0519-Symb not found -> must reserve an address and define symbol
... Copy 0150-0199 to 9001-9050 (50 words)
0202: 69 LDD 4307 0112 symb: lod dtaggb farbld 0520-read from dtagg+IRB=0307+0001 the tag processed (Read 0308: 0907800000+) tag is 4 last digits
optimization routines
farbl = fix addr blank -> calc the addr for blank IA
0112: 96 BD6 9058 0221 symb: farbl bd6 9058 7f 0640- ??? (check DIST: 0907800000+ = tag for DA)
9058: 88 RAC 9007 9057 symb: 9058 rac 9007 0553-IRC=0, addr 9007 copies from addr 0156 = modet defined at line 1454- modet +00 0000 0000, so IRC=modet=0
9057: 48 NZC 0607 0829 symb: nzc farind 829 0554-IRC is 0 -> jmp to 829
0829: 43 BMB 0682 9005 symb: 829 bmb 9005 0656-IRB is 1 (=processing IA) so jmp 9005
9005: 65 RAL 9039 9015 symb: 9005 ral 9039 0668-Addr 9039 is copied from 0188=optim=optimization word, Now ACC: 0000000000 0303050499+, OV: 1
9015: 42 NZB 9016 9017 symb: nzb 2f 0669-IRB is 1 (=processing IA), so jmp to 2f
9016: 46 BMI 9018 9019 symb: bmi 1f 0670-??? depending on optimiz word (optimiz type?) ACC: 0000000000 0303050499+, OV: 0
9019: 92 BD2 0212 9020 symb: bd2 d 7f 0671-Check DIST: 0303050499+ Digit is 9 -> jmp to 7f
9020: 35 SLT 0004 9017 symb: 7 slt 4 2f 0688-ACC: 0000000303 0504990000+, OV: 0
9017: 20 STL 9058 9025 symb: 2 stl 9058 0689-Save optimization word in 9058: Write 9058: 0504990000+
9025: 65 RAL 9041 9026 symb: ral 9041 0690-Addr 9041 is copied from 0190=basex=DA location as 00 0000 NNNN, now ACC: 0000000000 0000000024+, OV: 0
9026: 14 DIV 9008 0832 symb: div 9008 d 0691-Div basex by 2 (ACC: 0000000000 0000000012+, OV: 0
0832: 44 NZU 9027 9028 symb: nzu 4f 0692-continue if basex odd, jmp to 4f if basex is even
9028: 67 RAM 9058 9031 symb: 4 ram 9058 5f 0696-Acc=basex, now ACC: 0000000000 0504990000+, OV: 0 NN MM 000000 -> NN/MM is L+NN/MM fpr next word to select depending on L odd/even
9031: 30 SRT 0008 9032 symb: 5 srt 8 0697-ACC: 0000000000 0000000005+, OV: 0 -> this is the optimization offset to be added to DA
9032: 15 ALO 9041 9004 symb: alo 9041 9004 0698-AccLo=basex+NN=14+5=29 -> optimized word for symbolic address, now ACC: 0000000000 0000000029+, OV: 0
get the addr to reserve 00..49 (first band)
9004: 14 DIV 9033 0491 symb: 9004 div 50i farofd 0699-div addr by 50, Div result ACC: 0000000029 0000000000+, OV: 0 (AccLo=remainder)
reserve addr in AccUp
0491: 65 RAL 8003 9049 symb: farof ral 8003 9049 0700-Acc=29 = addr to reserve (the remainder of div by 50)
9049: 15 ALO 8002 9034 symb: 9049 alo 8002 0704-
9034: 15 ALO 8002 9035 symb: alo 8002 0705-Acc=116=29x4
9035: 69 LDD 8006 9036 symb: lod 8006 0706-DIST=IRB=1 (=1 means processing IA)
9036: 24 STD 0257 0661 symb: std 30007 d 0707-Save IRB=1 in 30007 (addr 0257)
0661: 82 RAB 0004 9613 symb: rab 4 9013c 0708-Set IRB=4, jmp 9013 (IRC=0, set at line 0554 with value of modet)
9013: 88 RAC 0000 9037 symb: 9013 rac 0 1f 0709-IRC=0
9037: 16 SLO 9033 9038 symb: 1 slo 50i 0711-Acc=116-50=66
9038: 46 BMI 9050 9040 symb: bmi 9050 0712-acc=66>0 -> continue
9040: 58 AXC 0050 9037 symb: axc 50 1b 0713-IRC=IRC+50=50, jmp to 9037 to continue subtracting
9037: 16 SLO 9033 9038 symb: 1 slo 50i 0711-Acc=66-50=16
9038: 46 BMI 9050 9040 symb: bmi 9050 0712-loop again
9040: 58 AXC 0050 9037 symb: axc 50 1b 0713-IRC=IRC+50=100, jmp to 9037 to continue subtracting
9037: 16 SLO 9033 9038 symb: 1 slo 50i 0711-Acc=16-50=-34
9038: 46 BMI 9050 9040 symb: bmi 9050 0712-exit loop
9050: 09 LDI 0917 9051 symb: 9050 ldi 20001 9051 0714-Copy 0917-0926 to 9050-9059 (10 words)
9051: 35 SLT 0004 9050 symb: 9051 slt 4 9050 0730-Acc = -0034 0000, OV: 0
9050: 15 ALO 9053 9054 symb: 9050 alo 1f 2f 0731-Acc = TLU 9052+Acc = TLU 9018 9058
9054: 20 STL 9055 9056 symb: 2 stl hld 0732-Store TLU instr at hld=9055
9056: 69 LDD 9052 9057 symb: lod 9052 0733-DIST=1
9057: 27 SET 9002 0496 symb: set 9002 d 0734-
0496: 09 LDI 7750 9055 symb: ldi a0001c hld 0735-copy from 1750+IRC=1850 Copy 1850-1899 to 9002-9051 (50 words) = 8888888888
9055: 84 TLU 9018 9058 symb: ... Search DIST: 0000000001+ ' ~'
... Found 9018: 8888888888+ 'YYYYY' -> is equiv to 1866, availability for Addr 0029
... Result ACC: 0000000000 8490189058+, OV: 0
9058: 16 SLO 9053 9059 symb: 3 slo 1b 0738-Acc=acc-xx9052xxxx=-00 0034 0000: slo TLU base addr to get index on table
9059: 46 BMI 9001 0525 symb: bmi 9001 d 0739-jmp to 9001 if availability found (acc < 0)
9001: 09 LDI 0250 9001 symb: 9001 ldi 30000 9001 0723-Copy 0250-0299 to 9001-9050 (50 words)
9001: 30 SRT 0004 9016 symb: 9001 srt 4 0752-Acc=-34
9016: 58 AXC 8002 9017 symb: axc 8002 0753-IRC=100+Acc=100-34=66
9017: 58 AXC 0050 9002 symb: axc 50 9002 0754-IRC=IRC+50=66+50=116
9002: 60 RAU 7750 9018 symb: 9002 rau a0001c 0755-Now Acc=(1750+IRC)=(1866)=8888888888 0000000000+, OV: 0
9018: 36 SCT 0000 9019 symb: sct 0 0756-ACC: 8888888888 0000000000+, OV: 0
9019: 82 RAB 8002 9020 symb: rab 8002 0757-IRB=0
9020: 35 SLT 0001 9021 symb: slt 1 0758-Now ACC: 8888888880 0000000000+, OV: 0
9021: 31 SRD 4001 9022 symb: srd 1 b 0759-Now ACC: 0888888888 0000000000+, OV: 0
9022: 21 STU 7750 9023 symb: stu a0001c 0760-Store Avail data with addr reserved: Write 1866: 0888888888+ this reservation for addr 0029
9023: 60 RAU 8006 9024 symb: rau 8006 0761-AccUp=IRB=0
9024: 19 MPY 9025 9026 symb: mpy 50i 0762-Acc=0x50=0
9026: 82 RAB 8002 9027 symb: rab 8002 0763-IRB=Acc -> IRB=IRB x 50
9027: 65 RAL 8007 0647 symb: ral 8007 d 0764-Acc=IRC=116
0647: 14 DIV 0750 0553 symb: div 4i d d 0765-ACC: 0000000000 0000000029+, OV: 0
0553: 19 MPY 9028 0546 symb: mpy 500i d 0766-Acc=AccUpx500+AccLo=0x500+29=29 en AccUp
0546: 15 ALO 8003 9029 symb: alo 8003 0767-Now ACC: 0000000029 0000000029+, OV: 0
9029: 15 ALO 8006 9003 symb: alo 8006 9003 0768-AccLo=AccLo+B = 29+0=29, Now ACC: 0000000029 0000000029+, OV: 0
9003: 82 RAB 9008 9005 symb: 9003 rab 9008 9005 0769-IRB=1 (restore IRB=1=processing IA)
9005: 47 BOV 9030 9004 symb: 9005 bov 1f 9004 0770-OV Not Set (whould been set on line 0535- if addr blank)-> Branch Not Taken
9004: 20 STL 9006 9031 symb: 9004 stl 9006 findx 0771-Save addr to assign to symbol: Write 9006: 0000000029+
add new symbol to symbol table,
add symbol addr to symbol addr table
9031: 60 RAU 9007 9032 symb: findx rau 9007 0772-addr 9007 copies from addr 0256 = level defined at line 0804- level alf +00 0000 0000, so Acc=level=0
last copy operation:
line 723-Copy 0250-0299 to 9001-9050 (50 words)
9032: 88 RAC 8001 9033 symb: rac 8001 0773-IRC=Acc=0=last 4 digits of level=first symbol free in symbol table
9033: 30 SRT 0002 9034 symb: srt 0002 0774-Now ACC: 0000000000 0000000000+, OV: 0
9034: 16 SLO 8002 9035 symb: slo 8002 0775-Clear AccLo
9035: 84 TLU 9011 9036 symb: tlu 9011 0776-addr 9011 copies from addr 0260:
line 1305 30010 BMI 898 3 0260 +46 0898 0003
line 1206 30011 BOV 1 0261 +47 1966 0001
line 1474 30012 BD6 1F 0262 +96 1539 1739
line 1446 30013 WTM 0 B 3 0263 +56 4000 0003
line 1095 30014 BD7 9008 0264 +97 9008 9014
... Search DIST: 0000000000+ ' '
... Found 9011: 4608980003+ '~~8 ~'
... Result ACC: 0000000000 0090110000+, OV: 0
9036: 15 ALO 9037 8002 symb: alo 8002 0777-Add to located addr the instr 64 9999 0594 ->
AccLo=00 9011 0000 + 64 9999 0594
= 6590100594 = RAL 9010 0594
8002: 65 RAL 9010 0594 -addr 9010 copies from addr 0259
line 1490 30009 STD RAMSW 1 0259 +24 0773 0001
... Read 9010: 24 0773 0001+
... ACC: 0000000000 2407730001+, OV: 0
0594: 15 ALO 9007 0501 symb: alo 9007 d 0779-acclo=acclo + level. As level=0, ACC: 0000000000 24 0773 0001+, OV: 0
0501: 20 STL 0256 0509 symb: stl level d 0780-set level: Write 0256: 24 0773 0001+ (=STD RAMSW 0001)
0509: 59 SXC 0293 0915 symb: sxc 293 d 0781-set IRC=irc (that is =level)-293
0915: 49 BMC 9038 0827 symb: bmc store hlt11 0782-if IRC >= 0 -> symb table full
9038: 69 LDD 1493 0596 symb: store lod s0294 d 0783-DIST=symbol to add to table: Read 1493: 6161000000+ 'AA ' (s0294=sentinel for TLU=symb searched)
0596: 24 STD 7493 9039 symb: std s0294c 0784-Store new symbol in symbol table indexed by IRC, -> STD 1200 9039 (developed addr)
9039: 66 RSL 8007 9040 symb: rsl 8007 0785-Set Acc=IRC=index on symbol table, Now ACC: 0000000000 0000000293+, OV: 0
9040: 14 DIV 9041 0206 symb: div 2i d 0786-symbol addr table at e0147. Stores two symbol addr (in DA&IA) per word -> this is why index on e0147 = index on Symb table /2. remainder is used to select DA or IA
293/2 -> Div result ACC: 0000000001 0000000146+, OV: 0
0206: 89 RSC 8002 9042 symb: rsc 8002 0787-IRC=Index on symb table addr=-146
9042: 16 SLO 8001 9043 symb: slo 8001 0788-clear acclo: Read 8001: 0000000146+, Now ACC: 0000000001 0000000000+, OV: 0
9043: 15 ALO 9006 9044 symb: alo 9006 0789-AccLo=symbol addr: Read 9006: 0000000029+, Now ACC: 0000000001 0000000029+, OV: 0
9044: 69 LDD 7196 9045 symb: lod e0147c 0790-e0001=symbol addr table (at addr 1196). IRC=-146 -> LDD 1050 9045 (developed addr), Read 1050: 0000000000+
9045: 44 NZU 9046 9047 symb: nzu 2f 0791-2 addr per word. result of div by 2 set if addr symbol is on DA side or IA side. Now ACC: 0000000001 0000000029+, OV: 0
9046: 35 SLT 0004 9009 symb: slt 4 9009 0792-Store on DA -> shift to DA position. Now ACC: 0000010000 0000290000+, OV: 0
9009: 22 SDA 7196 9048 symb: 9009 sda e0147c 0793-Store DA on Symbol Addr table
9048: 30 SRT 0004 9049 symb: srt 4 3f 0794-restore addr, Now ACC: 0000000001 0000000029+, OV: 0
9049: 47 BOV 4002 9000 symb: 3 bov 2 b 9000 0799-IRB=1, but OV=0 -> return to 9000
check if resolved addr is in drum/ias
9000: 09 LDI 0303 9029 symb: 9000 ldi 00001 9029 0518-
... Copy 0303-0349 to 9000-9046 (47 words)
9029: 88 RAC 9031 9018 symb: 9029 rac 9031 9018 0582-addr 9031 comes from addr 0334 = save value of IRC = -256 = Save IRC (value to calc return addr from master calculation)
9018: 20 STL 9050 9021 symb: 9018 stl 9050 0590-save absolute location addr Write 9050: 0000000029+
9021: 35 SLT 0006 9022 symb: slt 6 0591-Now ACC: 0001000000 0029000000+, OV: 0
9022: 16 SLO 8002 9023 symb: slo 8002 0592-AccLo to DIST, ACC=0001000000 0000000000+, OV: 0
9023: 84 TLU 9002 9024 symb: tlu 9002 0593-Search in memory map at lines 0583-0589
... Search DIST: 0029000000+ ' * '
... Found 9002: 1999000001- ')9 ~'
... Result ACC: 0001000000 0090020000+, OV: 0 -> AccLo = 00 ADDR 0000 addr of data found
9024: 15 ALO 9025 8002 symb: alo 8002 0594-Read 9025: 8000009026+, ACC: 0001000000 8090029026+, OV: 0
8002: 80 RAA 9002 9026 Read 9002: 1999000001-, IRA: 0001-
Set IRA=contents of addr 9002=-1.
9026: 41 BMA 9016 9012 symb: bma 9016 9012 0596-
9016: 67 RAM 9404 9216 symb: 9016 ram 9004b 9016a 0597-ACC: 0000000000 0907800000+, OV: 0
9015: 17 AML 9050 9027 symb: 9015 aml 9050 1f 0600-Read 9050: 0000000029+, ACC: 0000000000 0907800029+, OV: 0
9027: 69 LDD 8003 9028 symb: 1 lod 8003 0602-clear distrib
9028: 23 SIA 9050 9001 symb: sia 9050 9001 0603-Write 9050: 0000000029+
9001: 65 RAL 8001 6300 symb: 9001 ral 8001 300 c 0604-Acc=addr, jmp to 300+IRC = 300+(-256) = 44 (line 0441-)
back to processing the instruction
0044: 69 LDD 9011 0600 symb: 44 lod 9011 alfin 0441-The addr 9011 holds the inst being assmbled: Read 9011: 60 0024 0000+ already has OpCode (RAU=60), DA (=0024). Now will set IA
0600: 23 SIA 9011 0207 symb: alfin sia 9011 0442-Set IA on instr assembled: Write 9011: 6000240029+
0207: 69 LDD 1960 0764 symb: lod 1960 0443-Read 1960: 0000908000+ source code control word
0764: 96 BD6 0622 0527 symb: bd6 1f 0444- 8-> instr is negative, 9=positive, Now DIST: 0000908000+
0527: 65 RAL 9011 0241 symb: ral 9011 2f 0445-get inst assembled as positive value: Read 9011: 6000240029+
0241: 15 ALO 9000 0008 symb: 2 alo 9000 3f 0451-addr 9000 comes from addr 0303 adend set at line 0470-; Now Read 9000: 0000000000+, ACC: 0000000000 6000240029+, OV: 0
0008: 20 STL 0314 2219 symb: 3 stl instr 219 a 0452-save instr assembled. IRA=output mode: -1 -> 1-card output format
select output mode
0218: 65 RAL 0477 0081 symb: 218 ral fivtg pnch1 0453-Read 0477: 8888888888-, ACC: 0000000000 8888888888-, OV: 0
0081: 46 BMI 0642 0635 symb: pnch1 bmi 9f 2f 0921-jmp to 2f if is 5 word per card mode
0642: 65 RAL 0046 0601 symb: 9 ral 533tl 0943-now 533tl=0
0601: 45 NZE 0684 0705 symb: nze corof 0944-jmp to corof if NO core mode
0705: 65 RAL 1961 0766 symb: ral locat 0945-assembled instr location: Read 1961: 1221000000+, ACC: 0000000000 1221000000+, OV: 0
0766: 16 SLO 0368 0773 symb: slo n0027 ramsw 0946-Read 0368: 4905050598+, now ACC: 0000000000 3684050598-, OV: 0
0773: 46 BMI 0684 0685 symb: ramsw bmi corof corsw 0985-jmp to NO core mode (corof)
0684: 88 RAC 0209 0890 symb: corof rac finis prone 1000-jmp to prone (print one card), the jmp to finis (IRC=0209)
print/punch one card
0890: 81 RSA 0001 1496 symb: prone rsa 1 1002-IRA=-1
1496: 69 LDD 1449 0757 symb: lod onesw 1003-Read 1449: 9999999999-
0757: 92 BD2 0830 1017 symb: bd2 9f 1004-
1017: 50 AXA 0001 0026 symb: axa 1 90001 1005-IRA=0
0026: 67 RAM 0780 0893 symb: 90001 ram locus 1010-Read 0780: 0000001221+ <-- addr of assembled instr
0893: 35 SLT 0005 0656 symb: slt 5 1011-ACC: 0000000000 0122100000+, OV: 0
0656: 27 SET 9057 0930 symb: set 9057 1012-
0930: 15 ALO 0585 0694 symb: alo ccnt1 1013-ccnt1 = card count <- number of cards punched
0694: 15 ALO 0897 0604 symb: alo 1ixxx 1014-incr, now ACC: 0000000000 0122100001+, OV: 0
0604: 29 STI 1957 0770 symb: sti 1957 1015-
... Copy 9057-9059 to 1957-1959 (3 words)
0770: 23 SIA 0585 0940 symb: sia ccnt1 1016-store updated ccnt1: Write 0585: 0000000001+
0940: 27 SET 9040 1045 symb: set 9040 1017-
1045: 09 LDI 1951 0672 symb: ldi 1951 1018-copy read card area to punch card area
... Copy 1951-1970 to 9040-9059 (20 words)
0672: 20 STL 9048 1030 symb: stl 9048 1019-Write 9048: 0122100001+
1030: 65 RAL 9050 0687 symb: ral 9050 1020-Read 9050: 1221000000+, ACC: 0000000000 1221000000+, OV: 0
0687: 10 AUP 9049 1495 symb: aup 9049 1021-Read 9049: 0000908000+, ACC: 0000908000 1221000000+, OV: 0
1495: 35 SLT 0003 0703 symb: slt 3 1022-
0703: 30 SRT 0003 0762 symb: srt 3 1023-
0762: 47 BOV 0916 0633 symb: bov 1f 1024- ???
0633: 30 SRT 0002 0639 symb: srt 2 1025-ACC: 0000009080 0012210000+, OV: 0
0639: 22 SDA 9047 0706 symb: sda 9047 1026-Write 9047: 0012218000+ <- location and card type
0706: 69 LDD 0314 1018 symb: lod instr 1027-Read 0314: 6000240029+ <- assembled instr
1018: 24 STD 9046 0683 symb: std 9046 1028-
0683: 35 SLT 0002 0939 symb: slt 2 1029-ACC: 0000908000 1221000000+, OV: 0
0939: 17 AML 0046 0901 symb: aml 533tl 2f 1030-read 0046: 0000000000+
0901: 16 SLO 9050 0709 symb: 2 slo 9050 1033-Read 9050: 1221000000+, Now ACC: 0000908000 0000000000+, OV: 0
0709: 69 LDD 8003 0671 symb: lod 8003 1034-Read 8003: 0000908000+
0671: 23 SIA 9049 2028 symb: sia 9049 90003a 1035-Set punch control word (Write 9049: 0000900000), jmp to 0028+IRA, as IRA=* -> jmp to 0028
0028: 71 WR1 9040 0830 symb: 90003 wr1 9040 9f 1006-punch at last
L: ... Punch Card Unit CDP1
L: ... Punch Card 9040: 0091929291+ ' 1221'
L: ... Punch Card 9041: 0000000000+ ' '
L: ... Punch Card 9042: 6161000000+ 'AA '
L: ... Punch Card 9043: 7961840000+ 'RAU '
L: ... Punch Card 9044: 0000000000+ ' '
L: ... Punch Card 9045: 0000000000+ ' '
L: ... Punch Card 9046: 6000240029+ '~ ~ *' <- instr
L: ... Punch Card 9047: 0012218000+ ' ~~~ ' <-- xx NNNN xxxx location
L: ... Punch Card 9048: 0122100001+ '~~~ ~' <-- xx xxxx NNNN card count
L: ... Punch Card 9049: 0000900000+ ' 0 '
L: Punch Card: 6I1954195C 0001241221800?600024002I 1221rau aa
0830: 69 LDD 1448 0851 symb: 9 lod prtsw 1007-Read 1448: 8888888888-
0851: 92 BD2 0554 2027 symb: bd2 9f 90002a 1008-jmp to 9f (no PTR output selected)
0554: 47 BOV 6000 6000 symb: 9 bov 0 c 0 c 1036-clear OV, jmp to IRC=209
0209: 65 RAL 1962 0067 symb: finis ral progp 0458-finish instr processing. progp=0 -> Acc=0
0067: 45 NZE 0121 0949 symb: nze 1f 0459-Acc=0 -> jmp to 1f
0949: 60 RAU 0256 0511 symb: 1 rau level 0465-Now ACC: 2407730001 0000000000+, OV: 0
0511: 24 STD 0215 0674 symb: std kee 0466-???
0674: 60 RAU 0927 0532 symb: rau corec 0467-???, Now Acc: 0000008999 0000000000+, OV: 0
0532: 20 STL 0188 0542 symb: stl optim 0468-clear optim var
0542: 21 STU 0096 1049 symb: stu keepp 0469-???, Write 0096: 0000008999+
1049: 20 STL 0303 0507 symb: stl adend 0470-???, Write 0303: 0000000000+
0507: 69 LDD 0460 0615 symb: lod carry 0471-Read 0460: 6264980024+
0615: 24 STD 0223 0526 symb: std keep ssout 0472-???
0526: 70 RD1 1999 1998 symb: ssout rd1 1999 start 0474-
L: Read Card: rauaa
L: ... Read Card Unit CDR1
L: ... Read Card 1951: 0000000000+ ' '
L: ... Read Card 1952: 6161000000+ 'AA '
L: ... Read Card 1953: 0000000000+ ' '
L: ... Read Card 1954: 7961840000+ 'RAU '
L: ... Read Card 1955: 0000000000+ ' '
L: ... Read Card 1956: 0000000000+ ' '
L: ... Read Card 1957: 0000009999+ ' 99'
L: ... Read Card 1958: 0000009999+ ' 99'
L: ... Read Card 1959: 0000009999+ ' 99'
L: ... Read Card 1960: 0000908000+ ' 0~ '
1998: 60 RAU 1960 0015 symb: start rau 1960 0127-

209
I650/sw/supersoap/build_ssoap_ramac_src.txt Normal file
View file

@ -0,0 +1,209 @@
1 builds supersoap in ramac
1 using ssoap_loader.dck and
1 ssoap_main.dck as input
1 ssoap_core.dck as input
1 print disc-track saved
syn 1961
syn 1962
syn 1963
1000lodrdld clias start: call clear ias, then jmp to read loader deck
1 save main deck in ramac, starting at disk 38, track 00
dskad 00 0003 8000
1 clear ias routine
cliasstdexit0 save exit word
raa 59 ira = 59
ralzero 1f clear acc
1 stu 9000a store in 9000+ira
sxa 1
bmaexit0 1b
1 process ssoap loader deck
1 loader deck will be stored in core in 9000-9039
1 last instr of loader deck should have loc 1999
rdld rd1 1961 1961 read loader deck card
1961ral 1951 get word1 (sets card type)
slotyc
nzerdld skip non type c cards
rau 1953 get word3 (location in da)
slt 2
srt 6
stuloc save location
sup9k if >= 9000 jmp to 1f
bmi 1f
ralloc add core offset so loc 1966
alocofs becomes 9006 (in core)
stlloc 1f
1 ralloc
raa 8002 ira=loc in core
lod 1954 get word4 (instruction word)
std 0000a store at loc
sloldend if loc!=9039 then
nzerdld cl2 jmp to read next card
tyc 69 1954 1953 first word on type c cards
loc 00 0000 0000 soap deck card location
9k 00 0000 9000
cofs 00 0000 7040 core offset = 9000 minus 1960
ldend 00 0000 9039 last addr of loader routine in core
1 ssoap loader deck processed
1 loader deck is now stored in core in 9000-9039
1 process ssoap main deck
1 loader deck will be stored in core starting at 9040
1 when core filled, track is written
1 main deck should be sorted in location ascending order
1 last instr of main deck should have loc 1999
cl2 raa 0 next main dec loc to store
rab 40 rdma first addr free in core
rdma rd1 1962 1962 read main deck card
1962ral 1951 get word1 (sets card type)
slotyc
nzerdma skip non type c cards
rau 1953 get word3 (location in da)
slt 2
srt 6
stuloc save location
sup9k if >= 9000 jmp to error halt
bmi hlt2
ralloc if card location < last card
slo 8005 jmp to error halt
bmihlt2
nze 2f jmp to 2f if ira=loc
rac 8002 irc=number of zero cards to save to core to arrive to last card location
lodzero store zero in core
stdsvw 1f word to save in core
1 lod svcor call store in core, B++, A++, write track if core full
sxc 1
nzc1b 2f jmp to 2f when loc=IRA
2 lod 1954 get word4 (instruction word)
stdsvw word to save in core
lod svcor call store in core, B++, A++, write track if core full
ralloc
slomaend if loc!=1999 then
nzerdma cl3 jmp to read next card
1 ssoap main deck processed
1 main supersoap program is now stored in ramac
1 tracks 00-33
1 process ssoap core deck
1 these decks goes to tracks 34-66. deck loads to
1 9000-9059, final cdd pseudo op stores it to given track
cl3 lddrdco clias clear ias
rdco rd1 1963 1963 read core deck card
1963ral 1951 get word1 (sets card type)
slotya is type-a card
nze1f if not, then jmp to type-c check
ral 1955 get word5 (loc+opcode, as digits)
srt 5
sloii38 is 00038xxxxx
nze1f if not, then jmp to type-c check
ral 1955 is cdd, so get track
srt 3
slt 1
stldskad
lod svtr call save track routine
rau 1955 if saved disk 38, track 66
supii38b then jmp to cl4 (load core finished)
nzucl3 cl4 else jmp to clear ias to read next track
1 ral 1951
slotyc
nzerdco skip non type c cards
rau 1953 get word3 (location in da)
slt 2
srt 6
stuloc save location
sup9k if < 9000 jmp to read next card
bmirdco
ralloc is 9000 word, store in ias
raa 8002 ira=loc in core
lod 1954 get word4 (instruction word)
std 0000ardco store at loc, jmp to read next card
tya 00 0000 8000 first word on type a cards
ii38 00 0000 0038
ii38b 00 0386 6000
1 finish ok. main deck loaded in ramac, with load routine
cl4 ral 9000 read from ias to force the cpu to wait on ias
interlock up to last write pending in ramac has
finished before halting the cpu
hlt 0000 9898 finish ok
hlt1 hlt 1111 9999 cards at loc 90XX not allowd in main deck
hlt2 hlt 2222 9999 last card is not in ascending order
zero 00 0000 0000
maend 00 0000 1999 last addr of main deck in drum
1 call store in core, incr irb, incr ira, write track if core full
svcorstdexit0 save exit word
lodsvw load word
std 9000b and save in core
axa 1 incr ira
axb 1 incr irb
ral 8006 if irb<60
slocoful then exit
nzeexit0 1f
svtr stdexit0 1f save core to track
1 loddskad core full. seek ramac address to save core
sds 9000
wds 9000 write core in ramac at address dskad
raldskad punch track saved
slt 5 as dd tt00 0000
stl 1977 where dd=disk number=38
rauzero tt=track number from 00 to 33
std 1978
std 1979
std 1980
std 1981
std 1982
std 1983
std 1984
wr1 1977
raldskad increment track number for next write
alonxtr
stldskad
rab 0 exit0 core saved. reset irb (core empty again) and exit
exit0 00 0000 0000 routine return jmp to saved exit word
svw 00 0000 0000 word to save in core
coful 00 0000 0060 core is full
nxtr 00 0000 0010 to increment track number
end

3565
I650/sw/supersoap/ssoap.txt Normal file
View file

File diff suppressed because it is too large Load diff

1
I650/sw/supersoap/ssoap_calling_card.dck Normal file
View file

@ -0,0 +1 @@
6519541957 SUPERSOAP360001195500000380024719589876+(date)+++85900019538690009000

10
I650/sw/supersoap/ssoap_calling_card.txt Normal file
View file

@ -0,0 +1,10 @@
1951: 65 1954 1957+ RAL 1954 1957
1952: 00 0759 0617- S UPER SOAP
1953: 36 0001 1955+ SCT 0001 1955
1954: 00 0003 8002+ NOP 0003 8002
1955: 47 1958 9876+ BOV 1958 9876
1956: 00 0000 0000+ (date)
1957: 85 9000 1953+ SDS 9000 1953
1958: 86 9000 9000+ RDS 9000 9000

2021
I650/sw/supersoap/ssoap_core.dck Normal file
View file

File diff suppressed because it is too large Load diff

22
I650/sw/supersoap/ssoap_example.txt Normal file
View file

@ -0,0 +1,22 @@
0001 1 EXAMPLE CALCULATE F OF X
0002
0003 BLR 1951 1960 READ AREA
0004 P0001 BLR 27 P0002 PUNCH AREA
0005 START RAU ONE 1F SET X 0004 +60 0007 0011
0006 1 STU P0001 TO 1 0011 +21 0027 0030
0007 MPY A CALCULATE 0030 +19 0033 0003
0008 ALO B F 0003 +15 0006 0061
0009 RAU 8002 0061 +60 8002 0019
0010 MPY P0001 0019 +19 0027 0047
0011 ALO C 0047 +15 0000 0005
0012 STL P0002 0005 +20 0028 0031
0013 WR1 P0001 PUNCH 0031 +71 0027 0037
0014 RAU P0001 0037 +60 0027 0081
0015 SUP XMAX IS X MAX 0081 +11 0034 0039
0016 NZU 9876 0039 +44 0043 9876
0017 AUP 101 1B INCREASE X 0043 +10 0046 0011
0018
0019 ONE 00 0000 0001 CONSTANTS 0007 +00 0000 0001
0020 XMAX 00 0000 0100 0034 +00 0000 0100
0021 101 00 0000 0101 0046 +00 0000 0101
0022 END

22
I650/sw/supersoap/ssoap_example_src.txt Normal file
View file

@ -0,0 +1,22 @@
1 example calculate f of x
blr 1951 1960 read area
p0001blr 27 p0002 punch area
startrauone 1f set x
1 stup0001 to 1
mpya calculate
alob f
rau 8002
mpyp0001
aloc
stlp0002
wr1p0001 punch
raup0001
supxmax is x max
nzu 9876
aup101 1b increase x
one 00 0000 0001 constants
xmax 00 0000 0100
101 00 0000 0101
end

59
I650/sw/supersoap/ssoap_loader_src.txt Normal file
View file

@ -0,0 +1,59 @@
1
1 dsk output from 0000 1999
1 loads supersoap from dsk to drum
1 page 52 of supersoap manual
1 this routine loads tracks 00-33 from ramac
1 to drum addr 0000-1999
1 this routine is stored in disk 38, track 00
1 when track is read to core, the routine
1 uses words 9000-9039.
1 this routine starts al 9000 and is called
1 by ssoap_calling_card.
1 when called distributor should have the disk
1 addr of this loader (000 03800 0)
1 loads words 9040-9059 to drum 0000-0019
1 then read next track and stores it in drum 0020-0080
1 and so on up to track 33. then routine jumps
1 to transfer intruction
1
blr 0 1999
bla 1966 1999
rd syn 9004
j0001blr 1971 j0006
9000rau 8001 9001
9001rsa 1700 9002
9002alord 9003
9003rab 0 9005
9005sti 1965 2f
2 aup10i
lod 8003
sds 9000 j0001b
j0001sti 1700a 8002
rd rds 9000
axb 1 2b
j0002sti 1720a
sti 1750a 8002
j0003sti 1780a
sti 1800a 8002
j0004sti 1840a
bma 9f
sti 1850a 8002
j0005sti 1900a
sti 1950a 8002
j0006sti 1960a
axa 300
rab 0 j0001
9 lod1f
sti 1950 8001
10i 00 0 10
1 transfer instruction
1 rd1 1999 1998
end

1524
I650/sw/supersoap/ssoap_main.dck Normal file
View file

File diff suppressed because it is too large Load diff

3555
I650/sw/supersoap/ssoap_main_core_src.txt Normal file
View file

File diff suppressed because it is too large Load diff

98
I650/tests/i650_test.ini Normal file
View file

@ -0,0 +1,98 @@
:: i650_test.ini
::
:: there are not know diagnostic program for ibm 650.
:: so sanity check of simulator is done by executing some programs
::
cd %~p0
cd ../sw
set console -n log=console.txt
set debug -q -n debug.txt
set cpu debug=cmd;data;detail
set mt debug=cmd;data;detail;exp
set dsk debug=cmd;data;detail;exp
:: Limit maximum diagnostic execution time
runlimit 2 minutes
set on
on error ignore
on runtime echof "\r\n*** Test Runtime Limit %SIM_RUNLIMIT% %SIM_RUNLIMIT_UNITS% Exceeded ***\r\n"; exit 1
:: Basic Opcodes test
echof
echof
echof "** IBM 650: Basic Instruction Test: "
do run_fds.ini fds/example.txt
if ar!=9999 echof "FDS failed (bad ar)";exit 1
:: checks mem contents
if 0977!=0000000009 echof "FDS failed (bad 0977)";exit 1
if 0978!=5090000000 echof "FDS failed (bad 0978)";exit 1
if 0979!=5030000000 echof "FDS failed (bad 0979)";exit 1
echof "FDS Ok"
echof "** Test: passed."
echof
echof
echof "** IBM 650: Floating Point Instruction Test: "
do run_fortransit.ini fortransit/fortransit_example_2_src.txt fortransit/fortransit_example_2_data.txt
if -f not "deck_out.dck" == "../tests/testmm.dck" echof "FORTANSIT Mat Mult failed"; exit 1
echof "FORTRANSIT Ok"
echof "** Test: passed."
echof
echof
echof "** IBM 650: Index, IAS and RAMAC: "
do run_supersoap_ramac.ini supersoap/ssoap_example_src.txt
if ar!=9898 echof "SuperSoap failed (bad ar)";exit 1
if -f not "deck_out.dck" == "../tests/ssoapexpl.dck" echof "SuperSoap Example failed"; exit 1
echof "SuperSoap Ok"
echof "** Test: passed."
echof
echof
echof "** IBM 650: 4k Drum and Tape: "
do build_soap4_tap_lib.ini
if ar!=0002 echof "Soap4 failed (bad ar)";exit 1
if -f not "deck_out.dck" == "../tests/soap4tap.dck" echof "Soap4 tap lib failed"; exit 1
echof "Soap4 Ok"
echof "** Test: passed."
echof
echof
echof "** clean up temp files generated during tests "
det all
set -q nodebug
set -q console nolog
del -q debug.txt
del -q print.txt
del -q console.txt
del -q deck_out_run.dck
del -q deck_out_pat.dck
del -q deck_out_5cd.dck
del -q deck_out.dck
del -q deck_in.dck
echof
echof
echof "!! All Tests Passed !!"
echof
exit 0
:end

13
I650/tests/soap4tap.dck Normal file
View file

@ -0,0 +1,13 @@
0?0000800? 0001 1 soap test tap
0?0000800? 0002 1
0?0000800? 0003 equsub1 1000
0?0000800? 0004 1
6I1954195C 0005241000800?000000000D sub1 nop 0000 sub2 commen
0?0000800? 0006 1 sub2 tap
6I1954195C 0007240004800?000002000H sub2 nop 0002 comment
6I1954195C 0008240008800?010002001B hlt 0002
0?0000800? 0009 1
6I1954195C 0010240012800?010001001F hlt 0001
0?0000800? 0011 pst
0?0000800? 0000 equsub1 1000
0?0000800? 0000 equsub2 0004

22
I650/tests/ssoapexpl.dck Normal file
View file

@ -0,0 +1,22 @@
?000008000 0001 1 example calculate f of x
?000008000 0002
?000008000 0003 blr 1951 1960 read area
?000008000 0004 p0001blr 27 p0002 punch area
F919541953 0005240004800?600007001A startrauone 1f set x
F919541953 0006240011800?210027003? 1 stup0001 to 1
F919541953 0007240030800?190033000C mpya calculate
F919541953 0008240003800?150006006A alob f
F919541953 0009240061800?608002001I rau 8002
F919541953 0010240019800?190027004G mpyp0001
F919541953 0011240047800?150000000E aloc
F919541953 0012240005800?200028003A stlp0002
F919541953 0013240031800?710027003G wr1p0001 punch
F919541953 0014240037800?600027008A raup0001
F919541953 0015240081800?110034003I supxmax is x max
F919541953 0016240039800?440043987F nzu 9876
F919541953 0017240043800?100046001A aup101 1b increase x
?000008000 0018
F919541953 0019240007800?000000000A one 00 0000 0001 constants
F919541953 0020240034800?000000010? xmax 00 0000 0100
F919541953 0021240046800?000000010A 101 00 0000 0101
?000008000 0022 end

12
I650/tests/testmm.dck Normal file
View file

@ -0,0 +1,12 @@
48000000520000000001000000000100000000000000000000000000000000000000000000010004
110000005L0000000002000000000100000000000000000000000000000000000000000000020004
30300000530000000003000000000100000000000000000000000000000000000000000000030004
166000005L0000000004000000000100000000000000000000000000000000000000000000040004
100000005L0000000001000000000200000000000000000000000000000000000000000000050004
69000000520000000002000000000200000000000000000000000000000000000000000000060004
262000005L0000000003000000000200000000000000000000000000000000000000000000070004
19200000530000000004000000000200000000000000000000000000000000000000000000080004
13900000530000000001000000000300000000000000000000000000000000000000000000090004
80000000510000000002000000000300000000000000000000000000000000000000000000100004
32400000530000000003000000000300000000000000000000000000000000000000000000110004
16900000530000000004000000000300000000000000000000000000000000000000000000120004

2
README.md
View file

@ -100,6 +100,8 @@
#### Hans-Åke Lund has implemented an SCELBI (SCientic-ELectronics-BIology) simulator.
#### IBM 650 simulator from Roberto Sancho Villa
### New Host Platform support - HP-UX and AIX
### Simulator Front Panel API

8
Visual Studio Projects/I650.vcproj
View file

@ -203,6 +203,14 @@
RelativePath="..\I650\i650_cpu.c"
>
</File>
<File
RelativePath="..\I650\i650_dsk.c"
>
</File>
<File
RelativePath="..\I650\i650_mt.c"
>
</File>
<File
RelativePath="..\I650\i650_sys.c"
>

9
Visual Studio Projects/Simh.sln
View file

@ -403,6 +403,11 @@ Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "PDP10-KL", "PDP10-KL.vcproj
{D40F3AF1-EEE7-4432-9807-2AD287B490F8} = {D40F3AF1-EEE7-4432-9807-2AD287B490F8}
EndProjectSection
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "I650", "I650.vcproj", "{95B64699-4B93-4BFE-9024-0A2302D9B71A}"
ProjectSection(ProjectDependencies) = postProject
{D40F3AF1-EEE7-4432-9807-2AD287B490F8} = {D40F3AF1-EEE7-4432-9807-2AD287B490F8}
EndProjectSection
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Win32 = Debug|Win32
@ -733,6 +738,10 @@ Global
{DA2AA7A0-B679-456B-B152-DEF40FAE5A7A}.Debug|Win32.Build.0 = Debug|Win32
{DA2AA7A0-B679-456B-B152-DEF40FAE5A7A}.Release|Win32.ActiveCfg = Release|Win32
{DA2AA7A0-B679-456B-B152-DEF40FAE5A7A}.Release|Win32.Build.0 = Release|Win32
{95B64699-4B93-4BFE-9024-0A2302D9B71A}.Debug|Win32.ActiveCfg = Debug|Win32
{95B64699-4B93-4BFE-9024-0A2302D9B71A}.Debug|Win32.Build.0 = Debug|Win32
{95B64699-4B93-4BFE-9024-0A2302D9B71A}.Release|Win32.ActiveCfg = Release|Win32
{95B64699-4B93-4BFE-9024-0A2302D9B71A}.Release|Win32.Build.0 = Release|Win32
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE

BIN
doc/i650_doc.doc
View file

Binary file not shown.

5
makefile
View file

@ -1586,7 +1586,7 @@ I7094_OPT = -DUSE_INT64 -I ${I7094D}
I650D = ${SIMHD}/I650
I650 = ${I650D}/i650_cpu.c ${I650D}/i650_cdr.c ${I650D}/i650_cdp.c \
${I650D}/i650_sys.c
${I650D}/i650_dsk.c ${I650D}/i650_mt.c ${I650D}/i650_sys.c
I650_OPT = -I ${I650D} -DUSE_INT64 -DUSE_SIM_CARD
@ -2099,7 +2099,7 @@ ALL = pdp1 pdp4 pdp7 pdp8 pdp9 pdp15 pdp11 pdp10 \
swtp6800mp-a swtp6800mp-a2 tx-0 ssem b5500 isys8010 isys8020 \
isys8030 isys8024 imds-210 imds-220 imds-225 imds-230 imds-800 imds-810 \
scelbi 3b2 i701 i704 i7010 i7070 i7080 i7090 \
sigma uc15 pdp10-ka pdp10-ki pdp10-kl pdp6
sigma uc15 pdp10-ka pdp10-ki pdp10-kl pdp6 i650
all : ${ALL}
@ -2862,7 +2862,6 @@ endif
i650 : ${BIN}i650${EXE}
${BIN}i650${EXE} : ${I650} ${SIM}
#cmake:ignore-target
${MKDIRBIN}
${CC} ${I650} ${SIM} ${I650_OPT} ${CC_OUTSPEC} ${LDFLAGS}
ifneq (,$(call find_test,${I650D},i650))