/pdp-1 fortran part 3 /----- /"sense light" statements /turn on dummy sense light sens, jsp nxtwer sas (flexo sel jmp stt jsp nxtwer sas (flexo igh jmp stt jsp kfm /kill flt. mode jsp nxtwer sas (flexo t jmp stt jsp nxtwer sas (20 /zero jmp a law msg jda ptext jmp dochk msg, text /jsp cff/ a, law msg2 jda ptext lac i where jda alpha law 66 /f jda alpha law i 7777 /mask = 770000 and i where sza jmp lter /light numeer > 99 jsp nxtwer sad del+13 /c/r jmp dochk /okay lter, law 41. /error 41 = sense light > 99 jmp bad msg2, text /law 1 dac f/ . /----- /"assign" statements /assign i to n assi, jsp nxtwer sas (flexo ign jmp stt jsp kfm jsp lw /.law . jsp st back, jsp nxtwer jda number jmp a lac i where jda alpha jmp back a, law 4033 /middle dot, comma jda opcode lac (flexo dap jda opcode cla lio i where rcl 6s rcl 6s sad (flexo to jmp .+3 law 11. /error 11 = can i t find "to" jmp bad dio i where lac where jda define b, lac i where sad del+13 /c/r jmp dochk jda alpha idx where jmp b /----- /"if" statements if, lac where dac temp dzm lp a, lac i temp sad (flexo sen jmp yy1+1 /try sense light/switch sad del+16 /( jmp upit sas del+17 /) jmp idt law i 1 add lp dac lp sza i jmp yeck idt, idx temp jmp a upit, idx lp jmp idt yeck, lac temp dac final idx where jsp math law 1 sad iflag jmp y dzm flm-1 /clear flt. mode flag law strm jda ptext y, law msg1 jda ptext jsp stnom lac jps-1 jda alpha lac jps-2 jda alpha jsp stnom lac jps-1 dac store lac jps-2 dac store+1 jsp stnom lac store sas jps-1 jmp notsam lac store+1 sad jps-2 jmp nodo notsam, law msg2 jda ptext lac store jda alpha lac store+1 jda alpha 0 jmp nodo msg1, text / spa jmp st/ msg2, text / sza i jmp st/ strm, text /=>strf lfm lac strf/ stnom, dap rtr dzm jps-2 idx final lac i final dac jps-1 jda number jmp e13 idx final lac i final sad del+21 / , rtr, jmp 0 sad del+13 /c/r jmp rtr dac jps-2 jda number jmp e13 idx final lac i final sad del+21 /, jmp rtr sad del+13 /c/r jmp rtr e13, law 13. /error 13 = non digit char. in paths of ifstmnt yy1, jmp bad /path of if, i.e., if(i) 1,a,5 4 /try sense switch/light idx temp dac scratch+3 /temp store lac i scratch+3 sad (flexo sel jmp slight sas (flexo ses jmp if +3 idx scratch+3 lac i scratch+3 sas (flexo wit jmp if+3 jsp kfm lac scratch+3 dac where jsp nxtwer and del+13 /oct 77 dac scratch sub (8. sma jmp er14 jsp nxtwer sas del+17 /) jmp er14 lac (flexo szs jda opcode lac scratch jda alpha nxtst, law swmsg jda ptext a47, jsp nxtwer sad del+21 /, jmp .+3 jda alpha jmp a47 jsp carret jmp jps er14, law 14. /error 14 = illegal sw. no. > 7 jmp bad swmsg, text / jmp st/ slight, jsp kfm /kill flt. mode idx scratch+3 lac i scratch+3 sas (flexo igh jmp if+3 idx scratch+3 dac where dac rp2 lio i scratch+3 cla rcl 6s sas (23 jmp .-3 dio lp2 /light no. law litemsg1 jda ptext >>15<< lac lp2 jda alpha law 66 /f jda alpha law swmsg jda ptext findoff, idx rp2 lac i rp2 sas del+21 jmp findoff lac del+13 /replace comma after 1st path with c/r dac i rp2 idx rp2 lac i rp2 sad del+13 /c/r jmp .+3 jda alpha jmp .-5 jsp nxtwer sas del+17 jmp er15 law lt3msg jda ptext lac lp2 jda alpha law 66 /f jda alpha jsp carret jmp jps generr,er15, law 15. /general (non-specific) error in statement jmp bad litemsg1, text /law 1 sas f/ lt3msg, text / dzm f/ 0 /store second half of stmnt no. here jpsw, 0 /store first half of stmnt no. here jps, dzm jpsw-1 jsp nxtwer dac jpsw jda number jmp e13 jsp nxtwer sad del+13 /c/r jmp nodo dac jpsw-1 jda number jmp e13 jsp nxtwer sas del+13 jmp e13 jmp nodo o /----- /"end flex" statement eff, jsp nxtwer sas (flexo x jmp ne1 dzm flm-1 /out of flt. mode after endflex stmnt law endflx jda ptext jmp dochk endflx, text /jsp eff/ ne1, jsp lstwer jmp ne2 /----- /"end" statement stm, text /strf_..laf_.. dec / stm2, text / 0 / term, jsp nxtwer sad (flexo fle /check for endflex stmnt jmp eff ne2, jsp lstwer /restore where law dolist+2 dac strwrd lac dolist-1 dac word dzm scratch bakup, lac i strwrd sza jmp fnd1 idx strwrd idx strwrd idx strwrd isp word jmp bakup jmp ahed fnd1, law i 2 add strwrd dac tp lac i tp jda message idx tp lac i tp jda message law mesg jda ttext law 1 dac scratch jmp bakup+3 mesg, text / unterm. do / rerun, text / jmp mainprog d / ahed, law 1 sas scratch jmp .+3 law 16. /error 16 = some unterm. do loops jmp bad lac stmnt sza jmp peo jsp nxtwer sad del+13 jmp fst peo, jsp goto-16 law rerun jda ptext fst, dzm fg1 law stm jda ptext lac lad /output size of array area jda bindec law stm2 jda ptext jsp dos /output blk law ilist /output unsubsc. var. storage dac word loy, jsp carret clf 3 lac i word jda fixed stf 3 lac i word sza i jmp loz jda alpha idx word lac i word jda alpha law dts jda ptext szf i 3 jmp zom law 4033 jda opcode law 7373 jda alpha zom, idx word sas define /inxt jmp loy loz, jsp carret law fcn /output flt. const. dac word fc1, sad nct jmp fc2 law 7763 /c/r, c jda alpha law fcn-1 sub word cma ADD [" SAR "S ?DIVIDE BY ' JDA BINDEC LAW FCM" JDA PTEXT LAC I WORD DAC RP' ?TEMPx STORE FOR FLTxPTx ZERO CHECK JDA NUMB LAW FCM' JDA PTEXT IDX WORD LAC RP' ?CHECK FOR FLTxPTx ZERO SZA I DZM I WORD LAC I WORD JDA NUMB IDX WORD JMP FC" FCM"= TEXT ?= OCT ? FCM'= TEXT ? OCT ? FC'= JSP CARRET LAC [FLEXO FIN JDA ALPHA LIO DEL+22 jda output jsp carret law i 20 jda feed lio (13 jda output law i 200 jda feed law typend jda ttext cla>>05<>05<>05<>60<< /----- /arithmetic statements arith, lac where dac temp jsp idxtmp sas del+13 /c/r jmp .+3 law 17. /error 17 = bad arith stmnt jmp bad /a = c/r -no stmnt on right of = law buffer /define variable name jda define /after return if "define" is zero variable was flt., /if non-zero was fixed jsp math clf 5 law 1 sas iflag jmp fltg lac define sza jmp a jsp crtab jsp jd law msg1 ad1, jda ptext stf 5 a, jsp name jmp dochk fltg, lac define sza jmp fxit /fixed pt. variable name jsp name jmp dochk fxit, dzm flm-1 law msg2 jmp ad1 rpl, text /=>/ name, dap retrn szf 5 jmp dcit law rpl jda ptext nm2, law buffer dac where loopit, lac i where sad del+11 retrn, jmp 0 sad del+17 lac del+7 sad del+16 lac del+6 jda alpha idx where jmp loopit dcit, jsp dc jmp nm2 msg1, text /xf l / msg2, text / jsp ff / . /----- /misc. subroutines sdt, dap ex law 1 dac bindec-1 ex, jmp 0 0 flm, dap exit lac stmnt sza jmp fltit lac flm-1 sza exit, jmp 0 fltit, law enter dac flm-1 jda ptext jmp exit enter, text /efm 2 / kfm, dap exit lac flm-1 sza i exit, jmp 0 law leave jda ptext dzm flm-1 jmp exit leave, text /lfm / /output carriage return carret, dap exit lio del+13 jmp put /output a space spc, dap exit cli jmp put /output carriage return, tab crtab, dap .+3 law 7736 jda alpha jmp 0 /output tab tabt, dap exit lio (36 put, jda output exit, jmp 0 >>15<< /get the next word from the buffer nxtwer, dap .+3 idx where lac i where jmp 0 /get the previous word from the buffer lstwer, dap .-1 law i 1 add where dac where jmp lstwer-2 /output "st" (used in stmnt. no.) st, dap .+3 law 2223 jda alpha jmp 0 /interchange AC-IO swap, 0 dap .+4 lac swap rcr 9s rcr 9s jmp 0 idxtmp, dap .+3 idx temp lac i temp jmp 0 punch, jda output /input subr. (get char. from paper tape or typewriter) torp, dap a jsp c sad (75 jmp fill /backspace cancels line sad (13 jmp wait /stop code, no "end" a, jmp 0 c, dap rtrn szs 50 jmp b jsp buf /get a char. from paper tape jmp xx1 /char. in AC b, szf i 1 jmp .-1 tyi clf 1 jda swap /swap AC| IO j xx1, and del+13 /oct 77 sas del+13 rtrn, jmp 0 idx linect law 77 jmp rtrn wait, error 1 /stop code - no "end" dzm buf-1 jmp fill >>76<< typin, dap a jsp torp sad (36 jmp a+1 /filter out tabs sza i jmp typin+1 /filter out spaces a, jmp 0 lac buffer sas (flexo c jmp typin+1 jmp dec /fortran comment stmnt /error returns from compiler bad, dac tem jsp sdt /set bindec for tyo output jsp typcr lac (726551 jda message lac tem jda bindec law 3643 jda message lac (flexo ine jda message lac linect jda bindec jsp typcr law 1 dac output-2 /prevent furthur norm. output dzm bindec-1 /set bindec back to norm.output jmp fill /check for illegal do termination nodo, lac stmnt sza i jmp fill lio stmnt+1 jda dolk jmp fill law 7. /error 7 = do terminated by jmp bad /a do, if, stop, or goto /search dolist for argument in AC-IO dolk, 0 dap endolk dio tem law dolist dac sct doin, lac donxt sad sct jmp endolk lac i sct sas dolk jmp doidx idx sct lac i sct sas tem jmp doidx2 idx endolk idx sct endolk, jmp 0 /returns to +1 if found with addr. of nest count in AC doidx, idx sct doidx2, idx sct idx sct jmp doin q /output an op. code opcode, 0 dap xit lac opcode alf, jda alpha jsp spc /space xit, jmp 0 /output three dots, space for decal comments cmt, dap xit lac (737373 jmp alf /output .jmp . instruction jp, dap xit lac (flexo jmp jmp alf /output .law .instruction lw, dap xit lac (flexo law jmp alf /output .dac . instr. dc, dap xit lac (flexo dac jmp alf /output .lac . instr. lc, dap xit lac (flexo lac jmp alf /output .jda . instr. jd, dap xit lac (flexo jda jmp alf /scan dolist, if all terminated output "blk" dos, dap return law dolist+2 dac tem lac dolist-1 dac tp loop, lac i tem sza return, jmp 0 idx tem idx tem idx tem isp tp jmp loop e jsp carret lac (flexo blk jda alpha jmp return 4 /storage areas store, .+2/ scratch, .+4/ temp, 0 doct, 0 donxt, 0 linect, 0 decl, 0 iflag, 0 strwrd, 0 where, 0 word, 0 upind, 0 lp, 0 lp2, 0 rp, 0 3