.TITLE PDP9-15 ALGOL COMPILER PASS2 9 MAR 72 EDIT 305 /EDIT 003 26 AUG 71 TO ALLOW .ABS ASSEMBLY /IF %SY DEFINED /COPYRIGHT DIGITAL EQUIPMENT CORPORATION /SYSTEM VERSION PARAMETERS DEFINE CONDITIONAL ASSEMBLY /IF UNDEFINED RELOCATABLE VERSION PRODUCED WHERE EACH /PASS RUNS AS A SEPARATE PROGRAM. .IFUND %SY .GLOBL SIZE .ENDC .IFDEF DOS %BOS=152 .ENDC .DEFIN .BOS ADDR .IFDEF DOS LAC* (%BOS SPA!CLA JMP ADDR /BOS MODE .ENDC .ENDM / .DEFIN .OVLAY NAME .IFDEF DOS 0 24 .+1 .SIXBT "NAME" .ENDC .ENDM .IFDEF %SY .ABS .ENDC /.IFUND %C2 PRODUCE RELOCATABLE ASSEMBLY /.IFUND %S2 PRODUCE STAND-ALONE PROGRAM /.IFUND %S3 DUMP STACKS FOR PASS 3 WHEN STAND-ALONE .IFDEF %C2 .LOC %C2 .ENDC START JMP P3CON /JUMP INTO PROGRAM .IFUND %SY .IODEV -2,-3,-13,-15 .ENDC .IFUND %S2 OBM 302000 ICMK=4000 ALTMDE=400 /RCOMST /START PROGRAM:READ COMMAND STRING AND SET UP CONTROL DATA .IODEV -2,-3 RCOMST XX .INIT -3,1,P3CON /TTA OUTPUT .INIT -2,0,P3CON /TTA INPUT .WRITE -3,2,ANNOUC,6 /'ALGOL' LAC* S00102 /GET SCOM+2 DAC SP02 DAC AOPTW /ADDR OPTION WORD DAC* S00010 DZM* 10 /)CLEAR DZM* 10 /)FILE DZM* 10 /)NAME LAC* S00010 DAC AXW /ADDR EXT LAC K3 DAC* AOPTW /OPTION WORD =-3 DAC SP01 /COUNT FOR 6 BIT PACKING LAC PROCH /SET UP TO READ OPTIONS DAC BRCH RDCH .READ -2,3,COMSTR,3 /READ CHAR .WAIT -2 LAC CHAR /GET CHAR SAD S00015 /CR? JMP CR /YES SAD S00175 /ALTMODE? JMP ALTM /YES SAD S00137 /_? JMP BA /YES BRCH XCT PROCH+1 /PROCESS CHAR JMP RDCH PROCH XCT .+1 JMP OPTION /PROCESS BEFORE_ JMS FILNAM /PROCESS AFTER_ JMP RCOMST+1 /RESTART IF 2_ OPTION AND S00007 /HOLD LS 3 BITS OF CHAR CMA /)CONVERT TO COUNT DAC SP00 /)& HOLD CLA!STL RAR /MOVE 1 BIT TO RIGHT IN AC ISZ SP00 /ACCORDING TO CHAR READ JMP .-2 CMA / AND* AOPTW /CLEAR THIS BIT IN OPTION WORD DAC* AOPTW JMP RDCH /READ AGAIN FILNAM XX SAD S00073 /CHAR=; JMP SCN /YES,READ EXTN AND S00077 /)HOLD SIXBIT DAC CHAR /)IN CHAR LAC* SP02 /FILENAME WORD RTL /SHIFTED LEFT RTL /AND NEXT CHAR RTL /PACKED IN AND Z77700 TAD CHAR DAC* SP02 ISZ SP01 /3 CHARS PACKED? JMP* FILNAM /NO,READ ISZ SP02 /YES,BUMP TO NEXT WORD FN01 LAC K3 /RESET COUNT DAC SP01 JMP* FILNAM /READ CHAR FW XX LAC SP01 /GET PACK CT SAD K3 /WORD FULL JMP* FW /YES,EXIT CLA /PACK IN ZERO JMS FILNAM JMP FW+1 /; SCN LAC FILNAM DAC SP00 JMS FW /FILL UP CURRENT WORD LAC AXW DAC SP02 /SET TO READ EXTN JMP* SP00 /_ BA ISZ BRCH /BUMP TO READ FILENAME ISZ SP02 /PT TO FILNAM JMP RDCH SRC 232203 /SIXBIT 'SRC' ANNOUC 3002 0 .ASCII /ALGOL >/<175> COMSTR 2003 0 CHAR 0 ALTM LAW 777377 /MARK'RETURN TO MONITOR' AND* AOPTW DAC* AOPTW CR JMS FW /FINISH OFF WORD LAC SP02 TAD K1 SAD AXW JMP .+3 LAC SRC DAC* AXW /EXTN='SRC' IF NONE GIVEN /REST ROUTINE TO RESTORE COMPILER DATA FROM BULK STORAGE / IN DUMP MODE. FILE NAME IN CONTROL AREA REST .INIT RESTS,0,P3CON LAC K14 DAC SP00 /COUNT OF STACKS TO BE READ LAC AOPTW DAC RESTCN DAC RESTFN IDX RESTFN /ADDRESS OF FILENAME & EXT TAD C4 DAC SP01 /ADDR OF WORD HOLDING ADDR OF STAT TABLE DAC SP04 /HOLD ADDR OF WORD HOLDING ADDR STAT TABLE / .SEEK RESTS,RESTFN CAL+RESTS&777 3 RESTFN 0 LAW 773777 AND* AOPTW /HOLD ALL OPTIONS EXCEPT 'I' DAC SP02 LAC SKST DAC SP03 /HOLD ADDR OF TOP OF CORE / READ RESTS,4,RESTCN,4 /READ OPTIONS,FILENAME & EXTN CAL+4000 RESTS&777 10 RESTCN 0 -4 LAC K26 DAC RESTL /LENGTH OF STAT TABLE LAC SP01 TAD C1 DAC RESTCA /ADDR OF STAT TABLE REST1 .WAIT RESTS / .READ RESTS,4,RESTCA,RESTL /READ STAT TABLE,THEN STACKS CAL+4000 RESTS&777 10 RESTCA 0 RESTL 0 IDX SP01 /ADDR OF SK BASE LAC* SP01 /)LENGTH OF STACK DAC RESTL /)TO READ TAD SP03 /ADD ADDR OF TOP END OF FREE CORE DAC RESTCA IDX RESTCA /ADDR OF READ STACK INTO LAC SP03 /)TOP OF FREE CORE DAC* SP01 /)TO SK BASE IDX SP01 LAC RESTCA /)END OF STACK DAC* SP01 /)TO SK PTR TAD K1 DAC SP03 /RESET TOP OF FREE CORE ISZ SP00 JMP REST1 REST2 .CLOSE RESTS LAC* AOPTW AND SP02 /HOLD 'I' OPTION FROM OPTIONS RESTORED DAC* AOPTW LAC AINBA /)UPDATE ADDR OF STAT TABLE TAD K2 /TAD K2(LISTAK) DAC* SP04 /)AT BOTTOM OF CORE JMP* RCOMST SKST %C2-1 .ENDC .EJECT /TABLE OF LOCATIONS REQUIRING BANK BIT INITIALISATION BKINIT XCT .+0 A STATIN+1 A P3CON2+10 A P3CON3-2 A P3CON4-3 A P3CON4-2 A P3CON4+1 A P3CON4+4 A OVLAY-3 A OVLAY-2 A ENDP21+2 A AINBA .IFNZR %C1-6 A CALLP1+2 .ENDC .IFUND DOS A CALLP1+4 .ENDC .IFDEF %S3 A CALLP3+2 .IFUND DOS A CALLP3+4 .ENDC .ENDC A C3-2 A C3-1 A C3+7 A RINTF+2 A INPERR+2 A ABORT1+2 .IFDEF %S2 A CLIN+5 .ENDC A COMP60+1 A ERR+11 A PUTV+2 A PUTW+2 A PUTOUT+4 A NSTK13+1 A LNP+2 A SCV+1 A BLL+2 A BLL+6 A LABRF1+3 A LABRF4-4 A LABRF4+1 A LABRF4+4 A C6-2 A C6-1 A C6+4 A MODP+1 A C4-2 A C4-1 A FELS+1 A FEC+1 A T00000-2 A GENDP+1 A XENDP+5 A XENDP+6 A GTEP+4 A EXCALL+1 A EXCALL+2 A GPRLK+3 A PLSW+3 A BNL+3 A BNL+5 A PLOC+4 A OUTSK+4 A GGR01+4 A GGR-6 A GGR-4 A GGR-2 A P2SK+2 A RLSK+1 A STRSK+1 A OWNSK-4 A OWNSK2-2 A P2SK1+10 A P3SK+2 A GLBSK+1 A GLBSK1+5 A G.E A TXB3E A AAGLST A ASKLIM A XB A DMP+2 A DMP01+2 A G.S /10 SPARE ENTRIES A G.S /FOR PATCHING A G.S A G.S A G.S A G.S BKEND A G.S A TXB3-1 TXB3-TXB3E A VTOA02 VTOA02-ATXB3 BNCT BKEND-.+1 Z17777 717777 ASKLIM OVLAY-55 AAGLST GLST-1 .EJECT /LIST OF RADIX 50 REPRESENTATIONS OF RUN TIME GLOBALS GLST 124421 /%BA 124422 /%BB 124427 /%BG 124432 /%BJ 124433 /%BK 124434 /%BL 124445 /%BU 124377 /%AW * 124567 /%DW * 127521 /.BA * 124476 /%CF * 124507 /%CO * 124506 /%CN * 124444 /%BT * 124372 /%AR * 127477 /.AW * 124441 /%BQ * 124402 /%AZ * 124400 /%AX * 124401 /%AY 124435 /%BM + 124436 /%BN + 124431 /%BI + 124437 /%BO + 124450 /%BX + 124351 /%AA 124352 /%AB 124374 /%AT 124375 /%AU 124376 /%AV 124423 /%BC 124424 /%BD 124430 /%BH 124440 /%BP 124442 /%BR 124446 /%BV 124447 /%BW 124451 /%BY 124452 /%BZ 124471 /%CA 124472 /%CB 124473 /%CC 124475 /%CE 124477 /%CG 124500 /%CH 124501 /%CI 124502 /%CJ 124503 /%CK 124504 /%CL 124505 /%CM 124510 /%CP 127452 /.AB 127454 /.AD 127455 /.AE 127467 /.AO 127470 /.AP 127471 /.AQ 127472 /.AR 127473 /.AS 127474 /.AT 127475 /.AU 127476 /.AV 127501 /.AY 127522 /.BB GLSTE=. /NOTE *THESE POSITIONS FIXED FOR GEN OF JMS* BY GINSTR / + JMP* /ASSIGNMENTS OF ALL RUN TIME GLOBAL SYMBOLS /TO THE VIRTUAL ADDRESSES OF THE VOCAB ENTRY /WHICH HOLDS THEIR RADIX 50 CODES %BA=7775 %BB=%BA-2 %BG=%BB-2 %BJ=%BG-2 %BK=%BJ-2 %BL=%BK-2 %BU=%BL-2 %CF=7751 .AW=7737 %BQ=7735 %AZ=7733 %AY=7727 %AA=7713 %AB=%AA-2 %AT=%AB-2 %AU=%AT-2 %AV=%AU-2 %BC=%AV-2 %BD=%BC-2 %BH=%BD-2 %BP=%BH-2 %BR=%BP-2 %BV=%BR-2 %BW=%BV-2 %BY=%BW-2 %BZ=%BY-2 %CA=%BZ-2 %CB=%CA-2 %CC=%CB-2 %CE=%CC-2 %CG=%CE-2 %CH=%CG-2 %CI=%CH-2 %CJ=%CI-2 %CK=%CJ-2 %CL=%CK-2 %CM=%CL-2 %CP=%CM-2 .AB=%CP-2 .AD=.AB-2 .AE=.AD-2 .AO=.AE-2 .AP=.AO-2 .AQ=.AP-2 .AR=.AQ-2 .AS=.AR-2 .AT=.AS-2 .AU=.AT-2 .AV=.AU-2 .AY=.AV-2 .BB=.AY-2 .EJECT .IFDEF %S2 OBM 102200 ICMK=400 ALTMDE=1000 .ENDC /P3CON PHASE 3 CONTROL /SETS UP STATISTICS TABLE. PUTS GLOBAL NAMES INTO VOCAB IN A /PREDETERMINED ORDER. /INITIALISES PHASE 3 PROCESSES THE INTERMEDIATE CODE /& THEN APPENDS THE STACK CONTENTS. P3CON JMS . /START PASS BY INITIALISING LAC P3CON /BANK BITS AND S60000 DAC BANK /HOLD BANK BITS TAD BKINIT /SET UP TABLE START AND S77777 DAC* C8 /IN AUTO LAW BKINIT-BKEND DAC SP01 /SET COUNT OF TABLE LENGTH NXBKAD LAC* AUTO /ADDR FROM TABLE(13 BIT) XOR BANK /ADD IN BANK BITS DAC SP00 /HOLD LAC* SP00 /GET WORD TO INITIALISE AND Z17777 /DISCARD OLD BANK BITS XOR BANK /INSERT NEW BANK BITS DAC* SP00 /REPLACE IT ISZ SP01 /FINISHED TABLE JMP NXBKAD /NOW INIT CORE TABLES NXTABL LAC* AUTO /ADDR OF TABLE(13 BIT) AND S77777 XOR BANK /ADD IN BANK BITS DAC* C9 /HOLD IN AUTO 1.2 DAC* C10 LAC* AUTO /LENGTH OF TABLE DAC SP00 IDX BNCT /INCR COUNT OF TABLES(*2) NXTENT LAC* AUTO1 /BANK INIT ALL ENTRIES SPA /IN TABLE:EXCEPT -VE WORDS JMP .+3 AND Z17777 XOR BANK DAC* AUTO2 ISZ SP00 /END OF TABLE? JMP NXTENT /NO ISZ BNCT /END OF LIST OF TABLES? JMP NXTABL /NO .IFUND %S2 JMS RCOMST .ENDC LAC* S00102 DAC AOPTW /SET ADDR OF OPTION WORD TAD C1 /SET UP ADDR OF FILENAME DAC UP15+6 /FOR INT CODE OUTPUT DAC CLOUT1+2 /FOR CLOSING INT CODE OUTPUT TAD C2 DAC AXW /ADDR OF FILE EXTN TAD C2 DAC STOUT /ADDR OF STAT TABLE IN ALCOM DAC STATIN JMS COPY /MOVE STAT TABLE STATIN XX /INTO MODULE INBASE 33 LAC OUBASE /MOVE PASS 1 OUTPUT DAC INCODE /TO BE PASS 2 INPUT TAD* WORK /ADD SIZE FROM PASS 1 IDX WORK /AND LOSE TAD K1 DAC ICBASE LAC* S00102 /INITIALISE PASS 2 OUTPUT AK AND S77777 TAD C75 DAC OUT TAD K39 DAC OUBASE TAD K2 /SET UP INT CODE OUTPUT BUFFER DAC UP18+2 TAD K1 DAC BLKADD LAC S25500 /BUFFER HDR WD DAC* UP18+2 LAC* AOPTW CMA AND OBM /EXTRACT OPTIONS O,B,M SZA /ANY REQD? JMP P3CON1 /YES LAC OUBASE /NO:CLOSE DOWN OUT SK TAD K28 DAC OUBASE DAC OUT IDX PUTOUT+1 /MARK NO OUTPUT P3CON1 LAC GLBASE /EMPTY OLD DICT SK DAC GLOBAL LAC VOBASE /EMPTY VOCAB STACK DAC VOCAB LAC AAGLST DAC* C10 /ADDR GLST-1 TO AUTO 12 LAW GLST-GLSTE DAC SAC P3CON2 LAC* AUTO2 /RADIX 50 OF GLOBAL NAME JMS PUTV /TO VOCAB SK CLA /0 PTR WORD JMS PUTV /TO VOCAB ISZ SAC JMP P3CON2 .INIT -2,0,RECALL /^P TO TERMINATE PASS JMS TOPT 100 /'D' OPTION? SKP /YES JMP P3CON3 /NO .INIT -2,0,DMP+400000 /ENABLE CTRLT(^T) P3CON3 JMS TAKEW /GET MAXL(MAIN PROGRAM) TAD* WORK /ADD MAXOTD+1(=DNLBL(MAIN PROGRAM)) TAD C1 JMS PUTW /STORE AS DBIL(MAIN PROGRAM) JMS COPY /)CREATE DUMMY PROC INFO K2 /)FOR MAIN PROGRAM M*1+WORK /)ON WORK SK 4 P3CON4 JMS EVA WKBASE DAC CPI /POINT CPI TO IT JMS LAM /RETRIEVE OWN SIZE M*6+WORK /FROM TOP OF WORK DAC DIM /& HOLD IN DIM JMS COPY /)SET UP PROC INFO M*6+CPI /)IN FIXED SPACE NAME1 6 OVLAY JMS FNW /OPEN INPUT &GET FIRST WORD ISZ* AXW /EXT='A02' JMS OBEY JMP ANAL+4 P3CON6 JMS OUTSK ENDP2 JMS CLOUT /CLOSE OUTPUT FILE DZM TENS LAC ERRNO /#ERRORS IDX TENS /BUMP TENS COUNT TAD K10 /-10 SMA!STL /-VE? JMP .-3 /NO TAD C10 /YES:ADD 10 RTR /)SHIFT TO THIRD RTR /)CHAR IN 5/7 PAIR XOR ENO+1 /PACK LAST 3 BITS DAC ENO+1 LAC U40006 /CREATE '('<0>'0' SZL TAD C1 /ADD 1 IF UNITS>7 DAC ENO LAC TENS /RETRIEVE TENS-1 TAD K1 SNA /SUPPRESS TENS IF = 0 JMP ENDP21 TAD K10 /REDUCE TO <10 SMA!STL JMP .-2 TAD S00072 /MAKE +VE & ASCII CHAR RTL /)SHIFT TO SECOND RTL /)CHAR IN 5/7 PAIR XOR ENO /PACK INTO BUFFER DAC ENO ENDP21 .WRITE -3,2,EOP2M,6 / 'EOP2 (NN)' .WAIT -3 JMS COPY AINBA INBASE STOUT XX C27 33 XCT PUTOUT+1 /PASS 3 REQD? JMP RESTART /NO CALLP3=. .IFUND %S3 JMS DUMP /DUMP COMPILER DATA JMP RESTART .ENDC .IFDEF %S3 .IFUND DOS JMS OLAY /CALL PASS 3 %B3 /SYSTEM BLOCK # %C3-1 /CORE ADDR-1 -%L3 /-LENGTH %S3 /START ADDR .ENDC .OVLAY ALCP3@ .ENDC EOP2M 6002 0 .ASCII 'EOP2' ENO .ASCII '('<0><0>')'<175> RESTART JMS TOPT ALTMDE /ALTMODE IN COMMAND? JMP MONITR /YES .IFDEF DOS .BOS MONITR .ENDC CALLP1=. .IFUND DOS JMS OLAY %B1 /SYSTEM BLOCK # %C1-1 /CORE ADDR-1 -%L1 /-LENGTH %S1 /START ADDR .ENDC .OVLAY ALGOL@ /^P COMES HERE RECALL JMS INOPEN /.DLETE INPUT IF OPEN IDX PUTOUT+1 /MARK PASS 3 NOT REQUIRED JMS CLOUT /CLOSE & DELETE OUT IF THERE JMP CALLP1 /RELOAD PASS 1 /INOPEN IF INT.CODE FILE OPEN CLOSE & DELETE IT INOPEN XX LAC SCRSW /PICK UP INPUT SWITCH XOR BANK DAC SP00 /PICK UP SWITCH WORD LAC* SP00 SAD SCRIN+2 /USING IN CORE DATA? JMS CLIN /NO:CLOSE & DLETE IT JMP* INOPEN MONITR .EXIT CLOUT XX /CLOSE OUTPUT JMS TOPT ICMK /INT.CODE OUTPUT PRODUCED? SKP /YES JMP* CLOUT /NO .CLOSE INTOUT /CLOSE FILE XCT PUTOUT+1 /OUTPUT REQD FOR PASS 3? SKP /NO JMP* CLOUT /YES CLOUT1 .DLETE INTOUT,CLOUT1+2 /NO:DELETE IT JMP* CLOUT .EJECT /SOURCE INPUT CONTROL ROUTINE / S/R 'FNW' IS CALLED TO FETCH NEXT WORD OF INPUT INTO NXOP / THROUGHOUT PASS 2. (MAINLY CALLED IN ANAL VIA GTNEXT) / 'SCRSW' CONTROLS FROM WHERE THE INPUT IS READ /INITIALLY 'INITIN' IS OBEYED TO DETERMINE WHETHER AN INT CODE /FILE IS PRESENT / IF SO,THE FILE IS OPENED AND 'SCRSW' CAUSES INFILE /TO BE OBEYED / IF THERE IS NO INT CODE FILE OR THE INT CODE FILE /HAS BEEN READ 'SCRSW' CAUSES INPUT TO BE TAKEN FROM /THE STACK 'INCODE' FNW XX /FETCH NEXT WORD OF INPUT SCRSW XCT SCRIN /SWITCH ON SOURCE OF INPUT INCORE IDX SCRSW /SWITCH TO INCODE SK LAC* INCODE IDX INCODE /NXOP_INCODE(-) DAC NXOP JMP* FNW SCRIN JMP INITIN /ON FIRST CALL OF FNW INITIALISE INPUT JMP INFILE /GET INPUT FROM INT CODE FILE SKP /GET INPUT FROM INCODE SK /INITIALISE INPUT INITIN IDX SCRSW /SWITCH TO INT CODE FILE INPUT JMS TOPT ICMK /INT CODE FILE PRESENT? SKP /YES JMP INCORE /NO:SWITCH TO INCODE SK LAC* AOPTW /) XOR INITIN+2 /)CLEAR INT CODE MARK DAC* AOPTW /) JMS COPY / M*4+CLOUT1+2 /)PRESERVE INPUT FILE NAME INFN /)FOR .DLETE AFTER READING C3 3 .INIT INTIN,0,P3CON .SEEK INTIN,INFN JMP RINTF /READ FIRST BUFFER LOAD /GET INPUT FROM INT CODE FILE INFILE LAC* AINWD /NEXT INPUT WORD FROM BUFFER IDX AINWD /BUMP ADDR DAC NXOP /NXOP_NEXT INPUT WORD ISZ IBUFCT /END OF BUFFER LOAD? JMP* FNW /NO:EXIT WITH WORD IN NXOP RINTF .READ INTIN,0,INBUFF,42 /READ BUFFER LOAD OF INT CODE FILE .WAIT INTIN LAC INBUFF /HEADER WORD AND S00077 SAD C5 /EOF? JMP ENDIF /YES:CLOSE INTIN & SWITCH TO INCODE SK TAD V77760 SPA /READ ERROR? JMP INPERR /YES:REPORT & ABORT /INITIALISE BUFFER CONTROL LAW -51 DAC IBUFCT /BUFFER LOAD OF 50 WORDS LAC AINB2 DAC AINWD /ADDR OF FIRST WORD JMP INFILE /FETCH FIRST WORD /END OF INT CODE FILE REACHED ENDIF JMS CLIN /CLOSE & DELETE INPUT FILE JMP INCORE /SWITCH TO INPUT FROM INCODE SK /REPORT READ ERROR & ABORT INPERR .WRITE -3,2,INFAIL,12 /REPORT READ ERROR .CLOSE INTIN /CLOSE INT CODE FILE JMP ABORT1 ABORT JMS ERR /REPORT ERROR & ABORT JMS INOPEN /.DLETE INOUT IF OPEN ABORT1 .WRITE -3,2,BORT,6 IDX PUTOUT+1 /MARK PASS 3 NOT REQD JMP ENDP2 CLIN XX /CLOSE & DELETE INPUT FILE .CLOSE INTIN .IFDEF %S2 .DLETE INTIN,INFN .ENDC JMP* CLIN BORT 3002 0 .ASCII 'ABORTED '<175> INFAIL 6000 0 .ASCII 'INT.CODE FILE READ ERROR'<15> .EJECT /COMP COMPILE OPERATOR /ON ENTRY OPERATOR TO BE PROCESSED HELD IN NXOP /USES TABLE TXB3 IF NXOP HOLDS OPERATOR /USES (LCR,LCP) GEN TABLE IF NXOP HOLDS SKPTR /USES (LVR,LVP) GEN TABLE IF NXOP INDICATES DICT INFO /FOR DICT INFO Q2 IS SET UP TO INDICATE GEN TABLE ENTRY COMP XX LAC NXOP /LOAD OPERATOR SPA!RAL /DICT INFO? JMP COMP50 /YES SPA /OPCODE? JMP COMP30 /YES JMS MES /NO:STACK PTR JMP RR+15 /SK # TO LS END AND S00017 /& EXTRACT FOR MODIFIER JMS GFTLU /TO GEN CODE FROM TABLE LCR LAC LCR-1 LCP-LCR COMP20 DZM NXTRQD /MARK NXT REQD JMP* COMP COMP30 JMS MES JMP R-7 /OPCODE TO LS END AND S00077 TAD ATXB3 DAC SP04 LAC* SP04 /GET TXB3 TABLE ENTRY SPA /TO USE ANAL? JMP* SP04 /NO:JMP TO ENTRY(XX IF ILLEGAL) LAC COMP /STACK COMPS LINK JMS PUTW /THEN STACK XB AND PLANT RETURN JMS OBEY /LINK FOR ANAL LCOMP JMP COMP44 DAC XB /RESET XB JMS TAKEW /RESET COMP LINK DAC COMP JMP* COMP /EXIT COMP44 LAC S77777 AND* SP04 /GET 15 BIT ADDR FOR XB DAC XB XOR* SP04 /EXTRACT TOP 3 BITS SNA /OPERATOR REQD ON WK SK? JMP COMP45 /NO LAC NXOP /YES,HOLD OPERATOR ON WORK JMS PUTW COMP45 JMS FNW JMP ANAL+4 /ENTER ANAL (RETURNS TO COMP41-1) COMP50 SMA /IS IT L & C COUNT? JMP ERREC /YES JMS CLADI /CLASSIFY DICT INFO TAD FADSW /ADD FADSW IF NOT ARRAY(OR SWITCH) JMS GFTLU /GENERATE CODE FROM LVR TABLE LAC LVR LVP-LVR ISZ ARSW /WAS THIS AN ARRAY REF? SKP JMP* COMP /NO:EXIT COMP60 JMS LAM /YES:GET # DIMS M*1+WORK /FROM WORK STACK DAC NXOP /& HOLD IN NXOP AS LEADING PARAM LAC JMS%BV /AC=JMS* %BV JMS OUT3L /GENERATE JMP* COMP /EXIT .EJECT /ELSE3 PROCESS ELSE OPERATOR ELSE3 JMS GELSE JMP COMP20 /DO3 PROCESS DO OPERATOR / S/R CALL GENERATED IF MULTIPLE FOR ELEMENTS DO3 LAC DOLAB SNA /MULTIPLE FOR ELEMENTS? JMP DO31 /NO:'DO' A DUMMY JMS GLLR /YES JMS /DOLAB /G(JMS 'DOLAB') LAC ELLAB /IS FOREL AN AFOR? SNA /NO JMP COMP20 /YES:CONTINUE JMS GLLR /G(JMP 'ELLAB') JMP /ELLAB LAC U12000 /)ENDC TO NXOP DAC NXOP /)TO TERMINATE IFS JMP* COMP /EXIT DO31 LAC ELLAB /)IS FOREL A'WHILE' SZA /) OR 'STEP'? JMS PUTW /YES: STACK ELLAB JMP COMP20 /RETURN /FLK3 PROCESS SECOND FLK OPERATOR IN FOREL / ONLY PRESENT ON MULTIPLE FOR ELEMENTS FLK3 JMS FNW /OTD(FOR LINK) TO NXOP JMS JLW /G(JMP 'OVER DO STATS') LAC JMS%AU /G(DISPL(FOR LINK)) JMS OUT4 /G(JMS* %AU) LAC DOLAB JMS PLOC /DOLAB PLANTED JMS GEN4 XX /G(XX):LINK TO DO S/R JMS GEN3 JMP .-3 LAC NXOP JMS PUTW /OTD(FOR LINK) TO WK JMP COMP20 /EXIT & RELOAD NXOP .EJECT /ERROR REPORTING ROUTINE -ERR# IN AC /ONLY ERROR NOS. 23,24,29,98 &99 pOSSIBLE ERR XX IDX ERRNO /COUNT #ERRORS REPORTED JMS TCA TAD ERRCH DAC .+1 /PICK UP ASCII FOR ERROR # 0 /LAC ERRNUM-27+ERROR # DAC EBUFF .WRITE -3,2,ERRBUF,14 .WAIT -3 JMP* ERR ERRCH LAC ERRNUM-27 ERRBUF 7002 0 .ASCII '**E' EBUFF .ASCII <0><0><0>' (' ERPOSN .ASCII '0,0)(0,0)'<15> .BLOCK 5 /BLOCK FOR LINE & CHAR COUNT /FROM INT.CODE INPUT ERREC LAW -11 /READ IN 8 WORDS OF ASCII DAC SP00 /LINE & CHAR POSN LAC AAERP DAC* C8 ERREC1 JMS FNW DAC* AUTO ISZ SP00 JMP ERREC1 JMP COMP+1 .EJECT /RDDI READ AND DECODE DICT INFO /CALLED WHEN NXOP CONTAINS OP(DICT INFO) TO READ DICT BLOCK /ITS STORES IT IN CORE AND SETS Q2=8 IF NONLOCAL / Q2=4 IF OWN / Q2=0 IF LOCAL / SETS UP LOCNSSKTHL /FROM 1ST WORD READ / NXOP /TO HOLD DISPL READ AS 2ND WORD /SETS NXTRQD =0 TO INDICATE ANOTHER WORD INPUT REQD RDDI XX LAC NXOP /HOLD FIRST WORD IN CASE AND T77777 /REMOVE TOP 2 CONTROL BITS DAC HOLDP /SHORT DICT INFO (2 WORDS) DZM Q2 JMS FNW DAC SKTHL /HOLD NEXT WORD OF DICT INFO AND S03700 CMA /-H-1 AND Z77700 TAD CHL /CHL-H-1 SPA!CLA /NONLOCAL? JMP RDDI03 /NO,LOCAL LAC C8 DAC Q2 /NONLOCAL:Q2=8 RDDI01 JMS TOPT 40000 /'X' OPTION? SKP /YES JMP RDDI02 /NO:DICT INFO NOW READ JMS FNW /DISPL HELD IN NXOP DAC HOLDP /HOLD DISPL JMS FNW /FETCH LAST WORD RDDI02 LAC HOLDP DAC NXOP /NXOP_DISP DZM NXTRQD /MARK NEXT REQD LAC SKTHL AND T40000 /EXTRACT KIND SAD S40000 /OWN? SKP /YES JMP* RDDI /NO,EXIT LAC C4 DAC Q2 /Q2_4 IF OWN JMP* RDDI RDDI03 SAD CLRSW /LOCAL REF VALID JMP RDDI01 LAW -1 /NO:CHECK LEVEL NOT=CURRENT LEVEL TAD SKTHL /HL-1 CMA TAD CHL /CHL-HL AND S03777 /EXTRACT RESULTANT HL SZA /REF. WITHIN THIS BLOCK JMP RDDI01 /NO:OK LAW -143 /YES,REPORT ERROR 99 JMS ERR JMP RDDI01 /CLADI CLASSIFY DICT INFO:Q2=6 IF SWITCH NAME /Q2&1=1 IF REAL:Q2&2=2 IF FN:Q2&4=4 IF OWN:Q2&8=8 IF NON LOCAL /EXIT TO LINK+1 IF ARRAY OR SWITCH NAME CLADI XX JMS RDDI Z50001 CLC DAC ARSW /ARSW=-1(IF NOT ARRAY) LAW 774000 AND SKTHL /EXTRACT SKT SAD U24000 /LABEL ARRAY (IE SWITCH) JMP CLADI2 /YES:Q2=6 SMA!RAL /SORT=ARRAY? ISZ ARSW /YES:ARSW=0 SKP!RTL /NO:SKIP JMP CLADI4 /EXIT AS IF LOCAL INTEGER ACTUAL SZL!RAL /KIND=ACTUAL OR OWN? SNL /NO:FORMAL BY NAME? JMP CLADI3 /NO AND Z00000 /EXTRACT TYPE SAD W00000 /IS IT STRING? JMP CLADI1 /YES: EXIT AS IF ACT. INT. IDX Q2 /YES:Q2:=Q2+2 IDX Q2 CLADI3 AND U00000 /EXTRACT INT/BOOL BIT SNA /INTEGER OR BOOLEAN? IDX Q2 /NO:2:=Q2+1 IF NOT INT/BOOL CLADI1 LAC Q2 JMP* CLADI /EXIT WITH Q2 IN AC CLADI4 LAC Q2 SAD C4 /OWN ARRAY? TAD C12 /YES:TREAT AS FETCH ADDR SKP CLADI2 LAC C6 /Q2=6 FOR SWITCH DAC Q2 /ALSO IN AC IDX CLADI /BUMP LINK FOR ARRAY OR SWITCH JMP CLADI1 /EXIT TO LINK+1 .EJECT /ANAL /ANALYSES THE SOURCE BY INTERPRETING SYNTAX BLOCKS ANAL LAC* XB AND S17777 XOR BANK DAC XB /XB:= ADDR OF CATOM LAC* XB /CATOM INTO AC SPA!RTL /SKIP IF C=0 OR 1 JMP ANAL02 /JUMP IF ATOM NOT CODE OR MASK SNL!RTR /SKIP IF C=1:CATOM IN AC JMP ANAL01 /J IF C=0: CATOM IN AC SAD NXOP /CATOM=CURRENT CODE ? ISZ NXTRQD /YES, SO MARK NEXT INPUT REQD & SKIP JMP ANAL03-2 JMP ANAL03-3 ANAL02 SZL /)IF C=3 THEN JUMP TO XB TO OBEY ROUTINE TO JMP* XB /)DETERMINE STATE:RETURN TO ANAL03 JMS OBEY /STACK XB AS LINK AND ENTER ANAL (C=2) LANAL JMP ANAL ANAL01 AND NXOP /MASK CURRENT CODE WITH CATOM SNA!STL /MASK BIT SET IN CURRENT CODE ? CLC!SKP /NO, SO SET AC=-1(FALSE) AND SKIP GLK /YES, SO SET AC = +1(TRUE) /COMMON PATH ONCE CATOM HAS BEEN PROCESSED;DEALS WITH ACTION AND NEXT ANAL03 DAC STATE TAD XB DAC XB /XB:=NEXT(STATE) TAD STATE DAC ANAL90 LAC* XB /AC:=NEXT(STATE) SPA /ACTION REQD ? XCT* ANAL90 ANAL04 LAC NXTRQD SZA!CLC /SKIP IF NEXT INPUT REQD (NXTRQD=0) JMP .+3 DAC NXTRQD /RESET NXTRQD TO -1(NEXT INPUT NOT REQD) JMS FNW /GET NEXT INPUT LAC* XB /AC=NEXT(STATE) RTL /AC0=N(STATE),L=S(STATE) SPA!CLC /SKIP IF N=0(FALSE):AC=-1 JMP ANAL /IF N=TRUE THEN GO TO PROCESS NEXT XB SZL /SKIP IF S=0(FALSE):AC=-1 CLA!RAL /IF S=1(TRUE) THEN AC=+1 DAC STATE /RESET STATE FROM AC JMP EXIT /EXIT TO LINK ON WORK STACK .EJECT /PUT /SUBROUTINE TO PUT C(AC) ON STACK GIVEN AS A TRAILING ARGUMENT. /CALLING SEQUENCE: /SCRATCHPAD USED:SP00,SP01,SP02 / JMS PUT / .DSA PTR PUT XX DAC SP00 PUT01 LAC* PUT /LOAD ADDR OF STACK POINTER AND S77777 SAD AOUT /OUT SK? JMP PUT04 /YES DAC STLIM DAC PTRADD LAC* STLIM /LOAD STACK POINTER TAD K1 /DECREMENT STACK PTR DAC STWDAD /HOLD ISZ STLIM /STLIM:=ADDR OF STACK LIMIT SAD* STLIM /STACK OVERFLOW? JMP MOVE /YES,SO MOVE STACKS ABOUT DAC* PTRADD /INSERT NEW PTR IN STAT. TABLE PUT02 LAC SP00 /LOAD WORD TO BE STACKED DAC* STWDAD /PUT ON STACK ISZ PUT JMP* PUT PUT04 LAC OUBASE /)LOAD ADDR OF WD ABOVE LAST TAD SIZE /)WD ON OUT SK SAD OUT-1 /OUT SK OVERFLOW? JMP PUT06 /YES DAC STWDAD JMS TCA TAD OUT SPA /SIZE LESS THAN 40? ISZ OUT /NO,SO INCREMENT OUT PTR ISZ SIZE JMP PUT02 PUT06 JMS UP /MOVE STACKS UP OR OUTPUT BUFFER JMP PUT04 /TRY AGAIN .EJECT PUTV XX JMS PUT .DSA VOCAB JMP* PUTV PUTW XX JMS PUT .DSA WORK JMP* PUTW PUTOUT XX XCT OUTSW /SKP IF OUTPUT REQD JMP* PUTOUT /OTHERWISE EXIT JMS PUT .DSA OUT JMP* PUTOUT TAKEW XX LAC* WORK ISZ WORK JMP* TAKEW .EJECT /MOVE /CALLED FROM ROUTINE PUT TO MOVE STACKS DOWN THE CORE WHEN STACK /OVERFLOW OCCURS. /ENTRY:STLIM CONTAINS THE ADDRESS OF THE LOCATION IN THE STATISTICS /TABLE FOLLOWING THE POINTER TO THE STACK WHICH OVERFLOWED. /SCRATCHPAD USED:SP01,SP02 MOVE LAC STLIM DAC SP01 MOVE2 LAC* SP01 /LOAD ADDR OF BASE OF CURRENT STACK SAD OUT /OUT SK? JMP MOVE10 /YES ISZ SP01 /SP01:=ADDR OF CURRENT STACK POINTER LAC* SP01 CMA /AC=-CURRENT STACK POINTER-1 DAC SP02 /STORE TEMPORARILY ISZ SP01 /SP01:=ADDR OF NEXT BASE PTR LAC* SP01 AND S77777 /IGNORE SIGN BIT IF SET TAD SP02 TAD C25 /AC:=BASE(NEXT)-PTR(CURRENT)+24 SMA /FREE SPACE>23? JMP MOVE2 /NO,SO TRY AGAIN LAC SP01 TAD K1 DAC SP01 /SP01:=ADDR Of STACK POINTER LAC* SP01 /LOAD STACK POINTER TAD K1 /SET UP A-I 10 WITH START ADDR FOR DAC* C8 /STACK TRANSFER TAD K24 /SET UP A-I 11 WITH DESTINATION DAC* C9 /ADDR FOR STACK TRANSFER LAC* STLIM CMA TAD* SP01 /AC:=PTR-(BASE + 1) DAC SP02 /SET UP COUNT FOR TRANSFER LOOP MOVE4 LAC* AUTO /START OF TRANSFER LOOP DAC* AUTO1 ISZ SP02 JMP MOVE4 /END OF TRANSFER LOOP /THIS SECTION UPDATES THE STATISTICS TABLE WITH THE NEW STACK POSITIONS MOVE6 LAC* SP01 /AC:=ADDR OF LAST ENTRY TO BE UPDATED TAD K24 DAC* SP01 /STORE UPDATED ENTRY LAC SP01 SAD STLIM /TABLE UPDATED? JMP MOVE8 /YES TAD K1 DAC SP01 /DECREMENT PTR JMP MOVE6 MOVE8 LAC STWDAD JMP PUT02-1 MOVE10 JMS UP /MOVE STACKS UP CORE, OR OUTPUT BUFFER JMP PUT01 .EJECT /UP /SUBROUTINE TO MOVE STACKS UP THE CORE WHEN STACK OVERFLOW /OCCURS. IF THE STACKS ARE TOO TIGHTLY PACKED TO BE MOVED /UP,A BUFFER-FULL OF INTERMEDIATE CODE IS OUTPUT (UNLESS /THIS WOULD NOT RELIEVE THE JAM,WHEN THE RUN IS ABORTED /AND AN ERROR MESSAGE OUTPUT). /ENTRY LOCN FSREQD HOLDS 1+THE SIZE OF FREE SPACE / REQUIRED BEFORE THE STACK BELOW THE FREE SPACE IS / MOVED UP. /EXIT STACKS MOVED UP,BUFFER OUTPUT,OR ABORT. /SCRATCHPAD USED: SP01,SP02 /AUTO-INDEX REGS. USED: 14,15 UP XX DZM SMF /CLEAR "STACKS MOVED" FLAG LAC FREQD SKP UP02 LAC FSREQD RCR DAC FSREQD /HALVE SIZE OF FREE SPACE REQD SNA /RESULT=0? JMP UP12 /YES,SO GO TO OUTPUT BUFFER LAC AINBA DAC SP02 UP04 ISZ SP02 UP06 LAC* SP02 /GET NEXT PTR SAD OUT-1 /LAST FREE SPACE? JMP UP10 /YES,SO EXIT FROM LOOP ISZ SP02 /SP02:=ADDR OF NEXT BASE JMS TCA TAD* SP02 /AC:=-(FREE SPACE+1) TAD FSREQD /AC:=-(FREE SPACE-(FSREQD-1)) SMA /STACK TO BE MOVED? JMP UP04 /NO,SO FIND NEXT FREE SPACE DAC SMF JMS TCA /AC:=FREE SPACE -FSREQD DAC SP01 /HOLD TAD* SP02 /)SET NEW BASE ENTRY DAC* SP02 /)IN STAT TABLE DAC* C12 /HOLD ISZ SP02 /SP02:=ADDR OF PTR LAC SP01 TAD* SP02 /)SET NEW PTR ENTRY DAC* SP02 /)IN STAT TABLE CMA /ACC:=-(NEWPTR-1) TAD C2 DAC SP01 /HOLD FOR USE IN LOOP JMP UP09 UP08 LAC* AUTO4 /START OF LOOP TO MOVE STACK UP DAC* AUTO5 ISZ ISZCT JMP UP08 UP09 LAC* C12 /LOAD OLD ADDR OF LAST WD MOVED TAD SP01 /SUBTRACT (NEW PTR-1) SPA!SNA /WHOLE STACK MOVED? JMP UP06 /YES,SO JMP OUT OF LOOP TAD SMF /SUBTRACT NO OF WORDS TO MOVE SMA /SHORT BLOCK TO BE MOVED ? CLA /NO ACC:=0 JMS TCA /YES ACC:=MODIFIER TAD SMF /MODIFY NO OF WORDS TO BE MOVED:=CNT DAC ISZCT /RESET COUNT FOR INNER LOOP LAC* C12 /) TAD ISZCT /)RESET AUTO-INDICES DAC* C13 /)FOR INNER LOOP TAD SMF /) DAC* C12 /) JMP UP08 UP10 LAC SMF SNA /ANY STACKS MOVED? JMP UP02 /NO JMP* UP /YES,SO EXIT UP12 LAW -50 /LOAD NO OF WORDS IN OUT STACK TAD SIZE SMA /SHOULD BUFFER BE OUTPUT? UP14 JMP UP16 /YES K23 LAW -27 /NO,SO REPORT ERROR 23 JMP ABORT UP15 .INIT INTOUT,1,P3CON /OBEYED ONCE ONLY .ENTER INTOUT,UP15+6 /ADDR OF FILENAME SET BY P3CON LAC INITIN+2 XOR* AOPTW /)SET IC MARKER IN OPT WD DAC* AOPTW /) IDX UP14 /BUMP TO .ENTER ONLY ONCE SKP UP16 JMP UP15 LAW -6 /SET TO WRITE 6 BUFFER LOADS DAC SP02 /(ONE FILE BLOCK) UP18 .WRITE INTOUT,0,UP18,42 /BUFF ADDR SET BY P3CON LAC SIZE JMS TCA DAC SP01 /HOLD CT FOR LOOP LAC OUBASE TAD C39 DAC* C12 TAD K40 DAC* C13 UP20 LAC* AUTO4 /START OF LOOP DAC* AUTO5 ISZ SP01 /END? JMP UP20 /NO K40 LAW -50 /)DECREMENT SIZE BY TAD SIZE /)NO OF WDS DAC SIZE /)OUTPUT TAD K40 /AC:=NEW SIZE-40 SPA /SIZE<40? CLA /YES: AC:=0 TAD C39 /AC:=39 OR SIZE-1 TAD OUBASE DAC OUT /SET OUT SKPTR IN STAT TABLE ISZ SP02 /6 BUFFERS WRITTEN? SKP /NO JMP* UP /YES:EXIT LAW -50 /REDUCE SIZE TAD SIZE /BY BUFFER LOAD SMA /BUFFER LOAD LEFT? JMP UP18 /YES JMP* UP /EXIT /TOPT /TEST FOR OPTION /CALL: JMS TOPT / MASK FOR OPTION /RETURNS TO LINK IF OPTION SET(BIT=0) /RETURNS TO LINK+1 IF OPTION NOT REQUIRED(BIT=1) TOPT XX LAC* AOPTW /LOAD OPTION WORD AND* TOPT /MASK FOR OPTION REQD IDX TOPT SZA /OPTION REQD? IDX TOPT /NO,SKP LOCATION JMP* TOPT /YES,RETURN .EJECT /OBEY /ROUTINE TO STACK A LINK ON THE WORK STACK AND ENTER THE ROUTINE /SPECIFIED AS A TRAILING PARAMETER. /A LINK ALWAYS HAS THE SIGN BIT SET. /WHEN LINK POINTS TO ANAL, IT IS STORED AS XB WITH BITS 0-2 SET TO 110 /WHEN LINK POINTS TO COMP, IT IS STORED AS XB WITH BITS 0-2 SET TO 111 /IN ALL OTHER CASES C(AC) IS STACKED, THEN LINK AS 15-BIT ADDR /WITH SIGN BIT SET. /CALLING SEQUENCE: / JMS OBEY / JMP ROUTINE OBEY XX JMS PUTW /PUT C(AC) ON WORK STACK LAC OBEY /GET LINK AND S77777 /KEEP 15 BIT ADDR SAD ALANAL /LINK TO ANAL? LAC Y00000 /YES SAD ALCOMP /LINK TO COMP? LAC Z00000 /YES SPA /LINK TO COMP OR ANAL? JMP OBEY2 /YES TAD W00001 /SET SIGN AND STEP 1 JMS PUTW /PUT LINK ON WORK STACK JMP* OBEY /ENTER ROUTINE OBEY2 XOR XB DAC* WORK JMP* OBEY /EXIT /ROUTINE TO JUMP TO THE ADDRESS SPECIFIED BY THE LAST LINK /STORED ON THE WORK STACK. /CALLING SEQUENCE: / JMP EXIT EXIT JMS TAKEW /TAKE CURRENT WD OFF WORK STACK SMA /SKIP IF LINK JMP EXIT /REPEAT DAC SP01 /DUMP LINK ADDR RTL SZL /LINK FROM ANAL OR COMP? JMP EXIT05 /YES JMS TAKEW /TAKE STORED AC OFF WORK STK JMP* SP01 /JUMP TO IT EXIT05 RAL LAC SP01 AND S77777 SZL /LINK FROM ANAL JMP LCOMP+1 /NO TAD STATE JMP ANAL03+2 .EJECT /NSTK /ROUTINE TO SEARCH THE VOCAB STACK FOR A MATCH WITH THE NAME HELD (IN /RADIX 50 FORMAT) IN THE FIRST TWO WDS OF THE NAME CHARACTER BLOCK. /IF NO MATCH IS FOUND THE NEW NAME IS ADDED TO THE STACK. THE DISPLACE- /MENT OF THE ENTRY FROM THE BASE OF THE STACK IS INSERTED IN THE L.S. /EXIT AC CONTAINS VADDR OF VOCAB ENTRY NSTK XX LAC NCB RAL /L=1 IF NEW NAME 2 WDS, L=0 IF 1 WD LAC VOCAB DAC SP01 NSTK2 SAD VOBASE /AC POINTS TO BASE OF VOCAB STACK ? JMP NSTK14 /YES ISZ SP01 LAC* SP01 /AC := FIRST WD OF CURRENT NAME ISZ SP01 SAD NCB /SAME AS FIRST WD OF NEW NAME ? JMP NSTK8 /YES SPA /TWO WD NAME IN VOCAB ? NSTK4 ISZ SP01 /YES: SP01 POINTS TO SECOND WD NSTK6 LAC SP01 JMP NSTK2 /J WITH AC = ADDR OF LAST WD OF CURR ENTRY NSTK8 SMA!SNL /NEW NAME ONE WD AND CURR NAME ONE WD ? JMP NSTK12 /YES SMA /NEW NAME TWO WDS AND CURR NAME ONE WD? JMP NSTK6 /YES SNL /NEW NAME ONE WD AND CURR NAME TWO WDS? JMP NSTK4 /YES LAC* SP01 /LOAD SECOND WD OF CURR NAME SAD NCB1 /SAME AS SECOND WD OF NEW NAME ? JMP NSTK12 /YES, SO EXIT WITH TWO-WD NAME FOUND JMP NSTK4 NSTK12 LAC SP01 TAD K2 /AC:=PTR NSTK13 JMS EVA00 /CONVERT ADDR TO VADDR .DSA VOBASE JMP* NSTK /EXIT WITH VADDR IN AC NSTK14 SNL /NEW NAME ONE WD? JMP NSTK16 /YES LAC NCB1 /PUT SECOND WD OF NEW JMS PUTV /NAME ON VOCAB STACK NSTK16 LAC NCB JMS PUTV /PUT FIRST WD ON VOCAB Z50000 CLA /PUT ZERO DICT PTR WD JMS PUTV /ON VOCAB STACK LAC VOCAB /LOAD POINTER JMP NSTK13 .EJECT /EVA 12/8/69 JDS /ROUTINE TO EVALUATE VIRTUAL ADDRESS OF FREE END OF STACK /CALLING SEQUENCE JMS EVA / ADDRESS OF STACK BASE /RESULT IS VIRTUAL ADDRESS IN AC AND SP00 AND IS 16 BIT /STACK INDICATOR(4 BITS) + DISPLACEMENT (12BITS) /SIGN BIT OF PARAMETER SET IF INDIRECT REFERENCE /USES LOCATIONS SP00,SP01,SP02 EVA XX LAC* EVA /GET PARAMETER DAC SP00 /DUMP (IN CASE INDIRECT) SPA /SKIP IF DIRECT LAC* SP00 /RELOAD IF INDIRECT DAC SP00 /DUMP ADDRESS OF BASE DAC SP02 /:=ADDR OF BASE ISZ SP00 /:=ADDR OF PTR LAC* SP00 /VALUE OF PTR DAC SP00 /:=ABS ADDR TO CONVERT EVA01 LAC* SP02 /VALUE OF BASE DAC SP01 CMA TAD SP00 /ADDR-BASE VAL.-1 = DISPL. TAD S07777 /VADDR+4095 SPA /VADDR > 12 BITS? JMP EVA90 TAD Z70001 /REVERT TO DISPL. (-VE) AND* SP01 /SET IN STACK # DAC SP00 /STORE RESULT: ALSO IN AC ISZ EVA JMP* EVA /EXIT EVA90 LAW -35 /ERROR 29 JMP ABORT /COMPUTE VADDR OF ABS ADDR GIVEN IN AC WRT STACK SPECIFIED. /CALLING SEQUENCE: / ABS ADDR IN AC / JMS EVA00 / ADDR OF SK BASE /INDIRECTION NOT ALLOWED EVA00 XX DAC SP00 /:=ABS ADDR TO CONVERT LAC* EVA00 DAC SP02 /:=ADDR OF BASE LAC EVA00 /)MOVE LINK DAC EVA /) JMP EVA01 /J & COMPUTE VADDR .EJECT /VTOA***JDSMART 29/7/69 /SUBROUTINE TO CONVERT STACK DISPLACEMENT(VIRTUAL ADDRESS)TO AN /ABSOLUTE CORE ADDRESS /VIRTUAL ADDRESSES ARE 16BIT QUANTITIES OF THE FORM / LS 12 BITS GIVE DISPLACEMENT(0-4094) / TOP 4 BITS (B2-B5) INDICATE STACK REFERENCED /ON ENTRY THE AC HOLDS THE VIRTUAL ADDRESS /ON EXIT THE AC HOLDS THE CORRESPONDING ABSOLUTE ADDRESS /AND IT IS DUMPED INTO SP00 /USES ROUTINES MES /USES LOCATIONS SP00,SP01, VTOA XX /ON ENTRY AC=VIRTUAL DAC SP01 /DUMP VIRTUAL JMS MES /GET INDICATOR TO LS END OF AC JMP RR+14 AND C15 RCL TAD VTOA02 /)GET APPROP POSITION IN STACK DAC VTOA01 /)INDICATOR CONVERSION TABLE LAC SP01 /GET VADDR AND S07777 /)MAKE REL TO BASE TAD Z70001 /)-VE DISPL. VTOA01 0 /TAD* VTOA02+1+SK# :ADD BASE VALUE DAC SP00 /)TO GIVE ABSOLUTE ADDRESS CMA /-ABS ADDR-1 ISZ VTOA01 /STEP TO ADRR OF PTR XCT VTOA01 /AC:=PTR ADDR-ABS ADDR-1 SMA /WITHIN CURRENT LIMIT OF STACK? JMP VTOA90 /NO:ERROR 24:ABORT LAC SP00 /LOAD RESULT JMP* VTOA /EXIT VTOA90 LAW -30 JMP ABORT .EJECT /MES 9SEP69 JDS /MULTIPLE ENTRY SUBROUTINE /CALL JMS MES / JMP (LABEL) /WHERE (LABEL) IS THE ADDRESS OF THE / /CODE TO BE EXECUTED / MES XX JMP* MES /OBEY IN LINE JMP TO CODE ISZ MES /BUMP LINK JMP* MES /RETURN /SHIFT AC RIGHT UP TO 9 PLACES .REPT 11 RAR R JMP MES+2 /SHIFT AC LEFT TO 9 PLACES .REPT 11 RAL L JMP MES+2 RR=L-23 LL=R-23 .EJECT /LAM****JDSMART 14/8/69 /ROUTINES TO LOAD AC FROM INDIRECTLY ADDRESS CORE (AFTER MODIFICATION) /CALLING SEQUENCE JMS LAM(LOAD AC) OR DAM(DUMP AC) / MOD+A /WHERE LOCN.A CONTAINS ADDR TO BE MODIFIED AND THEN USED. /'MOD' IS THE TOP 3 BITS(VALUE 0-7) WHICH IS ADDED TO THE /ADDR FOUND TO GIVE THE EFFECTIVE ADDR. /ROUTINE EQUIVALENT TO:- / LAC A / TAD MOD / DAC SP00 / LAC* SP00 /OR TO LAC* A,X WHERE INDEX REG.CONTAINS MOD /USES LOCATIONS SP00,SP01,SP02,SP03 /USES ROUTINE EMA /ON EXIT SP00 HOLDS ABS(15-BIT) ADDR OF CORE LOCATION REFERENCED. EMA XX /EVALUATE MODIFIED ADDRESS GIVEN IN AC DAC SP03 RTL RTL AND C7 /)EXTRACT MODIFIER AND DAC SP01 /)DUMP IT LAC* SP03 /)GET ADDRESS OF TAD SP01 /)OF LOCATION REQUIRED DAC SP00 /)&DUMP IT JMP* EMA LAM XX /LOAD AC FROM ABSOLUTE MODIFIED LAC* LAM /GET PARAMETER JMS EMA /EVALUATE MODIFIED ADDRESS LAC* SP00 /LOAD REQUIRED CONTENTS ISZ LAM JMP* LAM /EXIT DAM XX /DUMP AC IN ABSOLUTE MODIFIED DAC SP02 /STORE AC LAC* DAM /GET PARAMETER JMS EMA /EVALUATE MODIFIED ADDRESS LAC SP02 /RELOAD AC DAC* SP00 /DUMP IN SPECIFIED LOCATION ISZ DAM JMP* DAM /EXIT .EJECT /LVM****J.D.SMART 29/7/69 /ROUTINES TO LOAD AC AND DUMP AC FROM & TO VIRTUALLY ADDRESSED STORE /CALLING SEQUENCE JMS LVM(LOAD AC FROM VIRTUAL)OR DVM / MOD+A /WHERE LOCATION A CONTAINS A VIRTUAL ADDRESS,WHICH IS MODIFIED /TO GIVE THE EFFECTIVE VIRTUAL ADDRESS. /MOD IS THE TOP 3 BITS OF PARAMETER WD.(VALUE 0-7) /USES LOCATIONS SP00,SP01,SP02,SP03 /USES ROUTINES EMA VTOA /ON EXIT SP00 HOLDS ABS(15-BIT) ADDR OF CORE LOCN.REFERENCED LVM XX /LOAD AC FROM VIRTUAL MODIFIED LAC* LVM /GET PARAMETER JMS EMA /EVALUATE REQUIRED VIRTUAL JMS VTOA /CURRENT VIRTUAL TO ABSOLUTE LAC* SP00 /LOAD AC FROM ABSOLUTE ISZ LVM JMP* LVM /EXIT DVM XX /DUMP AC IN VIRTUAL MODIFIED DAC SP02 /STORE AC LAC* DVM /GET PARAMETER JMS EMA /EVALUATE REQUIRED VIRTUAL JMS VTOA /CONVERT TO ABSOLUTE LAC SP02 /RELOAD AC DAC* SP00 /DUMP IN SPECIFIED LOCATION ISZ DVM JMP* DVM /EXIT LNP XX JMS LVM NXOP JMP* LNP .EJECT /COPY***JDSMART 14/8/69 /SUBROUTINE TO COPY BLOCKS OF CORE /THREE PARAMETERS:-1)POSITION OF SOURCE AND MEANS OF ACCESS / 2)POSITION OF DESTINATION AND MEANS OF ACCESS / 3)LENGTH (IN WORDS) /THERE ARE THREE MEANS OF ACCESS:- / 1)ABSOLUTE CORE ADDRESS GIVEN / 2)DISPLACEMENT IN STACK GIVEN (VIRTUAL ACCESS) / 3)ON FREE END OF STACK (STACK ACCESS) /THE ABOVE INFORMATION IS SUPPLIED BY THREE IN-LINE PARAMETERS /FOLLOWING THE SUBROUTINE CALL:- / JMS COPY / SOURCE INFO / DESTINATION INFO / LENGTH (GIVEN POSITIVELY) /THE SOURCE AND DESTINATION INFO TAKE THE FOLLOWING FORM /MS 3 BITS ARE INDICATORS / BN(SIGN BIT)=1=>LEVEL OF INDIRECTION / B1=1=> POSITION GIVEN AS VIRTUAL ADDRESS / B2=1=> POSITION GIVEN AS STACK POINTER (ONLY IF B1=0) /IF B1 =1 & B0=0 THEN LS 16 BITS ARE THE VIRTUAL ADDRESS OTHERWISE /THE LS 15 BITS ARE ADDRESS APPROPRIATE TO SETTING OF B0,1&2 /THE ACCUMULATOR IS PRESERVED /USES ROUTINES:- PUT / VTOA / LVM /USES LOCATIONS: SP00,1,2 /USES AUTOINDICES: AUTO2,AUTO3 COPY XX /LINK DAC COPYSV /DUMP AC LAC* COPY /PICK UP SOURCE INFO DAC COPYSC /DUMP(IN CASE INDIRECT) SPA /SKIP IF NOT INDIRECT LAC* COPYSC /ACCESS ADDRESSED WORD DAC COPYSC /DUMP SOURCE POSITION LAC* COPY /RELOAD SOURCE INFO ISZ COPY /INCR.LINK TO DEST INFO SNA /SOURCE = ZERO? JMP COPY11 /YES: ARRANGE TO CLEAR DEST. RTL /B1 TO LINK,B2 TO AC0 SZL /IS SOURCE A VIRTUAL ADDRESS? JMP COPY06 /YES SPA /IS SOURCE A STACK JMP COPY08 /YES /ABSOLUTE SOURCE-LOAD ADDRESS -1 INTO AUTOINDEX LAC COPYSC /LOAD SOURCE ADDRESS COPY01 TAD K1 /DECREMENT FOR AUTOINDEXING DAC* C10 /DUMP IN AUTOINDEX 12 LAC ASCAB COPY02 DAC COPY05 /SET UP SOURCE ROUTINE /PROCESS DESTINATION INFO LAC* COPY /LOAD DEST INFO DAC COPYDT /DUMP(IN CASE INDIRECT) SPA /INDIRECT? LAC* COPYDT /YES:ACCESS ADDRESS DAC COPYDT LAC* COPY /RELOAD DEST INFO SNA /DEST. = ZERO? JMP COPY12 /YES: ARRANGE NOT TO COPY SOURCE RTL SZL /DEST VIRTUAL? JMP COPY09 /YES SPA /DEST A STACK JMP COPY10 /YES /ABSOLUTE DESTINATION-LOAD ADDRESS-1 INTO AUTOINDEX LAC COPYDT /DEST ADDRESS COPY03 TAD K1 /DECREMENT DAC* C11 /DUMP IN AUTOINDEX 13 LAC ADTAB /SET TO COPY ABSOLUTE COPY04 DAC COPY05+1 /SET UP DEST ROUTINE ISZ COPY /STEP AUTO TO LENGTH LAC* COPY /LOAD LENGTH DAC COPYCT /DUMP IN COUNT SPA /INDIRECT REF LAC* COPYCT /YES-LOAD LENGTH SNA /ZERO? JMP COPY05+4 /YES,SO DO NOTHING JMS TCA /NEGATE COUNT DAC COPYCT /DUMP COPY05 XX /GET WORD FROM SOURCE XX /PUT RESULT IN DESTINATION ISZ COPYCT /INCREMENT COUNT JMP COPY05 /REPEAT IF NONZERO ISZ COPY /STEP LINK LAC COPYSV /RESTORE AC JMP* COPY /EXIT /VIRTUAL SOURCE-CONVERT TO ABSOLUTE IF DEST. NOT A STACK COPY06 LAC* COPY /LOAD DEST INFO RTL /B2 TO AC0 SMA /IS DEST A STACK? JMP COPY07 /NO SZL /IS IT VIRTUAL? JMP COPY07 /YES: S BIT IS SK# LAC ASCV /SET TO COPY FROM VIRTUAL JMP COPY02 /CONVERT VIRTUAL SOURCE TO ABSOLUTE COPY07 LAC COPYSC /VIRTUAL ADDRESS TO AC JMS VTOA /CONVERT TO ABSOLUTE & JMP COPY01 /J TO LOAD INTO AUTOINDEX /SOURCE A STACK COPY08 LAC ASCS /SET TO COPY FROM STACK JMP COPY02 /CONVERT VIRTUAL DESTINATION TO ABSOLUTE COPY09 LAC COPYDT /VIRTUAL ADDRESS TO AC JMS VTOA /CONVERT TO ABSOLUTE & JMP COPY03 /LOAD INTO AUTOINDEX /DESTINATION A STACK COPY10 LAC ADTS /SET TO COPY STACK JMP COPY04 / ZERO SOURCE COPY11 LAC ASCZE /SET AC CLEAR AS SOURCE JMP COPY02 / ZERO DEST. COPY12 LAC ADTZE /SET NOT TO WRITE TO DEST JMP COPY04 /ADDRESS OF CODE SEQUENCES FOR LOADING AND DUMPING AC APPROPRIATELY ASCAB LAC* AUTO2 /ABS. SRC ASCS JMP SCS /SRC A STACK ASCV JMP SCV /VIRTUAL SRC ASCZE CLA /ZERO SRC ADTAB DAC* AUTO3 /ABS,VIRT DEST ADTS JMP DTS /DEST A STACK ADTZE NOP /ZERO DEST /DUMP AC ON STACK DTS JMS PUT COPYDT .DSA /DESTINATION ADDRESS IN APPROPRIATE FORM JMP COPY05+2 /LOAD AC FROM VIRTUAL SCV JMS LVM / COPYSC /ADDR. OF VIRT ADDR ISZ COPYSC /REDUCE VADDR BY ONE JMP COPY05+1 /J TO DUMP AC /LOAD AC FROM STACK SCS LAC* COPYSC /GET ADDRESS OF STACK PNTR DAC SP00 /DUMP IT LAC* SP00 /LOAD STACK WORD ISZ* COPYSC /TAKE WORD OFF STACK JMP COPY05+1 /J TO DUMP AC /TCA /ROUTINE TO TWO'S COMPLEMENT THE AC TCA XX CMA TAD C1 JMP* TCA .EJECT /PHASE 3 SYNTAX BLOCKS JMS COMP /COMPILE PROG MODULE AS /EXIT OK MODL3 CC+MP /*MP?* AN MODL13 /YES_ JMP GEMP /G(ENTER MAIN PROGRAM) MODL13 CX BEG3 /PROCESS MAIN PROGRAM BLOCK Y00000 AS /EXIT OK JMP JMS%DW /G(JMS* %DW) BEG3 JMP STCHL /:TRUE N BEG13 /_ JMS COMP /COMPILE DECL AN BEG13 /NO_ BEG13 CC+ENDD /*ENDD?* AN BEG23 /YES_ JMP GENDD /G(END DEC) JMS COMP /COMPILE OPS UNTIL END AN BEG23 /_ BEG23 CC+END /*END?* AS /YES JMP GENDB /G(END BLOCK) N PDEC23 /NO_ PDEC3 JMP INTPR / N PDEC13 /YES_ JMP GJPE /G(JMP & PROC ENTRY) AN PDEC33 /_ PDEC13 JMP MODP / AN PDEC33 /YES JMP GPEM /G(PROC ENTRY FOR MODULE) N PDEC43 PDEC23 JMP TROP / AN PDEC43 JMP GTEP /G(TRACE EXT PROC CALL) JMS COMP /COMPILE OPS UNTIL ENDP AN PDEC33 /REPEAT PDEC33 CC+ENDP /*ENDP?* W00000 A /EXIT FAIL JMP GENDP /G(END PROC) N PDEC43 /SCAN UNTIL ENDP PDEC43 CC+ENDP AS JMP XENDP /EXIT FROM EXT. PROC DECL IFS3 CX IFCL /RECURSE 'IFCL' AN IFS13 /_ JMS JLW /G(JMP W(+)) N IFS23 /_ IFS13 CC+ENDC /*ENDC?* W00001 A 1 /EXIT FAIL JMS PLW /PLANT LABEL W00002 A 2 /EXIT FAIL FR23 0 /MASK 0;FALSE SVX1 JMP KTW / AN SVX /NO JMP JMS%AZ /G(STACK INTEGER) A /NO: FI3 JMP TFN / N FI13 /YES_ N ARD3 /NO_ ARD13 JMP ARNM / AN ARD13 /YES_COMPILE IT JMS COMP /COMPILE PARAMS AN PC3 /REPEAT PC3 JMP DICT / AS JMP GPC /G( PROC CALL) DZM DOLAB /MARK 'NO LABEL IN DOLAB' AN FOR13 /_ FOR3 CC+FLK /*FLK?* MULTIPLE FOR ELEMENTS? AN FOR23 /_YES JMP DOL /BUY LABEL & HOLD IN DOLAB SVX JMP COMP00 /COMPILE SUBSCR EXP OR CALL SV N SVX1 /_LOOK AT NXOP STEP3 JMP STEP / N STEP13 /_ WH3 JMP WHILE / AN STEP23 /_ JMS COMP AN IFS13 /_NO IFS23 CC+ENDF /*ENDF?*IN WHILE OR STEP? A /EXIT JMP ENDFOR /TERMINATE FOR(SINGLE FOREL) AFOR3 JMP COMP00 /G(V:=A) AN STEP23 /_ DZM ELLAB /MARK AFOR STEP13 JMP COMP00 /G(V:=V+B;(STEP)) AN STEP23 /_ JMP EFOREL /SET LOC FOR INIT JMP STEP23 JMP COMP00 /G(CONDITION;(WH,STEP);DO(AFOR)) 0 /FAIL ARD3 JMP ASEG / AN ARD23 /YES_ DZM NXTRQD /DISCARD ASEG OP JMS COMP /COMPILE BPL AN ARD13 /_ ARD23 0 /M(0):FAIL JMS COMP /COMPILE OPS UNTIL ENDF AN FOR13 /REPEAT FOR13 CC+ENDF /*END OF FOR?* 0 /FAIL JMS COMP /COMPILE OPS UNTIL ENDF AN FOR23 /_REPEAT FOR23 CC+ENDF /*END OF FOR?* AS /EXIT OK JMP GXDO /G(EXIT FROM DO S/R) JMP DECLAB /SET OTLOC FOR LABEL A /FAIL LAB3 0 /M(0):FAIL NEG3 JMP COMP00 / N NEG13 /_ JMP JMS%CF /G(JMS* %CF) A /FAIL(LOSE OP) NEG13 JMP TRL / A /FAIL(LOSE OP) JMP JMS.BA /G(JMS* .BA) NOT3 JMP COMP00 /:TRUE AS JMS GCMA /G(CMA) REL3 JMP RELAT2 /:TRUE AS /_ JMS GCLA /G(CLA) IFX3 CX IFCL /RECURSE 'IFCL' AN IFX13 /_ JMS JLW /G(JMP W(+)) IFX13 JMP COMP00 /:TRUE AN IFX23 /_ JMP FELS /G(FLOAT IF REQD);GELSE IFX23 JMP COMP00 /:TRUE A /FAIL JMP FEC /G(FLOAT IF REQD):PLW N IFCL2 /_ IFCL JMP REL / N IFCL1 /_ IFCL1 JMP RELAT1 /:TRUE S /OK IFCL2 JMP COMP00 /:TRUE AS /OK JMP GSNA /G(SNA) FIX3 JMP COMP00 /:TRUE AS /OK JMP JMS%AR /G(JMS* %AR) FLT3 JMP COMP00 /:TRUE AS /OK JMP JMS.AW /G(JMS* .AW) 0 GOTO3 JMP COMP00 /:FALSE IF LOCAL TO BLOCK AS /OK JMP JMP%BX /G(JMP* %BX) BPL3 JMP COMPC /:TRUE AN BPL13 /_ JMP JMS%AZ /G(JMS* %AZ) N BPL3 /_ BPL13 CC+END /*END?* A /FAIL JMP DARR /G(DECL ARRAY) DYAD3 JMP COMP00 /:TRUE AN DYAD13 /_ JMP FL1 /G(FLOAT FIRST ARG IF NEC) N DYAD53 /_ DYAD13 JMP CI / AN DYAD23 /_ JMP JMS%AZ DYAD23 JMP COMP00 /:TRUE AN DYAD33 /_ JMP FL2 /G(FLOAT SECOND ARG IF NEC) JMP JMS%CO AN DYAD43 /_ DYAD33 JMP CI / AN DYAD43 /_ JMP JMS%CN FSTR3 JMP COMP00 /G(LOAD ADDR OF STRING) A JMP JMS%AZ /STACK IT 0 DYAD43 JMP OPS /:FALSE N DYAD63 /_ DYAD53 JMP CRL / AN DYAD23 /_ JMP JMS%AX A /NO:STACK THEN FAIL FR3 JMP TFN / N FR13 /YES_ JMP OPR /G(SIMPLE REAL DYADIC OP) A /FAIL DYAD63 JMP SI / A /FAIL JMP OPI /G(SIMPLE INTEGER DYADIC OP) N SV33 /_ SV3 JMP VCALL / N SV13 /_ N SV23 /_ SV13 JMP TRL / N SV33 /_ SV23 JMP SV31 /:TRUE A /FAIL JMP JMS%BQ SV33 JMP SV31 /:TRUE 0 /FAIL JMP JMP%BN AN FR23 /_ FR13 CX CF /RECURSE AN FR23 /_ JMP JMP%BI JMP JMP%BM AN FR23 /_ FI13 CX CF /RECURSE AN FR23 /_ JMP JMP%BO N CF1 /_ CF JMP DICT / AS /OK JMS COMPA /COMPILE 'FETCH ADDR' JMS COMP /COMPILE A /FAIL CF1 JMP SUBV / AS /OK JMS COMPA /COMPILE 'FETCH ADDR' SW3 JMP COMP00 /:TRUE AN SW13 /_ JMS JLW /G(JMP W(+)) JMP PLSW /PLANT LOC IN SW LIST AN SW13 /_ SW13 CC+END /*END?* AS /OK JMS PLW /PLANT LOC JMP JMP%BN AN FR23 /_ FLAB13 0 /MASK 0:FALSE FLAB3 JMP TFN /:TRUE AN FLAB13 /_ JMS COMPA /COMPILE 'FETCH ADDR' N ASS53 /_ ASS3 CC+END /*END?* N ASS13 /_ ASS13 JMP COMP00 /:TRUE AN ASS23 /_ JMP FFASS /G(FIX OR FLOAT FOR ASSIGN) JMP SDA /SET UP # DICT ATTRS TO PROCESS AN ASS43 /_ ASS23 JMP KARG / FALSE IF ZERO N ASS33 /_ JMP JMS%BT /STORE REAL FROM STACKED ADDR AN ASS23 /_ ASS33 JMP TRL / AN ASS23 /_ JMP SRS JMP SNX /RESET NXOP/NXTRQD A /FAIL ASS43 JMP KARG / AN ASS43 /_ JMP GASS /G(ASSIGN TO DICT INFO) N ASS3 /_ ASS53 JMP SKAD / AN ASS3 /_ JMP JMS%AZ .EJECT /STEP 3,AFOR3,WH3 /PROCESS ABOVE FOR ELEMENT OPERATORS /COMP IS USED TO PROCESS THE CONSTITUENTS OF EACH ELEMENT /STEP3 & WH3 PLANT A LABEL IN 'ELLAB' FOR LATER REFERENCE STEP IDX STEPAS JMS COMP /COMPILE(V:=A) LAC C2 DAC TAG /SET LOC BACK TO VALUE LAC HOLDL DAC LOC /LOC SET BACK TO ASSIGN STORE CODE JMS OUTRLB /ISSUE CODE 2(RESET LOC) JMS JLW /COMPILE JMP OVER STEP CODE WHILE JMS BNL /BUY LABEL (SET AT LOC) DAC ELLAB /AND HOLD IN ELLAB JMS PLOC JMP TRUE EFOREL LAC LOC /HOLD LOC IN HOLDP DAC HOLDP LAC HOLDL /PLANT DESTINATION FOR DAC LOC /STEP JMP AT 'STORE' OF ASSIGN JMS PLW LAC HOLDP /RESET LOC DAC LOC JMP ANAL04 .EJECT /DECLAB PROCESS LABEL DECLARATION /ON ENTRY NXOP HOLDS PTR TO ATTRS ON LABEL STACK /NEXT 1 OR 2 WORDS IN INCODE ARE LABEL NAME IN RADIX 50 DECLAB JMS BLL /GET LABLOC ENTRY JMS PLOC /PLANT LOC IN LABLOC ENTRY JMS FNW /1ST HALF OF LABEL NAME DAC NAME1 /TO NAME1 JMS FNW /GET SECOND HALF DAC NAME2 /STORE IN NAME2 JMS OUTNAM /OUTPUT CODES 7&8 JMS GEN43 /APPEND CODE 43 JMP TT /TEST FOR TRACING /BLL BUY LABLOC FOR LABEL IF NECESSARY:LPTR IN NXOP BLL XX JMS LVM /GET LABLOC FROM LABEL ATTRS M*2+NXOP SNA /LABLOC ASSIGNED? JMS BNL /NO:GET ONE JMS DVM /STORE IN LABEL ATTRS M*2+NXOP JMP* BLL .EJECT /LABREF GENERATE CODE SEQUENCE FOR LABEL REFERENCE /COMPILES 'LABEL VALUE TO FLOPAC'EXCEPT FOR 'VALUE'CALL FOR LABELS /IN CURRENT LEVEL;THEN EXITS TO COMP WITH STATE=FALSE LABREF XX JMS LNP /UPNPTR(ATTRS) TO AC SPA /DECLARED? JMP LABRF1 /YES AND T77777 /NO:EXTACT UPNPTR DAC NXOP /INTO NXOP SZA /END OF CHAIN? JMP LABREF+1 /NO LAW -142 /YES:NOT DECLARED JMS ERR /ERROR 98 JMS GEN3 JMP .+0 /G(JMP .) JMP* LABREF LABRF1 JMS BLL /BUY LABLOC & PLACE IN ATTRS DAC LLL /HOLD LABLOC IN LLL (OTDISPL IF FORMAL) JMS LVM /SKTHL WORD OF ATTRS M*3+NXOP AND S03777 /)HOLD HL DAC SKTHL /)IN SKTHL AND S00077 /EXRACT L(LEVEL) SNA /FORMAL LABEL(L=0)? JMP FORML /YES DAC NXOP /INTO NXOP LAC SKTHL JMS TCA /-HL TAD CHL /CHL-HL SZA /IN CURRENT BLOCK? JMP .+3 /NO SAD FADSW /YES:VALUE CALL? JMP LABRF2 /YES TAD NXOP /CHL-H JMS MES /CHL-H TO LS END OF AC JMP R-6 AND S00077 /EXTRACT H SNA!CMA /IN CURRENT HIER? JMP LABRF3 /YES TAD C1 /)NO: HOLD CT OF HIERARCHIES BACK DAC SP05 /)IN SP05 LAC PRCHN /GET HIER CHAIN PTR JMP .+3 /WORK UP CHAIN JMS LVM /UNTIL RIGHT HIER REACHED SP04 DAC SP04 /) ISZ SP05 /) JMP .-4 /) LABRF4 JMS LVM /ACCESS NEXT WORD ON SK(PTR TO PROC INFO) M*1+SP04 DAC SP04 /HOLD JMS LVM /ACCESS DBIL FOR LABEL'S HIER M*4+SP04 SKP LABRF3 LAC DBIL CMA /-DBIL-1 TAD NXOP /ADD LEVEL JMS TCA /DBIL-L+1 DAC NXOP LAC JMS%BR /G(JMS* %BR);D(BASE);D(DBIL-L+1) JMS OUT3NL LAC LLL XOR U00000 JMS GLLR /G(ADDR OF LABEL):15 BIT 0 JMP* LABREF LABRF2 LAC LLL /FOR LABELS LOCAL TO BLOCK JMS GLLR /G(JMP LABEL) JMP DZM NXTRQD /MARK NXTRQD JMP FALSE /EXIT FROM LABREF,GFTLU,COMP,COMP00 FORML LAC LLL /OTDISPL OF FORMAL THUNK DAC NXOP /TO NXOP LAC SKTHL CMA AND Z77700 TAD CHL SMA!CLA /NONLOCAL? LAC C8 /YES AC_8 JMS GFTLU /G(FETCH FORMAL REAL VALUE) LAC LVR+3 LVP-LVR JMP COMP20 /EXIT TO COMP .EJECT /PHASE 3 CATOM TESTS /STCHL USED ON BEGIN BLOCK TO STACK CHL AND RESET /FROM NXOP (WORD FOLLOWING BEG OPERATOR) STCHL LAC CHL JMS PUTW LAC C46 /LIST BLOCK ENTRY DAC TAG LAC NXOP DAC CHL JMS OUTRLB DZM NXTRQD JMP TRUE /INTPR PROCESS DICT INFO FOR PROC DECL /STACKS CHL & RESETS H=H+1,L=1 /STACKS OLD HIERARCHY INFO (CPI) & RESETS IT FROM ATTRS /EXITS TRUE IF INTERNAL PROC;FALSE IF EXTERNAL INTPR LAC CHL JMS PUTW /STACK CHL AND S03700 /HOLD H TAD S00101 /H=H+1;L=1 DAC CHL /INTO CHL LAC CPI JMS PUTW /W(+)_CPI JMS RDDI /READ & DECODE DICT INFO LAC NXOP DAC CPI /RESET CPI JMS COPY /CPOY PROC INFO INTO M*6+CPI /FIXED STORE NAME1 C6 6 LAC PRCHN /)HOLD PRCHN ON JMS PUTW /)WORK SK JMS EVA /RESET PRCHN TO WKBASE /HOLD VADDR OF OUTER HIER DAC PRCHN /POINTER CLC /MARK NEXT NOT REQD DAC NXTRQD /(SET BY RDDI) JMS LNP AND U00000 /EXTRACT EXT BIT INTPR2 SZA JMP FALSE JMP TRUE /MODP TRUE IF (WORK+2)=0 MODP JMS LAM /STACKED CHL=0? M*2+WORK JMP INTPR2 /YES:TRUE .EJECT /SI TRUE IF CAA(WORK)=0 ELSE FALSE SI LAC* WORK AND S70000 JMP INTPR2 /CI TRUE IF CAA(WORK)=4 ELSE FALSE CI LAC* WORK TAD Z40000 JMP SI+1 /CRL TRUE IF CAA(WORK)>4 ELSE FALSE CRL LAC S70000 AND* WORK TAD Z40000 CR01 SPA!SNA JMP FALSE JMP TRUE /TRL TRUE IF A1(WORK)=1 ELSE FALSE TRL LAC* WORK AND S20000 JMP CR01 /DICT TRUE IF NXOP IS DICT INFO DICT LAC NXOP SMA JMP FALSE JMP TRUE /SUBV TRUE IF NXOP IS SV SUBV LAC NXOP AND U07700 TAD X74100 /IS IT 203700? JMP INTPR2 /ASEG TRUE IF NXOP IS ASEG ASEG LAC NXOP AND U07700 TAD X72600 /=0 IF ASEG JMP INTPR2 /ARNM TRUE IF NXOP IS SK#=6 OR 7 (ARRAY NAME) ARNM LAC NXOP AND Z60000 SAD S60000 /SK#=6 OR 7? JMP TRUE JMP FALSE /RELAT1,RELAT2 COMPILE RELATIONAL /ON ENTRY TO RELAT1 OPERATOR IN NXOP & IS TO BE STACKED /ON ENTRY TO RELAT2 OPERATOR STACKED & NXOP UPDATED RELAT1 LAC NXOP JMS PUTW /STACK OPERATOR JMS FNW / RELAT2 JMS COMP /COMPILE SUBTRACTION LAC* WORK AND S20000 SNA /REAL ARGUMENT? JMP .+3 /NO JMS GGR /G(LAC* .AB) IF REAL LAC* .AB LAC* WORK /GET REL OPCODE TAD S00400 /SET 'AND' IF GT,GE,NE AND S01300 /PRESERVE OPERATE SKIP BITS TAD Z50001 /ADD CLC OPBITS JMS GEN4A /GENERATE JMP TRUE /VCALL TRUE IF FADSW=0 ELSE FALSE VCALL LAC FADSW DZM FADSW /CLEAR SWITCH JMP INTPR2 /TFN TEST IF FORMAL BY NAME:IF SO G(SET THUNK;JMP OVER THUNK):TRUE / :ELSE COMPILE EXPRESSION :FALSE TFN LAC* WORK AND S20000 SZA /FORMAL BY NAME? JMP TFN01 /YES JMS COMP /NO JMP FALSE TFN01 JMS GGR /G(JMS* %BP) JMS* %BP JMS JLW /G(JMP OVER THUNK ROUTINE) JMP TRUE /SV31 COMPILE SUBSCRIPT EXPS & STACK FOLLOWED BY ARRAY CALL /# SUBSCRIPTS IN ARGCT FIELD OF OP ON WORK SV31 LAW -1 TAD* WORK AND S00077 DAC DIM /#DIMS LAC XB / JMS OBEY /STACK XB JMP SV3101 DAC XB /RESET XB JMP TRUE SV3101 LAC DIM /ARGCT JMS PUTW /STACK # DIMS FOR RDDI CMA JMS PUTW /WORK(+)_ LAC ASVX /)SET UP XB DAC XB /)FOR SUBSCR EXP JMP ANAL+4 /ENTER ANAL /KTW BUMP ARGCT ON WORK:FALSE IF ZERO KTW ISZ* WORK JMP TRUE JMP FALSE /TROP TRUE IF TRACE OPTION ON ELSE FALSE TROP DZM NXTRQD /MARK NEXT REQD JMS TOPT 400000 SKP FALSE CLC!SKP TRUE LAC C1 JMP ANAL03 /KARG SAC+1:IF SAC=0 THEN FALSE ELSE TRUE KARG ISZ SAC JMP TRUE JMP FALSE /REL TRUE IF NXOP IS RELATIONAL OR NOT,ELSE FALSE REL LAC NXOP SMA!RAL /SKIP IF DICT INFO SMA /OPERATOR? JMP FALSE /NO AND S06000 /YES: SAD S04000 /IS OP 20-27 OR 60-67 JMP TRUE /YES:(RELAT OR NOT) JMP FALSE /NO:(ANY OTHER EXPRESSION OP) /SKAD PROCESS LHS OF ASSIGNMENT /IF SV OR(NOT OWN &(FN OR 1 WORD NL)) THEN COMPILE 'ADDRESS' /IF OWN OR REAL OR LOCAL 1 WORD STACK DICT INFO ON WORK FOR LATER SKAD LAC NXOP SPA /DICT INFO? JMP SKAD02 /YES JMS COMPA /COMPILE 'ADDR OF ARRAY ELEMENT' SKAD01 IDX SAC /INCR COUNT OF 'STACKED ADDRESSES' JMP TRUE SKAD02 JMS CLADI /CLASSIFY DICT INFO(NEVER ARRAY) TAD K8 SZA!RTR /NON LOCAL ONE WORD? SZL /NO:FORMAL BY NAME SKP /YES JMP SKAD03 /NO:STACK DICT INFO LAC Q2 /PICK UP DICT TYPE JMS GFTLU /USE LVR,LVP TABLE FOR LAC LVR+14 /CODE GENERATION OF FETCH ADDR. LVP-LVR JMP SKAD01 SKAD03 JMS TAKEW DAC HOLDP /HOLD ASS OP JMS COPY /STACK Q2,NXOP & HOLDP Q2 M*1+WORK C4 4 JMP FALSE /OPS COMPILE DYADIC OPERATION FOR / 1ST ARG COMPUTED ONTO RUN TIME STACK / 2ND ARG COMPUTED INTO AC OR FLOPAC OPS LAC NXOP /PRESERVE NXOP DAC HNX LAC S27773 /PUT SKPTR OF (16) DAC NXOP /INTO NXOP JMS TAKEW /RETRIEVE OPERATOR JMS MES JMP R-6 AND S00077 ISZ STATE /STATE=FALSE(-1) IF REAL TAD C8 /SUBTRACT 8 IF REAL OP TAD K8 JMS GFTLU /COMPILE FROM LAC OPSR-14 /TABLES (OPSR,OPSP) OPSP-OPSR LAC HNX /RESET NXOP DAC NXOP JMP FALSE /COMPC COMPILE OPERATOR CHECKING THAT NO REFERENCES ARE /TO VARIABLES LOCAL TO CURRENT BLOCK /SWITCH CLRSW SET NON ZERO INDICATES TO RDDI THAT CHECK /IS TO BE APPLIED:NOT USED RECURSIVELY COMPC CLC DAC CLRSW JMS COMP DZM CLRSW JMP TRUE COMP00 JMS COMP JMP TRUE .EJECT /PHASE 3 ACTIONS /OPI COMPILE SIMPLE 'AC'DYADIC OPERATION(INT OR BOOL) / 1ST ARG ALREADY COMPILED,PRODUCING VALUE IN AC OR FLOPAC AT OBJECT TIME / 2ND ARG IS SIMPLE(CONSTANT OR DICT INFO(NOT FN)) AND / IS AVAILABLE IN NXOP OPI JMS CLARG /CLASSIFY 2ND ARG INTO AC JMS GFTLU /COMPILE FROM TABLES(OPIR,OPIP) LAC OPIR-14 OPIP-OPIR JMP ANAL04 /OPR COMPILE SIMPLE REAL DYADIC OPERATION / /AS FOR OPI OPR JMS CLARG JMS GFTLU LAC OPRR-40 OPRP-OPRR JMP ANAL04 /JMSGL GENERATE JMS* GLOBAL NAME / ENTERS AT APPROP IDX TO GENERATE MOD TO VOCAB PTR / ON ENTRY COUNT IN JMSCT IS ZERO JMS%AW IDX JMSCT JMS%DW IDX JMSCT JMS.BA IDX JMSCT JMS%CF IDX JMSCT JMS%CO IDX JMSCT JMS%CN IDX JMSCT JMS%BT IDX JMSCT JMS%AR IDX JMSCT JMS.AW IDX JMSCT JMS%BQ IDX JMSCT JMS%AZ IDX JMSCT JMS%AX LAC JMSCT GINSTR DZM JMSCT CCL / RAL /1+2*JMSCT TAD T27730 /ADD JMS*(-47) JMS GGRA JMP ANAL04 /JMPGL GENERATE JMP* GLOBAL NAME / ENTRY AS FOR JMSGL JMP%BM IDX JMSCT JMP%BN IDX JMSCT JMP%BI IDX JMSCT JMP%BO IDX JMSCT JMP%BX LAC JMSCT TAD U37772 /MAKE INTO JMP*(-63) JMP GINSTR /DOL BUY NEW LABEL & HOLD VADDR(LABLOC) IN DOLAB DOL JMS BNL DAC DOLAB JMP ANAL04 /ENDFOR TERMINATE WHILE OR STEP WHEN SINGLE FOREL ENDFOR JMS TAKEW /TAKE STACKED ELLAB JMS GLLR JMP /ELLAB /G(JMP 'ELLAB') JMS PLW /PLANT FALSE DEST FOR IFS CLC DAC NXTRQD /LEAVE'ENDF' IN NXOP FOR 'FOR13 JMP ANAL04 /GCMA GENERATE 'CMA' GCMA XX JMS GEN4 CMA JMP* GCMA GCLA XX JMS GEN4 CLA JMP* GCLA GSNA JMS GEN4 SNA JMP ANAL04 /COMPA COMPILE OPERATOR INTO 'FETCH ADDR OF VARIABLE' /SWITCH FADSW SET TO 12(DEC) IMPLIES THIS TO COMP / USED RECURSIVELY:PROC WITH FN PARAMS USED AS SUBSCRIPT /FADSW HAS NO NEED TO BE RECURSIVE COMPA XX LAC C12 DAC FADSW LAC COMPA /W(+)_LINK JMS PUTW JMS COMP DZM FADSW JMS TAKEW /LINK_W(-) DAC COMPA JMP* COMPA .EJECT /FFASS FIX/FLOAT FOR ASSIGNMENT:OPERATOR ON WORK /ARGCT CHANGED TO # STACKED DICT INFO AND FIX/FLOAT GENERATED ACCORDING /TO CAA IN OPERATOR:MARK'NEXT NOT REQD'(NXTRQD=-1) FFASS LAC NXOP /)PRESERVE NXOP DAC HNX /) LAC NXTRQD /)AND NXTRQD WHILE COMPILING DAC HNR /)ASSIGNMENTS CLC /MARK NEXT NOT REQD DAC NXTRQD LAC LOC /HOLD LOC DAC HOLDL /IN HOLDL IDX HOLDL /INCR FOR FIX/FLOAT LAC SAC CMA DAC SAC /SAC=-#STACKED ADDRS-1 TAD* WORK DAC* WORK /ARGCT(WORK)=# OF STACKED DICT INFO LAC STEPAS /CHECK IF V:=A IN STEP ELEMENT SZA!CLC DAC SAC /RESET SAC=-1 IF SO LAC* WORK AND S30000 SAD S10000 /ASSIGNING REAL TO INT? JMP JMS%AR /YES,FIX SAD S20000 /ASSIGNING INT TO REAL? JMP JMS.AW /YES FLOAT K1 LAW -1 /REDUCE HOLDL TAD HOLDL /IF NO FIX/FLOAT DAC HOLDL JMP ANAL04 /RETURN /SNX RESET NXOP,NXTRQD AT END OF ASSIGNMENT PROCESS SNX LAC HNR DAC NXTRQD LAC HNX DAC NXOP JMP ANAL04 /SDA /SET UP STACKED DICT INFO COUNT IN SAC SDA JMS TAKEW AND S00077 /EXTRACT # STACKED DICT INFO CMA /-#SDI-1 DAC SAC /HOLD IN SAC FOR USE BY KARG JMP ANAL04 .EJECT /GENDD /GENERATE END DEC CODE GENDD JMS GGR LAC* %AA JMS CBILE LAC JMS%BU JMS OUT3L JMP ANAL04 /GENDB GENERATE END BLOCK CODE GENDB LAC C47 DAC TAG LAC CHL JMS OUTRLB JMS TAKEW DAC CHL SNA /MAIN PROGRAM TOP LEVEL? JMP ANAL04 /YES TAD K1 /HL-1 SNA /H=0 &L=1? JMP GENDB1 /YES AND S00077 SNA /L=1 & H NOT=0(INTERNAL PROC)? JMP ANAL04 /YES:IGNORE AT END OF PROC GENDB1 JMS CBILE LAC JMS%BG JMS OUT4 JMS GGR DAC* %AA JMP ANAL04 /CBILE COMPUTE BIL ENTRY DISPL LEFT IN NXOP +VELY CBILE XX LAC CHL AND S00077 CMA TAD C2 TAD DBIL DAC NXOP JMP* CBILE /GELSE GENERATE ELSE CODE GELSE XX JMS TAKEW DAC HOLDP JMS JLW /G(JMP W(+)) LAC HOLDP JMS PLOC /PLANT LABEL FROM WORK JMP* GELSE .EJECT /FELS /IF AA(WORK-1)=1 THEN FLOAT;GO TO GELSE /USED IN IFEXP FELS JMS LAM M*1+WORK AND S30000 /EXTRACT AA FROM OP SAD S10000 JMS FLOAT JMS GELSE JMP ANAL04 /FEC IF AA(WORK-1)=2 THEN FLOAT;GO TO PLW FEC JMS LAM M*1+WORK AND S30000 SAD S20000 JMS FLOAT FEC1 JMS PLW JMP ANAL04 /FL1 /IF AA(WORK)=1 THEN FLOAT FL1 LAC* WORK AND S30000 SAD S10000 JMP JMS.AW JMP ANAL04 FL2 LAC* WORK /FLOAT IF AA(WORK)=2 AND S30000 SAD S20000 JMP JMS.AW JMP ANAL04 /DARR INITIAL CALL FOR DECLARING ARRAYS /G(JMS* %AW) WITH DIM & ELEMENT SIZE INFO IN AC /OPERATOR ON WORK GIVES 2*#DIM IN ARGCT FIELD & A2=1 IF REAL ARRAY DARR LAW -2 TAD* WORK AND S00077 /AC=2*#DIM-2=2B-2 CMA DAC SP00 /SP00=-2B+1 LAC* WORK AND S10000 SZA /REAL ARRAY? LAC C1 /YES XOR SP00 JMS GEN4A JMP JMS%AW .EJECT /FLOAT COMPILE FLOAT INSTRUCTION FLOAT XX JMS GGR JMS* .AW JMP* FLOAT /GXDO COMPILE EXIT FROM DO S/R /FOR LINK DISPL ON WORK:LABEL FOR JMP OVER S/R IN WORK-1 GXDO JMS TAKEW DAC NXOP /FOR LINK DISPL TO NXOP LAC JMP%AT /G(LAW DISPL(FOR LINK)) JMS OUT4 /G(JMP* %AT) JMP FEC1 /PLANT LABEL FOR JMP OVER S/R /STRL /COMPILE STORE REAL CODE STRL XX JMS GEN3 DAC .+2 /G(DAC .+2) JMS GGR JMS* .AP /G(JMS* .AP) JMS GEN4 XX /G(XX) JMP* STRL /SRS COMPILE STORE REAL IN STACKED ADDR SRS JMS GGR JMS* %AY /G(JMS* %AY) ADDR TO AC JMS STRL /STORE REAL JMP ANAL04 /GPC GENERATE PROC CALL GPC JMS RDDI /ANALYSE DICT INFO JMS LNP AND U00000 /EXTRACT EXT BIT SZA /INTERNAL PROC? JMP EXCALL /NO:G(EXT CALL) / GENERATE INTERNAL PROC CALL /NXOP SET UP BY INTPR1 TO HOLD VADDR OF PROC INFO FOR PROC DZM SKTHL /MAKE H=0 FOR OUT2H JMS OUT2H LAC Z50000 /G(CLA) IF DNLBL=0 JMS GEN4A /G(LAW DISPL OF NLBL) JMS LVM /ACCESS PROC ENTRY POINT) M*2+NXOP JMS GLLR T00000 JMS /EP JMP ANAL04 .EJECT /GENDP /COMPILE END PROC SEQUENCE /VADDR OF PROC INFO ON WORK(+) GENDP JMS LVM /ACCESS NPW WORD IN PROC INFO M*3+CPI TAD C2 /BUMP TO DISPL OF 1 WORD RESULT DAC NXOP SMA /REAL? JMP GENDP1 /NO TAD W00002 /YES JMS TCA JMS GEN4A /G(LAW DISPL(REAL RESULT LOC)) JMS GGR JMS* %BJ /G(JMS* %BJ) GENDP1 LAC JMS%BD /G(JMS* %BD) JMS OUT3L /G(DIPL OLD BASE-1) JMS PLW XENDP JMS TAKEW DAC PRCHN /UNSTACK OUTER HIER PTR JMS TAKEW DAC CPI JMS COPY M*6+CPI NAME1 6 JMS TAKEW /)RESET DAC CHL /)CHL JMP ANAL04 .EJECT /GJPE GENERATE PROC ENTRY SEQUENCE (NOT FOR PROC MODULE) /PROC INFO ALREADY COPIED INTO NAME1...ETC TO DNLBL GJPE JMS JLW /GEN JUMP OVER PROC BODY JMS OUTNAM /PROCNAME AS CODES 7&8 ENTPR JMS GGR JMS* %BB JMS GPEP /G(PROC ENTRY PARAMS) TT JMS TOPT /TRACE OPTION ON? 400000 JMS GTC /YES: G(TRACE CALL) NEXT DZM NXTRQD /MARK NEXT REQD JMP ANAL04 /RETURN /GPEP GENERATE PROC ENTRY PARAMETERS / TO FOLLOW G(JMS* %BB) GPEP XX JMS GEN43 /G(LINK LOCN) & HOLD ADDR IN PROC INFO JMS GPRLK GJPE1 JMS GEN3 JMP .-2 /G(JMP .-2) LAC NPW TAD C2 AND S17777 JMS GEN37 /G(NPW+2) LAC DBIL CMA JMS GEN37 /G(-DBIL-1)=FIXED SPACE LAC DNLBL JMS TCA JMS GEN37 /G(DISPL OF NLBL) LAC CHL JMS MES JMP R-6 AND S00037 JMS TCA JMS GEN37 /G(-HIERARCHY #) JMP* GPEP .EJECT /GTEP GENERATE TRACE EXTERNAL PROC GTEP JMS JLW /G(JUMP OVER TRACE SEQUENCE) JMS GPRLK /PLANT PROC LINK JMS GTC /GEN TRACE CALL JMS LVM /CLEAR EXT BIT CPI /IN PROC INFO AND X77777 /SO THAT CALLS APPEAR DAC* SP00 /TO BE INTERNAL LAC EP JMS GLLR U06501 LAC 6501 /G(LAC 'LINK') JMS NSTK /PUT PROC NAME IN VOCAB TAD S60000 /PREFIX DAC* JMS GGRA /G(DAC* EXTNAME) LAC GGRA+3 TAD T20000 /PREFIX LAC JMS GGRA LAC EP JMS GLLR /G(DAC 'EP') S40000 DAC LAC EP JMS GLLR /G(ISZ 'EP') ISZ LAC EP JMS GLLR /G(JMP* 'EP') JMP* JMP FEC1 /EXCALL /GENERATE CALL TO EXTERNAL PROC EXCALL JMS COPY /)COPY NAME OF PROC M*6+NXOP /)TO NAME1,2 NAME1 C2 2 JMS NSTK /PUT NAME ON VOCAB SK TAD T20000 /PREFIX JMS* JMS GGRA /G(JMS* EXT. NAME) JMP ANAL04 .EJECT /GPRLK GENERATE PROCEDURE LINK LOCATION GPRLK XX JMS BNL /BUY NEW LABLOC ENTRY JMS DVM /STORE IN EP IN PROC INFO M*2+CPI DAC EP /HOLD IN EP JMS PLOC /PLANT LOC JMS GEN4 /G(XX) XX JMP* GPRLK /GPEM GENERATE PROC ENTRY FOR MODULE GPEM DZM CHL /HL=0 FOR MODULE JMS OUTNAM LAC C10 DAC TAG LAC C1 /DEFINE PROC NAME AS INTERNAL GLOBAL JMS OUTRLB LAC C19 /)PROC MODULE NAME DAC TAG /)OUTPUT AS PROG NAME LAC W00000 JMS OUTRLB JMS GGR /G(JMS* %BB) JMS* %BB JMS GEN43 /DEFINE PROC NAME AS INTERNAL SYMBOL JMS GPEP /G(PARAMS) JMS JLW /G(JMP INTO PROC) JMS P2SK /OUTPUT SKS DZM NXTRQD JMP FEC1 /PLANT JMP DEST /GEMP GENERATE ENTRY TO MAIN PROGRAM GEMP JMS P2SK /OUTPUT SKS LAC LOC /HOLD PROG STARTING DAC STLOC /ADDR FOR .END LAC C25 /INDICATE TO P3 COMPILING DAC TAG /)MAIN PROGRAM JMS OUTRLB JMS GGR JMS* %BA /G(JMS* %BA) LAC* AOPTW /)SET SIGN BIT AND W00000 /)IF TRACE OPTION XOR W00000 /)ON. TAD DIM /ADD IN OWN SIZE JMS GEN37 /G(OWNSIZE,37) LAC DIM SNA /ANY OWN? JMP GEMP1 /NO LAC C26 /)OUTPUT ADDRESS DAC TAG /)OF FIRST WORD CLA /)OF OWN JMS OUTSTW GEMP1 JMS FNW SAD U06501 /NXOP='BEG'OP? JMP GEMP2 /YES:END OF DATSLOT LIST JMS GEN37 /G(DATSLOT#,37) LAC C22 DAC TAG LAC NXOP JMS OUTRLB /G(.IODEV DATSLOT#) JMP GEMP1 /(400000 IF ALL) GEMP2 JMS GGR JMS* %BB /G(JMS* %BB) JMS GPEP /G(PARAMS) JMP NEXT /GASS GENERATE ASSIGNMENT TO DICT INFO STACKED /WORK HOLDS OTDISPL (MOVED BACK TO NXOP) /WORK-1 HOLDS Q2 FOR THIS VARIABLE GASS JMS TAKEW /HOLD SKTHL DAC SKTHL JMS TAKEW /HOLD OTDISPL DAC NXOP /IN NXOP LAC STEPAS /CHECK IF V:=A IN STEP ELEMENT RAR DZM STEPAS /RESET STEPAS JMS TAKEW /RETRIEVE Q2 SZL /YES,IT WAS,DO NOT GENERATE CODE JMP ANAL04 TAD C54 /USE ENTRIES IN OPRP+54-32 JMP OPR+1 /PLSW PLANT LOC IN SWITCH LIST PLSW IDX SWLA LAC LOC JMS DVM SWLA JMS COMPA JMP JMP%BN .EJECT /FORWARD REFERENCE HANDLING ROUTINES /BNL BUY NEW LABEL & HOLD ON LABLOC STACK /PLOC PLANT LOCATION COUNT IN SPECIFIED WORD OF LABLOC SK BNL XX CLA JMS PUT /LABLOC(+)_0 LABLOC JMS EVA LLBASE /VADDR(END OF LABLOC)IN AC JMP* BNL PLOC XX /AC HOLDS VADDR OF LABLOC ENTRY TO BE SET DAC SP04 LAC LOC JMS DVM SP04 JMP* PLOC /JLW BUY A LABEL,HOLD ON WORK & G(JMP 'LAB') JLW XX JMS BNL /BUY NEW LABEL JMS PUTW /HOLD ON WORK(+) JMS GLLR /G(JMP 'LAB') JMP 0 JMP* JLW /PLW IF WORK(+) IS VADDR(LABLOC)THEN SET VALUE OF LOC / INTO THIS LABLOC ENTRY PLW XX LAW 770000 AND* WORK /HOLD MS 6 BITS OF WORD ON WORK SAD T10000 /IS IT LABLOC PTR SKP /YES JMP* PLW /NO:EXIT JMS TAKEW /VADDR(LABLOC) TO AC JMS PLOC /PLANT LOC INTO IT JMP* PLW /EXIT .EJECT /CLARG CLASSIFY SECOND ARG TO DYADIC OPERATOR /USED BY OPI,OPR CLARG XX LAC NXOP SPA!CLL /SK PTR? JMP CLARG2 /NO AND T70000 /EXTRACT SK# JMS MES JMP RR+14 /SHIFT TO LS END SAD C1 /IF REAL(SK#=1) TAD C1 /MAKE=2 RTL RTL /16*SK#=32 FOR ARITH CLARG1 DAC SP00 / 48 FOR BOOLS JMS TAKEW /GET OPERATOR JMS MES JMP R-6 AND S00077 /EXTRACT OPCODE TAD SP00 /ADD COMPUTED MODIFIER DZM NXTRQD JMP* CLARG /EXIT CLARG2 JMS RDDI /DECODE DICT INFO LAC Q2 /SET AC=0 LOCAL RCL JMP CLARG1 / =8 OWN .EJECT / =16 NON LOCAL /CODE GENERATION ROUTINES /CALLED FROM TABLES WITH SYMBOLS?R,?P / OUT1 XX /IF NXOP=0G(CLA,4)ELSE G(-NXOP,4) LAC NXOP /GET DISPL AND S17777 JMS TCA SNA LAC Z50000 /AC=INSTR(CLA) JMS GEN4A JMP* OUT1 OUT2L XX /G(-DISPL,39):TRAILING PARAMETER LAC NXOP AND S17777 JMS TCA JMS GEN39 JMP* OUT2L OUT2H XX /SET AC=-DNLBL+H:EXIT TO LINK+1 IF NOT=0 LAC SKTHL JMS MES /EXTRACT H FROM SKTHL JMP R-6 /AND SHIFT TO LS END AND S00037 CMA /-H-1 TAD DNLBL /DNLBL-H-1 CMA /-DNLBL+H SZA /ZERO? IDX OUT2H /BUMP LINK IF DISPL NOT=0 JMP* OUT2H OUT2NL XX /G(-DNLBL+H,37);OUT2L JMS OUT2H NOP /DUMMY IN CASE=0 JMS GEN37 JMS OUT2L JMP* OUT2NL OUT3L XX /G(P,GLOB):OUT2L:P IN AC JMS GGRA JMS OUT2L JMP* OUT3L OUT3NL XX /G(P,GLOB);OUT2NL:P IN AC JMS GGRA JMS OUT2NL JMP* OUT3NL OUT4 XX /OUT1;G(P,GLOB):P IN AC DAC .+3 JMS OUT1 JMS GGR XX JMP* OUT4 OUT5L XX /OUT3L(JMS* %BZ) LAC JMS%BZ JMS OUT3L JMP* OUT5L OUT5NL XX /OUT3NL(JMS* %BY) LAC JMS%BY JMS OUT3NL JMP* OUT5NL OUT6 XX /OUT3NL(JMS* %BH) LAC JMS%BH JMS OUT3NL JMP* OUT6 OUT7 XX /G(P,GLOB):GSR(LAC*) JMS GGRA JMS GSR U21000 LAC* 1000 JMP* OUT7 OUT8L XX /OUT5L;OUT7(P) DAC HOLDP JMS OUT5L LAC S27773 /PUT SKPTR TO (16) DAC NXOP /INTO NXOP LAC HOLDP JMS OUT7 JMP* OUT8L OUT8NL XX /OUT5NL;OUT7(P) DAC HOLDP JMS OUT5NL LAC S27773 /PUT SKPTR TO (16) DAC NXOP LAC HOLDP JMS OUT7 JMP* OUT8NL OUT9 XX /GSR(P) DAC .+2 JMS GSR XX JMP* OUT9 OUT10 XX /G(P,GLOB);GSR(LAC) JMS GGRA JMS GSR U07700 LAC 7700 JMP* OUT10 OUT11 XX /GSR(TAD*) JMS GSR V77760 TAD* 17760 JMP* OUT11 OUT12 XX /G(P,GLOB);GSA(400000) JMS GGRA JMS GSA XCT JMP* OUT12 OUT13 XX /G(P,GLOB);GSA(0) JMS GGRA JMS GSA 0 JMP* OUT13 OUT14 XX /G(P,GLOB);G(400016,4) JMS GGRA JMS GEN4 XCT 16 JMP* OUT14 OUT15 XX /OUT6,OUT14(P) DAC HOLDP JMS OUT6 LAC HOLDP JMS OUT14 JMP* OUT15 OUT16 XX /GSR(AND*) JMS GSR AND* JMP* OUT16 OUT17L XX /OUT5L;P DAC .+4 JMS OUT5L LAC S27773 /PUT SKPTR TO (16) DAC NXOP /INTO NXOP XX /JMS PLANTED JMP* OUT17L OUT17N XX /OUT5NL;P DAC .+4 JMS OUT5NL LAC S27773 /PUT SKPTR TO (16) DAC NXOP /INTO NXOP XX /JMS PLANTED JMP* OUT17N OUT18 XX /GSA(XOR*);G(CMA,4) JMS GSR XOR* JMS GCMA JMP* OUT18 OUT19 XX /G(JMS* %CG);GSR(XOR*) JMS GGR JMS* %CG JMS GSR XOR* JMP* OUT19 OUT20 XX /OUT6;G(P,GLOB) DAC .+3 JMS OUT6 JMS GGR XX JMP* OUT20 OUT21 XX /OUT4(P);G(JMS* %BQ) JMS OUT4 JMS GGR JMS* %BQ JMP* OUT21 OUT22 XX /OUT20(P);G(JMS* %BQ) JMS OUT20 JMS GGR JMS* %BQ JMP* OUT22 OUT23 XX /IF NXOP=037776(FALSE=0)THEN G(CLA,4) Z70001 LAW 770001 /ELSE G(CLC,4)(TRUE) TAD NXOP /AC=027776(T),027777(F) CMA /AC=750001(T);750000(F) JMS GEN4A /G(CLC)(T);G(CLA)(F) JMP* OUT23 OUT24 XX /IF AC=BOOLEAN (NXOP)THEN OUT23 ELSE NULL SAD NXOP JMS OUT23 JMP* OUT24 OUT25 XX /IF BOOL(NXOP)=TRUE G(CLC) ELSE G(CMA) SAD NXOP /AC=TRUE (037775) JMP .+3 JMS GCMA /G(CMA) IF FALSE SKP JMS OUT23 /G(CLC) IF TRUE (IN AC) JMP* OUT25 OUT26 XX /IF NXOP='FALSE':G(CMA) ELSE NULL SAD NXOP /AC='FALSE' JMS GCMA /GCMA JMP* OUT26 OUT27 XX /FETCH ADDR OF ACTUAL REAL & STORE FLOPAC DAC SP00 /HOLD PARAM LAC GFTLU /PRESERVE CURRENT LINK DAC LGFTLU /OF GFTLU LAC SP00 /PARAM TO AC JMS GFTLU LAC LVR LVP-LVR LAC LGFTLU /RESET LINK DAC GFTLU /OF GFTLU JMS STRL /G(STORE REAL SEQUENCE) JMP* OUT27 HSLA XX /HOLD SWITCH LIST ADDR LAC NXOP DAC SWLA JMP* HSLA OUT28 XX /OUT2H;OUT13(JMS* %BW) JMS OUT2H LAC Z50000 /G(CLA) IF DNLBL=0 JMS GEN4A LAC JMS%BW JMS OUT13 JMP* OUT28 /OPTIMISATION OF INTEGER DYADIC OPERATIONS /OUT29: ADD INTEGER OUT29 XX LAC NXOP /GET INTEGER SKPTR SAD S27776 /IS INTEGER ZERO? JMP* OUT29 /YES:NO CODE JMS GSR /NO TAD /G(TAD(INT)) JMP* OUT29 /OUT30 SUBTRACT INTEGER OUT30 XX LAC NXOP /GET INT SKPTR SAD S27776 /IS INTEGER ZERO? JMP* OUT30 /YES:NO CODE LAC JMS.AY /NO JMS OUT10 /G(JMS* .AY);(LAC (INT)) JMP* OUT30 /OUT31: MULTIPLY INTEGER OUT31 XX LAC NXOP SAD S27774 /IS INTEGER=1? JMP* OUT31 /YES:NO CODE SAD S27775 /IS INTEGER=-1? JMP OUT311 /YES SAD S27772 /IS INTEGER =2? JMP OUT312 /YES LAC JMS.AD /NO JMS OUT10 /G(JMS* .AD):G(LAC(INT)) JMP* OUT31 OUT311=. /MULT BY -1 JMS GGR /G(JMS* %CF) JMS* %CF /TO NEGATE AC JMP* OUT31 OUT312=. /MULT BY 2 JMS GEN4 /G(RCL) RCL /TO DOUBLE AC JMP* OUT31 /OUTNAM OUTPUTS CODES 7&8 FOR RADIX 50 NAME HELD IN / NAME1 &NAME2. NAME2 IS CLEARED FOR SHORT NAMES OUTNAM XX LAC C7 /OUTPUT 1ST HALF DAC TAG /AS CODE 7 LAC NAME1 SMA /SHORT NAME? DZM NAME2 /YES JMS OUTRLB IDX TAG /CODE 8 LAC NAME2 /2ND HALF OF NAME SZA /ZERO (SHORT NAME)? JMS OUTRLB /NO JMP* OUTNAM .EJECT /GGRA GENERATE GLOBAL REF (INSTR IN AC) GGRA XX DAC .+2 /DEPOSIT INSTR JMS GGR XX JMP* GGRA OUTSK XX /OUTPUT STACKS AS RLB AND TERMINATE JMS P3SK /OUTPUT FINAL CONSTANTS LAC LOC /)PUT PROG SIZE JMS PUT /)ON END OF GLOBAL FOR PH4 GLOBAL LAC C23 /)OUTPUT LOADER CODE 23(.END) DAC TAG /)WITH STARTING ADDR LAC STLOC / LOCN OF 1ST INSTR JMS OUTRLB LAW -3 SAD LCCT /ALL TAGS OUTPUT? JMP* OUTSK /YES JMP .-4 /NO:OUTPUT FILLERS /GSR GENERATE STACK REFERENCE:SKPTR IN NXOP LAC NXOP JMS GENR GSR XX JMP .-3 JMP* GSR /GSA GENERATE STACK ADDRESS(15 BIT):SKPTR IN NXOP LAC NXOP XOR U00000 /ADD 16 TO SK# JMS GENR GSA XX JMP .-4 JMP* GSA /GLLR GENERATE LABLOC SK REFERENCE:SKPTR IN AC JMS GENR GLLR XX JMP .-2 JMP* GLLR .EJECT /GTC GENERATE TRACE CALL /ON ENTRY NAME IN RADIX 50 FORM IS HELD IN NAME1,NAME2 /THE ROUTINE GENERATES THE SEQUENCE:- / JMS* %BC / .SIXBT (CHARS FROM NAME1 / .SIXBT (CHARS FROM NAME2)OR 0 IF NAME IS SHORT GTC XX JMS GGR /G(JMS* %BC) JMS* %BC LAC NAME1 /FIRST 3 CHARS AND T77777 /REMOVE TOP 2BITS JMS OUT.SB /OUTPUT AS .SIXBT JMS GEN37 LAC NAME1 SMA!CLA /SHORT NAME? JMP GTC1 /YES LAC NAME2 /SECOND 3 CHARS JMS OUT.SB /OUTPUT AS .SIXBT GTC1 JMS GEN37 JMP* GTC /OUT.SB GIVEN AC IN RADIX 50 FORMAT OUTPUT A / SIXBIT LITERAL OUT.SB XX JMS XR50 /CREATE 3 SEPARATE CHARS DZM SP00 /CLEAR .SIXBT PACKED WORD LAC R50.1 /)FIRST CHAR JMS R50.SB /)TO .SIXBT JMS MES /SHIFT UP JMP L-6 DAC SP00 LAC R50.2 /)SECOND CHAR JMS R50.SB /)TO .SIXBT JMS MES /SHIFT UP JMP L-6 DAC SP00 LAC R50.3 /)THIRD CHAR JMS R50.SB /)TO .SIXBT JMP* OUT.SB /XR50 EXPAND AC(IN RADIX 50 FORMAT) INTO 3 / RADIX 50 CHARS XR50 XX DZM R50.1 /)CLEAR 2 RADIX 50 DZM R50.2 /)CHARS XR50.1 IDX R50.1 TAD Z74700 /SUBTRACT(50*50) SMA />3100? JMP XR50.1 /YES TAD S03100 XR50.2 IDX R50.2 /CREATE SECOND CHAR+1 TAD K40 /SUBTRACT 50 SMA />50? JMP XR50.2 /YES XR50.3 TAD C41 DAC R50.3 /REMAINDER=THIRD CHAR JMP* XR50 /R50.SB CONVERT RADIX 50 CHAR IN AC INTO .SIXBT FORM / RESULT XOR'D INTO SP00 R50.SB XX TAD K1 /REDUCE TO CHAR VALUE SNA /SPACE? JMP R50.SP /YES TAD K27 SPA /LETTER? JMP R50LET /YES SNA /%? TAD K9 /YES SAD C1 /.? CLA /YES TAD S00016 /ASSUME DIGIT SAD S00032 /#? TAD K23 /YES R50.SP TAD C5 R50LET TAD C27 CLL XOR SP00 JMP* R50.SB .EJECT /OUTRLB OUTPUT RELOCATABLE BINARY UNIT /CALL:-AC CONTAINS LOADER WORD: THE LOADER CODE IS IN TAG / JMS OUTRLB /LOADER WORD PUT ONTO OUT STACK AND TAG PACKED INTO LCWORD /WHEN THIS HAS THREE TAGS IN IT IS PUT ONTO OUT STACK /SCRATCH PAD USED:SP00,1,2 OUTRLB XX JMS PUTOUT /LOADER WORD TO OUTSK LAC LCWORD /GET PARTIAL WORD OF CODES JMS MES /SHIFT LEFT 6 JMP L-6 AND Z77700 XOR TAG /PACK IN NEW CODE DAC LCWORD ISZ LCCT /WORD NOW FULL? JMP* OUTRLB /NO JMS PUTOUT /YES,OUTPUT IT K3 LAW -3 DAC LCCT /RESET COUNT OF 3 JMP* OUTRLB OUTSTW XX JMS OUTRLB /OUTPUT RLB IDX LOC /INCR LOCATION COUNT JMP* OUTSTW .EJECT /GENR GENERATE STACK REFERENCE INSTRUCTION /CALL:- AC HOLDS VADDR OF STACK POSN BEING REFERENCED / JMS GENR /ROUT LINK OF CALLER /ADDR OF SKELETON INSTR / JMP ? /CALLER JMP TO PROCESS / NEXT INSTRUCTION /CONTROL RETURNS HERE WITH CALLERS / /LINK BUMPED PASSED SKELETON INSTR & JMP ? /SK#+32 BECOMES THE LOADER CODE(TAG) /SCRATCHPAD USED:SP00,1,2, GENR XX XOR W00000 /ADD 32 TO SK#(=TAG) DAC TAG /HOLD AND S07777 /EXTRACT DISPL DAC SP00 /HOLD LAC TAG /)SHIFT LOADER CODE JMS MES /)TO LS END IF TAG JMP RR+14 AND S00077 DAC TAG LAC* GENR /LOAD ADDR OF SKELETON INSTR DAC SP01 / Z60000 LAW 760000 AND* SP01 /EXTRACT OPFIELD OF INSTR XOR SP00 /ADD IN DISPL JMS OUTSTW /OUTPUT GENERATED INSTR ISZ* GENR /BUMP CALLERS LINK IDX GENR /BUMP LINK(TWICE) IDX GENR JMP* GENR /EXIT .EJECT /GGR GENERATE GLOBAL REFERENCE INSTRUCTION /CALL:- JMS GGR / OPFIELD VOCPTR /OPFIELD IS THE INSTR MNEMONIC (WITH * IF REQD) /VOCPTR IS THE DISPLACEMENT OF THE VOCAB ENTRY FOR THE GLOBAL NAME /THE POINTER WORD IN THE VOCAB ENTRY IS ZERO UNTIL THE NAME IS USED /WHEN USED THE POINTER WORD POINTS TO THE ETV WORD BOUGHT FOR IT /ON THE GLOBAL STACK /SCRATCHPAD USED:SP00,1,2 GGR01 LAC* GGR /GET PARAM AND S07777 /EXTRACT VOCPTR DAC SP04 /HOLD JMS LVM /LOAD VOCAB PTR WORD SP04 SZA /NAME ALREADY USED? JMP GGR-1 /YES:GENERATE INSTR LAC SP04 /NO:BUY ETV WORD TAD C1 /STEP VOCPTR TO NAME JMS PUT /PUT ON GLOBAL STACK GLOBAL JMS EVA /FIND VADDR OF ETV WORD GLBASE JMS DVM /STORE IN PTR IN VOCAB ENTRY SP04 JMS GENR /GENERATE REFERENCE INSTR GGR XX JMP GGR01 /JUMP ON ENTRY TO PROCESS JMP* GGR /EXIT /GFTLU /GENERATE FROM TABLE LOOK UP /GENERAL PURPOSE DOUBLE TABLE LOOK UP. THE FIRST TABLE WILL CONTAIN /SUBROUTINE CALLS. THE SECOND TABLE WILL CONTAIN THE PARAMETER TO BE /SUPPLIED TO THIS ROUTINE /CALLING SEQUENCE:- / AC CONTAINS TABLE MODIFIER / JMS GFTLU / LAC T1 /T1=ADDRESS OF FIRST TABLE / T2-T1 /T2=ADDRESS OF SECOND TABLE GFTLU XX TAD* GFTLU /AC=LAC T1+MOD DAC .+4 /DUMP AHEAD IDX GFTLU /BUMP TO NEXT PARAM TAD* GFTLU /AC=LAC T2+MOD DAC .+3 /DUMP AHEAD 0 /LAC T1+MOD /LOAD ROUTINE CALL DAC .+2 /DUMP AHEAD 0 /LAC T1+MOD+(T2-T1) /LOAD PARAM TO AC 0 /JMS ROUT /CALL ROUTINE IDX GFTLU /BUMP LINK JMP* GFTLU /EXIT .EJECT /BEGSK OUTPUT LOADER CODE INTRODUCING A STACK / LOADER CODE=SK#+27:LOADER WORD=-(# WORDS ON STACK) / IF STACK EMPTY NO OUTPUT PRODUCED /CALL JMS BEGSK / SKBASE / JMP NOSTACK /_RETURN HERE IF STACK EMPTY /RETURN HERE IF STACK HAS SOME CONTENTS,THEN SAC / HOLD -(#WORDS ON STACK) AND NXOP HOLDS VADDR OF PTR /OF END OF STACK /SCRATCHPAD USED: SP00,6 /ROUTINES USED: MES,OUTRLB,EVA BEGSK XX LAC* BEGSK /ADDR OF SKBASE DAC SP06 /HOLD DAC BEGSK1 /AND FOR EVA IDX BEGSK /BUMP LINK TO EMPTY STACK RETURN LAC* SP06 DAC SP00 /ADDR GIVEN BY BASE WORD JMS TCA /-BASE IDX SP06 TAD* SP06 /PTR-BASE=-(# WORDS ON SK) SNA JMP* BEGSK /EXIT IF EMPTY STACK DAC SAC /HOLD # WORDS ON SK IDX BEGSK /BUMP LINK TO 'SK NOT EMPTY' RETURN LAC* SP00 /BASE WORD OF SK JMS MES JMP RR+14 AND S00077 /SK# TO LS END SAD C6 /GLOBAL SK? JMP BEGSK1-1 /YES: NO INTRODUCTORY CODE TAD C27 DAC TAG /STORE TAG(=SK#+27) LAC SAC JMS OUTRLB /OUTPUT SK INTRODUCOR CODE JMS EVA /)COMPUTE VADDR OF PTR END BEGSK1 XX /SKBASE /)OF SK DAC NXOP JMP* BEGSK .EJECT /OUTBLK OUTPUT BLOCK FROM STACK /CALL: TAG TO USE IN AC / JMS OUTBLK /ON ENTRY NXOP HOLDS VADDR OF FIRST WORD TO OUTPUT / SAC HOLDS -(#WORDS TO OUTPUT) /IF,WHEN THE BLOCK HAS BEEN OUTPUT ,NXOP POINTS TO BASE /ENDSK IS CALLED /AND RETURN IS TO LINK+1 OUTBLK XX DAC TAG /SET UP TAG JMS LNP /GET STACK WORD JMS OUTSTW /OUTPUT AS RLB IDX NXOP /BUMP TO NEXT SK WORD ISZ SAC /END OF BLOCK? JMP OUTBLK+2 /NO:REPEAT JMS ENDSK /CHECK FOR END OF SK JMP* OUTBLK /NO:EXIT LINK IDX OUTBLK /YES:BUMP LINK & EXIT JMP* OUTBLK /ENDSK CHECK IF NXOP AT END OF SK / IF NOT EXIT TO LINK /IF SO,PUT LOC+1 ON TO SK,OUTPUT CODE 27+SK# & EXIT TO LINK+1 ENDSK XX LAC NXOP / AND S07777 /EXTRACT SK DISPL SAD S07777 /BACK TO BASE? SKP!CLL /YES JMP* ENDSK /NO:EXIT IDX ENDSK /BUMP LINK XOR NXOP /EXTRACT SK# JMS MES JMP RR+13 /SK#*2 TO LS END DAC HOLDL /2*SK# TO HOLDL TAD GSKPTR /ADD(LAC VTOA02+1) DAC .+1 ENDSK1 XX /LAC VTOA02+1+2*SK# DAC SP00 /HOLD SK BASE IDX ENDSK1 XCT ENDSK1 /LOAD SK PTR DAC ENDSK4 /DEPOSIT SK PTR LAW -14 TAD HOLDL SNA /GLOBAL SK? JMP ENDSK2 /TES LAC* SP00 /NO:DISCARD SK DAC* ENDSK4 /CONTENTS ENDSK2 LAC HOLDL /)CODE RCR /27+SK# TAD C27 /)TO DAC TAG /)TERMINATE SK LAC LOC TAD C1 /)LOC+1 TO END JMS PUT /)OF SK ENDSK4 XX /SK PTR K12 LAW -14 TAD HOLDL SZA /GLOBAL SK? JMS OUTRLB /NO JMP* ENDSK /EXIT GSKPTR LAC VTOA02+1 .EJECT /P2SK OUTPUT CONTENTS OF INTEGER,REAL,STR & OWN STACKS P2SK XX /OUTPUT INTEGER STACK AS CODE 45'S JMS BEGSK /INTRODUCE SK INBASE UNUSED /INTEGER SK NEVER EMPTY LAC C45 /CODE 45 TO TAG JMS OUTBLK /OUTPUT SK CONTENTS UNUSED /SK EMPTY WHEN SAC=0 RLSK=. /OUTPUT REAL STACK AS CODE 37'S JMS BEGSK /INTRODUCE SK RLBASE JMP STRSK /NEXT IF SK EMPTY LAC C37 JMS OUTBLK UNUSED /SK EMPTY WHEN SAC=0 STRSK=. /OUTPUT STRING STACK /FIRST WORD OF STRING BLOCK CHANGED TO CHARACTER COUNT JMS BEGSK /INTRODUCE SK STBASE JMP OWNSK /NEXT IF SK EMPTY STRSK1 IDX NXOP /BUMP NXOP TO STR PTR VADDR JMS GSA /OUTPUT STR ADDR PTR 0 JMS LNP /LOAD STRING WORD COUNT(=N) DAC SP00 CMA!CLL /-N-1 DAC SAC /COUNT OF WORDS IN THIS STRING BLOCK LAC SP00 RTL TAD SP00 RAR /5N/2 JMS TCA JMS DVM /PUT CHAR CT INTO HEAD OF STRING BLOCK NXOP LAC C37 JMS OUTBLK /OUTPUT THIS STRING BLOCK JMP STRSK1 /REPEAT IF STACK NOT EMPTY OWNSK=. /OUTPUT OWN STACK:WORK SK GIVES COMMON SIZE /OTHER ENTRIES ON OWN ARE EITHER /(1) COMMON DISPLACEMENTS(SINGLE +VE WORDS) /(2) OWN DOPE VECTORS INTRODUCED BY VADDR /POINTING TO NEXT WORD ON OWN LAC DIM SNA /ANY COMMON SPACE? JMP P2SK1 /NO:END OF OUTPUT DAC NXOP /HOLD SIZE OF COMMON LAC .XX DAC NAME1 JMS OUTNAM /INTRODUCE BLANK COMMON(.XX) LAC C12 DAC TAG LAC NXOP /DEFINE BLANK COMMON SIZE JMS OUTRLB JMS BEGSK OWBASE UNUSED /OWN SK NOT EMPTY IF OWN NONZERO OWNSK2 LAC C26 /SET CODE 26 IN CASE OWN T.V DAC TAG JMS LNP IDX NXOP SAD NXOP /ARRAY WORD POINTING TO DOPE VECTOR? JMP OWNSK4 /YES JMS OUTSTW /DEFINE T.V. LOCN FOR THIS COMMON WORD: / BUYS LOCN. FOR CODE 5 GENERATED FROM / CODE 26 BY PHASE 4 JMS ENDSK /CHECK END OF SK? JMP OWNSK2 /NO DZM SAC /CLEAR SAC FOR ASSIGNMENTS JMP P2SK1 /YES:END OF OUTPUT OWNSK4 JMS GSA /OUTPUT ARRAY WORD 0 JMS LNP /GET(-#DIMS) TAD K3 / DAC SAC /)=(-#DIMS-3)WORDS TO OUTPUT LAC C37 /)AS CONSTANTS JMS OUTBLK JMP OWNSK2 /MOVE INTEG STACK TO HIGHEST AVAILABLE CORE ADDRESS P2SK1 LAC* INTEGR /HOLD OCLOC FROM INTEGER SK IDX INTEGR /&REMOVE IT DAC SP00 /FOR INTEGER SK(ONLY CONTENTS OF SK) LAC ASKLIM /MOVE INBASE DAC INBASE /AND INTEGR PTR DAC INTEGR /TO TOP OF AVAILABLE FREE STORE LAC SP00 /RESET INTEGER 'OCLOC' JMS PUT /ONTO SK INTEGR JMP* P2SK /EXIT .EJECT /P3SK OUTPUT SWITCH SK & GLOBAL SK AT END OF PHASE 3 P3SK XX /OUPUT SWITCH STACK /FIRST WORD OF SWITCH LIST GIVES LENGTH OF LIST /ENTRIES IN LIST ARE UNRELOCATED ADDRESSES OF GENERATED CODE JMS BEGSK /INTRODUCE SK SWBASE JMP GLBSK /JMP IF EMPTY SWSK1 LAC C37 DAC TAG /HEAD OF SWITCH LIST AS CONSTANT JMS LNP IDX NXOP JMS TCA / DAC SAC /COUNT FOR OUTBLK JMS OUTSTW /OUTPUT WORD LAC C5 /)OUTPUT SWITCH LIST JMS OUTBLK /)AS 15 BIT ADDRESSES JMP SWSK1 GLBSK=. /OUTPUT GLOBAL STACK AS TABLE OF ETV LOCNS /EACH ENTRY ON SK IS VADDR OF GLOBAL NAME IN VOCAB JMS BEGSK /INTRODUCE GLOBALS GLBASE JMP* P3SK GLBSK1 JMS LNP /GET VOCPTR TAD U00000 /MARK VADDR FOR COPY DAC .+2 JMS COPY /COPY R50 NAME XX /FROM VOCAB NAME1 /INTO NAME1,NAME2 2 JMS OUTNAM LAC C19 /DEFINE GLOBALS DAC TAG /AS INTERNAL SYMBOLS LAC LOC JMS OUTRLB LAC C27 /CODE FOR ETV DAC TAG LAC LOC /PUT OWN ADDR IN ETV JMS OUTSTW IDX NXOP JMS ENDSK /CHECK END OF SK? JMP GLBSK1 /NO JMP* P3SK /YES:EXIT .EJECT /GEN3 /GENERATE CODE 3 STORABLE WORD /CALL: JMS GEN3 / OPCODE .(RELATIVE LOCN) GEN3 XX LAC C3 DAC TAG /CODE 3 TO TAG LAC GEN3 /ADDR OF PARAM AND S17777 JMS TCA TAD* GEN3 /REDUCE BACK TO RELATIVE LOC TAD LOC /ADD CURRENT LOC JMS OUTSTW IDX GEN3 JMP* GEN3 /GEN4 GENERATE CODE 4 STORABLE WORD /CALL JMS GEN4 / OPERATE INSTRUCTION GEN4 XX LAC C4 DAC TAG LAC* GEN4 JMS OUTSTW IDX GEN4 JMP* GEN4 /GEN4A AS GEN 4 BUT OPERATE INSTRUCTION IN AC GEN4A XX DAC .+2 JMS GEN4 XX JMP* GEN4A /GEN37 GENERATE CODE 37(LITERAL) /LITERAL IN AC GEN37 XX DAC SP00 LAC C37 DAC TAG LAC SP00 JMS OUTSTW JMP* GEN37 /GEN43 GENERATE CODE 43 (LOCATION OF USER NAME) GEN43 XX LAC C43 DAC TAG LAC LOC JMS OUTRLB JMP* GEN43 .EJECT /CONTROL TABLE FOR OPERATORS:USED BY COMP TXB3 S+ASS3 S+IFX3 S+DYAD3 /AND S+DYAD3 /OR S+DYAD3 /IMP S+DYAD3 /EQUIV UNUSED /ENDC,ENDF S+REL3 /LT S+REL3 /EQ S+REL3 /LE FOR3 S+REL3 /GE S+REL3 /NE S+REL3 /GT AFOR3 WH3 STEP3 GOTO3 IFS3 PC3 PC3 /FC S+SV3 S+DYAD3 /+ S+DYAD3 /- S+DYAD3 /* S+DYAD3 // S+DYAD3 /IDIV S+DYAD3 /^ S+DYAD3 /I^Z S+NEG3 ARD3 PDEC3 /PDEC UNUSED /ASEG S+BPL3 LAB3 SW3 UNUSED /MP UNUSED /DUMST JMP* COMP /IGNORE ENDP JMP DO3 /DO NOT3 /NOT JMP* COMP /IGNORE ENDD JMP ELSE3 /ELSE BEG3 /BEG UNUSED /END UNUSED /DICT JMP FLK3 /FLK(SECOND ONE IN FOREL) S+FR3 S+FI3 UNUSED FSTR3 S+FLAB3 FIX3 TXB3E FLT3 /TABLE TO GENERATE CODE FOR LOAD ADDR/VALUE FROM DICT INFO /LOAD VALUE ROUT /Q2= LVR JMS OUT4 /0:1WD ACT LOC JMS OUT4 /1 3WD ACT LOC JMS OUT21 /2 1WD FN LOC JMS OUT4 /3 3WD FN LOC JMS OUT9 /4 1WD OWN JMS OUT12 /5 3WD OWN JMS OUT28 /6 SWITCH UNUSED /7 JMS OUT20 /8 1WD ACT NON LOCAL JMS OUT15 /9 3WD ACT NON LOCAL JMS OUT22 /10 1WD FN NON LOCAL JMS OUT20 /11 3WD FN NON LOCAL /LOAD ADDR ROUT JMS OUT4 /0 JMS OUT4 /1 JMS OUT4 /2 JMS OUT4 /3 JMS OUT9 /4 JMS OUT9 /5 JMS OUT28 /6 UNUSED /7 JMS OUT6 /8 JMS OUT6 /9 JMS OUT20 /10 JMS OUT20 /11 JMS%BG=. /LOAD VALUE PARAM LVP JMS* %BG /0 JMS* %BJ /1 JMS* %BK /2 JMS* %BK /3 U24000 LAC* 4000 /4 JMS* .AO /5 JMS%BW JMS* %BW /6:UNUSED AS PARAM:INSTR GENERATED BY OUT28 JMP%AT JMP* %AT /7:UNUSED AS PARAM JMS* %BQ /8 JMS* .AO /9 JMS* %BL /10 JMS* %BL /11 /LOAD ADDR PARAM TAD* %AB /0 TAD* %AB /1 JMS* %BK /2 JMS* %BK /3 LAC /4 LAC /5 0 /6 JMS%AU JMS* %AU /7 NOT PARAM JMS%BD JMS* %BD /8 NOT PARAM UNUSED /9 JMS* %BL /10 JMS* %BL /11 .EJECT /OPIR TABLE FOR CODE GENERATION OF INTEGER DYADIC /OPERATIONS FOR SIMPLE SECOND ARG /THERE ARE 4 CASES:LOCAL,NON LOCAL,OWN OR CONSTANT /AC=12 /LOCAL BOOLEAN(Q2=0) OPIR JMS OUT17L /AND JMS OUT17L /OR JMS OUT8L /IMP JMS OUT17L /EQUIV UNUSED UNUSED UNUSED UNUSED /AC=20 /OWN BOOLEAN (Q2=8) JMS OUT6 /AND JMS OUT19 /OR JMS OUT7 /IMP JMS OUT18 /EQUIV UNUSED UNUSED UNUSED UNUSED /AC=28 /NON LOCAL BOOLEAN (Q2=16) JMS OUT17N /AND JMS OUT17N /OR JMS OUT8NL /IMP JMS OUT17N /EQUIV /AC=32 /LOCAL INTEGER (Q2=0) JMS OUT3L /+ JMS OUT3L /- JMS OUT3L /* UNUSED // N/A JMS OUT8L /IDIV ERRNUM 311430 /ERROR# 23 311500 /ERROR# 24 UNUSED /AC=40 /OWN INTEGER (Q2=8) JMS OUT11 /+ JMS OUT7 /- JMS OUT7 /* 311620 /ERROR# 29 JMS OUT7 /IDIV UNUSED /^ UNUSED UNUSED /AC=48 /NON LOCAL INTEGER (Q2=16) JMS OUT17N /+ JMS OUT8NL /- JMS OUT8NL /* UNUSED // JMS OUT8NL /IDIV UNUSED /^ UNUSED UNUSED UNUSED UNUSED UNUSED UNUSED /AC=60 /CONSTANT BOOLEAN (Q2=48) JMS OUT24 /AND JMS OUT24 /OR JMS OUT25 /IMP JMS OUT26 /EQUIV /AC=64 /CONSTANT INTEGER (Q2=32) JMS OUT29 /+ JMS OUT30 /- JMS OUT31 /* UNUSED // JMS OUT10 /IDIV JMS OUT10 /^ /OPIP TABLE OF PARAMETERS FOR USE WITH OPIR TABLE /LOCAL BOOLEAN OPIP JMS OUT16 /AND JMS OUT19 /OR JMS* %CH /IMP JMS OUT18 /EQUIV UNUSED UNUSED UNUSED UNUSED / OWN BOOLEAN UNUSED UNUSED JMS* %CH UNUSED /EQUIV UNUSED UNUSED UNUSED UNUSED /NON LOCAL BOOLEAN JMS OUT16 /AND JMS OUT19 /OR JMS* %CH /IMP JMS OUT19 /EQUIV /LOCAL INTEGER JMS* %CA /+ JMS* %CB /- JMS* %CC /* JMS%BV JMS* %BV //:UNUSED AS PARAM JMS* .AE /IDIV UNUSED /^ UNUSED UNUSED /OWN INTEGER UNUSED JMS* .AY /- JMS* .AD /* UNUSED // JMS* .AE /IDIV UNUSED /^ UNUSED UNUSED /NON LOCAL INTEGER JMS OUT11 /+ JMS.AY JMS* .AY /- JMS.AD JMS* .AD /* JMS%BY JMS* %BY //:UNUSED AS PARAM JMS* .AE /IDIV JMS%BZ JMS* %BZ /^:UNUSED AS PARAM 345600 /ERROR# 98 345620 /ERROR# 99 UNUSED UNUSED UNUSED UNUSED /CONSTANT BOOLEAN 37776 /FALSE /AND 37775 /TRUE /OR 37775 /TRUE /IMP 37776 /FALSE /EQUIV /CONSTANT INTEGER UNUSED /+ UNUSED /- UNUSED /* UNUSED // JMS* .AE /IDIV JMS* .BB /^ .EJECT /OPRR, TABLE FOR CODE GENERATION OF REAL DYADIC /OPERATIONS FOR SIMPLE SECOND ARG /AC=32 /LOCAL REAL OPRR JMS OUT4 /+ JMS OUT4 /- JMS OUT4 /* JMS OUT4 // UNUSED /IDIV JMS OUT4 /^ UNUSED UNUSED /AC=40 /OWN REAL JMS OUT12 /+ JMS OUT12 /- JMS OUT12 /* JMS OUT12 // UNUSED /IDIV JMS OUT12 /^ UNUSED UNUSED /AC=48 /NON LOCAL REAL JMS OUT15 /+ JMS OUT15 /- JMS OUT15 /* JMS OUT15 // UNUSED /IDIV JMS OUT15 /^ JMS OUT3L /1 WD LOCAL ASSIGN JMS OUT27 /3 WD LOCAL ASSIGN UNUSED UNUSED JMS OUT9 /1 WD OWN ASSIGN JMS OUT12 /3 WD OWN ASSIGN UNUSED UNUSED UNUSED JMS OUT27 /3 WD NON LOCAL ASSIGN /AC=64 /REAL CONSTANT JMS OUT13 /+ JMS OUT13 /- JMS OUT13 /* JMS OUT13 // UNUSED /IDIV JMS OUT13 /^ /OPRP TABLE OF PARAMETERS FOR USE WITH OPRR TABLE /LOCAL REAL OPRP JMS* %CI /+ JMS* %CJ /- JMS* %CK /* JMS* %CL // UNUSED /IDIV JMS* %CM /^ UNUSED UNUSED /OWN REAL JMS* .AQ /+ JMS* .AR /- JMS* .AS /* JMS* .AT // UNUSED /IDIV JMS* %CE /^ UNUSED UNUSED /NON LOCAL REAL JMS* .AQ /+ JMS* .AR /- JMS* .AS /* JMS* .AT // UNUSED /IDIV JMS* %CE /^ JMS%BU JMS* %BU /1 WD LOCAL ASSIGN C13 15 /3 WD LOCAL ASSIGN UNUSED UNUSED DAC* /1 WD OWN ASSIGN JMS* .AP /3 WD OWN ASSIGN UNUSED UNUSED UNUSED C21 25 /3 WD NON LOCAL ASSIGN /REAL CONSTANT JMS* .AQ /+ JMS* .AR /- JMS* .AS /* JMS* .AT // UNUSED /IDIV JMS* %CE /^ .EJECT /OPSR,OPSP TABLES FOR GENERATION OF DYADIC OPERATIONS /WHEN FIRST ARG WAS STACKED OPSR JMS OUT9 /AND JMS OUT19 /OR JMS OUT7 /IMP JMS OUT18 /EQUIV /GENERATION TABLE FOR STACK PTRS LCR JMS OUT13 /1 REAL JMS OUT9 /2 INTEGER JMS OUT23 /3 BOOLEAN JMS OUT9 /4 STRING JMS LABREF /5 LABEL JMS OUT3L /6 OT DISPL OF ARRAY WORD JMS OUT3L /7 OT DISPL OF ARRAY WORD JMS HSLA /10 SWITCH(HOLD SW LIST ADDR) JMS OUT14 /REAL+ JMS OUT14 /REAL- JMS OUT14 /REAL* JMS OUT14 /REAL/ UNUSED /REAL IDIV -ILLEGAL JMS OUT14 /REAL^ UNUSED UNUSED JMS OUT9 /INT+ JMS OUT7 /INT- JMS OUT7 /INT* UNUSED /INT/ CANNOT OCCUR JMS OUT7 /INT IDIV /INT^ CANNOT OCCUR(EXPN +VE CONSTANT OPSP AND* /AND UNUSED /OP JMS* %CH /IMP UNUSED /EQUIV UNUSED LCP JMS* .AO /1 LAC /2 JMS%BH JMS* %BH /NO PARAM LAC /4 JMS%BR JMS* %BR /NO PARAM JMS%AV JMS* %AV /6 JMS* %AV /7 JMS* .AQ /R+ JMS* .AU /R- JMS* .AS /R* JMS* .AV /R/ UNUSED JMS* %CP /R^ UNUSED UNUSED TAD* /I+ JMS* .AY /I- JMS* .AD /I* UNUSED JMS* .AE /I 'IDIV' /STATISTICS TABLE G.E SP06 /LIMITS OF GLOBAL DATA G.S AINWD /FOR PRINTING BY LISTAK INBASE XX INTEGR XX RLBASE XX REAL XX STBASE XX STRING XX OWBASE XX OWN XX SWBASE XX SWITCH XX LABASE XX LABEL XX PRBASE XX PROC XX VOBASE XX VOCAB XX WKBASE XX WORK XX LLBASE XX LABLOC XX GLBASE XX GLOBAL XX ICBASE XX INCODE XX OUT XX OUBASE XX SCOM A .EJECT / VTOA CONVERSION TABLE VTOA02 TAD* .+1 /SK# VOBASE /0 VOCAB RLBASE /1 REAL INBASE /2 INTEGR INBASE /3 INTEGR STBASE /4 STRING LABASE /5 LABEL GLBASE /6 GLOBAL PRBASE /7 PROC SWBASE /8 SWITCH LLBASE /9 LABLOC ICBASE /10 INCODE WKBASE /11 WORK OWBASE /12 OWN OUBASE /13 AOUT OUT / ADDRESS CONSTANTS AAERP ERPOSN-1 INFN=OVLAY-2 INBUFF=INFN-52 AINB2 INBUFF+2 ALANAL LANAL ALCOMP LCOMP ASVX SVX ATXB3 TXB3-12 .EJECT /NUMERICAL CONSTANTS .DEC C1 1 C5 5 C7 7 C8 8 C9 9 C10 10 C11 11 C12 12 C14 14 C15 15 C19 19 C22 22 C23 23 C25 25 C26 26 C37 37 C39 39 C41 41 C43 43 C45 45 C46 46 C47 47 C54 54 C72 72 C75 75 /K1=FFASS+15 /K3=OUTRLB+11 K8 -8 K9=ERREC K10 -10 /K12=ENDSK4+1 K14 -14 K24=VTOA90 K26 -26 K27 -27 K39 -39 K63 -63 .OCT /LITERALS S00007=C7 S00010=C8 S00015=C13 S00016=C14 S00017=C15 S00032=C26 S00033=C27 S00034 34 S00037 37 S00047=C39 S00072 72 S00073 73 S00077 77 S00101 101 S00102 102 S00103 103 S00116 116 S00117 117 S00137 137 S00175 175 S00400 400 S01300 1300 S03100 3100 S03700 3700 S03777 3777 S04000 4000 S06000 6000 S07777 7777 S10000 10000 S17777 17777 S20000 20000 S25500 25500 S27772 27772 S27773 27773 S27774 27774 S27775 27775 S27776 27776 S30000 30000 S60000=C13+3 S70000 70000 S77777 77777 T10000 110000 T20000 120000 T27730 127730 T40000 140000 T70000 170000 T77777 177777 U00000=LCP+1 U12000=IFS13 U37772 237772 U40006 240006 X72600 572600 X74100 574100 X77777 577777 Z00000 700000 /Z50000=NSTK16+2 /Z50001=CLADI+2 Z70000 770000 /Z70001=OUT23+1 Z74700 774700 Z77700 777700 .XX 131330 /RADIX 50 OF .XX .EJECT BANK XX /HOLDS BANK BITS AINWD XX /ADDR INPUT WORD IF INT FILE AOPTW XX /ADDR OPTION WORD AXW XX /ADDR OF FILE EXT BLKADD XX /STARTING BLOCK PASS 1 CPI XX /VADDR OF CURRENT PROC INFO DOLAB XX /HOLDS VADDR(LABLOC) FOR DO S/R ELLAB XX /HOLDS LABLOC FOR FOR ELEMENT LOOPS HNR XX /HOLD NXTRQD IN ASSIGNS HNX XX /HOLD NXOP IN ASSIGNS & OPS HOLDL XX /HOLDS LOC DURING ASS.FOR 'FOR' OPTM. IBUFCT XX /INPUT BUFFER COUNT LCWORD XX /HOLDS PACKING OF LC'S FOR RLB LGFTLU XX LLL XX /HOLDS LABLOC FOR USER LABEL ADDR STATE XX /USED BY ANAL SWLA XX /HOLDS SWITCH LIST VADDE FOR DECLM TAG XX /HOLDS LOADER CODE FOR CURRENT RLB /GLOBALS:INITIALLY SET K2 -2 /THIS BLOCK OF 4 INITIALLY COPIED TO WORK AS PROC INFO ARSW 0 /ARRAY SWITCH(=O:ARRAY,-1=NOT ARRAY) CHL 0 /CURRENT HIERARCHY,LEVEL CLRSW 0 /CHECK LOCAL REF SWITCH DIM 0 /# DIMENSIONS/PARAMETERS :ALSO #OWN WORDS AT START ERRNO 0 /COUNTS # ERRORS REPORTED FADSW 0 /FETCH ADDR SWITCH(-12:FA;=0:FV) FREQD 40 /CONTROLS OPERATION OF 'UP' LCCT -3 /LOADER CODE PACKING COUNT LOC 0 /LOCATION COUNT FOR RLB JMSCT 0 /COUNT FOR IDX CHAIN NXTRQD -1 OUTSW SKP /OBEYED IF OUTSK REQD. Z40000 NOP /HERE IF OUTSK NOY REQD NOP /IN CASE SWITCHED OFF AGAIN BY ABORT PRCHN 0 /WK SK PTR FOR OUTER PROCS SIZE 0 /USED BY UP SAC 0 /CT OF SKD ADDRS FOR ASS3 STLOC 1 /STARTING ADDR OF OBJECT CODE XB MODL3 /STARTING SYNTAX BLOCK ADDR FOR ANAL STEPAS 0 /FLAG FOR V:=A IN STEP ELEMENT /LOCAL STORAGE ANAL90 XX COPYSV XX COPYSC XX COPYCT XX FSREQD XX /USED BY UP Q2 XX /) /CLASSIFICATION OF DICT INFO NXOP XX /)FIXED /NEXT OPERATOR FROM INPUT SKTHL XX /)ORDER /SKTHL WORD OF DICT INFO HOLDP XX /) /HOLDS PARAM IN OUT R/T(# ARG IN SKAD) PTRADD XX /USED BY MOVE SMF XX /USED BY UP STLIM XX /USED BY MOVE STWDAD XX /USED BY MOVE /STORAGE FOR CURRENT HIERARCHY INFO(FROM PROC INFO) NAME1 XX NAME2 XX EP XX /ENTRY PT TO PROC NPW XX /# PARAMETER WORDS DBIL XX /DISPL BLOCK INDEX LIST DNLBL XX /DISPL NON LOCAL BASE LIST /SCRATCHPAD SP00 XX SP01 XX SP02 XX SP03 XX SP04 XX SP05 XX SP06 XX /AUTO-INDEX REGISTERS USED AUTO=10 AUTO1=11 AUTO2=12 AUTO3=13 AUTO4=14 AUTO5=15 /ASSIGNMENTS ENDP=6000 ENDC=12000 ENDD=6300 ENDF=2000 MP=5600 FLK=7001 END=6600 N=100000 M=100000 NCB=NAME1 NCB1=NCB+1 IDX=ISZ INTIN=-13 INTOUT=-15 TENS=SP00 R50.1=SP04 R50.2=SP05 R50.3=SP06 GEN39=GEN37 ISZCT=JMSCT UNUSED=XX CC=200000 S=CC A=400000 AS=A+S AN=A+N CX=A DMPS=-15 DUMPS=-15 RESTS=-13 /GENERAL ROUTINE TO DRIVE SYSTEM BOOTSTRAP /FOR CORE OVERLAY OR TO WRITE TO SYSTEM DEVICE /CALLING SEQUENCE JMS OLAY / BLOCK NO +400,000 IF WRITE / CORE ADDR.-1 / 2'S COMP NEG W.C. / PROGRAM START ADDRESS ON COMPLETION /ROUTINE PUTS THIS ADDRESS INTO .SCOM+5 .IFUND DOS OLAY XX /ENTRY LAW -1 /SET AUTO INDEX 10 WITH TAD OLAY /ADDRESS OF FIRST TRAILING AND S77777 DAC* C8 /PARAMETER -1 LAC* S00100 /SET ADDR OF BOOTSTRAP DAC* C9 /-1 INTO AUTO INDEX 11 TAD C21 DAC SP01 /PUT IN JMP ADDRESS FOR TAD C2 /JMPS TO BOOTSTRAP DAC SP02 LAC* AUTO /GET BLOCK NO TAD* BLKADD DAC SP00 /STORE AND S07777 /AND OF SIGN BIT DAC* AUTO1 /PUT INTO BTSTRAP LAC* AUTO /TRANSFER CORE ADDR-1 DAC* AUTO1 LAC* AUTO /TRANSFER WORD CT DAC* AUTO1 LAC* AUTO1 /MOVE AUTO INDEX 11 LAC* AUTO1 /TO NEXT REQD LOCN IN BOOTSTRAP-1 LAC S21000 /UNIT NO INTO BOOTSTRAP DAC* AUTO1 LAC* AUTO /PUT STARTING ADDR DAC* NOWT /INTO LOCATION 0 LAC JMP.T1 /START VIA MONITOR DAC* S00105 LAC SP00 SMA /WRITE? JMP* SP01 /EXIT TO DTBEG JMP* SP02 /EXIT TO DTOUT S21000 21000 S00105 105 NOWT 0 /LOCATION 0 .IFDEF PDP15 JMP.T1 253 .ENDC .ENDC S00100 100 .EJECT /DUMP STACKS AND CONTINUE /DMP /CODE TO DUMP COMPILER DATA ONTO DATSLOT DMPS=-15 IN DUMP MODE. /ACTIVATED BY ^T (BUT ONLY WHEN DUMP OPTION REQUESTED). DMP .INIT DMPS,1,DMP+400000 LAC AOPTW /ADDR OF OPTION WD DAC* S00016 /HOLD IN AUTO 16 TAD C4 /ADDR OF STAT TABLE SPACE DAC* S00017 /HOLD IN AUTO 17 TAD C1 DAC DMPCA /SET IN .WRITE DAC DMP93 LAC* 16 /) DAC DMPFN /)SET UP FILENAME FOR LAC* 16 /)DUMP FILE DAC DMPFN+1 /) IDX DMPFN+2 /INCREMENT EXTENSION DMP01 .ENTER DMPS,DMPFN LAW -2 TAD AINBA DAC DMP92 K15 LAW -17 DAC DMP91 /CT FOR #WRITES DAC DMP90 IDX DMP90 /CT FOR #SKS DMP02 LAC* DMP92 /BASE CMA /-B-1 IDX DMP92 TAD* DMP92 /PTR-B-1(-#WDS ON SK) DAC* 17 LAC* DMP92 /PTR DAC* 17 IDX DMP92 ISZ DMP90 /END OF STAT TABLE? JMP DMP02 /NO, LOOP K28 LAW -34 DAC DMPL / .WRITE DMP04 CAL+4000 DMPS&777 11 DMPCA 0 DMPL 0 LAC* DMP93 DAC DMPL /SET LENGTH OF SK IN .WRITE IDX DMP93 LAC* DMP93 DAC DMPCA /SET UP ADDR OF SK IDX DMP93 ISZ DMP91 /LAST SK? JMP DMP04 /NO, SO WRITE OUT SK .CLOSE DMPS LAC* S00116 /LOAD PC AND LINK DAC DMP90 RAL /SET LINK FOR RETURN LAC* S00117 /SET AC FOR RETURN JMP* DMP90 DMPFN 0 0 .SIXBT !D10! DMP90 XX DMP91 XX DMP92 XX DMP93 XX .EJECT .IFUND %S3 /DUMP ROUTINE TO DUMP COMPILER DATA ONTO BULK STORAGE IN DUMP MODE / USES CONTROL DATA STORED AT ADDR GIVEN BY SCOM+2 DUMP XX .INIT DUMPS,1,DUMP IDX DUMPFN+2 /BUMP DUMP FILE EXTN LAC AOPTW /GET ADDR OF OPTION WORD DAC DUMPOW DAC* S00010 /& HOLD IN AUTO 10 LAC* 10 DAC DUMPFN /SET UP FILNAM FOR DUMP FILE LAC* 10 DAC DUMPFN+1 LAC AXW /GET ADDR OF STAT TABLE TAD C2 /TAD C2(LISTAK) DAC SP02 DAC SP04 DAC DUMPCA .ENTER DUMPS,DUMPFN /OPEN DUMP FILE / .WRITE DUMPS,4,AOPTW,4 /WRITE OPTION WORD & FILNAM CAL+4000 DUMPS&777 11 DUMPOW 0 -4 LAC K14 DAC SP01 /CT FOR # WRITES DAC SP00 ISZ SP00 /COUNT FOR # SK DUMP1 LAC SP02 / DAC SP03 /HOLD ADDR OF BASE WORD LAC* SP02 /BASE CMA /-B-1 ISZ SP02 TAD* SP02 /PTR-B-1(-#WDS ON SK) DAC* SP03 /HOLD IN BASE WORD ISZ SP02 ISZ SP00 /END OF STAT TABLE? JMP DUMP1 /NO,REPEAT LAC K26 /YES,DUMP STAT TABLE DAC DUMPL / .WRITE DUMP2 CAL+4000 DUMPS&777 11 DUMPCA 0 DUMPL 0 LAC* SP04 DAC DUMPL /SET UP LENGTH OF SK ISZ SP04 LAC* SP04 DAC DUMPCA /SET UP ADDR OF SK ISZ SP04 ISZ SP01 /END OF SK JMP DUMP2 /NO DUMP STACK .CLOSE DUMPS JMP* DUMP DUMPFN 0 0 .SIXBT !AL1! /!AL2!FOR PASS 2 .ENDC CSIZE=.-START+1 PCH .BLOCK 7000-CSIZE /CREATE PATCHING AREA /TO FILL UP TO 7000 WORDS OF CORE .END P3CON