/fortran subr. package - tape 1 --------------- /24 nov 65 /version 003 /errors_. /illegal op.code 140000 is used for error halts /the addr. part indicates the type of error /push continue twice to get past the halt /140001 = mul div switches not on - program will not run until switches are on /140002 = paper tape parity error - put char. in TW, push continue twice /140003 = illegal format, nogo /140004 = no c/r at end of format (paper tape input) /140005 = non digit char. in i or f input, go on - invalid char. used anyway /140006 = ------- not used --------------------------- /140007 = overflow - i input - go on and overflowed value used anyway /140010 = printer error status bit on - go on and status is rechecked /140011 = do index .> | 131071| ,go on - index invalid /140012 = flt. no. too large to convert to fixed pt., go on - trash for fixed pt. no. /140013 = not enough room in array storage, compiler error or array ig's used as decal inserts /140014 = too many subsc. or out of range, go on - invalid subsc. used anyway /140015 = out of bounds of array, go on - invalid subsc. used anyway /140016 = recursive subsc. - not allowed /140017 = exponent underflow, no go /140020 = exponent overflow, no go /140021 = sqrtf has a negative argument - go on, argument made positive /140022 = logf or log10f argument .< 0 no go /addr. 7777 is used for various debug. switches /bit 0 on = type overbar at start of every format check /bit 1 on = output number even if "f" or "i" field overflows /addr. 7775 and 7776 are used for escape char. in the format routines /if the input char. is the same as the char. in either address, for f, i, a, or x, /the input for the field is terminated and the next format specification is checked /normally c(7775) = tab, and c(7776) = carriage return xsy cal lap dpy srb iot xsy rcb cnv esm lsm cbs msm xsy mwc mrc mcb rck cac eem lem xsy procedure [ xsy mcs chn mec dao iso isd xsy asd aso asc dsc isb bac xsy bpc bio bjm dal xsy goto < .< > .> ^ xsy sin cos atn sqrt ln log exp exp10 |= xsy if then else clear set for stepu stepd xsy until while do <= xsy .>>04<< .= xsy mus dis xsy / x float unflt x dig beg lv6 op2 rs1 cmt jda fsy flexo imp lac 2 lst end / dig beg lv6 op2 rs1 jda fsy flexo idv lac 2 fde lst hlt end dss flc fdc fsb fad fmp fdv dss idv imp float unflt dss fbd sof /the following is used only during initialization of the array area and /is cleared and overlapped by the arrays />>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<< typ4, 0 dap typ4exit law i 4. => ct lio typ4 ril 6s jmp .+2 typ4loop, lio typ4 cla rcl 3s dio typ4 sza i law 20 jda swap jsp typ isp ct jmp typ4loop typ4exit, jmp 0 clear, sub (1 dap exit law 1 /check for mul div switches on mul (77 div (77 jmp .+3 sad (1 jmp .+3 oct 140001 /halt - switches are not on jmp .-7 lac cpbinst /change "jda arf" to "cpb" intext / dac i exit law 36 dac 7775 lio /.77 dio 7776 jsp typ lac arf sza i jmp exit-1 final - arf => arf tpo text /arrays / lac arf jda typ4 cli jsp typ lac final jda typ4 lio (77 jsp typ lac arf lio final jmp back cpbinst, oct 730445 /^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ /the above is all overlapped by the arrays final, loc .-1 arf' 0 jmp clear back, jda clearmem lac final dac i arf cla cli clf 7 exit, jmp 0 blk errfmt' lac 7777 ral 1s spa jmp tryit lio (flexo - xct unit isp w1m jmp .-3 jmp nxtlist tryit, idx w1 szf 4 jmp iout jmp fout digit, 0 dap exit lac digit sub (dec 10 sma oct 140005 /non-digit halt lac digit exit, jmp 0 blk /interchange AC and IO swap,swf' 0 dap exit lac swap rcr 9s rcr 9s exit, jmp 0 blk /get a char. from the typewriter typin, dap exit cla cli clf 1 szf i 1 jmp .-1 clf 1 tyi dio swap lac swap sad 7776 jmp exit sad 7775 jmp exit idx exit lac swap exit, jmp 0 blk leav, idx return jsp eol rtf'return,list, jmp 0 ti, jsp typin tif'sv1, 0 dap return lac tif lio ti jmp in typ' dap .+10 dio swap cks ril 2s spi i jmp .-3 lio swap tyo jmp 0 to, jsp typ tof'sv2, 0 dap return lio to lac tof jmp out /Following is the input/output routine with format decoding. /enter at "in" for input devices with the address of the format in the AC /and a word to be executed by an "xct" intext / in the IO_ which will cause /a 6 bit input char/ to be in the AC following the "xct" intext / /the input routine called by the "xct" instr/, must have two returns_, /a normal return to the word following the "xct" intext / is made if the /input 6 bit char/ matches the contents of 7775 or 7776, a skip return /(or return +1) is made if the input char. does not match 7775 or 7776. /enter at "out" for output devices with the address of the format in the AC /and a word to be executed by an "xct" intext / in the IO_ which will cause /a 6 bit output char/ from the IO to be output. inf'in, stf 3 jmp in2 out, clf 3 in2, dac fmtadr dio unit clf 6 dzm rpt lac fmtadr dac format getlist, lac i list /check for end of input/output list sad (760000 stf 6 /flag 6 on indicates that the end of list is present dzm word lac 7777 /debug. sma jmp pst lio (flexo . jsp typ pst, lio i format /check for type of format specification cla rcl 6s sad (flexo x jmp xfld sad (flexo h jmp hfld sad (flexo / jmp slash sad (76 jmp eofmt szf 6 jmp xfld sad (flexo f jmp ffld sad (flexo i jmp ifld sad (flexo a jmp afld sad (flexo c jmp pcc sza jmp illfmt /illegal format lac i format /must be repeat cma dac rpt idxfmt, idx format jmp getlist nxtlist, idx list isp rpt jmp getlist dzm rpt jmp idxfmt illfmt, oct 140003 /halt - unrecognized format specification jmp .-1 eofmt, szf 6 jmp leav jsp eol jmp getlist-3 blk pcc, cla /format spec. "c" is for printer paper advance control rcl 6s dac caf jmp idxfmt ldblks, 0 dap exit a37, cli xct unit isp ldblks jmp a37 exit, jmp 0 blk setws, dap exit cla rcl 6s dac w1 cma dac w1m cla rcl 6s dac w2 exit, jmp 0 blk udf' oct 140017 /halt - exp. underflow caf' 0 /printer carriage advance control digit format, 0 fmtadr, 0 unit, 0 ovf' oct 140020 /halt - exp. overflow rpt, 0 afld, jsp setws szf i 3 jmp ao a1, xct unit jmp strit-1 rcr 6s lac word rcl 6s dac word isp w1m jmp a1 lac word strit, xct i list jmp nxtlist ao, xct i list dac word law 3 sub w1 sza i jmp a3 sma jmp a4 jda ldblks law i 3. => w1m a3, lio word cla rcl 6s dio word jda swap xct unit isp w1m jmp a3 jmp nxtlist a4, cma dac w2 lio word ril 6s isp w2 jmp .-2 jmp a3+1 blk hfld, law 7777 and i format cma dac w1m szf 3 jmp hi h1, idx format law i 3. => w2 lac i format dac temp h2, cla lio temp rcl 6s dio temp jda swap xct unit isp w1m jmp .+2 jmp idxfmt isp w2 jmp h2 jmp h1 hi, law i 3. => w2 /"h" input directly replaces the "h" field in the format idx format dzm word h5, xct unit nop rcr 6s lac word rcl 6s dac word isp w1m jmp .+2 jmp h6 isp w2 jmp h5 lac word dac i format jmp hi h6, lac word dac i format h7, isp w2 jmp .+2 jmp idxfmt lac i format rcl 6s ior (76 dac i format jmp h7 blk slash, jsp eol jmp idxfmt /"/" in a format causes an end of line eol, dap exit lio (77 szf 3 jmp isinp xct unit exit, jmp 0 isinp, lac unit sas tif-1 jmp papr jsp typ jmp exit papr, xct unit nop sad 7776 jmp exit sad 7775 jmp exit oct 140004 /no c/r or tab at end of line (paper tape input) jmp exit blk ifld, jsp setws clf 4 szf i 3 jmp iout iin, xct unit jmp i7 sad (20 cla sas (flexo - jmp .+3 stf 4 jmp i6 dac temp jda digit law i 10. => ct /mul previous value by 10 and add new value dzm fwrd /and check for overflow clo i5, fwrd + word => fwrd isp ct jmp i5 fwrd + temp => word szo oct 140007 /overflow value > | 131071| i6, isp w1m jmp iin i7, lac word szf 4 cma jmp strit iout, lac w1 ral 6s jda sof xct i list jda float /float the value in the accumulator dac fwrd dio fwrd+1 stf 4 getrid, law fwrd jda fbd jmp nxtlist blk output' jsp .+1 dap exit szf i 4 jmp oput jda swap sad (73 jmp nxtlist jda swap oput, xct unit exit, jmp 0 blk fout, clf 4 noi 1 add w1 sub w2 sal 6s ior w2 jda sof efm 2 xct i list dac fwrd lfm jmp getrid blk xfld, jsp setws szf 3 jmp xin lac w1m jda ldblks jmp idxfmt xin, xct unit jmp idxfmt isp w1m jmp xin jmp idxfmt blk "10.0", oct 240000 oct 10000 fwrd, 0 0 ffld, jsp setws szf i 3 jmp fout dzm ct dzm fwrd dzm fwrd+1 clf 5 clf 4 gdigt, xct unit jmp setfract sas (flexo - jmp .+3 stf 4 jmp nxtdig sad (..20 cla sad (73 jmp decpt jda digit jda float /float the integer digit in the accumulator dac ftemp dio ftemp+1 idx ct efm 2 lac fwrd mul "10.0" add ftemp dac fwrd lfm nxtdig, isp w1m jmp gdigt setfract, lac w2 szf 5 lac ct /dec.pt. overrides format spec. sza i jmp nopt cma dac ct efm 2 /flt.pt. number is still in flt.accumulator div "10.0" hlt isp ct jmp .-3 strval, szf 4 cma xct i list /store the flt. word lfm jmp nxtlist decpt, dzm ct stf 5 jmp nxtdig nopt, efm 2 jmp strval blk stp. z /fortran subroutine package - tape 2 ------------------------------- /display the sense lights in the prog. flags and halt dff' dap exit clf 7 law 1 sad f1f stf 1 sad f2f stf 2 sad f3f stf 3 sad f4f stf 4 sad f5f stf 5 sad f6f stf 6 cla cli hlt exit, jmp 0 f1f' 0 f2f' 0 f3f' 0 f4f' 0 f5f' 0 f6f' 0 blk /do handling subr. /do loops may count up or down by any increment /if a do loop is satisfied the index, upon exit, contains the same value dof'ctaddr,word, 0 /"word" used in format routine dap exit clo xct i exit dac doit idx exit law i 1 add ctaddr dac lmaddr lac i ctaddr spa jmp some lac (oct 650500 /sma sza i lio = oct 650200 /spa i jmp more some, lac (oct 650200 /spa i lio (oct 650500 /sma sza i more, dac check dio check2 lac i doit add i ctaddr dac i doit szo oct 140011 /do index .> | 131071| ok, sub i lmaddr szo jmp over check,w1, 0 /"w1" used in format routine jmp loopagain around, lac i doit /restore index for exit sub i ctaddr dac i doit exit, jmp 0 loopagain, idx ctaddr jmp i ctaddr over, lac i doit add i lmaddr check2,w2_0 0 /"w2" used in format routine jmp loopagain jmp around doit,w1m_0 0 /w1m used in format routine lmaddr,temp, 0 /temp " " " " blk /fixed to floating conversion for fortran arith. statement /from fortran stmnt a = i-j/k /fortran output i-j/k / jda xf / dac a xf'ct, 0 /"ct" used in format routine dap exit lac i exit dac store lac xf jda float /float the value in the accumulator dac i store idx store dio i store idx exit exit, jmp 0 /floating to fixed conversion for fortran arith. /from fortran stmnt i = a+b /fortran output efm 2 / a+b / jsp ff / dac i ff' dap exitff jsp fdc /store flt. AC loc store law store jda unflt oct 140012 /flt. no. too large to convert to fix.pt. xct i exitff idx exitff exitff, jmp 0 store,ftemp, 0 0 /"ftemp" used in format routine blk /array handling subroutines /i1f defines 1 word (integer) arrays /i2f defines 2 word (floating) arrays /subsc. values begin with 1 instead of 0 /no recursive subsc. clearmem,ptr, 0 dap r dio endchk loop, dzm i ptr idx ptr and (7777 sas endchk jmp loop r, jmp 0 endchk, 0 blk i2f' dap exit cla jmp setrealflag i1f' dap exit law 600 setrealflag, dap realflag /usk for integer, nop for real noi 1 + exit . swap /make call to array subr. a usk poi 640600 =>| swap exit| .ptr idx exit idx ptr ptr| .ptr /now points to num of dim in subscript storage lac i ptr dap arraynameptr ral 5s and (37 dac nod cma dac count 1 => length muloop, idx ptr xct i ptr ACxlength=>length isp count jmp muloop /fall out pointing to nth dim length realflag, skp 0 sal 1s /double the length for real arrays AC+nod=>spaceneeded arf => listptr /look thru array storage lookloop, listptr| sma jmp look in, AC^poi 377777=>listptr sad final oct 140013 /no room jmp lookloop look, sub listptr sub spaceneeded sma jmp enough listptr| jmp in enough, listptr+nod xct realflag ior (400000 /mark real arrays with sign bit a 1 arraynameptr, dac 0 /set up name register listptr| =>oldptr lac listptr add spaceneeded ior (400000 dac i listptr and (377777 sad oldptr jmp past /new array exactly fills old space dac ct /this was oldptr =>| (AC) in old version lac oldptr dac i ct past, poi 400000-nod=>count /set up for backwards isp 1=>partialprod prodloop, isp count exit, jmp 0 idx listptr xct i ptr ACxpartialprod=>partialprod=>| listptr /store products of dimensions law i 1.+ptr=>ptr jmp prodloop ptr, 0 nod, 0 /no. of dimensions count, 0 spaceneeded, 0 listptr, 0 oldptr, 0 partialprod,length, 0 blk test, 0 nos, 0 csn, 0 io, 0 ssc' jda .+1 /this order is executed ac, 0 AC.ret1.ret2 idx ret2 /set the return addresses dio io /save io AC-2 a, AC.b b, lac 0 sas locssc jmp a /find entry in subscript area idx b xct b dip operation dap sscptr /set op and ptr to subscript values dzm csn sscptr| . arrayname ral 5s AC^poi 37 => nos /set no. of subsc. arrayname, lac 0 AC . operation . dimptr jda swap /save mode bit in IO sign cla spi i law 600 dap efmflag /set efmflag according to mode lac (oct 332400 rcl 1s dac scale loop, idx sscptr noi 1 + dimptr . dimptr idx csn sad nos jmp lastssc sscptr| sad locssc jmp recurse sscptr, xct 0 /get subscript value (skipped if recursive) sub (1 dimptr, mul 0 /mul by dimension value sza /too many subsc. or out of range if not zero (spa?) oct 140014 scl 9s scl 8s scale, 0 /shift left 1 (mul by 2) if real array AC+operation.operation jmp loop lastssc, sscptr| sad locssc jmp recurse xct sscptr /this instruction skipped if recursive sub (1 lio i dimptr spi jmp c mul i dimptr /do final mul if dimlist is not exhausted scl 9s scl 8s c, xct scale AC+operation.operation AC^poi 7777=>test /set up operand address d, dimptr| spa jmp e noi 1+dimptr.dimptr jmp d /step past unused dimensions e, (AC^poi 7777)-test sma sza i oct 140015 /bounds check ac lio io efmflag, skp 0 efm 2 operation, 0 ret1, jmp 0 ret2, jmp 0 recurse, oct 140016 /recursive subsc. locssc, loc ssc blk fin. e xsy imp idv tpo idv' 0 dap exit xct i exit dac temp idx exit lac idv scr 9s scr 8s div temp jmp exit dac temp idx exit lac temp exit, jmp 0 blk imp'ct3, 0 dap exit xct i exit dac temp idx exit lac imp mul temp scl 9s scl 8s exit, jmp 0 blk dss typ tpo' dap exit next, lac i exit dac temp idx exit law i 3 dac ct3 loop, cla lio temp rcl 6s dio temp sad (13 exit, jmp 0 rcr 9s rcr 9s jsp typ isp ct3 jmp loop jmp next temp, 0 blk fin. >>12<<