Directory of image this file is from
This file as a plain text file
/OPERATING SYSTEM FOR ROGALGOL /TO USE HYBRID NEW FUNCTIONS AND OLD FLOATING POINT PACKAGE /ADDRESSES OF NEW FPP ROUTINES FGET=5600 FPUT=5654 FADD=5631 FSUB=5730 FMUL=5640 FDIV=5671 FNEG=6000 FINPUT=7400 FOUTP=7200 FUNLST=6544 CHAR=57 DSWIT=60 DCAFL3=DCA 47 /TO USE NEW FLOATING POINT AS IT STANDS /CHANGE THE DEFINITIONS TO THE FOLLOWING /FGET=7306 /FPUT=7322 /FADD=7000 /FSUB=7117 /FMUL=6600 /FDIV=6722 /FNEG=7135 /FINPUT=6200 /FOUTP=5600 /FUNLST=7231 /CHAR=53 /DSWIT=52 /DCAFL3=NOP FIELD 0 *30 /EXIT TO INTERPRETER 0; CLA CMA; TAD 30; CDF CIF 10 DCA I XPC; JMP I XNEXT XPC, PC XNEXT, NEX *177; INIT /PROG STARTS CDF CIF 10; JMP I 177 CDF CIF 10; JMS I .+1; ERR FIELD 1 /SHORT ROUTINES TO HOLE IN FPP *5544 FNDLVL, 0 /SET T1 TO POINT AT LEVEL IN AC CIA; DCA T2; TAD 22; DCA T1 FNDL1, TAD I T1; TAD T2; SNA CLA; JMP I FNDLVL CLA CLL CML RTL; TAD T1; DCA T1 TAD I T1; DCA T1; JMP FNDL1 CHIN, NPOP; DCA DEV; JMS I .+2; JMP I SNEXT; INDEV XAND, POP; DCA T1; NPOP; AND T1; JMP I SNEXT *1 T1, 0 T2, 0 T3, 0 T4, 0 T5, 0 /21 IS BASE OF WORKING STACK ACTIVE IN CURRENT LEVEL /22 POINTS AT START OF CURRENT LEVEL NFSPAD=23 /ADDRESS OF NEXT FREE VARIABLE SPACE ABAS=24 SW1=25 WORD=26 PC=10 EKOSW=30 DEV=31 SP=32 TSP=27 FLAC=44 *33 SUDOMQ, 0 NPOP=JMS I .; XNPOP PNEXT, PNEX SNEXT, SNEX NEXT, NEX *62 AKBCHK, KBCHK VADR=JMS I .; XVADR NEXT6=JMS I .; XNEXT6 STAK=JMS I .; XSTAK UNSTAK=JMS I .; XUNSTA ISTAK=JMS I .; XISTA IUNSTAK=JMS I .; XIUNST XOUT, OUTDEV POP=JMS I .; XIPOP FPOP=JMS I .; XPOP FOPOP=JMS I .; XOPOP FPUSH=JMS I .; XPUSH PARAM=JMS I .; XPARAM SHL6=JMS I .; XSHL6
*100 NEX; ARR; FORMAT; RFP; PUT; STRING; PRINT; CHIN; CHOUT /CODES 0-8 J; EX; EN; GET; ADD; IGET; IPUT /CODES 9-15 SET; NEG; POW; MUL; DIV; SUB; EZ; GZ; LZ /CODES 16-24 ANYGET; ANYPUT; STFUN; JNT; PNEX; NOT; XAND; OR; EQUIV /CODES 25-33 FORST; IOC; EP; GP; GG; DI; SKIP; ISIGN; SETH /CODES 34-42 FIX; FLS1; FCONS; FLNEG; SETLAB; PFP; RPOW; FLMPY /CODES 43-50 FLS2; FLDIV; FLADD; FLSUB; EXINT; FSIGN; JF; ENF /CODES 51-58 EPF; FSTR; SVS; POPAR; STOP /CODES 59-63 *200 XNEXT6, 0; ISZ SW1; JMP NEXWD TAD WORD; AND (77; JMP I XNEXT6 NEXWD, CDF; TAD I PC; CDF 10 DCA WORD; CLA CMA; DCA SW1 TAD WORD; RTR; RTR; RTR; AND (77; JMP I XNEXT6 SETH, JMS XNEXT6 PNEX, DCA I SP; JMS DECSP NEX, JMS XNEXT6; TAD (JMP I 100; DCA .+1; HLT XSHL6, 0; RTL; RTL; RTL; AND (7700; JMP I XSHL6 CHOUT, POP; DCA T1; POP; DCA DEV TAD T1; JMS I XOUT; JMP NEX XPOP, 0; TAD (44; JMS XIUNST; JMP I XPOP XOPOP, 0; TAD (5575; JMS XIUNST; JMP I XOPOP XPUSH, 0; TAD (44; JMS XISTA; JMP I XPUSH XSTAK, 0; TAD I XSTAK; ISZ XSTAK; JMS XISTA; JMP I XSTAK XUNSTA, 0; TAD I XUNSTA; ISZ XUNSTA; JMS XIUNST; JMP I XUNSTA XISTA, 0; TAD (-1; DCA 11; JMS DECSP; TAD SP; DCA 12 TAD I 11; DCA I 12 TAD I 11; DCA I 12 TAD I 11; DCA I 12; JMP I XISTA XIUNST, 0; TAD (-1; DCA 11 ISZ SP; TAD I SP; DCA I 11 ISZ SP; TAD I SP; DCA I 11 ISZ SP; TAD I SP; DCA I 11; JMP I XIUNST XVADR, 0; TAD (-1; DCA XSTAK; TAD XSTAK CLL RAL; TAD XSTAK; JMP I XVADR GP, NEXT6; VADR; TAD 20; IUNSTA; JMP NEX FORMAT, POP; DCA 60; POP; DCA 57; CMA; JMP I 160 /TO PFP DECSP, 0; CLA CLL CMA RTL; TAD SP; DCA SP JMS TESTSP; JMP I DECSP ABS, 0; TAD FLAC+1; SPA CLA; JMS FNEG; JMP I ABS LZ, NPOP; SPA CLA; CMA SNEX, DCA I TSP; JMP NEX *400 DOSTR, 0; NEXT6; SNA; JMP I DOSTR TAD (-40; SPA; TAD (100; TAD (240 JMS I XOUT; JMP DOSTR+1 STRING, POP; DCA DEV; JMS DOSTR; JMP I NEXT DUM, 0; JMP I DUM
EP, NEXT6 EN, DCA FLAC+2 /PARAMETERS TO FLAC+2 TAD PC; IAC; DCA T1 /RETURN ADDRESS TO T1 CLA CMA; PARAM EPX, DCA PC /PROCEDURE ADDRESS TO PC PARAM; DCA T3 /NEW FIXED SPACE TO T3 CMA; TAD 23; DCA 11 /ADDRESS V1 NEW LEVEL NEXT6; DCA I 11 /V1/1=PROCEDURE NUMBER TAD T1; DCA I 11 /V1/2=RETURN ADDRESS TAD 22; DCA I 11 /V1/3=BASE LAST LEVEL TAD 21; DCA I 11 /V2/1=STACK BASE OF LAST LEVEL TAD 24; DCA I 11 /V2/2=ARRAY BASE LAST LEVEL TAD 23; DCA 22 /NEW V1=OLD FREE SPACE TAD T3; TAD 22; DCA 23 /NEW FREE SPACE=BASE+FIXED SPACE JMS TESTSP /CHECK ENOUGH ROOM JMS ALEV0 /CREATE ARRAY LEVEL 0 NEXT6; CIA; TAD FLAC+2 SZA CLA; JMS ERR /CHECK NO. PARAMS ACTUAL=EXPECTED TAD FLAC+2; SNA CLA; JMP ALDONE /ENTER IF NONE TAD (3; TAD FLAC+2 /LAST PARAMETER=PARMS+3 VADR; TAD 22; DCA T2 /ADDRESS THEREOF TAD FLAC+2; CIA; DCA T3 /COUNT PARAMETERS EP1, POP; DCA T4; NEXT6; DCA T1 /GET ACTUAL & EXPECTED TYPE TAD T1; CIA; TAD T4; SNA CLA; JMP OK /OK IF SAME TYPE TAD T1; TAD T4; TAD (-3; SZA CLA; JMS ERR /CONV. IF INT/REAL CMA; TAD T1; SZA CLA; JMP IEXPECT /WHICH TYPE EXPECTED? POP; DCA FLAC; JMS 5533; JMP OK-1 /YES, SO FLOAT IT IEXPEC, FPOP; JMS XFIX; FPUSH OK, TAD T2; IUNSTAK; CLA CLL CMA RTL; TAD T2; DCA T2 ISZ T3; JMP EP1 /TEST IF ALL DONE ALDONE, TAD SP; DCA 21; JMP I NEXT XIPOP, 0; ISZ SP; ISZ SP; ISZ SP; TAD I SP; JMP I XIPOP IOC, POP; SMA; DCA EKOSW; SPA CLA; RFC; JMP I NEXT TESTSP, 0; TAD 23; CIA CLL; TAD SP; SNL CLA; JMS ERR KSF; JMP I TESTSP; JMS I AKBCHK; JMP I TESTSP
*600 XEINT, EINT STSP=601 /FIXED UP BY FPP *602 ALEV0, 0 /CREATE ARRAY LEVEL 0 TAD 23; DCA ABAS /STARTS AT FREE SPACE DCA I 23; ISZ 23; JMP I ALEV0 /SET ZERO LEVEL J, CLA CMA; PARAM; DCA PC; JMP I NEXT INIT, DCA SW1; TAD P201; DCA PC IAC; DCA EKOSW /TELETYPE ECHO TAD XEINT; DCA 20; DCA I 20 /VARAIBLES START AFTER INTERPRETER TAD 20; DCA 22 /LOCALS ALSO TAD 20; CDF; TAD I (176; CDF 10; DCA 23 /NEXT FREE SPACE TAD STSP; DCA SP; JMS ALEV0 TAD SP; DCA 21 /21 IS WORKING STACK BASE OF CURRENT LEVEL ADEVIN, RFC; TLS; PLS; KCC; JMP I NEXT P201, 201 POW, DCA PPOW; CLA CLL IAC; DCA FLAC CML RTR; DCA FLAC+1; DCA FLAC+2 /1.0 TO FLAC POP; DCA T1 /EXPONENT TO T1 TAD T1; SNA; JMP EXFLT /ZERO EXPONENT? SPA; ISZ PPOW /PPOW 1 FOR NEGATIVE EXPONENTS SMA; CIA; DCA PCOUNT /COUNT OPERATIONS TAD PPOW; TAD (JMS I PMUL; DCA POWINS POW1, TAD SP; IAC POWINS, HLT; NOP /MULTIPLY OR DIVIDE FLAC BY MANTISSA ISZ PCOUNT; JMP POW1; JMP EXFLT PMUL, FMUL; FDIV PPOW, 0 PCOUNT, 0 AAAMUL=. MUL, DCA T4; JMS SIGN1; DCA M1; JMS SIGN1 DCA SUDOMQ; JMS PSDMUY M1, 0; JMP SIGN2 AAADIV=. DIV, DCA T4; JMS SIGN1; DCA D1; JMS SIGN1 DCA SUDOMQ; JMS PSDDVI D1, 0 SIGN2, CLA; TAD T4; RAR; CLA TAD SUDOMQ; SZL; CIA; JMP I PNEXT SIGN1, 0; POP; SPA; ISZ T4; SPA; CIA; JMP I SIGN1 AAAOR=. OR, POP; SNA CLA; JMP I NEXT NPOP; CLA CMA; JMP I SNEXT SET, NEXT6; SHL6 DCA T1; NEXT6; TAD T1; JMP I PNEXT SETLAB, TAD 22; DCA FLAC+1; PARAM; JMP FCONS+10 ADD, POP; NPOP; JMP I SNEXT GG, NEXT6; VADR; TAD 20; ISTAK; JMP I NEXT *1000 DIN, 0; JMS ERR /LOC 101 BECOMES CDF CIF JMS I .+2; JMP I DIN ADIN0, HLT /1004 GETS ADDRESS OF DISC INPUT ROUTINE OCTOUT, 0; RAL; DCA SUDOMQ; TAD (-4; DCA DIN OCTO1, TAD SUDOMQ; RAL; RTL; DCA SUDOMQ TAD SUDOMQ; AND (7; TAD (260; JMS TTO; CLA ISZ DIN; JMP OCTO1; JMP I OCTOUT ATTIN=. TTIN, 0; JMS LSI; JMS TTO TAD XM215; SNA; JMP CR CROUT, TAD X215; JMP I TTIN CR, TAD X212; JMS TTO; CLA; JMP CROUT X215, 215 X212, 212 XM215, -215 TTI, 0; TAD EKOSW; SZA CLA; JMP EKO JMS LSI; JMP I TTI EKO, JMS TTIN; JMP I TTI
FORST, FOPOP; FPOP /FINAL TO 5575+, INCREMENT TO FLAC JMS ABSVAD; DCA T1 /POINT AT REAL VARIABLE CMA; POP; SZA CLA; JMP INTFOR TAD FLAC+1; JMS FORST2 TAD T1; JMS FADD; NOP /ADD VARIABLE TO INCREMENT TAD T1; JMS FPUT; NOP /RESTORE IT JMS FSUB; 5575 /CURRENT-FINAL TAD FLAC+1 /GET SIGN OF CURRENT - FINAL SPA; CLA CMA /ALLOW FOR 4000 FORCON, ISZ T4; CIA /CHANGE ITS SIGN IF INCREMENT POSITIVE SMA CLA; CMA; JMP I SNEXT /SET 'TRUE' FOR DO AGAIN INTFOR, TAD FLAC+2; JMS FORST2 CLA CLL CML RTL; TAD T1; DCA T1 /ADJUST ADDRESS TAD FLAC+2; TAD I T1; DCA I T1 /DO INCREMENT TAD 5577; CIA; TAD I T1 /CURRENT - FINAL JMP FORCON /CONTINUE AS FOR REAL FORST2, 0 /SIGN OF INCREMENT TO T4, ZERO FLAC IF NO INCREMENTING SPA CLA; CMA; DCA T4 /T4=-1 FOR DECREMENT NPOP; SZA CLA; JMP I FORST2 DCA FLAC; DCA FLAC+1; DCA FLAC+2 JMP I FORST2 /NO INCREMENT IF S4=0 MESS, 0; TAD I MESS; ISZ MESS; SNA; JMP I MESS JMS TTO; CLA; JMP MESS+1 LUNST, 0 /TAKE OFF TOP VARIABLE LEVEL TAD 22; DCA 11 /SET TO GET V1/2 TAD 22; DCA 23 /RESTORE FREE SPACE POINTER TAD I 11; DCA T1 /RETURN ADDRESS TO T1 TAD I 11; DCA 22 TAD I 11; DCA 21 /RESTORE WORKING STACK BASE TAD I 11; DCA 24; JMP I LUNST
*1200 ERR, 0; CLA; TAD (277; JMS TTO; CLA TAD ERR; JMS OCTOUT WAIT, KCC; JMS MESS; 215; 212; 336; 0 JMS KBCHK; JMP .-1 KBCHK, 0; X7600, 7600; KSF; JMP I KBCHK KRS; TAD (-220; SNA; JMP I GOCP TAD (220-223; SNA; JMP WAIT IAC; SNA; JMP RESUM TAD (222-203; SZA CLA; JMP I KBCHK KCC; CDF CIF; JMP I X7600 RESUM, KCC; JMP I NEXT STOP=WAIT JNT, PARAM; DCA T1; POP; SZA CLA; JMP I NEXT CMA; TAD T1; DCA PC; JMP I NEXT ISIGN, POP; CIA; NPOP; SNA; JMP I SNEXT RAL; CLA IAC; SZL; CLA CMA; JMP I SNEXT APSDDI=. PSDDVI, 0 /COPIED FROM EAE SIMULATOR DCA PSDCAM; TAD I PSDDVI; ISZ PSDDVI CLL CIA; DCA MQLMUY /BUT NO OVERFLOW TEST TAD (7763; DCA PSDLSR; JMP .+11 TAD PSDCAM; RAL; DCA PSDCAM TAD PSDCAM; TAD MQLMUY; SZL DCA PSDCAM; CLA; TAD SUDOMQ; RAL; DCA SUDOMQ ISZ PSDLSR; JMP .-14 TAD PSDCAM; JMP I PSDDVI PSDLSR=DSWIT FIX, JMS GETS1; JMS 5500; TAD FLAC; JMP I SNEXT XFIX, 0; JMS 5500; TAD FLAC; DCA FLAC+2; JMP I XFIX FLS1, NPOP; DCA FLAC; JMS 5533; JMP EXFLT FLS2, FOPOP; POP; DCA FLAC; JMS 5533; FPUSH STAK; 5575; JMP I NEXT RFP, NPOP; DCA DEV; JMS FINPUT; TAD DSWIT; SNA CLA JMP RFP+2; JMP EXFLT PSDCAM=KBCHK MQLMUY=XFIX EQUIV, POP; CIA; NPOP; SNA CLA; CMA; JMP I SNEXT GOCP, INIT *1400 XNPOP, 0; DCA SIGN; TAD (3; TAD SP; DCA TSP TAD SIGN; TAD I TSP; JMP I XNPOP SIGN, 0 /FLAC=SIGN(FLAC) TAD FLAC+1; SNA; JMP SZ RAL; CLA IAC; SZL; CLA CMA SZ, DCA FLAC+2; JMP I SIGN FCONS, DCA SW1; CDF; TAD I PC; DCA FLAC TAD I PC; DCA FLAC+1 TAD I PC; CDF 10; DCA FLAC+2; FPUSH; JMP I NEXT FLNEG, JMS GETS1; JMS FNEG; JMP EXFLT FLDIV, IAC FLMPY, IAC FLSUB, IAC FLADD, JMS DOFP EXFLT, TAD SP; DCA 11 /STORE FLAC BACK IN S1 TAD FLAC; DCA I 11 TAD FLAC+1; DCA I 11 TAD FLAC+2; DCA I 11; JMP I NEXT DOFP, 0 TAD (JMS I XFLAD; DCA FLINS /GENERATE JMS INSTRUCTION IAC; TAD SP; DCA FLOPAD /OPERAND IS IN S1 ISZ SP; ISZ SP; ISZ SP /POINT AT TO BE OPERATED ON JMS GETS1 /GET IT TO FLAC FLINS, 0 FLOPAD, 0 /DO OPERATION JMP I DOFP XFLAD, FADD; FSUB; FMUL; FDIV FSIGN, CLA IAC; JMS DOFP /SUBTRACT JMS SIGN; JMP EXFLT /TAKE SIGN STFUN, JMS GETS1 /GET OPERAND NEXT6; TAD (FUNLST; DCA T1 /ADDRESS OF ROUTINE TAD I T1; DCA T1 JMS I T1; JMP EXFLT RPOW, UNSTAK; T1 /EXPONENT TO T1 JMS GETS1 /GET MANTISSA JMS 5263; JMS I XFLAD+2; T1 /LN, *EXPONENT JMS 5135; JMP EXFLT /EXPONENTIAL GETS1, 0 /GET S1 TO FLAC, LEAVE SP WHERE IT IS TAD SP; DCA 11 TAD I 11; DCA FLAC TAD I 11; DCA FLAC+1 TAD I 11; DCA FLAC+2 DCAFL3; TAD 11; DCA TSP; JMP I GETS1
APSDMU=. PSDMUY, 0 CLA CLL; DCA MQLDVI; TAD (7763; DCA PSDL TAD I PSDMUY; DCA PSDMQL; ISZ PSDMUY JMP .+10 TAD MQLDVI; SNL; JMP .+3 CLL; TAD PSDMQL; RAR DCA MQLDVI; TAD SUDOMQ; RAR; DCA SUDOMQ ISZ PSDL; JMP .-13; TAD MQLDVI; JMP I PSDMUY MQLDVI, 0 PSDL, 0 PSDMQL, 0 *1600 SUBSA, 0 /WORK OUT SUBSCRIPT ADDRESS JMS ABSVAD; TAD (2; DCA T1 /ADDRESS ARRAY VARIABLE CMA; TAD I T1; DCA 17 /ADDRESS DOPE VECTOR TAD I 17; CIA; DCA WRDS /=-1 IF ONE WORD TAD I 17; CIA; DCA T3 /COUNT SUBSCRIPTS NEXT6; TAD T3; SZA CLA; JMS ERR /CHECK NO. OF SUBSCRIPTS TAD I 17; CIA; POP; DCA T1 /1ST SUBS-LOWER BOUND SUBSA3, ISZ T3; SKP; JMP SUBSA1 /ANY MORE SUBSCRIPTS? TAD I 17; DCA SUDOMQ /YES, GET MULTIPLIER FOR IT TAD I 17; CIA; POP; DCA SUBSA2 /NEXT SUBS-LOWER BOUND JMS PSDMUY SUBSA2, 0; TAD SUDOMQ; TAD T1; DCA T1 /TIMES VECTOR, ADD TO ADDRESS JMP SUBSA3 /SEE IF THERES ANY MORE SUBSA1, TAD WRDS; CMA; SNA CLA; JMP SUBSA4 /IF 3 WORDS TAD T1; CLL RAL /MULTIPLY ADDRESS BY 3 SUBSA4, TAD T1; IAC; TAD 17; DCA T1 /ADD TO LOWEST ADDRESS ISZ WRDS; ISZ SUBSA; JMP I SUBSA /EXIT 2 IF 2 WORDS WRDS, 0 AAASA2=SUBSA2 AAASA3=SUBSA3 GET, NEXT6; VADR; TAD 22; ISTAK; JMP I NEXT XPARAM, 0; ISZ SW1; NOP; CDF TAD I PC; CDF 10; JMP I XPARAM LSI, 0; KSF; JMP .-1; JMS I AKBCHK; KRB; JMP I LSI SUB, POP; CIA; NPOP; JMP I SNEXT EX, JMS LUNST; DCA SW1; TAD T1; DCA PC; JMP I NEXT SVS, NEXT6; CIA; DCA T4 /VARIABLE LEVEL REQUIRED SVS1, TAD I 22; TAD T4; SNA CLA; JMP SAS /DO ARRAYS IF OK JMS LUNST; JMP SVS1 /ELSE TAKE OFF TOP AND TRY AGAIN IGET, JMS SUBSA CLA CLL CMA RAL /SUBTRACT 2 IF INTEGER/BOOLEAN TAD T1; ISTAK; JMP I NEXT /WILL STACK 2 JUNK WORDS IPUT, FPOP; JMS SUBSA; JMP IPUT1 TAD T1; JMS FPUT; NOP; JMP I NEXT IPUT1, TAD FLAC+2; DCA I T1; JMP I NEXT ANYGET, CMA ANYPUT, DCA T3 /SET MARKER JMS ABSVAD ISZ T3; JMP ANYP; ISTAK; JMP I NEXT ANYP, IUNSTAK; JMP I NEXT ABSVAD, 0 /WORK OUT ABSOLUTE VARIABLE ADDRESS NEXT6; JMS FNDLVL; NEXT6; VADR; TAD T1; JMP I ABSVAD NOT, NPOP; CMA; JMP I SNEXT
*2000 DOUT, 0; JMS ERR /LOC 2001 BECOMES CDF CIF JMS I .+2; JMP I DOUT ADOUT0, HLT /2004 GETS ADDRESS OF DISK OUTPUT ROUTINE SAS, NEXT6; CIA; DCA T1 /REQUIRED ARRAY DEPTH TAD 21; DCA SP /CLEAR WORKING STACK AT LABEL SAS1, TAD I ABAS; TAD T1; SNA CLA; JMP I NEXT /GOT IT? JMS AUNST; JMP SAS1 AUNST, 0; TAD ABAS; DCA 23 /REDUCE FREE SPACE POINTER ISZ ABAS; TAD I ABAS; DCA ABAS /RESTORE ARRAY BASE POINTER JMP I AUNST PRINT, POP; CLL; SPA; CIA CML; DCA SUDOMQ POP; DCA DEV; TAD (255; SZL; JMS I XOUT CLA; JMS PRIN; JMP I NEXT PRIN, 0; STAK; PRIN /SAVE RETURN ADDRESS TAD SUDOMQ; TAD (-12; SMA CLA; JMP GT10 TAD SUDOMQ LASTD, TAD (260; JMS I XOUT FPOP; JMP I FLAC /RETURN GT10, JMS PSDDVI; 12; DCA I SP; JMS DECSP; JMS PRIN POP; JMP LASTD PFP, DCA 56; FPOP; POP; DCA DEV; JMS FOUTP; JMP I NEXT HSI, 0; JMS I AKBCHK; RSF; JMP .-2; RRB RFC; JMP I HSI TTO, 0; TSF; JMP .-1; TLS; JMP I TTO HSO, 0; PSF; JMP .-1; PLS; JMP I HSO JF, DCA SW1; FPOP; CMA; TAD FLAC+2; DCA PC JF1, TAD FLAC+1; CIA; TAD 22 SNA CLA; JMP I NEXT; JMS LUNST; JMP JF1 EPF, NEXT6 ENF, DCA FLAC+2 /NUMBER OF PARAMS TAD PC; DCA T1; DCA SW1 /RETURN ADDRESS TO T1 CMA; POP; JMP I .+1; EPX /GET PROCEDURE ADDRESS FSTR, TAD PC; DCA T2; CMA; POP; DCA PC /ADDRESS OF STRING POP; DCA DEV STAK; 25; DCA SW1 /SAVE PC ETC. JMS I XDOSTR; UNSTAK; 25 TAD T2; DCA PC; JMP I NEXT XDOSTR, DOSTR POPAR, JMS AUNST; JMP I NEXT
*2200 DODI, JMS ERR; JMS I ADI0; JMP I NEXT NDECS, 0 ADI0, ERR NEG, NPOP; CIA; JMP I SNEXT GZ, NPOP; SMA SZA CLA; CMA; JMP I SNEXT PUT, NEXT6; VADR; TAD 22; IUNSTAK; JMP I NEXT ARR, NEXT6; DCA T1 /DEPTH OF DECLARATION TAD I ABAS; CIA; TAD T1 SNA CLA; JMP AR1 /SAME AS NOW? TAD T1; DCA I 23 /1ST WORD LEVEL NUMBER ISZ 23; TAD ABAS; DCA I 23 /2ND IS BASE OF LAST LEVEL CLA CMA; TAD 23; DCA ABAS /POINT AT NEW LEVEL ISZ 23 /NEW FREE SPACE POINTER AR1, NEXT6; CIA; DCA NDECS /COUNT DECLARATIONS NEXT6; VADR; TAD (2; TAD 22 DCA DECADR /POINT AT IST ARRAY VARIABLE NEXT6; DCA ARNW /GET NUMBER OF WORDS EACH ELEMENT TAD ARNW; DCA I NFSPAD /PUT IT IN DOPE VECTOR TAD NFSPAD; DCA I DECADR /ADDRESS VECTOR TO VARIABLE ISZ NFSPAD; NEXT6; DCA I NFSPAD /NO. OF SUBSCRIPTS TO DV TAD I NFSPAD; ISZ NFSPAD; CIA; DCA SUBSC /COUNT SUBSCRIPTS TAD SUBSC; DCA SUBSC1 IAC; DCA ARNE /1 ELEMENT FOR HOMOGENEOUS ALGORITHM AR2, POP; DCA T2; POP; DCA T3 /T2=UPPER, T3=LOWER BOUND TAD T3; CIA; TAD T2; IAC /NO. OF ELEMENTS DCA SUDOMQ; JMS PSDMUY /MULTIPLY BY PREVIOUS TOTAL ARNE, 0; TAD SUDOMQ; DCA ARNE /TO GET NEW TOTAL TAD T3; DCA I NFSPAD; ISZ NFSPAD /LOWER BOUND TO VECTOR ISZ SUBSC; SKP; JMP LASTSS /ANY MORE SUBSCRIPTS? TAD ARNE; DCA I NFSPAD /YES, STORE NO. ELEMENTS IN VECTOR ISZ NFSPAD; JMP AR2 /AND DEAL WITH IT LASTSS, TAD ARNE; DCA SUDOMQ; JMS PSDMUY /INCREASE FREE SPACE POINT ARNW, 0; TAD NFSPAD; TAD SUDOMQ; DCA NFSPAD /BY ARRAY SIZE JMS TESTSP /ROOM FOR IT? ISZ NDECS; SKP; JMP I NEXT /ANY MORE DECLARATIONS? TAD I DECADR; DCA T1 /POINT AT DOPE VECTOR TAD (3; TAD DECADR; DCA DECADR/NEXT VARIABLE TAD NFSPAD; DCA I DECADR /STORE ADDRESS NEW VECTOR TAD SUBSC1; CLL RAL; TAD (-1; DCA SUBSC /COUNT VECTOR SIZE AR4, TAD I T1; DCA I NFSPAD; ISZ T1; ISZ NFSPAD ISZ SUBSC; JMP AR4 JMP LASTSS /COPY DOPE VECTOR DECADR=DSWIT SUBSC=T4 SUBSC1=T5 DI, POP; JMP DODI EXINT, TAD PC; IAC; DCA T1; DCA SW1; CDF CIF; JMP I T1 EZ, NPOP; SNA CLA; CMA; JMP I SNEXT *2400 INDLST, ERR; TTI; HSI; DIN; ERR; ERR; ERR; ERR OUTLST, DUM; TTO; HSO; DOUT; ERR; ERR; ERR; ERR INDEV, 0; CLA; DCA T5; TAD XINLST; JMS IOFAN; JMP I INDEV OUTDEV, 0; DCA T5; TAD XOUTLST; JMS IOFAN; CLA; JMP I OUTDEV XINLST, JMS I INDLST XOUTLS, JMS I OUTLST XM7, -7 SKIP, POP; DCA DEV; TAD SK215; JMS I XOUT TAD SK212; JMS I XOUT; JMP I NEXT SK215, 215 SK212, 212 IOFAN, 0; TAD DEV; DCA XJMS TAD DEV; SPA; JMS I INDLST TAD XM7; SMA SZA CLA; JMS I INDLST; TAD T5 XJMS, 0; JMP I IOFAN EINT=.
/LOAD ALGOL INTERPRETIVE CODE TAPES /MAIN LIST FROM STACK START (600^) TO 3677 /FORWARD REF LIST FROM 3700 TO 3777 FIELD 0 *200 CDF CIF 10; JMP I .+1; 4000 FIELD 1 CL=23 RESULT=24 VALUE=26 SVRES=27 SP1=10 *4000 LOAD, TLS; KCC; JMS MESS 215;212;"R;"O;"G;"A;"L;"G;"O;"L;"O;"A;"D;"E;"R 240;"I;"N;"-;0 JMS TTIN; TAD (-260; DCA DEV; RFC CLA CLL CML RAR; DCA GOCP CLA CLL CMA RTL; TAD DEV; SNA CLA; JMS DIX TAD 600; TAD (-3677; DCA MLSIZE TAD 600; DCA SP1; TAD (-100; TAD MLSIZE; DCA ABAS DCA I SP1; ISZ ABAS; JMP .-2 /CLEAR LISTS TAD (200; DCA CL; JMS FDIG /SKIP TO 0 OF FIELD 0 FSC, JMS IN; TAD (-";; SZA CLA; JMP .-3 /FIND ; LOOP, CLA CMA; DCA SIGN JMS IN; JMS DIGTST; SKP; JMP CONST TAD (-"-; SNA; JMP NCONST TAD ("--":; SNA; JMP LOOP /IGNORE MULTIPLE : TAD (":-"V; SNA; JMP END TAD ("V-"L; SNA; JMP LABEL TAD ("L-"F; SNA; JMP FCON; JMS ERR END, JMS FDIG; JMS RCON /SKIP ORIGIN *125 JMS FDIG; DCA RESULT; JMS RCON /READ FIXED SPACE CLA; CDF; TAD CL; DCA I (175 /NEXT FREE SPACE TAD RESULT; DCA I (176; CDF 10 /FIXED SPACE JMS MESS; 215;212;"E;"N;"D;"S;" ;0 TAD (INIT; DCA GOCP; TAD CL; JMP WAIT-1 *4200 MAXLOC, 7577 /GETS OVERLAID BY SYSTEMS DEVICE INTERFACES LABEL, JMS IN; JMS DIGTST; JMS ERR DCA RESULT; JMS RCON; DCA CHAR; JMS CHKLNO /LABEL NUMBER TO RESULT TAD CHAR; TAD (-",; SNA; JMP DECLAB TAD (",-"=; SNA; JMP DEFLAB TAD ("=-";; SNA; JMP STLAB /MAY BE TERMINATED BY ; TAD (";-":; SZA CLA; JMS ERR /OR : STLAB, JMS LOOKUP; JMP NOTDECL /STORE LABEL. DECLARED? JMS STORE; JMP LOOP /YES STORE IT NOTDEC, JMS STORE; CMA; TAD CL /STORE LAST ADDRESS USED IN PROG DCA I T5 /AND THIS ADDRESS IN MAIN TABLE TAD RESULT; JMS SFWD /SEE IF ITS IN FORWARD LIST JMP LOOP /FINISHED IF ALREADY THERE JMS SFWD; SKP; JMS ERR /ELSE LOOK FOR SLOT TAD RESULT; DCA I T1; JMP LOOP /AND MAKE ENTRY DECLAB, TAD CL; DCA VALUE; JMP LABVAL /VALUE IS CURRENT ADDRESS DEFLAB, TAD RESULT; DCA SVRES /SAVE LABEL BEING DEFINED JMS IN; JMS DIGTST; JMP DEFL1 /ANOTHER LABEL? DCA RESULT; JMS RCON /NO, READ CONSTANT CLA; TAD RESULT DEFL2, DCA VALUE; TAD SVRES; DCA RESULT /RESTORE LABEL JMP LABVAL DEFL1, TAD PL; SZA CLA; JMS ERR /CHECK FOR L DCA RESULT; JMS RCON; JMS CHKLNO /READ DEFINING LABEL JMS LOOKUP; JMS ERR; JMP DEFL2 /CHECK DECLARED, VALUE IN AC LABVAL, JMS LOOKUP; SKP; JMS ERR /FAIL IF ALREADY DECLARED DCA T4; DCA I T1 /SAVE ADDRESS LAST USE, CLEAR FREF ENTRY TAD VALUE; DCA I T5 /PUT VALUE IN MAIN TABLE DFR, TAD T4; SNA CLA; JMP LOOP /FREFS TO FILL IN? CDF; TAD I T4; DCA T3 /YES, SAVE LINK TAD VALUE; DCA I T4; CDF 10 /REPLACE BY VALUE TAD T3; DCA T4; JMP DFR /CHECK IF ANY MORE PL, -"L STORE, 0 CDF; DCA I CL; CDF 10; ISZ CL TAD CL; CIA; TAD MAXLOC; SNA CLA; JMS ERR; JMP I STORE DIGTST, 0 TAD (-260; SPA; JMP NOT1 TAD (260-272; SMA; JMP NOT2 TAD (272-260; ISZ DIGTST; JMP I DIGTST NOT1, TAD (260-272 NOT2, TAD (272; JMP I DIGTST FDIG, 0; JMS IN; JMS DIGTST; JMP .-2; JMP I FDIG
*4400 RCON, 0 JMS IN; JMS DIGTST; JMP I RCON DCA IN; TAD RESULT; CLL RTL; TAD RESULT CLL RAL; TAD IN; DCA RESULT; JMP RCON+1 IN, 0 JMS INDEV; TAD PM215; SNA; TAD (":-215 TAD PM212; SNA; JMP IN+1 TAD PM240; SNA; JMP IN+1 TAD PM377; SNA; JMP IN+1 TAD PM211; SNA; JMP IN+1 TAD P211; SNA; JMP IN+1; JMP I IN PM215, -215 PM212, 215-212 PM240, 212-240 PM377, 240-377 PM211, 377-211 P211, 211 SFWD, 0 /SEARCH FORWARD LIST, LABEL NO. IN AC CIA; DCA T2; TAD (-100; DCA T3 TAD (3677; DCA T1 SFWD1, ISZ T1; TAD I T1; TAD T2 SNA CLA; JMP I SFWD /EXIT 1 IF FOUND, T1^ENTRY ISZ T3; JMP SFWD1 /IF NOT CHECK IF EXHAUSTED ISZ SFWD; JMP I SFWD /AND EXIT 2 IF SO LOOKUP, 0 /LOOKUP LABEL NO. IN RESULT, AC=0 TAD RESULT; TAD 600; DCA T5 /POINT AT MAIN ENTRY TAD RESULT; JMS SFWD; JMP INFWD /SEARCH FORWARD LIST TAD I T5; SZA; ISZ LOOKUP /EXIT 2 IF DECLARED JMP I LOOKUP /ELSE EXIT 1, NO PREVIOUS USE INFWD, TAD I T5; JMP I LOOKUP /ADDRESS OF PREVIOUS USE FCON, JMS FINPUT; TAD DSWIT; SNA CLA; JMP FCON TAD FLAC; JMS STORE; TAD FLAC+1; JMS STORE TAD FLAC+2; JMS STORE; JMP I .+1; FSC NCONST, DCA SIGN CONST, DCA RESULT; JMS RCON; CLA; TAD RESULT ISZ SIGN; CIA; JMS STORE; JMP LOOP DIX, 0; TAD 2204; TAD (-ERR; SNA CLA; JMS ERR /IS DIX0 THERE? TAD 2204; DCA T1; CDF CIF CLA IAC; JMS I T1; JMP I DIX /YES, DO IT CHKLNO, 0; CLA; TAD RESULT; TAD MLSIZE; SZA SMA CLA; JMS ERR JMP I CHKLNO MLSIZE, 0 $