.TITLE PDP9-15 ALGOL COMPILER 9 MAR 72 EDIT 308 /EDIT 002 REMOVED BUG IN INTEGER DIVISION WITH COMPLEX DIVISOR /EDIT 003 ALLOWS .ABS VERSION 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. /PROGRAM STARTS AT FIRST LOCATION /IF %SY DEFINED AN ABSOLUTE VERSION IS PRODUCED FOR SYSTEM INSERTION /USING PATCH .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 / / / .IFDEF %S1 .LOC %S1 .ENDC / / / /P1C10 /CODE TO DEAL WITH PRE-SET PROCEDURES(NORMALLY OVERWRITTEN /BY STACKS) JMP START P1C10 LAC APSP /)SET XB FOR ENTRY TO DAC XB /)ANAL JMS P1C71 /INIT STAT TABLE JMS BLKSET LAC BSS-1 /)DISALLOW 'DATSLOT' DAC BSS-5 /)DIRECTIVE JMS GNC00 /GET FIRST CHAR JMS GNBS56 /GET FIRST USEFUL CHAR JMS GNBS /GET FIRST BS JMS GNEL /GET FIRST ELEMENT JMS OBEY /STACK LINK(.+2) JMP ANAL+4 /PROCESS PRE-SET PROC FILE LAC STATE /RETURN TO HERE SAD C1 /STATE=TRUE? JMP P1C20 /YES:O.K. LAW -132 /REPORT ERROR 90 JMS ERR JMP P1C2-3 P1C20 LAC C2 /)SET FREQD FOR CALL OF DAC FREQD /)ROUTINE UP JMS UP /PACK STACKS UP TIGHT LAC POLISH JMS TCA TAD AP1C10 SPA /PRE-SET PROC STACKS TOO LONG? JMP P1C2 /NO:OK. LAW -36 /REPORT ERROR 30 JMP P1C20-2 AP1C10 P1C10+1377 .EJECT /SYNTAX BLOCKS FOR PRE-SET PROCEDURES(OVERWRITTEN BY STACKS) 0 /EXIT FAIL PSP1 CC+BEGEL /*BEGEL?* AN PSP11 DZM XSTAT1-1 /ALLOW ONLY EXTERNAL PROC BODIES N PSP31 PSP11 CC+FPEL /*FPEL?* AN PSP21 JMP PH2 /DO PHASE 2 ON FPEL 0 /EXIT FAIL PSP21 JMP PDEC /*PROCESS PROC DECN* N PSP41 0 /EXIT FAIL PSP31 CC+ENDEL /*ENDEL?* N PSP51 N PSP31 PSP41 CC+SCEL /*SCEL?* N PSP11 LAW -136 /ERROR 94 AS /EXIT TRUE PSP51 40000 /*MASK XHEL* S /EXIT OK APSP PSP1 .EJECT /P1C30 /READS DATSLOT DIRECTIVE AND OUTPUTS "MAIN PROGRAM" /OP FOLLOWED BY DATSLOTS USED /DATSLOT 0=NO DATSLOTS USED /DATSLOT 8=DATSLOT 10(OCT)(10 NOT ALLOWED IN SOURCE) /DATSLOT 9=ALL DATSLOTS USED /CODE OVERWRITTEN BY STACKS P1C30 LAC U05600 JMS PUTOUT /OUTPUT MP OP JMS GNBS60 /GET NEXT MEANINGFUL CHAR AND S03000 SAD S03000 /DIGIT? JMP P1C36 /YES JMP P1C33 /NO P1C31 SAD U00057 /COMMA? JMP P1C30+2 /YES P1C32 SAD U60056 /NO:SEMI-COLON? JMP P1C39 /YES P1C33 LAW -40+Z /NO:REPORT ERROR 32 JMS ERR LAC K1 DAC ELANAL /SET ELANAL=FALSE P1C34 JMS GNBS /GET NEXT BASIC SYMBOL LAC AMODL1 /SET XB FOR MAIN PROG MODULE JMP SETXB P1C36 ISZ NUMDAT /COUNT DIGITS READ LAC BSW TAD C3 AND S00017 /AC:=OCTAL DIGIT SNA /ZERO? JMP P1C38 /YES SAD C9 /NINE? JMP P1C37-2 /YES JMS PUTOUT /OUTPUT DIGIT JMS GNBS60 /GET NEXT MEANINGFUL CHAR JMP P1C31 LAW -1 / DAC DCT P1C37 LAC W00000 JMS PUTOUT /OUTPUT "IODEV ALL" P1C38 LAC NUMDAT SAD C1 /ONLY ONE DIGIT READ? SKP /YES:OK JMP P1C33 /NO JMS GNBS60 /GET NEXT MEANINGFUL CHAR JMP P1C32 P1C39 DZM BSW /CLEAR BSW FOR GNBS CALL JMP P1C34 S03000 3000 U05600 205600 AMODL1 MODL1 NUMDAT 0 .EJECT /INITIALISE STATISTICS TABLE(OVERWRITTEN BY STACKS) P1C71 XX LAC AAINBA DAC* C8 /AUTO:=STATISTICS TABLE-1 LAC AGLOBL DAC STPTR /STPTR:=ADDR OF LAST FREE REG. LAC AASTIN DAC* C9 P1C72 LAC* AUTO1 SNA /END OF INIT TABLE? JMP P1C80 /YES DAC SP00 /SP00:=1ST ENTRY IN TABLE AND Z70000 /RETAIN STACK INDICATOR XOR S07777 /MAKE LS. 12 BITS 7777 DAC* STPTR /DUMP 1ST ENTRY INTO STACK LAC STPTR /GET ADDR OF BASE OF STACK DAC* AUTO /DUMP IN STACK BASE REG. LAC SP00 AND S07777 /GET COUNT (-VE) OF ENTRIES XOR Z70000 /IN STACK DAC SP01 /DUMP P1C73 ISZ SP01 /MORE ENTRIES FOR THIS STACK? JMP P1C74 /YES LAC STPTR /ADDR OF LAST ENTRY IN STACK DAC* AUTO /DUMP IN STACK PTR TAD K1 /) DAC STPTR /)MOVE SK PTR BACK 1 WORD JMP P1C72 /REP. TO END OF INIT. TABLE /SET UP INITIAL CONTENTS OF SK P1C74 LAC STPTR /)MOVE SK PTR TAD K1 /)BACK 1 WORD DAC STPTR LAC* AUTO1 /GET SK CONTENTS DAC* STPTR /DUMP IN SK JMP P1C73 /INITIALISE OUT SK FOR PRESET PROC MODE P1C80 LAC AP1C30 DAC OUBASE TAD C1 /ZERO CAN BE PUT ON OUTSK DAC OUT DZM SIZE JMP* P1C71 AP1C30 P1C30 .EJECT /STINIT STACK INITIALISATION TABLE (OVERWRITTEN BY STACKS) STINIT 027772 /INTEGR 0 /FALSE -1 /TRUE 1 16 /FOR AUTO-INDEXING IN OBJ.CODE 2 /FOR OPTIMISATION IN OBJ.CODE 017777 /REAL 047777 /STRING 147777 /OWN 107777 /SWITCH 057777 /LABEL 077777 /PROC 007777 /VOCAB 137777 /WORK 117777 /REVPOL 067777 /DICT 127777 /POLISH 0 /EOT .EJECT /GNC00 /INITIAL ENTRY POINT TO ROUTINE GNC(EXECUTED ONCE /ONLY,THEN OVERWRITTEN BY STACKS) GNC00 XX LAC GNC00 DAC GNC .IFUND %SY .IODEV -11,-12,-13,-15 .ENDC .INIT DATIN,IN,P1C4+5 LAC LIST SNA /LISTING REQD? JMP GNC02 /NO .INIT DATOUT,1,P1C4+5 LDSZP LAC S02766 /)CHANGE DATSLOT FOR ERRORS DAC ERR08+4 /) IN .WRITE'S DAC HDBUFF-6 /) LAC S00766 /)CHANGE DATSLOT FOR ERRORS DAC ERR08+10 /)IN .WAIT GNC02 .SEEK DATIN,GNC /ADDR OF FILENAME SET BY RCOMST LAC LIST SNA /LISTING REQD? JMP GNC021-3 /NO LAC GNC14 DAC* AXW /SET EXTENSION TO LST .ENTER DATOUT,GNC14 /ADDR OF FILENAME SET BY RCOMST LAC GNC18 DAC* AXW /SET EXTENSION TO A01 JMS GNC60 /READ IN FIRST BUFFER GNC021 JMP GNC01 .EJECT /RCOMST /ROUTINE TO READ THE COMMAND STRING AND SET UP THE OPTION WORD /(THE LOWEST FREE REGISTER OF CORE). /OVERWRITTEN BY STACKS .IFUND %SY .IODEV -3,-2 .ENDC RCOMST LAC WORK /PRESERVE WORK SK PTR DAC SP06 EMPTY1 LAC SP06 /RESTART PT FOR ^P OR ERRORS DAC WORK .INIT -3,1,EMPTY1 .BOS ...A .WRITE -3,2,ANNOUC,8 ...A .INIT -2,0,EMPTY1 .BOS ...B .WRITE -3,2,OPTION,4 ...B .READ -2,2,GNC73,34 .WAIT -2 LAC GNC06 TAD C4 DAC GNC08 LAC GNC70 DAC GNC75 ISZ GNC75 DZM LIST DZM XDICT DZM ERRMOD DZM PRESET DZM ALTMOD LAC* S00102 DAC FILE DAC AOPTW /ADDRESS OF OPTION WORD DAC* S00010 DZM* 10 DZM* 10 /CLEAR FILENAME AND EXTENSION DZM* 10 LAC* S00010 DAC AXW DZM* 10 LAC* S00010 DAC SYMB ISZ FILE /FILENAME WORD LAW -3 DAC* AOPTW DAC PACKCT /COUNT FOR PACKING 6 BIT DZM FNCC DZM CT1 JMS BSCON LAC ACSTR DAC XB JMS OBEY /STACK LINK (.+2) JMP ANAL+4 /PROCESS COMMAND STRING(RETURN TO .+1) LAC AOPTW TAD C1 DAC GNC021-4 /INIT .ENTER FOR LISTING DEVICE DAC UP15+6 /INIT .ENTER FOR INT OUTPUT DAC GNC02+2 /INIT .SEEK FOR SOURCE FILE JMS TLPTRS /SET CCODE AND GTNEXT FOR TOP LEVEL .IFUND %B0 JMS REST /LOAD PRESET STACKS .ENDC JMS INIT /RESET OUT AND OUBASE AND SET UP BLKADD LAC PRESET SZA /PRESET PROC OPTION SET? JMP P1C10 /YES JMS BLKSET /GET STARTING BLOCK # FOR PASS1 JMS GNC00 /GET FIRST CHAR JMS GNBS56 /GET FIRST USEFUL CHAR JMS GNBS /GET FIRST BASIC SYMBOL SAD U00076 /'DATSLOT'? JMP P1C30 /YES LAC AMOD21 /)NO SO SET XB FOR ENTRY TO SETXB DAC XB /)PROC MODULE ANALYSIS JMP P1CON AMOD21 MODL21 .EJECT /SYNTAX BLOCKS INTERPRETED BY ANAL WHEN PROCESSING THE COMMAND STRING JMP POPT /SET BIT IN OPTION WORD AN CSTR /YES CSTR JMP OPTN /OPTION CHAR? N CSTR4 /NO,CHECK FOR _ N CSTR13 /CHECK FOR CR OR ALTM CSTR4 CC+26 /_? N CSTR5 /YES,CHECK FOR FILENAME CHAR N CSTR10 /NO,CHECK FOR .,%,OR # CSTR5 1000 /LETTER OR DIGIT? AN CSTR5 /YES JMP PFN /PACK FILENAME CHAR N CSTR8 CSTR6 CC+20056 /;? AN CSTR7 /YES,CHECK FOR EXT CHAR JMP TFNS /TEST NO. OF FILENAME CHARS N CSTR11 /NO,CHECK IF .,% OR # CSTR7 1000 /EXT CHAR=LETTER OR DIGIT? AN CSTR7 /YES JMP PFN /PACK EXT CHAR N CSTR9 /NO CSTR8 CC+72 /SPACE? AN CSTR7 /YES,CHECK FOR EXT CHAR JMP TFNS /TEST NO. OF FILENAME CHARS N CSTR5 CSTR9 JMP CRALT /TEST FOR CR OR ALTM A /YES JMP NOEXT /CHECK NO OF FILENAME CHARS N CSTR6 /NO,CHECK FOR; CSTR10 4000 /.,%, OR #/? AN CSTR5 /YES JMP PFN /PACK FILENAME CHAR N CSTR12 CSTR11 4000 /.,% OR #? AN CSTR7 /YES JMP PFN /PACK EXT CHAR N CSTR7 CSTR12 JMP CRALT A JMP TXS N CSTR CSTR13 JMP CRALT A /EXIT THROUGH STRERR JMP STRERR .EJECT CRALT LAC BSW XOR U00000 SAD S00015 /CARRIAGE RETURN? JMP CARR02 /YES SAD S00175 /ALTMODE? JMP .+3 /YES DZM NXTRQD JMP FALSE /NO ISZ ALTMOD CARR LAC* AOPTW XOR S01000 /RET TO MONITOR BIT CLEARED DAC* AOPTW /WORD CARR02 .INIT -3,1,P1C4+10 JMS TOPT 40000 ISZ XDICT JMS TOPT 20000 /LISTING REQUIRED? ISZ LIST /YES JMS TOPT /NO 4000 /PRESET PROCEDURES REQUIRED? ISZ PRESET /YES JMS TOPT /NO 10000 /ERROR MODULE REQUIRED? ISZ ERRMOD /YES JMS TOPT 100 SKP /DUMP OPTION SET JMP TRUE / .INIT -3,1,DMP /FOR ^T CAL+1000 -3&777 1 A+DMP 0 JMP TRUE OPTN LAC BSW SAD LLET-1 /K OPTION? JMP FALSE AND U00000 SNA /OPTION CHAR? JMP FALSE /YES JMP TRUE /NO .EJECT BSCON XX BSCON2 JMS UNP5.7 /UNPACK 5/7 ASCII DAC BSW /HOLD 7 BIT CHAR SAD S00015 /CR? JMP BSCON6 SAD S00175 /ALTM? JMP BSCON6 TAD K32 SPA JMP BSCON2 TAD K64 SMA JMP BSCON2 TAD S00140 TAD ABSS /NO,ADD ADDRESS OF BSTABLE DAC BSW /ADDRESS OF BASIC SYMBOL LAC* BSW /BASIC SYMBOL DAC BSW JMP* BSCON /NO,EXIT BSCON6 XOR U00000 JMP .-3 POPT LAC BSW AND Z76300 AND* AOPTW SNA /OPTION BIT ALREADY CLEARED JMP POPT2 /YES,EXIT XOR* AOPTW /NO,CLEAR OPTION BIT DAC* AOPTW POPT2 DZM NXTRQD /SET MARK TO GET NEXT CHAR JMP ANAL04 .EJECT PFN LAC BSW DZM NXTRQD JMS FILNAM /PACK CHAR INTO FILENAME ISZ PACKCT /3 CHARS PACKED? JMP ANAL04 /NO ISZ FILE /YES,SET TO NEXT WORD LAW -3 DAC PACKCT /RESET COUNT JMP ANAL04 /RETURN .EJECT TFNS LAW -6 TAD FNCC SMA!SZA /FNCC>6? JMP STRERR /YES SNA /NO,FNCC=6? JMP TFNS2 /YES TFNS1 CLA JMS FILNAM /PACK FILENAME WITH SPACES ISZ PACKCT /3 CHARS PACKED? JMP TFNS1 /NO LAW -3 /YES,RESET COUNT DAC PACKCT ISZ FILE /SET TO NEXT FILENAME WORD JMP TFNS /JUMP BACK TFNS2 JMS PACKFN LAW -3 DAC PACKCT DZM FNCC JMP ANAL04 TXS LAC FNCC /EXT CHAR COUNT SNA /COUNT=0? JMP TXS2 /YES TAD K3 SMA!SZA /COUNT>3? JMP STRERR /YES,REPORT ERROR SNA /COUNT=3? JMP TXS4 /YES,EXIT TXS1 CLA JMS FILNAM /PACK WITH SPACES ISZ PACKCT /3 CHARS PACKED? JMP TXS1 /NO,LOOP ISZ FILE DAC* FILE JMP ANAL04 TXS2 JMS SRCEXT JMP ANAL04 TXS4 LAC* AXW JMP TXS2-2 SRCEXT XX LAC SRC DAC* AXW DAC* SYMB JMP* SRCEXT NOEXT JMS SRCEXT JMP TFNS .EJECT FILNAM XX AND S00077 TAD K29 SPA /DIGIT OR #? JMP FILNA6 /NO TAD S00060 /YES, SO CONVERT DIGITS TO ASCII SAD S00072 /#? TAD K23 /YES, SO CONVERT TO ASCII FILNA2 DAC BSW LAC* FILE RTL RTL RTL AND Z77700 TAD BSW DAC* FILE ISZ FNCC JMP* FILNAM FILNA6 TAD C2 SPA /. OR %? TAD K18 /NO,LETTER SZA /%? TAD C8 /NO,. TAD S00045 JMP FILNA2 .EJECT /PACKFN-PACK FILENAME FROM COMMAND STRING FROM /6 BIT INTO 5/7 ASCII / PACKFN XX LAC S60000 JMS PAK5.7 /PACK FORM FEED LAC* S00102 DAC TEMP /ADDRESS OF FILENAME WORD ISZ TEMP PACK02 LAC* TEMP DAC TEMP1 /1ST WORD OF FILENAME PACK04 JMS CHARAC LAC CT1 SAD C4 /5 CHARS PACKED 5/7? JMP PACK03 /YES ISZ PACKCT /NO,3 CHARS UNPACKED FROM TEMP1? JMP PACK04 /NO,LOOP ISZ TEMP /YES,SET TO NEXT WORD OF FILENAME LAW -3 DAC PACKCT /RESET UNPACKING COUNT TO -3 JMP PACK02 /LOOP PACK03 LAC TEMPFN+1 /PACK FILENM RCL /)AND FILENM+1 WITH DAC FILENM+1 /5*7 BIT ASCII CHARS LAC TEMPFN+2 RAL DAC FILENM DZM TEMPFN+1 /PAIR TO 0 ISZ PACKCT PACK06 JMS CHARAC ISZ PACKCT /REMAINING 2 CHARS PACKED? JMP PACK06 /NO,LOOP LAC TEMPFN+1 CLL RTL RTL DAC FILENM+2 JMP* PACKFN /EXIT .EJECT /CHARAC /ROUTINE TO CONVERT 6-BIT TO 5/7 ASCII CHARAC XX LAC TEMP1 AND Z70000 /GET TOP 6 BITS SNA JMP CHAR01 /YES CLL!RAR TAD U00000 /CONVERT FROM 6 BIT XOR Y00000 /TO 7 BIT CHAR01 JMS PAK5.7 ISZ CT1 /INCREMENT CHAR COUNT LAC TEMP1 JMS MES /SHIFT NEXT CHAR OF JMP L-6 /FILENAME TO TOP 6 BITS DAC TEMP1 JMP* CHARAC /EXIT /PAK5.7 /ROUTINE TO PACK 5/7 ASCII PAK5.7 XX DAC TEMPFN LAW -7 DAC TEMP2 /COUNT FOR 7 BIT PACK PAK01 LAC TEMPFN RAL DAC TEMPFN LAC TEMPFN+1 RAL DAC TEMPFN+1 LAC TEMPFN+2 RAL DAC TEMPFN+2 ISZ TEMP2 /7 BITS PACKED? JMP PAK01 /NO,LOOP JMP* PAK5.7 /YES,EXIT .EJECT STRERR .BOS ...C STRERM .WRITE -3,2,ERRMES,2 .WAIT -3 JMP EMPTY1 ERRMES 4/2*1000 0 .ASCII /?/<175> .EJECT ANNOUC 10/2*1000 0 .ASCII /ALGOL V1A/<15> OPTION 4/2*1000 0 .ASCII />/<175> FILE 0 PACKCT 0 FNCC 0 SYMB 0 CT1 0 ACSTR CSTR SRC 232203 S00045 45 S00072 72 S25500 25500 Z76300 776300 .EJECT /BANK-BIT INITIALISATION SECTION (OVERWRITTEN) START JMS . LAC START AND S60000 /AC:=BANK BITS DAC BANK TAD TSTRT /SET UP A-I 10 TO START OF AND S77777 DAC* C8 /INITN TABLE NXTADR LAC* AUTO /GET ADDR FROM TABLE XOR BANK /BANK BIT INITIALISE IT DAC SP00 LAC* SP00 /LOAD 15-BIT PROG ADDR AND Z17777 /DISCARD OLD BANK BITS XOR BANK /INSERT NEW BANK BITS DAC* SP00 /PUT BACK IN CODE ISZ BCNT /FINISHED? JMP NXTADR /NO LAW -2 /SET TABLE COUNT DAC BCNT LAC AVTOA DAC* C8 DAC* C9 NXTENT LAC* AUTO /)INTIALISE TABLE OF RAL SPA!RAR /15-BIT ADDRESS? JMP .+3 /NO,SO IGNORE AND Z17777 /)CONSECUTIVE 15-BIT ADDRESSES XOR BANK DAC* AUTO1 NXTCNT ISZ BCNT1 /FINISHED THIS TABLE? JMP NXTENT /NO ISZ BCNT /FINISHED? SKP /NO,GO DO STATISTICS TABLE JMP RCOMST /YES, GO TO READ COMMAND STRING /NOW BANK INITIALISE STATISTICS TABLE ISZ NXTCNT /PICK UP SIZE OF STATISTICS TABLE LAC AAINBA /START OF TABLE JMP NXTENT-2 /GO INIT TABLE .EJECT /BANK BIT INITIALISATION TABLE TSTRT A . A AP1C10 A APSP A AMODL1 A AP1C30 A GNC00+5 A GNC02-7 A EMPTY1+4 .IFUND DOS A EMPTY1+10 A EMPTY1+14 A EMPTY1+20 A EMPTY1+24 .ENDC .IFDEF DOS A ...A-2 A ...A+2 A ...B-2 A ...B+2 .ENDC A AMOD21 A CARR02+2 A OPTN-3 .IFUND DOS A STRERR+2 .ENDC .IFDEF DOS A STRERR+5 .ENDC A ACSTR A AVTOA A GLOBL A GLOBL+1 A WORK A P1C1+1 A P1C1+2 .IFNZR %C1-6 A P1C6-3 .ENDC .IFUND DOS A P1C6-1 .ENDC .IFDEF %S4 A P1C6+3 .IFUND DOS A P1C6+5 .ENDC .ENDC .IFDEF %S2 A P1C9-3 .IFUND DOS A P1C9-1 .ENDC .ENDC .IFDEF %B0 .IFDEF DOS A P1C9DA A P1C9DA+2 A P1C9DA+4 .ENDC .IFUND DOS A P1C9+2 A P1C9+4 .ENDC .ENDC .ENDC A PUTW+2 A PUTRP+2 A PUTPOL+2 A PUTOUT+2 A VAB+1 A CVRS+4 A GSTR14-2 A GSTR14-1 A GSTR14+3 A GSTR14+5 A GSTR14+7 A GSTR14+11 A ENDSP+4 A ENDSP5-1 A ENDSP5+3 A ENDSP5+11 A USEV-20 A USEV-15 A DEC00 A UPNPTR+3 A CNA+5 A CNA+6 A CDL01+13 A CDL02-5 A CDL02-4 A CDL05+1 A CDL05+2 A CDL05+5 A CDL07+5 A CDL08+1 A FDA+2 A ODL+2 A ODL+5 A ODL+6 A PH2ERR-4 A PH2ERR-3 A PRP+2 A PD+2 A PD+5 A PD+10 A OPOUT-5 A OPOUT-4 A SWD+6 A SWD+11 A SWD+13 A OTOWN+6 A OTOWN1-6 A OTOWN1-2 A OTOWN1-1 A OTOWN1+2 A OTOWN1+4 A DIPOL2-3 A OTSOWN+2 A OTSOWN+4 A CAFC2+1 A CAFC14+1 A CDVW1-2 A CDVW4-2 A CDVW4+5 A CDVW6+7 A FNPK10-11 A FNPK10-2 A CAP04-1 A CAP04+1 A CPN2-5 A GNBS+5 A GNBS+6 A NSTK13+1 A NSTK16-1 A NSTK16+2 A NSTK16+5 A ISTK10-3 A ISTK10+2 A RSTK7+1 A RSTK8+2 A RSTK8+5 A RSTK8+10 A GNC20+2 A GNC20+3 A GNC20+13 A GNC20+14 A GNC70 A GNC71 A HDBUFF-4 A ERR06-10 A ERR06-7 A ERR06-3 A ERR06-2 A ERR07+1 A ERR07+2 A ERR10-5 A ERR24-6 A ERR24-3 A ERR24+1 A ERR24+4 A ERR30-2 A ERR30-1 A ERR32+1 A PACKEL+2 A PACKEL+3 A PACK-3 A PACK-2 A LDA0+2 A LDA1+2 A LDA2+2 A LDA3+2 A LV4+2 A DDA2+2 A SCV+1 A POLOUT+2 A TCA-4 A TCA-3 A EOP2+2 A CSTAT2-1 A CCODE A DEST A CHRLY+6 A GTNEXT /) A GTNEXT /)FOR PATCHING A GTNEXT /)INITIALISATION A GTNEXT /)TABLE A DMP02-10 .IFUND DOS A TP2 A TP4 .ENDC TEND=.-1 BCNT TSTRT-TEND BCNT1 VTOA02+1-TQ BCNT2 INBASE-OUBASE AVTOA VTOA02 Z17777 717777 .BLOCK %V1-%K1-Z17777+%S1 .EJECT /STATISTICS TABLE GLOBL SP06 /)DELIMIT GLOBAL LOCNS AOPTW /)FOR DUMP OPTION 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 GLOBL RPBASE XX REVPOL XX DIBASE XX DICT XX POBASE XX POLISH XX OUT XX OUBASE XX .EJECT /P1CON PASS 1 CONTROL P1C1 JMS COPY /)RETURN TO HEREAFTER COMPILING SOURCE OTCD /)ANDPUT OTCD,MAXOTD, M*1+WORK /)MAXL AND SIZE 4 /)ON WORK SK CLA JMS PUTOUT /)OUTPUT FINAL 2 DUMMY JMS PUTOUT /)WDS FOR PHASE 3 OR ERROR MODULE LAC SIZE /INSERT CORRECT SIZE FOR DAC* WORK /PASS2 OR ERROR MODULE P1C2 .CLOSE DATIN LAC LIST SNA /LISTING REQD? JMP .+7 /NO LAC LDSZP-1 /IGNORE "EOP1" IF SAD C34 /LISTING TO TTY SKP JMS EOP /OUTPUT "EOP1" .CLOSE DATOUT LAC S02775 DAC EOP2 LAC EMODE SNA /ERRORS IN PASS1? JMP P1C8 /NO LAC ERRMOD SZA /ERROR MODULE REQD? JMP P1C6 /YES P1C4 JMS EOP /OUTPUT EOP1(N) .WAIT -3 LAC ALTMOD SNA /ALT MODE? JMP .+3 /NO, CR ...C .EXIT .IFDEF %S1 .IFUND DOS JMS OLAY /OVERLAY WITH PASS1 %B1 %C1-1 -%L1 %S1 .ENDC .OVLAY ALGOL@ .ENDC .IFUND %S1 XX .ENDC P1C6 JMS CSTAT /COPY STAT TABLE TO BOTTOM OF CORE,ETC .IFDEF %S4 .IFUND DOS JMS OLAY /OVERLAY WITH ERROR MODULE %B4 %C4-1 -%L4 %S4 .ENDC .OVLAY ALCP4@ .ENDC .IFUND %S4 JMS DUMP JMP P1C4+3 .ENDC P1C8 LAC PRESET SZA /PRESET PROC OPTION SET? JMP P1C9 /YES JMS CSTAT /COPY STAT TAB TO BOTTOM OF CORE,ETC .IFDEF %S2 .IFUND DOS JMS OLAY /OVERLAY WITH PASS 2 %B2 %C2-1 -%L2 %S2 .ENDC .OVLAY ALCP2@ .ENDC .IFUND %S2 JMS DUMP JMP P1C4+3 .ENDC .IFDEF %B0 .IFUND DOS P1C9 JMS OLAY /WRITE BACK PRESET PROCS .ENDC .IFDEF DOS P1C9 LAC* BLKADD /COMPUT ABSOLUTE BLOCK # TAD A%B0 /TO WRITE OUT PRESET INFO DAC* P1C9DA /TO COMPILER ON SYSTEM DEVICE LAC P1C9DA STL /SET LINK FOR BOOTSTRAP WRITE JMP* S00155 /EXIT VIA SCOM TABLE P1C9DA .+1 %B0 .ENDC .IFUND DOS A+%B0 .ENDC %C0-1 -%L0 P1C4+3 .IFDEF DOS A%B0 %B0 .ENDC .IFUND %B0 P1C9 JMP P1C6 .ENDC .EJECT /GNEL:ROUTINE TO ANALYSE THE SOURCE CODE AND ATTEMPT TO FIT IT TO THE / FORMAT OF A SYNTAX ELEMENT. IF THE ATTEMPT SUCCEEDS A TRANSFORM- / ATION OF THE SOURCE IS PRODUCED ON THE REVPOL STACK IN REVERSE / POLISH NOTATION. GNEL XX LAC LCT3 /REMEMBER START OF CURRENT EL DAC LCT5 LAC CHPOS3 DAC CHPOS5 DZM EXTMRK LAC ELANAL SAD K1 /ELANAL=TRUE(+1)? JMP GNEL18 /NO, SO REPOSITION ON NEXT VALID RESTART LAC BS /SYMBOL AND S60000 /MASK "E" AND "S" BITS IN BS SAD S20000 /BS=CODE FOR NORMAL ELEMENT STARTER? JMP GNEL12 /YES SAD S60000 /BS=CODE FOR A SHORT ELEMENT STARTER? JMP GNEL4 /YES CLC /BS DOES NOT HOLD AN EL STARTER: AC=-1 DAC ELANAL /ELANAL:=FALSE(-1) LAC BS SAD SEXH /SOURCE EXHAUSTED? JMP GNEL2 /YES SNA /INVALID KEYWORD? JMP .+3 /YES LAW -10 /REPORT ERROR 8 JMS ERR LAC LCT6 /) DAC LCT4 /)CORRECT POSN OF END LAC CHPOS6 /)OF CURRENT ELEMENT DAC CHPOS4 /) LAC U00150 /LOAD INVEL CODE SKP GNEL2 LAC U40160 /LOAD XHEL CODE GNEL3 DAC CEL /STORE IN CEL INVEL, XHEL, ENDEL, ELSEL, BEGEL OR JMP* GNEL /SCEL, AND EXIT FROM GNEL GNEL4 LAC BS SAD U60061 /BS='END'? JMP GNEL32 /YES SAD U60062 /BS='ELSE'? JMP GNEL8 /YES SAD U60060 /BS='BEGIN'? JMP GNEL5 /YES LAC U00110 /LOAD "SEMI-COLON ELEMENT" CODE SKP GNEL5 LAC U20120 /LOAD "'BEGIN' EL" CODE DAC CEL /CODE TO READ COMMENTS (IF ANY) AFTER ; OR 'BEGIN' GNEL6 DZM BSW /CLEAR BSW WHEN ; FOUND (IRRELEVANT FIRST TIME) JMS GNBS /GET NEXT INT. CODE IN BS AND AC SAD U00065 /'COMMENT'? SKP /YES JMP* GNEL /EXIT FROM GNEL GNEL7 JMS GNBS60 /GET NEXT CHAR CODE IN BSW AND AC SAD U60056 /;? JMP GNEL6 /YES SAD U00070 /SOURCE EXHAUSTED? SKP /YES JMP GNEL7 DAC BS /BS:=BSW JMP* GNEL /EXIT FROM GNEL /END OF CODE TO READ COMMENTS GNEL8 JMS GNBS /GET NEXT BASIC SYMBOL IN BS LAC U00140 /LOAD "'ELSE' EL" CODE JMP GNEL3 /THIS SECTION PROCESSES ANY ELEMENT STARTING WITH 'REAL','INTEGER', /'BOOLEAN','GOTO','IF','FOR','VALUE','ARRAY','SWITCH','PROCEDURE', /'LABEL','STRING','OWN','EXTERNAL' OR AN IDENTIFIER. GNEL12 DZM CTA /INITIALISE COUNTS DZM CTB DZM CTN DZM CTI LAC APUTR /SWITCH OUTPUT OF ROUTINES EXIT AND OUTOP DAC DEST /TO REVPOL STACK LAC ABS /SET UP PARAMETERS CCODE AND GTNEXT FOR ENTRY TO DAC CCODE /ANAL LAC AGNBS DAC GTNEXT LAC XB JMS OBEY /PUT XB AND LINK(.+2) ON WORK STACK JMP GNEL14 DAC XB /RESET XB LAC APUTO /SWITCH OUTPUT OF ROUTINES EXIT AND DAC DEST /OUTOP BACK TO OUT STACK LAC STATE DAC ELANAL /SET ELANAL ACCORDING TO STATE JMS TLPTRS /SET CCODE AND GTNEXT FOR TOP LEVEL LAC RESULT XOR U00000 JMP GNEL3 /SET CEL ACCORDING TO RESULT GNEL14 LAC BS AND S00077 /)PERFORM TABLE LOOK-UP TO GET TAD AELTAB /)ADDR OF APPROP SYNTAX BLOCK DAC XB /SET ADDR IN XB FOR ENTRY TO ANAL LAC BS SAD U20055 /'EXTERNAL'? ISZ EXTMRK /YES,SO SET EXT MARKER FOR GNBS SAD U20037 /BS=IDENTIFIER ? JMP ANAL /YES JMS OUTOP7 /)PUT REVPOL OP JMS PUTW /)ON WORK STACK JMS GNBS /GET NEXT BASIC SYMBOL IN BS JMP ANAL /THIS SECTION REPOSITIONS ON THE SOURCE WHEN GNEL IS ENTERED WITH /ELANAL=FALSE(-1) GNEL18 LAC C1 DAC ELANAL /SET ELANAL=TRUE(+1) LAC BS JMP GNEL20+1 GNEL19 LAC BSW SNA /BASIC SYMBOL WAITING? JMS GNBS60 /NO,SO GET NEXT CHAR SAD U60056 /;? JMP GNEL20 /YES SAD U00074 /KEYWORD QUOTE? JMP GNEL20 /YES SAD SEXH /SOURCE EXHAUSTED? SKP /YES JMP GNEL19+2 /NO,SO GO TO GET NEXT CHAR GNEL20 JMS GNBS /GET NEXT BASIC SYMBOL IN BS AND AC SAD SEXH /SOURCE EXHAUSTED? JMP GNEL2 AND S20000 /MASK "E" BIT IN BS SNA /BS=ELEMENT STARTER? JMP GNEL19 /NO LAC BS SAD U20037 /BS=IDENTIFIER? JMP GNEL19 /YES SAD U20044 /BS='IF'? JMP GNEL19 /YES SAD U60062 /BS='ELSE'? JMP GNEL19 /YES LAW -1 JMS ERR /REPORT ERROR 1 JMP GNEL+1 /RETURN TO UPDATE L+CH COUNTS /THIS SECTION READS ANY COMMENT AFTER 'END' GNEL30 LAC BSW SNA /SKIP IF BSW NOT CLEAR GNEL32 JMS GNBS60 /GET NEXT CHAR CODE IN AC AND BSW SAD U00074 /BSW='? JMP GNEL36 /YES SAD U60056 /;? JMP GNEL34 /YES SAD U00070 /SOURCE EXHAUSTED? JMP GNEL34 /YES JMP GNEL32 /NO GNEL34 JMS GNBS /CALL GNBS TO UPDATE L+CH COUNTS JMP GNEL38 GNEL36 JMS GNBS /GET KEYWORD CODE IN AC AND BS SAD U60061 /'END'? JMP GNEL38 /YES SAD U60062 /'ELSE'? JMP GNEL38 /YES LAW -60 /REPORT ERROR 48 JMS ERR GNEL38 LAC U00130 /LOAD ENDEL CODE JMP GNEL3 .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* CCODE /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 /RETURN WITH C(XB)+STATE IN AC TO ANAL03+2 ANAL01 AND* CCODE /MASK CURRENT CODE WITH CATOM SNA!STL /MASK BIT(S) 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) LAC* XB /AC:=NEXT(STATE) SMA /ACTION REQD ? JMP ANAL04 /NO LAC XB TAD STATE DAC ANAL90 /ANAL90:=ADDR OF ACTION WD XCT* ANAL90 /EXECUTE ACTION:JMP RETURNS TO ANAL04 LAC* ANAL90 SPA!RAL /ACTION WD WAS LAW OR ISZ INSTN? SMA!RAR /YES:SKIP AGAIN IF LAW SKP /ACTION WAS NOT TO REPORT ERROR XCT ERRORT /REPORT ERROR(-ERROR NO. IN AC) 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* GTNEXT /GET NEXT INPUT (IN BS OR CEL) 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 LAC* XB AND S77777 DAC RESULT /SET RESULT=NEXT(15 BITS) 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 CHOUT /YES,SO CHECK IF DATA WD -> OUT 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 PUT03 LAC SP00 /EXIT WITH AC PRESERVED ISZ PUT /BUMP LINK 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 /CHOUT /CALLED FROM ROUTINE PUT TO CHECK OUTPUT TO OUT STACK CHOUT LAC DCT /LOAD DATA COUNT SZA /DATA WD TO BE OUTPUT? JMP OUTPT2 /YES,SO GO TO OUTPUT OR IGNORE IT LAC SP00 /LOAD DATA WD SNA /ZERO(ONLY AT END OF COMPILATION)? JMP PUT04 /YES, SO OUTPUT IT SMA!RTL /DICT INFO, ERR MESS OR L+CH CTS? JMP CHOUT5 /NO SZL /DICT INFO? JMP CHOUT1 /YES SPA /ERROR MESSAGE? JMP CHOUT2 /YES LAW -11 /NO, L+CH CTS FOR PH3 JMP OUTPUT CHOUT1 LAC XDICT SZA /EXPAND DICT INFO? LAW -2 /YES TAD K2 /NO JMP OUTPUT CHOUT5 SNL /OPCODE? JMP CHOUT4 LAC SP00 /YES AND S07700 SAD S05400 /LABEL OP? SKP /YES JMP CHOUT4 /NO LAW -4 JMP OUTPUT CHOUT2 ISZ EMF /SET ERROR MSG FLG LAC SP00 /LOAD ERROR MSG OPCODE WD AND S00077 /MASK ARGCT FIELD JMS TCA /AC:=-NO.OF WDS IN ERROR MSG DAC DCT /SET DATA COUNT CHOUT3 ISZ DCT /INCREMENT DATA COUNT(CAN GO THRU 0) JMP PUT03 /EXIT FROM PUT,IGNORING OPCODE WD JMP PUT03 /DITTO CHOUT4 LAW -1 /SET DATA COUNT=-1 /THIS SECTION DECIDES WHETHER TO PUT THE GIVEN DATA WD ON THE OUT SK. OUTPUT DAC DCT OUTPT2 LAC EMF SZA /ERROR MESSAGE FLAG SET? OUTPT4 JMP OUTPT6 /YES LAC PRESET SZA /PRE-SET OPTION SET? JMP CHOUT3 /YES, SO IGNORE DATA WD & EXIT LAC EMODE SZA /ERROR MODE FLAG SET? JMP CHOUT3 /YES,SO IGNORE DATA WD & EXIT OUTPT6 ISZ DCT /INCREMENT DATA COUNT SKP /NOW ZERO? DZM EMF /YES,SO CLEAR ERROR MSG FLG JMP PUT04 /GO TO PUT DATA WD ON OUT SK .EJECT PUTW XX JMS PUT .DSA WORK JMP* PUTW PUTRP XX JMS PUT .DSA REVPOL JMP* PUTRP PUTPOL XX JMS PUT .DSA POLISH JMP* PUTPOL PUTOUT XX JMS PUT .DSA OUT JMP* PUTOUT .EJECT TAKEW XX LAC* WORK ISZ WORK JMP* TAKEW TAKERP XX LAC* REVPOL ISZ REVPOL JMP* TAKERP .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 /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 PRORP,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 ALPROP /LINK TO PRORP? LAC Z00000 /YES SPA /LINK TO PRORP 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 .EJECT /EXIT /ROUTINE TO JUMP TO THE ADDRESS SPECIFIED BY THE LAST LINK /STORED ON THE WORK STACK. /CALLING SEQUENCE: / JMP EXIT EXIT LAC STATE /STATE TO AC: -1=FALSE ; +1=TRUE SPA!CLA!STL /AC=0 IF TRUE RAL /AC=1 IF FALSE TAD EXIT04 /PICK UP MODIFIED JUMP DAC EXIT03 /DUMP IN CODE JMP EXIT02 /ENTER LOOP EXIT01 JMS* DEST /IF STATE=TRUE PUT DATA ON STACK EXIT02 JMS TAKEW /TAKE CURRENT WD OFF WORK STACK SMA /SKIP IF LINK EXIT03 0 /J TO EXIT02 IF FALSE: EXIT01 IF TRUE DAC SP01 /DUMP LINK ADDR RTL SZL /LINK FROM ANAL OR PRORP? JMP EXIT05 /YES JMS TAKEW /TAKE STORED AC OFF WORK STK JMP* SP01 /JUMP TO IT EXIT04 JMP EXIT01 /DATA WORD FOR INSTRUCTION AT EXIT03 EXIT05 RAL LAC SP01 AND S77777 SZL /LINK FROM ANAL? JMP LPRORP+1 /NO TAD STATE JMP ANAL03+2 /CODE OBEYED ONCE ONLY THEN USED AS LOCAL STORAGE P1CON JMS GNEL /GET FIRST ELEMENT JMS OBEY /STACK LINK(.+2) JMP ANAL+4 JMP P1C1 .EJECT /SYNTAX BLOCKS (AT BASIC SYMBOL LEVEL) /THESE BLOCKS ARE INTERPRETED BY ANAL WHEN IT IS PROCESSING AN ELEMENT. ASEL /FAIL IN ASSIGNMENT EL NAME1 CX QUAN1 /*RECURSE* N NAME11 N NAME21 NAME11 JMP TRES /*TEST IF RESULT=1* AS+PSEL /EXIT OK FROM PROCEDURE STATEMENT EL JMP OUTOP2-2 /OUTPUT REVPOL OP ISZ RESULT /ADD 1 TO RESULT AN NAME91 NAME21 CC+26 /*:=?* AN NAME31 JMP OUTOP1 /OUTPUT REVPOL OP ISZ CTA /ADD 1 TO ARG A COUNT AN NAME41 NAME31 CX QUAN1 /*RECURSE* AN NAME61 ISZ CTA /ADD 1 TO ARG A COUNT ASEL /FAIL IN ASSIGNMENT EL NAME41 JMP TRES /*TEST IF RESULT = 1* N NAME51 ASEL /FAIL IN ASSIGNMENT EL NAME51 CX EXP1 /*RECURSE* AS+ASEL /EXIT OK FROM ASSIGNMENT EL JMP SARGA /SET NO. OF ARGS IN REVPOL OP N NAME71 NAME61 CC+26 /* := ? * N NAME81 ASEL /FAIL IN ASSIGNMENT EL NAME71 CX SEXP41 /*RECURSE* AS+ASEL /EXIT OK FROM ASSIGNMENT EL JMP SARGA /SET NO. OF ARGS IN REVPOL OP N NAME31 NAME81 JMP TRES /*TEST IF RESULT=1* A+ASEL /FAIL IN ASSIGNMENT EL LAW -7 /ERROR 7 LAW -11 /ERROR 9 A+ASEL /FAIL IN ASSIGNMENT EL NAME91 JMP TRES /*TEST IF RESULT = 1* N NAME91+4 JMP OUTOP2-2 /OUTPUT REVPOL OP AS+PSEL /EXIT OK FROM PROCEDURE STATEMENT EL CC+27 /* : ? * AS+LBLEL /EXIT OK FROM 'LABEL' EL JMP OUTOP1 /OUTPUT REVPOL OP GOTEL /FAIL GOTO1 CX QUAN91 /*RECURSE* S+GOTEL /EXIT O.K. IFEL /FAIL ON 'IF' EL IF1 CX EXP1 /*RECURSE* N IF11 LAW -12 /ERROR 10 A+IFEL /FAIL ON 'IF' EL IF11 CC+31 /*'THEN'?* S+IFEL /EXIT OK FROM 'IF' EL N EXP1 EXPS1 CC+56 /*STRING QUOTE?* AS /EXIT OK JMP GSTR /READ IN STRING N SEXP1 EXP1 CC+20044 /*'IF'?* N EXP11 0 /FAIL EXP11 CX EXP1 /*RECURSE* N EXP21 LAW -5 /ERROR 5 A EXP21 CC+31 /*'THEN'?* AN EXP31 JMP OUTOP1 /OUTPUT REVPOL OP 0 /FAIL EXP31 CX SEXP1 /*RECURSE* N EXP41 LAW -6 /ERROR 6 A EXP41 CC+60062 /*'ELSE'?* N EXP51 0 /FAIL EXP51 CX EXP1 /*RECURSE* S /EXIT OK N SEXP11 SEXP1 CC+10001 /*'NOT'?* AN SEXP11 JMP OUTOP1 /OUTPUT REVPOL OP N SEXP21 SEXP11 CC+10010 /* + ? * AN SEXP31 JMP OUTOP2-3 /OUTPUT REVPOL OP N SEXP31 SEXP21 CC+10011 /* - ? * AN SEXP31 JMP OUTOP2-4 /OUTPUT REVPOL OP N SEXP71 /FAIL SEXP31 CX PRIM1 /*RECURSE* N SEXP41 S /EXIT OK SEXP41 10000 /*OPERATOR?* AN SEXP51 JMP OUTOP1 /OUTPUT REVPOL OP N SEXP61 SEXP51 10 /*ARITHMETIC OPERATOR?* AN SEXP31 JMS GNBS /GET NEXT BASIC SYMBOL IN BS AN SEXP1 SEXP61 20 /*RELATIONAL OPERATOR?* AN SEXP11 JMS GNBS /GET NEXT BASIC SYMBOL IN BS 0 /FAIL SEXP71 JMP TRES /TEST IF RESULT = 1 A /FAIL LAW -4 /REPORT ERROR 4 N QUAN1 PRIM1 200 /*CONSTANT OR ( ?* AN PRIM11 JMP OUTOP1 /OUTPUT REVPOL OP JMS GNBS /GET NEXT BASIC SYMBOL IN BS AS PRIM11 CC+216 /* ( ? * N PRIM21 0 /FAIL PRIM21 CX EXP1 /*RECURSE* N PRIM31 LAW -17 /ERROR 15 A /FAIL PRIM31 CC+17 /* ) ? * S /EXIT OK 1 /FAIL:RESULT=1 QUAN1 CC+20037 /*IDENTIFIER?* AN QUAN11 JMP OUTOP1 /OUTPUT REVPOL OP N QUAN51 QUAN11 CC+216 /* ( ? * AN QUAN21 JMP SC /SET PARAMETER COUNT TO ZERO 2 /FAIL:RESULT=2 QUAN21 CX EXPS1 /*RECURSE* N QUAN31 LAW -2 /ERROR 2 A+2 /FAIL:RESULT=2 QUAN31 JMP PDELIM /*PARAMETER DELIMITER?* AN QUAN41 ISZ* WORK /ADD 1 TO PARAMETER COUNT JMS GNBS /GET NEXT BASIC SYMBOL IN BS AN QUAN21 QUAN41 CC+17 /* ) ? * AS+1 /EXIT OK: RESULT=1 JMP OUTOP1 /OUTPUT REVPOL OP S /EXIT OK : RESULT=0 QUAN51 CC+106 /* LEFT SQ BRACKET ? * AN QUAN61 JMP SC /INITIALISE SUBSCRIPT COUNT 3 /FAIL : RESULT = 3 QUAN61 CX EXP1 /*RECURSE* AN QUAN71 ISZ* WORK /ADD 1 TO SUBSCRIPT COUNT N QUAN81 QUAN71 CC+57 /* , ? * N QUAN61 LAW -3 /ERROR 3 A+3 /FAIL : RESULT = 3 QUAN81 CC+7 /* RIGHT SQ BRACKET ? * AS+3 /EXIT OK : RESULT = 3 JMP OUTOP1 /OUTPUT REVPOL OP LAW -13 /ERROR 11 A /FAIL QUAN91 CC+20037 /*IDENTIFIER?* AN QUAN51 JMP OUTOP1 /OUTPUT REVPOL OP FOREL /FAIL IN 'FOR' ELEMENT FOR1 CX FORL1 /*RECURSE* AS+FOREL /EXIT OK FROM 'FOR' ELEMENT JMP SARGA /SET NO OF ARGS TO 'FOR' EL IN REVPOL OP LAW -31 /ERROR 25 A /FAIL FORL1 CC+20037 /*NAME?* AN FORL11 JMP OUTOP1 /OUTPUT REVPOL OP LAW -32 /ERROR 26 A /FAIL FORL11 CC+26 /* := ? * AN FORL21 JMP HCV /CV:VOCPTR TO CONTROLLED VAR:CV TO REVPOL 0 /FAIL FORL21 CX FLE1 /*RECURSE* AN FORL31 ISZ CTA /ADD 1 TO ARG A COUNT N FORL41 FORL31 CC+57 /* , ? * AN FORL21 JMP CVR /PUT COPY OF CV ON REVPOL LAW -33 /ERROR 27 A /FAIL FORL41 CC+63 /* 'DO' ? * S /EXIT OK 0 /FAIL FLE1 CX EXP1 /*RECURSE* N FLE11 N FLE21 FLE11 CC+30 /* 'STEP' ? * AN FLE31 JMP CVRS /PUT TWO COPIES OF CV ON REVPOL JMP OUTOP2-5 /OUTPUT REVPOL OP AS /EXIT OK FLE21 CC+32 /* 'WHILE' ? * AN FLE61 JMP OUTOP1 /OUTPUT REVPOL OP 0 /FAIL FLE31 CX EXP1 /*RECURSE* AN FLE41 JMP VAB /REMEMBER VADDR OF EXP & DO CVR LAW -34 /ERROR 28 A /FAIL FLE41 CC+64 /* 'UNTIL' ? * N FLE51 0 /FAIL FLE51 CX EXP1 /*RECURSE* AS /EXIT OK JMP VAC /REMEMBER VADDR OF EXP;OPS TO REVPOL 0 /EXIT FAIL FLE61 CX EXP1 /*RECURSE:PROCESS EXP* S /EXIT OK LAW -16 /ERROR 14 A /FAIL ILST1 CC+20037 /*IDENTIFIER?* AN ILST11 JMP OUTOP1 /OUTPUT REVPOL OP S /EXIT OK ILST11 CC+57 /* , ? * AN ILST21 ISZ CTN /ADD 1 TO ARG N COUNT 0 /EXIT FAIL ILST21 CX ILST1 /*RECURSE:PROCESS REST OF IDENT. LIST* S /EXIT OK SLIST /FAIL ON LABEL OR STRING LIST LSTR1 CX ILST1 /*RECURSE* AS+SLIST /EXIT OK FROM LABEL OR STRING LIST JMP SARGN /SET NO. OF ARGS IN REVPOL OP VALEL /FAIL VALUE1 CX ILST1 /*RECURSE* AS+VALEL JMP SARGN /SET NO. OF ARGS IN REVPOL OP LAW -14 /ERROR 12 A+SWDEC /FAIL SWCH1 CC+20037 /*IDENTIFIER?* AN SWCH11 JMP OUTOP1 /OUTPUT REVPOL OP LAW -41 /ERROR 33 A+SWDEC /FAIL SWCH11 CC+26 /* := ? * N SWCH21 SWDEC /FAIL IN SWITCH DECLARATION SWCH21 CX GOTO1 /*RECURSE* AN SWCH31 ISZ CTN /ADD 1 TO ARG N COUNT JMP SARGMN /SET NO. OF ARGS IN REVPOL OP AS+SWDEC /EXIT OK FROM SWITCH DECLARATION SWCH31 CC+57 /* , ? * N SWCH21 N TYPE31 TYPE1 CC+20047 /* 'ARRAY' ? * AN TYPE11 JMP OUTOP1 /OUTPUT REVPOL OP ARDEC!ARSP /FAIL IN ARRAY DEC OR SPEC TYPE11 CX ILST1 /*RECURSE* AN TYPE21 ISZ CTN /ADD 1 TO ARG N COUNT JMP ARD.SP /CHANGE OP ON WORK TO ARR SPEC FROM ARD AS+ARSP /EXIT OK FROM ARRAY SPEC TYPE21 100 /* LEFT SQ BRACKET ? * AN OWN51 ISZ CTI /ADD 1 TO ARG I COUNT N TYPE41 TYPE31 CC+20051 /* 'PROCEDURE' ? * AN PROC1 JMP OUTOP1 /OUTPUT REVPOL OP TLIST /FAIL IN TYPE LIST TYPE41 CX ILST1 /*RECURSE* AS+TLIST /EXIT OK FROM TYPE LIST JMP SARGN /SET NO. OF ARGS IN REVPOL OP ARDEC /FAIL IN ARRAY DECLARATION OWN41 CX ILST1 /*RECURSE* AN OWN51 ISZ CTN /ADD 1 TO ARG N COUNT ARDEC /FAIL IN ARRAY DECLARATION OWN51 CX BPL1 /*RECURSE* AN OWN61 ISZ CTA /ADD 1 TO ARG A COUNT JMP SARGA /SET NO. OF ARGS IN REVPOL OP AS+ARDEC /EXIT OK FROM ARRAY DECLARATION OWN61 CC+57 /* , ? * N OWN41 LAW -21 /ERROR 17 A /FAIL BPL1 CC+106 /* LEFT SQ BRACKET ? * AN BPL11 JMP OUTOP1 /OUTPUT REVPOL OP 0 /FAIL BPL11 CX IEXP1 /*RECURSE* AN BPL21 ISZ CTB /ADD 1 TO ARG B COUNT LAW -22 /ERROR 18 A /FAIL BPL21 CC+27 /* : ? * N BPL31 0 /FAIL BPL31 CX IEXP1 /*RECURSE* AN BPL41 ISZ CTB /ADD 1 TO ARG B COUNT JMP SARGB /SET NO. OF ARGS IN REVPOL OP AN BPL51 BPL41 CC+57 /* , ? * N BPL11 LAW -23 /ERROR 19 A /FAIL BPL51 CC+7 /* RIGHT SQ BRACKET ? * AN BPL61 JMP OUTOP2-1 /OUTPUT REVPOL OP JMP SARGN /SET NO. OF ARGS IN REVPOL OP AS /EXIT OK BPL61 0 /* , ? * LAW -20 /ERROR 16 A+OTDEC /FAIL IN OWN TYPE DEC OWN1 100000 /*'REAL','INTEGER' OR 'BOOLEAN' ? * AN OWN21 JMP NXTOP1 /OUTPUT REVPOL OP & SET NXTRQD N OWN31 OWN21 CC+20047 /* 'ARRAY' ? * AN OWN41 JMP OUTOP1 /OUTPUT REVPOL OP OTDEC /FAIL IN OWN TYPE DEC OWN31 CX ILST1 /*RECURSE* AS+OTDEC /EXIT OK FROM OWN TYPE DEC JMP SARGN /SET NO. OF ARGS IN REVPOL OP LAW -24 /ERROR 20 A+FPEL /FAIL IN FORMAL PARAMETER PROC1 CC+20037 /*IDENTIFIER?* AN PROC11 JMP OUTOP1 /OUTPUT REVPOL OP S+FPEL /EXIT OK PROC11 CC+216 /* ( ? * N PROC21 FPEL /FAIL IN FORMAL PARAMETER PROC21 CX FPAR1 /*RECURSE* AS+FPEL /EXIT OK JMP SARGMN LAW -25 /ERROR 21 A /FAIL FPAR1 CC+20037 /*IDENTIFIER?* AN FPAR11 JMP OUTOP1 /OUTPUT REVPOL OP LAW -26 /ERROR 22 A FPAR11 JMP PDELIM /* PARAMETER DELIMITER ? * AN FPAR21 ISZ CTN /ADD 1 TO ARG N COUNT JMS GNBS /GET NEXT BASIC SYMBOL IN BS AN FPAR1 FPAR21 CC+17 /* ) ? * S /EXIT OK N IEXP31 IEXP1 JMP TCTI /* TEST IF ARG I COUNT = 1 * N IEXP11 0 /FAIL IEXP11 CX EXP1 /*RECURSE* S /EXIT OK LAW -15 /ERROR 13 A /FAIL IEXP21 CC+235 /*INTEGER ? * AS /EXIT OK JMP OUTOP1 /OUTPUT REVPOL OP N IEXP21 IEXP31 CC+10011 /*-?* AN IEXP21 JMP OUTOP2-4 /OUTPUT REVPOL OP S+EXTEL /EXIT OK EXT1 CC+20037 /*IDENTIFIER?* AS+EXTEL /EXIT OK JMP OUTOP1 /OUTPUT REVPOL OP .EJECT /SYNTAX BLOCKS (AT ELEMENT LEVEL). /THESE BLOCKS ARE INTERPRETED BY ANAL WHEN IT IS PROCESSING ELEMENTS. LAW -133 /ERROR 91 AN MODL71 MODL1 CC+BEGEL /*BEGEL?* N MODL11 N MODL81 MODL11 1000 /*MASK DECN* N MODL91 LAW -137 /ERROR 95 AN MODL61 MODL21 CC+FPEL /*FPEL?* AN MODL41 JMP PH2 /DO PHASE 2 ON FPEL LAW -136 /ERROR 94 A /FAIL MODL31 40000 /*MASK XHEL* S /EXIT OK LAW -42+Z /ERROR 34 A /FAIL MODL41 JMP PDEC /*PROCESS PROC HEAD AND BODY* N MODL51 N MODL31 MODL51 CC+SCEL /*SCEL?* N MODL31 0 /EXIT FAIL MODL61 20000 /*MASK BEGEL* N MODL1 0 /EXIT FAIL MODL71 CC+FPEL /*FPEL?* AN MODL41 JMP PH2 /DO PH2 ON FPEL LAW -42+Z /ERROR 34 A /EXIT FAIL MODL81 CX CBX1 /*RECURSE TO RIGHT DEPTH* N MODL51 LAW -42+Z /ERROR 34 A MODL91 CX CB51 /*RECURSE:RECOVER DECN* N MODL51 LAW -135 /ERROR 93 AS /EXIT O.K. SCIV1 CC+INVEL /*INVEL?* N SCIV11 N SCIV1 SCIV11 CC+SCEL /*SCEL?* S /EXIT O.K. CB1 CC+BEGEL /*BEGEL?* N CB51 JMP BEGBL /OPEN DICT LEVEL AN CB31 CBX1 0 /*DUMMY MASK* 0 /FAIL CB31 CX DEC1 /*RECURSE:PROCESS DECS* N CB41 N CB61 CB41 CX COMP21 /*RECURSE:PROCESS BODY* AS /EXIT O.K. JMP ENDBL /CLOSE DICT LEVEL 0 /NO,EXIT FAIL CB61 JMP TRES /RESULT=1? N CB31 /YES N CB81 CB71 400 /*MASK VALUE PART OR SPEC* AN CB51 JMP IGNORE /REPORT ERROR 92 & GET NEXT EL N CB91 CB81 CX COMP21 /*RECURSE:PROCESS COMPOUND STAT* S /EXIT OK 0 /NO, EXIT FAIL CB91 JMP TRES /*RESULT=1?* N CB51 /YES, PROCESS WRONG EL N COMP31 COMP1 CC+SCEL /*SCEL?* N COMP21 N CB71 CB51 1000 /*MASK DEC* AN CB31 JMP BEGBL /OPEN DICT LEVEL LAW -141 /ERROR 97 A+1 /FAIL:RESULT:=1 COMP11 40000 /*MASK XHEL* 0 /FAIL COMP21 CX STAT11 /*RECURSE:PROCESS STAT* N COMP1 N COMP51 COMP31 CC+INVEL /*INVEL?* N COMP21 N COMP11 COMP41 4000 /*MASK ELSEL OR EXTEL* AN COMP21 JMP IGNORE N COMP61 COMP51 CC+ENDEL /*ENDEL?* S /EXIT TRUE N COMP41 COMP61 2000 /*MASK STATEMENT* AN COMP21 LAW -135 /ERROR 93 N DEC11 DEC1 CC+FPEL /*FPEL?* AN DEC41 JMP PH2 /DO PHASE 2 ON FPEL N DEC51 DEC11 1000 /*MASK DEC* AN DEC31 JMP PH2 /DO PHASE 2 ON DEC DEC31 CX SCIV11 /*RECURSE:SCEL(IGNORING INVEL)?* N DEC1 0 /FAIL DEC41 JMP PDEC /*PROCESS PROC HEAD AND BODY* N DEC31 JMP OUTOP2-11 /OUTPUT OP ENDD AS /EXIT OK DEC51 400 /*MASK VALUE PART OR SPEC* AN DEC31 JMP IGNORE /REPORT ERROR 92 & GET NEXT EL 0 /EXIT FAIL STAT1 CX STAT11 /*RECURSE:PROCESS STAT* AS /EXIT O.K. JMP OUTOP2-7 /OUTPUT OP "ENDF" TO WORK N STAT21 STAT11 CC+LBLEL /*LBLEL?* AN STAT11 JMP PH2 /DO PHASE 2 ON LBLEL N STAT31 STAT21 CC+FOREL /*FOREL?* AN STAT1 JMP PH2 /DO PHASE 2 ON FOREL N STAT41 STAT31 JMP TWL /*WORK =LINK?* N STAT81 0 /EXIT FAIL STAT41 CX UUS1 /*RECURSE:PROCESS UNLABELLED UNCOND STAT* N STAT51 N STAT61 STAT51 JMP TWL /*WORK=LINK?* S /EXIT O.K. STAT61 CC+ELSEL /*ELSEL?* AN STAT71 JMP OUTOP2-10 /OUTPUT OP "ELSE" TO OUT1 0 /EXIT FAIL STAT71 CX STAT11 /*RECURSE:PROCESS STAT* S /EXIT O.K. N STAT41 STAT81 CC+IFEL /*IFEL?* AN STAT91 JMP PH2 /DO PHASE 2 ON IFEL 0 /EXIT FAIL STAT91 CX COND1 /*RECURSE TO CUT OUT IFEL AFTER IFEL* S /EXIT O.K. N CB1 UUS1 10000 /*MASK ASEL,GOTEL OR PSEL* AS /EXIT O.K. JMP PH2 /DO PHASE 2 ON ELEMENT JMP OUTOP2 /OUTPUT OP "ENDC" TO WORK AN STAT11 COND1 0 /*MASK WITH ZERO* /THE FOLLOWING UPPER LEVEL SYNTAX BLOCKS ARE USED BY THE /ACTION PDEC. FPEL1 CX SCIV11 /*RECURSE:SCEL(IGNORING INVEL)?* AN FPEL21 JMP OUTOP2-6 /OUTPUT OP "ENDP" TO WORK FPEL11 CX SCIV11 /*RECURSE:SCEL(IGNORING INVEL)?* N FPEL51 FPEL21 CC+VALEL /*VALEL?* AN FPEL11 JMP PH2 /DO PHASE 2 ON VALEL JMP ENDSP /CHECK PARA-SPEC CORR THEN DO ODL AN FPEL41 FPEL31 400 /*MASK SPEC* AN FPEL11 JMP PH2 /DO PHASE 2 ON SPEC 0 /EXIT FAIL FPEL41 CX XSTAT1 /*RECURSE:PROCESS PROC BODY* AS /EXIT O.K. JMS CDL /CLOSE DICT LEVEL ROUND PROC BODY N STAT11 XSTAT1 CC+EXTEL /*EXTEL?* AS /EXIT OK JMP PH2 /DO PHASE 2 ON EXTEL N FPEL61 FPEL51 CC+VALEL /*VALEL?* AN FPEL11 LAW -140 /REPORT ERROR 96 N FPEL31 /NO FPEL61 CC+INVEL /*INVEL?* N FPEL11 /YES,IGNORE IT .EJECT /OUTOP1:THIS IS AN ACTION USED BY ANAL WHEN A BS CAN GENERATE A REVPOL /OPERATOR. OUTOP1 JMS OUTOP7 /GENERATE OPERATOR JMP RETURN /STACK OP AND RETURN TO ANAL /OUTOP2:THIS IS AN ACTION USED BY ANAL WHEN AN OPERATOR IS REQUIRED / WHICH IS NOT A FUNCTION OF BS. IT GENERATES A DISPLACEMENT IN / THE AC WHICH IS USED FOR A TABLE LOOK-UP TO EXTRACT THE / APPROPRIATE OPERATOR. ENTRY AT OUTOP2-N GENERATES 57(OCTAL)+N / IN THE AC. ISZ ISZCT ISZ ISZCT ISZ ISZCT ISZ ISZCT ISZ ISZCT ISZ ISZCT ISZ ISZCT ISZ ISZCT ISZ ISZCT OUTOP2 LAC ISZCT DZM ISZCT /CLEAR COUNT TAD K8 SMA /OUTPUT TO WORK STACK? JMP .+4 /NO TAD S00067 JMS OUTOP3 /GET OPERATOR JMP RETURN /STACK AND RETURN TAD APTAB DAC SP01 LAC* SP01 /LOAD OPERATOR JMS PUTOUT /OUTPUT IT JMP ANAL04 .EJECT /OUTOP3:ROUTINE TO GENERATE A REVPOL OP IN THE AC,HAVING / REMOVED ANY OPS OF HIGHER OR EQUAL PRECEDENCE (LOWER OR / EQUAL NUMERICAL PROCEDENCE VALUE)FROM THE WORK STACK. / REMOVAL FROM THE WORK STACK OF HIGHER PRECEDENCE / OPS STOPS WHEN A PROGRAM LINK(NEGATIVE WORD) IS REACHED. IF THE / NEW OPERATOR HAS THE SIGN BIT SET THEN THE SIGN IS CLEARED / AND THE L.S. 6 BITS ARE FILLED FROM THE CURRENT WORD ON THE / WORK STACK (TAKEN OFF). / /ENTRY:AC CONTAINS A POSITION IN THE LOOK-UP TABLE RVOP /EXIT:AC CONTAINS NEW OP. OUTOP3 XX TAD AARVOP /FORM ADDR OF TABLE POSITION DAC OUTOP8 LAC* OUTOP8 /LOAD OP FROM RVOP TABLE SMA JMP OUTOP4 /J IF ARG# NOT ON WORK STACK /THIS SECTION TAKES THE NUMBER OF ARGS FROM THE WORK STACK AND PLACES /THEM IN L.S. 6 BITS OF OPERATOR. JMS TAKEW /TAKE NO OF ARGS OFF WORK STACK JMS TARG /CHECK NO OF ARGS TAD V77701 /FILL UP WITH MASK TO CLEAR SIGN BIT AND* OUTOP8 /COMBINE WITH OPERATOR TO FORM NEW OP /THIS SECTION DEALS WITH PRECEDENCE AND LINKS OUTOP4 DAC OUTOP8 /DUMP OP AND Z70000 TAD S10000 /EXTRACT PRECEDENCE+1 DAC OUTOP9 /DUMP NEW PREC OUTOP5 LAC* WORK /EXTRACT CURRENT WORK STACK ENTRY SPA!CMA /SKIP IF OPERATOR: AC = -PREC(WORK)-1 JMP OUTOP6 /J IF LINK ON WORK TAD OUTOP9 /AC=PREC(NEW)-PREC(WORK) SPA JMP OUTOP6 /J IF PREC(NEW)31? JMP PDEC02 /NO:OK LAW -71 /)YES:ERROR 57:TOO MANY JMP ODL01 /)NESTED PROCS:ABORT PDEC02 DAC CHL LAC AFPEL1 /)SET UP XB FOR ENTRY TO DAC XB /)UPPER LEVEL SYNTAX BLOCKS JMS OBEY /WORK(+)_LINK(.+2) JMP ANAL+4 /RETURN FROM OBEY TO HERE /THIS SECTION TERMINATES BLOCK ENCLOSING WHOLE OF PROCEDURE, /USES CURRENT VALUES OF MAXOTD,MAXL TO COMPUTE DNLBL,DBI IN /PROC DATA THEN RESTORES STACKED VALUES OF MAXOTD,MAXL JMS CDL /CLOSE DICT LEVEL JMS TAKEW /)UNSTACK PROCNAME ATTRS DAC NAPTR /)PTR JMS LDA2 /LOAD PROC INFO PTR WD XOR W00000 /MARK PROC DEAD DAC* SP00 DAC SP04 LAC CHL JMS MES JMP R-6 AND S00037 /EXTRACT H TAD C1 /AC:=H+1 TAD MAXOTD /H+1+MAXOTD(=DNLBL) JMS DVM /DEPOSIT IN DNLBL IN PROC INFO M*5+SP04 TAD MAXL /L+DNLBL(=DBIL) JMS DVM /DEPOSIT IN DBIL IN PROC INFO M*4+SP04 AND Z60000 SNA /PROC OTD TOO LARGE(>4096)? JMP .+3 /NO LAW -73 /YES, SO REPORT ERROR JMS ERR JMS TAKEW DAC MAXOTD /RESTORE MAXOTD JMS TAKEW DAC MAXL /RESTORE MAXL JMS TAKEW /LOAD STACKED XB TAD STATE JMP ANAL03+2 /RETURN TO ANAL .EJECT /USEV 15/8/69 JDS /ROUTINE TO PROCESS REFERENCE TO VARIABLE /ON ENTRY V.ADDR OF VOCAB ENTRY HELD IN VOCPTR /ON EXIT IF SUCCESS:VADDR OF ATTRS LEFT IN NAPTR AND Q SET UP / FROM SKT(ATTRS) / FAILED:Q SET TO INVALID AND ERROR REPORTED /USES ROUTINES FDA,ERR,CNA USEV JMS FDA /FIND DICT ATTR JMP USEV03 /J NAME NOT USED JMP USEV04 /J NAME NOT USED THIS LEVEL JMP USEV02 /SCAN UPPER CHAIN LOOKING FOR DECLARED ATTRS /ERROR FLAGGED IF ATTRS ON LABEL STACK FOUND USEV01 JMS LDA0 /GET W0RD O OF ATTRS SPA /DECLARED? JMP USEVOK /YES:EXIT OK AND T77777 /GET PTR TO UPPER ATTRS DAC NAPTR /DUMP IT AND T70000 /EXTRACT STACK IND SAD S60000 /ON DICT STACK? JMP USEV01 /YES:CONT SCAN USEV02 LAW -66+Y /ERROR 54:NAME ON LABEL STACK JMP USEF USEV03 LAW -67+Y /ERROR 55:NAME NOT KNOWN JMP USEF /NAME NOT USED THIS LEVEL:CREATE ATTRS & FIND CURRENT DECLN. USEV04 LAC ADICT /SET STACK TO USE TO BE DAC DLST /DICT JMS CNA /CREATE NEW ATTRS JMP USEV01 /J TO SCAN FOR DECLN. .EJECT /USEL***JDSMART 31/7/69 /ROUTINE TO PROCESS REFERENCE TO LABEL /ON ENTRY V ADDR. OF VOCAB ENTRY HELD IN VOCPTR /ON EXIT:AS FOR USEV /USES ROUTINES FDA,CNA,ERR USEL LAC ALABEL /SET UP STACK TO USE DAC DLST /TO BE LABELS JMS FDA /FIND DICT ATTRS NOP /IF NAME NOT IN USE AT THIS JMS CNA /LEVEL CREATE ATTRS(ASSUMED) JMP USELOK /EXIT:ATTRS OK AT THIS LEVEL LAW -65+Y /NAME A VARB. AT THIS LEVEL:ERROR 53 USEF JMS ERR LAC S10300 /REFERENCE FAILED DAC Q /SET Q=INVALID,ACTUAL,VARIABLE JMP* PRORP USEVOK JMS DIPOL /POL(+)_DICT ATTRS JMP USELOK+2 USELOK LAC NAPTR /POL(+)_OP(LPTR) JMS PUTPOL JMS LDA3 /EXTRACT SKT(ATTRS) JMS XSKT /EXPAND INTO Q RTL RTL AND S40000 XOR Q /)SET COMPLEX BIT IN Q DAC Q /)IF FORMAL BY NAME JMP* PRORP .EJECT /DECV***JDSMART 29/7/69 /HANDLE DECLARATION OF A VARIABLE (NOT LABELS) /ON ENTRY VIRTUAL ADDRESS OF VOCAB ENTRY HELD IN VOCPTR /EXIT LINK+1: VIRTUAL ADDR.OF NAME ATTRS IN NAPTR /EXIT TO LINK IF NAME ALREADY DECLARED /USES LOCN SP00 /USES ROUTINES FDA,LVM,ERR,CNA DEC00 TRUE LAC Q AND S00020 SZA /LABEL? JMP DECL /YES DEC JMS TAKERP DAC VOCPTR LAC ADICT /ADDRESS OF DICT PTR DAC DLST /TO DLST FOR LATER REF JMS FDA /FIND DICT ATTRS JMP DECV03 /J NAME NOT IN USE JMP DECV03 /J NAME NOT USED THIS LEVEL JMP DECV02 /J NAME ON LABEL STACK DECV01 JMS LDA0 /GET DICT ATTRS WORD 0 SMA /IS IT DECLARED? JMP DECV04 /NO LAW -62+Y /YES;ERROR 50 JMS ERR JMP* DEC00 /ATTRS FOUND AT THIS LEVEL ON WRONG STACK DECV02 LAW -63+Y /ERROR 51:ON LABEL STACK JMS ERR JMS LDA0 /GET DICT ATTRS WORD 0 AND X77777 XOR U00000 /MARK 'NOT ACTIVE' DAC* SP00 /REPLACE DICT ATTR WORD AND T77777 /EXTRACT NATUP DAC NAPTR /DUMP IN NEW ATTRS /ATTACH NEW ATTRS INTO DICT STRUCTURE DECV03 JMS CNA /CREATE NEW NAME ATTRS JMS LDA0 /LOAD DICT ATTRS WD 0 XOR W00000 /)MARK ATTRS 'DECLARED' DAC* SP00 /) JMP* DEC00 DECV04 LAC DLST /_ATTRS NOT DECLARED SAD ALABEL /IS IT A LABEL ATTR? JMP DECV03+1 /YES : OK LAW -70+Y /NO JMS ERR /_ERROR 56 - USED BEFORE DECLN JMP DECV03+1 /DECL /ROUTINE LIKE DEC BUT HANDLES LABEL DECLARATIONS DECL JMS TAKERP DAC VOCPTR LAC ALABEL /)SET UP STACK TO USE DAC DLST /)TO BE LABEL STACK JMS FDA /FIND DICT ATTRS JMP DECV03 /J NAME NOT IN USE JMP DECV03 /J NAME NOT USED THIS LEVEL JMP DECV01 /J NAME ON LABELS (OK) LAW -64+Y /ERROR 52 :ON DICT STACK JMP DECV02+1 .EJECT /UPNPTR*JDSMART 31/9/69 /ROUTINE TO UPDATE NAME.PTR IN VOCAB ENTRY /ON ENTRY AC HOLDS ADDRESS OF WORD GIVING ABSOLUTE ADD OF ATTRS / LOC 'NAPTR' HOLDS DICT.PTR TO BE PUT INTO VOCAB /THE VIRTUAL ADDRESS OF THE VOCAB ENTRY TO BE UPDATED IS /HELD IN WORD ONE OF NAME ATTRS SUPPLIED BY AC /USES LOCATIONS SP00,1,2 /USES ROUTINES LAM,VTOA UPNPTR XX /LINK DAC SP02 /DUMP ADDR OF ATTRS ADDR JMS LAM /LOAD WORD 1 OF ATTRS M*1+SP02 /)INTO AC AND S07777 /GET VIRTUAL ADDR OF VOCAB JMS VTOA /CONVERT TO ABS(IN SP00) LAC NAPTR /LOAD V.ADDR OF ATTRS AND T77777 /MASK OFF TOP 2 BITS DAC* SP00 /DUMP INTO VOCAB ENTRY JMP* UPNPTR /EXIT .EJECT /CNA****JDSMART 31/7/69 /CREATE NEW NAME ATTRS IN THE DICT STRUCTURE AND ATTACH TO /RELEVANT VOCAB ENTRY. ATTRS SET UP IN LOCNS CHL TO NAPTR. /STACK TO USE GIVEN BY DLST /USES ROUTINES COPY,EVA,UPNPTR CNA XX JMS Q.SKT /Q INTO TOP END OF AC XOR CHL /PACK INTO CHL DAC CHL JMS COPY /)COPY NEW ATTRS ONTO CHL /)APPROP STACK M*5+DLST 4 LAC S03777 /CLEAR SKT IN CHL AND CHL DAC CHL LAC DLST /GET STACK PTR ADDR TAD K1 /CHANGE TO ADDR OF BASE DAC .+2 JMS EVA /EVAL VADDR OF STACK PTR 0 /DIBASE OR LABASE DAC NAPTR /STORE IT LAC* DLST /GET ADDR OF NEW NATTRS JMS UPNPTR /ATTACH TO VOCAB JMP* CNA .EJECT /CDL /CLOSE DICTIONARY LEVEL CDL XX DZM CDL92 /CLEAR CT OF RETAINED ATTRS JMS TAKEW /UNSTACK 'OUTER LEVEL' DAC CDL90 /TO CDL90 JMS TAKEW /UNSTACK VADDR OF DICT PTR JMS VTOA /CONVERT IT TO ABS(INTO SP00) LAC DICT /LOAD CURRENT DICT PTR JMS TCA TAD SP00 /OUTER DICT PTR-CURRENT D.P. RCR /COMPUTE # DICT ENTRIES RCR /TO BE PROCESSED CMA /(# WORDS/4) DAC CDL91 /STORE -VELY JMP CDL04 /J TO PROCESS THIS LEVEL ATTRS CDL01 LAC* DICT /YES:GET NAPTR WORD OF ATTRS DAC NAPTR /AND HOLD SPA!RAL /ATTR DECLARED? JMP CDL02 /YES SPA /ATTRS ACTIVE? JMP CDL03 /NO JMS LDA3 AND S03777 /)OUTER ATTRS SAD CDL90 /OUTER ATTRS AT OUTER LEVEL? JMP CDL02 /YES JMS LAM /)EXTRACT SKT FROM LOWER M*3+DICT /)LEVEL ATTRS AND Z74000 /) XOR CDL90 /CHANGE HL TO OUTER HL DAC* SP00 /RESET IN ATTRS JMS COPY /RETAIN THESE ATTRS M*1+DICT /ON WORK M*1+WORK 4 ISZ CDL92 /STEP CT.OF RETAINED ATTRS JMP CDL04 CDL02 LAC DICT /UPDATE NAPTR IN VOCAB ENTRY JMS UPNPTR CDL03 LAC DICT /)TAKE 4 WORD ATTR TAD C4 /)OFF DICT STACK DAC DICT CDL04 ISZ CDL91 /ANY ATTRS AT THIS LEVEL JMP CDL01 /YES:PROCESS IT LAC CDL92 /CONVERT CT OF # OF CMA /ATTRS RETAINED INTO CT FOR DAC CDL92 /SETTING BACK ON STACK JMP CDL06 CDL05 JMS COPY /COPY ATTR BACK TO DICT M*1+WORK /FROM WORK M*1+DICT 4 JMS EVA /)FIND ITS NEW VIRT. ADD DIBASE DAC NAPTR LAC DICT /)AND PUT THIS INTO VOCAB JMS UPNPTR CDL06 ISZ CDL92 /ANY ATTRS TO PUT BACK? JMP CDL05 /YES /CLOSE DOWN LABEL STACK LEVEL / LAC LABEL JMP CDL11+2 CDL07 LAC* CDL91 /GET NAPTR IN ATTRS RAL SPA /IS ATTR ACTIVE? JMP CDL11 /NO:IGNORE IT JMS LAM /EXTRACT HL FROM ATTRS M*3+CDL91 AND S03777 CMA TAD CHL /CHL-HL(ATTR) SMA /ATTRS AT OUTER LEVEL? JMP CDL12 /YES END OF PROCESS LAC* CDL91 /GET NAPTR WORD OF ATTRS DAC NAPTR /DUMP IT SPA /IS ATTR DECLARED? JMP CDL10 /YES:DISCARD IT AND T77777 /EXTRACT PTR FIELD SNA /IS NAPTR=0? JMP CDL08 /YES:RETAIN AT OUTER LEVEL JMS LDA3 /EXTRACT HL FROM UPNPTR ATTRS AND S03777 SAD CDL90 /AT OUTER LEVEL? JMP CDL09 /YES CDL08 JMS LAM /)EXTRACT SKT FROM LOWER M*3+CDL91 /)LEVEL ATTRS AND Z74000 /) XOR CDL90 DAC* SP00 /CHANGE TO OUTER LEVEL JMP CDL11 /J TO PROCESS NEXT /FOUND ATTR AT OUTER LEVEL:DISCARD THESE ATTRS CHECKING OUTER ATTRS /NOT ON DICT STACK CDL09 LAC NAPTR /EXTRACT STACK INDICATOR AND T70000 /FOR OUTER ATTRS SAD S60000 /OUTER ON DICT STACK SKP /YES:ERROR THEN DISCARD JMP CDL10 /NO:DISCARD JMS LDA1 DAC VOCPTR /HOLD IN VOCPTR FOR ERRORS LAW -130+Y /ERROR 88:LABEL REF TO JMS ERR /VARB AT OUTER LEVEL LAC U00000 /CLEAR NAPTR IN ATTRS JMP CDL10+2 CDL10 LAC* CDL91 XOR U00000 /MARK 'NOT ACTIVE' DAC* CDL91 LAC CDL91 /UPDATE NAPTR IN VOCAB ENTRY JMS UPNPTR /TO POINT TO OUTER ATTRS CDL11 LAC CDL91 TAD C4 DAC CDL91 SAD LABASE /LABEL SK EMPTY? SKP /YES JMP CDL07 /NO _ REPEAT PROCESS /END OF CLOSING DICT PROCESS CDL12 LAC CHL AND S00077 /=L(LEVEL) CMA TAD MAXL /MAXL-L-1 RAL /L=1 IF L>=MAXL LAC CHL AND S00077 /AC=L SZL /L>=MAXL? DAC MAXL /YES:MAXL:=L LAC OTD CMA TAD MAXOTD /MAXOTD-OTD-1 RAL /L=1 IF MAXOTD<=OTD LAC OTD SZL /OTD>=MAXOTD? DAC MAXOTD /YES:MAXOTD:=OTD JMS TAKEW /WORK(-) DAC OTD /OTD_ LAC CDL90 DAC CHL /SET CHL FOR OUTER LEVEL JMP* CDL /EXIT .EJECT /FDA****JDSMART 29/7/69 /FIND DICTIONARY ATTRS. /GIVEN VOCAB.PTR IN VOCPTR AND CURRENT LEVEL IN CHL WILL /EXIT TO LINK IF ATPTR IN VOCAB ENTRY=0 /EXIT TO LINK+1 IF LEVEL OF ATTRS FOUND NOT AT CURRENT LEVEL /EXIT TO LINK+2 IF ATTRS AT CURRENT LEVEL AND ON LABEL STACK /EXIT TO LINK+3 IF ATTRS AT CURRENT LEVEL AND ON DICT STACK / / FDA XX JMS LVM /GET VIRT ADDRESS OF ATTRS VOCPTR /FROM VADDR IN VOCPTR DAC NAPTR /DUMP SNA /ANY ATTRS ADDRESSED? JMP* FDA /NO:EXIT TO LINK ISZ FDA /STEP LINK JMS LDA3 /EXTRACT WORD HOLDING LEVEL AND S03777 SAD CHL /ARE ATTRS AT CURRENT LEVEL? SKP JMP* FDA /NO:EXIT TO LINK+1 ISZ FDA /STEP LINK LAC NAPTR /GET DICT ATTR PTR AND T70000 /EXTRACT STACK INDICATOR SAD S60000 /ARE ATTRS ON DIXT STACK? ISZ FDA /YES:EXIT TO LINK+3 JMP* FDA /NO:EXIT TO LINK+2 .EJECT /ODL JDS OCT69 /OPEN DICTIONARY LEVEL /PRESERVES OTD,VADDR OF LAST DICT.ENTRY & CHL ON ENTRY TO A BLOCK /OR PROCEDURE BODY. INCREMENTS LEVEL # ODL XX JMS EVA /)GET VADDR OF LAST DIBASE /)DICT ENTRY DAC OTD+1 JMS COPY /)STACK:OTD M*0+OTD /)VADDR(DICT) M*1+WORK /)CHL 3 ISZ CHL /L:=L+1 LAC CHL AND S00077 SZA /LEVEL NOW>63? JMP* ODL /NO:EXIT O.K. LAW -72 /YES:ERROR 58:TOO MANY NESTED BLOCKS ODL01 JMS ERR JMP P1C2-3 /ABORT .EJECT /PH2 /PHASE 2:AN ACTION USED BY THE UPPER LEVEL SYNTAX BLOCKS M=100000 PH2 CLC DAC NXTRQD /INIT. NXTRQD FOR PH2 SYNTAX BLOCKS SAD ELANAL /ELANAL=FALSE? JMP PH207 /YES,SO DISCARD REVPOL LAC CEL /) AND C7 /)SET Q ACCORDING TO TAD ATQ /)ELEMENT TO BE DAC SP03 /)PROCESSED LAC* SP03 /) DAC Q /) LAC CEL AND S00200 SZA /LINE & CHAR CTS REQD FOR PH3? JMP PH210 /YES PH201 LAC AQ /SET CCODE FOR ANAL DAC CCODE LAC APRORP /SET GTNEXT FOR ANAL DAC GTNEXT DZM ASSQ /)INITIALISE GLOBAL DZM DIMA /)LOCATIONS USED BY PH2 LAC APUTP /)SWITCH ROUTINE EXIT DAC DEST /)TO POLISH STACK LAC CAFC7 /)SWITCH ANAL'S TREATMENT OF DAC ERRORT /)ERRORS JMS PRORP /PROCESS REVPOL FOR ELEMENT JMS POLOUT /MOVE POLISH SK(INVERTED) TO OUT LAC APUTO /)SWITCH BACK ROUTINE EXIT DAC DEST /)TO OUT LAC GNEL2-7 /)SWITCH BACK ANAL'S DAC ERRORT /)TREATMENT OF ERRORS JMS TLPTRS /SET CCODE & GTNEXT FOR TOP LEVEL PH205 LAC RPBASE /DISCARD REVPOL DAC REVPOL CLC /PREPARE FOR GETTING NEXT UNIT OF INPUT JMP ANAL04+3 /RETURN TO ANAL PH207 LAC CEL SAD U01003 /FAILURE IN FPEL ELEMENT? ISZ FPLERR /YES,SO SET FLAG JMP PH205 PH210 JMS PACKEL /PACK L+CH CTS INTO ERR BUFFER LAC W00000 JMS PUTOUT JMS COPY /COPY PACKED INFO TO OUT SK ENUM+2 M*1+OUT 10 JMP PH201 .EJECT PH2ERR XX DAC SP01 /REMEMBER ERROR NO. LAC Q AND S00100 SZA /Q HAS INVALID BIT SET ? JMP* PH2ERR /YES, SO RETURN LAC SP01 /LOAD ERROR NO. (NEGATIVE) JMS ERR /REPORT ERROR LAC Q AND Z77600 XOR S00100 /SET INVALID BIT IN Q DAC Q JMP* PH2ERR .EJECT /PRORP JDS OCT69 /PROCESS REVERSE POLISH DATA /IF CURRENT ENTRY ON REVPOL IS AN OPERATOR THEN IT IS MOVED TO /WORK STACK AND IF TXB2 ENTRY HAS SIGN BIT SET THE ARG COUNT IS /STACKED (NEGATIVELY) BEFORE ANAL IS OBEYED. /IF CURRENT ENTRY IS VOCPTR IT IS PROCESSED AS A REFERENCE DEPENDING /UPON Q AND PUTS THE RESULTANT DICT INFO INTO POLISH. /IF CURRENT ENTRY IS A CONSTANT POINTER IT IS MOVED TO POLISH /IF CURRENT ENTRY IS A REVPOL PTR A COPY OF THE INFO IS MADE ON /END OF REVPOL AND THE ROUTINE IS REPEATED. PRORP XX JMS TAKERP /TAKE ENTRY FROM REVPOL DAC VOCPTR /& HOLD IN VOCPTR RAL SMA /IS IT AN OPERATOR? JMP PRORP2 /NO:ANALYSE IT LAC PRORP JMS PUTW /STACK LINK TO PRORP JMS OBEY /STACK XB AS RETURN LINK(.+2) LPRORP JMP PRORP1 /CONTINUE SETTING UP AT PRORP1 DAC XB /ON RETURN FROM ANAL:RESET XB LAC Q AND S00177 /)MARK Q AS COMPLEX XOR U50200 /)SORT=VAR:KIND=ACTUAL DAC Q JMS TAKEW DAC PRORP /RESET LINK TO PRORP JMP* PRORP /YES:EXIT /SET UP OPERATOR & ARGCT ON WORK & XB FOR ANAL TO PROCESS OPERATOR PRORP1 LAC VOCPTR AND U07777 /STACK OPERATOR(LESS PREC), KEEPING B1 JMS PUTW JMS MES JMP R-6 AND S00077 /EXTRACT OPCODE TAD ATXB2 /GET ADDR OF APPROP XB DAC XB LAC* XB SMA /ARGCT REQD? JMP ANAL /NO:ENTER ANAL LAC VOCPTR /YES: AND S00077 /PUT ARGCT ONTO WORK JMS TCA JMS PUTW JMP ANAL /ENTER ANAL /REVPOL NOT AN OPERATOR(AC=2*REVPOL WORD) PRORP2 AND Z60000 /EXTRACT PREC(SK#) SZA /IS IT VPTR?(SK#=0) JMP PRORP4 /NO LAC Q /YES AND S00020 /IS TYPE(Q)=LABEL? SNA /YES JMP USEV JMP USEL /REVPOL A CONSTANT PRORP4 SAD U20000 /IS IT A REVPOL PTR? JMP PRORP6 /YES RTR /NO:MOVE STACK# INTO SKT POSN XOR W00000 /PACK IN SORT=VARB:KIND=ACTUAL JMS XSKT /EXPAND RESULT INTO Q XOR T00000 /MARK AS CONSTANT (K IN Q) DAC Q LAC VOCPTR JMS PUTPOL /POL(+)_OP(CONSTANT) JMP* PRORP /REVPOL A REVPOL PTR-COPY DATA DELIMITED BY PTRS TO END OF REVPOL PRORP6 JMS TAKERP /GET VADDR(START) PRORP7 TAD K1 /STEP VADDR(START) DAC SP04 JMS LV4 /LOAD WORD TO AC JMS PUTRP /REVPOL(+)_ LAC SP04 SAD VOCPTR /REACHED VADDR(END)? JMP PRORP+1 /YES:PROCESS RESULT JMP PRORP7 /NO:REPEAT .EJECT /PHASE 2 SYNTAX BLOCKS JMS NQ /MARK Q NO TYPE AN EXP12 EXP2 JMP GNIN /*GET NEXT INPUT* N EXP32 EXP12 20000 /*MASK PROC* AN EXP22 JMP CQ /MARK Q COMPLEX LAW -104 /REPORT ERROR 68 AS /EXIT OK EXP22 JMP CDIMZ /*CHECK THAT PROC DIM=ZERO* AS /EXIT OK JMP OPFC /OUTPUT OP FC LAW -74+Y /REPORT ERROR 60 AS /EXIT OK EXP32 10000 /*MASK VARIABLE* S /EXIT OK BEXP2 CX EXP2 /*RECURSE:PROCESS EXP* N BEXP12 LAW -126+Y /REPORT ERROR 86 AS /EXIT OK BEXP12 4 /*MASK BOOLEAN* S /EXIT OK AEXP2 CX EXP2 /*RECURSE:PROCESS EXP* N AEXP12 LAW -127+Y /REPORT ERROR 87 AS /EXIT OK AEXP12 JMP IR /*MASK INT OR REAL* S /EXIT OK PAR2 CX EXP2 /*RECURSE:PROCESS EXP* 0 /EXIT FAIL NEG2 CX AEXP2 /*RECURSE:PROCESS ARITHMETIC EXP* AS /EXIT OK JMP QA /INSERT TYPE IN OP ON WORK STACK POS2 CX AEXP2 /*RECURSE:PROCESS ARITH EXP* 0 /EXIT FAIL IFEX2 CX EXP2 /*RECURSE:PROCESS EXP* AN IFEX12 JMP QW /PUT Q ON WORK STACK IFEX12 CX EXP2 /*RECURSE:PROCESS EXP* AN IFEX22 JMP QW /PUT Q ON WORK STACK IFEX22 CX BEXP2 /*RECURSE:PROCESS N IFEX32 DIV2 CX REXP2 /*RECURSE:PROCESS EXP & FLOAT IF INT.* AN DIV12 JMP QW /WORK(+)_Q DIV12 CX REXP2 /*RECURSE:PROCESS BASE & FLOAT IF INT.* AN IFEX32 JMP QW /WORK(+)_Q IFEX32 JMP CQQ /*CHECK VALIDITY,CREATE OP & Q* S /EXIT OK DYAD2 CX EXP2 /*RECURSE:PROCESS EXP* AN DYAD12 JMP QW /WORK(+)_Q DYAD12 CX EXP2 /*RECURSE:PROCESS EXP* AN IFEX32 JMP QW /PUT Q ON WORK STACK N DIV2 XPN2 JMP TPI /TEST IF EXPONENT IS +INT AN DYAD12 JMP QW /WORK(+)_Q JMS OPOUT /OUT(+)_OP(WORK)(-):WORK(+)_-ARGCT(OP) AN ARD12 ARD2 JMP QHOLD /*REMEMBER Q AND THEN MASK OWN BIT* AN ARD12 JMS OPOUT1 /WORK(+)_-ARGCT(WORK(-)) DZM NXTRQD /PROCESS NEXT UNIT OF INPUT A /EXIT FAIL ARD12 JMP CTANR /*DO CARG,THEN MARK NXTRQD IF TRUE* N ARD12 JMP OPOUT2 /DO OPOUT FOLLOWED BY POLOUT AN ASEG12 ASEG2 JMP PBPL /*PROCESS BOUND PAIR LIST* AN ASEG12 JMS OPOUT1 /WORK(+)_-ARGCT(WORK(-)) N ASEG32 ASEG12 JMP CARG /*INCREMENT ARGCT & TEST IF =0* N ASEG22 ASEG22 JMP DEC /*PROCESS VARIABLE DECN* AN ASEG12 JMP OTSA /OBJECT TIME SPACE ALLOCATION JMS POLOUT /OUT(+)_WHOLE OF POL STACK A /EXIT FAIL ASEG32 400 /*MASK OWN* A /EXIT FAIL JMP DSMF /DELETE STORAGE MAPPING FUNCTION AF2 JMP ARP /*PUT OP ASS ON REVPOL & MARK NXTRQD* S /EXIT O.K. BPL12 JMP CARG /*INCREMENT ARGCT & TEST IF =0* N BPL2 BPL2 CX IEXP2 /*RECURSE:PROCESS BOUND PR EXP* N BPL12 LAB2 JMP DECL /*PROCESS LABEL DECN* AS /EXIT O.K. JMP LABPOL /PUT LABEL INFO ONTO POL S /EXIT OK IEXP12 1 /*MASK REAL* AS /EXIT O.K. JMS FIX IEXP2 CX AEXP2 /*RECURSE:PROCESS ARITH EXP* N IEXP12 REXP2 CX AEXP2 /*RECURSE:PROCESS ARITH EXP* N REXP12 S REXP12 2 /*MASK INTEGER* AS /EXIT OK JMP CFLOAT /SET C BIT IN Q & FLOAT EXP N SV62 SV2 JMP REFV /*PROCESS ARRAY NAME* AN SV12 JMP QWA /WORK(+)_Q MOVING ARGCT LAW -75+Y /REPORT ERROR 61 AN SV62 SV12 4000 /*MASK ARRAY* AN SV22 JMP CHRLY /CHECK IF REAL ARRAY N SV32 SV22 2000 /*MASK FORMAL BY NAME* N SV42 LAW -76+Y /REPORT ERROR 62 AN SV42 SV32 JMP CDIM /*CHECK NO.OF SUBSCRIPTS* N SV42 JMP WQ /Q_WORK(-) AS /EXIT O.K. SV42 JMP CARG /*INCREMENT ARGCT & TEST IF =0* N SV52 SV52 CX IEXP2 /*RECURSE:PROCESS SUBSCRIPT EXP* N SV42 0 /EXIT FAIL SV62 JMP CARG /*INCREMENT ARGCT & TEST IF=0* N SV72 SV72 CX IEXP2 /*RECURSE:PROCESS SUBSCRIPT EXP* N SV62 0 /EXIT FAIL VAL12 JMP CARG /*INCREMENT ARGCT & TEST IF =0* N VAL2 LAW -101+Y /REPORT ERROR 65 AN VAL12 VAL2 JMP FNPV /*FIND PARAMETER & MARK BY VALUE* N VAL12 ASS2 CX EXP2 /*RECURSE:PROCESS EXP* AN ASS12 JMP ENDQWA /OUTPUT END OP & PUT Q ON WORK JMP ASW /PUT ASSQ ON WORK AN IFEX32 ASS12 JMP CTANR /*DO CARG,THEN MARK NXTRQD IF TRUE* N ASS22 LAW -117+Y /REPORT ERROR 79 AN ASS12 ASS22 JMP BIR /*MASK BOOLEAN INT OR REAL* N ASS32 N ASS42 ASS32 10000 /*MASK VARIABLE* N ASS62 LAW -120+Y /REPORT ERROR 80 AN ASS12 ASS42 20000 /*MASK PROCEDURE* N ASS52 LAW -121+Y /REPORT ERROR 81 AN ASS12 ASS52 JMP CAP /*CHECK ASSIGNMENT TO PROC NAME* N ASS62 LAW -122+Y /REPORT ERROR 82 AN ASS12 ASS62 JMP TASQ /*CHECK CONSISTENCY OF LHS'S* N ASS12 N GOTO12 GOTO2 JMP GNIN /*GET NEXT UNIT OF INPUT* LAW -125+Y /REPORT ERROR 85 A /EXIT FAIL GOTO12 20 /*MASK LABEL* S /EXIT OK N FOR42 FOR2 JMP REFV /*PROCESS VARIABLE REFERENCE* AN FOR12 JMP FLK /BUY 1 WD OF OTD & OUTPUT OP FLK LAW -123+Y /REPORT ERROR 83 N FOR42 FOR12 10000 /*MASK VARIABLE* N FOR22 LAW -124+Y /REPORT ERROR 84 N FOR42 FOR22 JMP IR /*MASKK INT OR REAL* N FOR32 JMP FLKPH3 /OUTPUT FOR LINK FOR PH3 AS /EXIT OK FOR32 JMP CTANR /*DO CARG,THEN MARK NXTRQD IF TRUE* AN FOR32 JMP DO /OUTPUT DO OP 0 /EXIT FAIL FOR42 JMP LOSECT /LOSE ARG CNT FROM WORK WH2 JMP IFRP /*PUT OP IFS ON REVPOL & MARK NXTRQD* N AF2 STEP2 JMP UNT /*EXPAND UNTIL PART* N STEP12 STEP12 JMP STP /*EXPAND STEP PART* N AF2 PDEC2 JMP DEC /*PROCESS VARIABLE DEC* AN PDEC12 JMP PN /SET DIM IN PROCNAME ATTRS JMP PD /PUT DICT INFO ON POL AS /EXIT OK PDEC12 JMP CARG /*INCREMENT ARGCT & TEST IF =0* AN PDEC12 JMP PRP /PUT PARAM NAMES ONTO POL STACK JMP QWA /WORK(+)_Q MOVING ARGCT AN FC32 FC2 JMP REFV /*PROCESS VARIABLE REFERENCE* AN FC12 JMP QWA /WORK(+)_Q MOVING ARGCT LAW -103+Y /REPORT ERROR 67 AN FC32 FC12 20000 /*MASK PROCEDURE* N FC22 LAW -104+Y /REPORT ERROR 68 AN FC32 FC22 JMP CDIM /*CHECK NO OF PARAMS* N FC42 OWN2 JMP OQK /*MARK OWN IN Q & MARK NXTRQD* 0 /EXIT FAIL JMP WQ /WORK(-)->Q A /EXIT FAIL FC32 JMP CTANR /*DO CARG,THEN MARK NXTRQD IF TRUE* N FC32 JMP WQ /Q_WORK(-) AS /EXIT OK FC42 JMP CAFC /CHECK ACTUAL-FORMAL CORRESPONDENCE JMS NQ /MARK NO TYPE IN Q AN PC12 PC2 JMP GNIN /*GET NEXT UNIT OF INPUT* LAW -106 /REPORT ERROR 70 A /EXIT FAIL PC12 40 /*MASK NO TYPE* N PC22 ISZ POLISH /LOSE OP FC FROM POL SK AS /EXIT OK PC22 20000 /*MASK PROC* N PC32 LAW -104 /REPORT ERROR 68 A /EXIT FAIL PC32 JMP CDIMZ /*CHECK THAT # PARAMS = 0* S /EXIT OK N TYPE12 TYPE2 JMP OPTQ /*MARK TYPE IN Q & TEST IF VARIABLE* A /EXIT FAIL ISZ WORK /LOSE ARGCT FROM WORK STACK N DEC2 /NO TYPE12 JMP LEVZ /*LEVEL ZERO(I.E.SPEC)?* N SPEC2 /YES DEC2 JMP DEC /*PROCESS VARIABLE DEC* AN DEC12 JMS OTS00 /COMPUTE OBJECT TIME DISPLACEMENT 0 /EXIT FAIL DEC12 JMP CARG /*INCREMENT ARGCT & TEST IF=0* N DEC2 LAW -77+Y /REPORT ERROR 63 AN SPEC52 SPEC2 JMP FNPK /*FIND KIND OF NEXT PARAM* N SPEC12 N SPEC22 SPEC12 2000 /*MASK FORMAL BY NAME* N SPEC52 SPEC22 4030 /*MASK LABEL, STRING OR ARRAY* AN SPEC52 LAW -100+Y /REPORT ERROR 64 0 /EXIT FAIL SPEC52 JMP CARG /*INCREMENT ARGCT & TEST IF=0* N SPEC2 SW2 JMP DEC /*PROCESS SWITCH VARIABLE DEC* AN SW12 JMP SWD /BUY SPACE FOR SW LIST & MARK DICT INFO S /EXIT OK SW12 JMP CTANR /*DO CARG,THEN MARK NXTRQD IF TRUE* AN SW22 JMP LQ /MARK LABEL IN Q LAW -102+Y /REPORT ERROR 66 AN SW12 SW22 20 /*MASK LABEL* N SW12 0 /EXIT FAIL EXT2 JMP CPN /CHANGE PROCNAME IF ALIAS GIVEN .EJECT /QA PH2 ACTION /SET TYPE INTO CONTROL FIELD IN OP ON WORK STACK QA LAC Q RAR /LINK=1 IF TYPE =REAL LAC* WORK SZL XOR S20000 /SET "REAL FIRST ARG" IN OP DAC* WORK JMP ANAL04 /RETURN TO ANAL /PRP PH2 ACTION /MOVE VOCPTR FROM REVPOL(-) TO PROC(+) PRP JMS TAKERP JMS PUT PROC JMP ANAL04 /PN PH2 ACTION /ARGCT(WORK) TO DIMA THEN DIM(ATTRS(NAPTR)):=-DIMA-1 PN LAC* WORK DAC DIMA LAC NAPTR /)HOLD VADDR(PROC ATTRS) DAC PA /)FOR ACTION ENDSP JMS DIM JMP ANAL04 /DO PH2 ACTION /OUTPUT DO OP TO POL STACK DO LAC U06100 JMP OPPOL /CHRLY PH2 ACTION /SET BIT 4 IN SV OP ON WORK SK IF ARRAY IS TYPE REAL CHRLY LAC Q AND C1 SZA /REAL ARRAY? LAC S20000 /YES,SO SET BIT 4 DAC SP06 /HOLD JMS LAM /)LOAD M*2+WORK /)SV OP XOR SP06 DAC* SP00 /REPLACE OP ON WORK SK JMP ANAL04 .EJECT /PD PH2 ACTION / FINISH SETTING UP PROC INFO ON PROC STACK AND ATTACH / TO PROC ATTRS.OPERATOR(WORK):=(PDEC,1) / DICT INFO(NAPTR)GOES TO POL(+) PD LAC DIMA JMS PUT /PROC(+)_#PARAMS+1(-VE) PROC JMS COPY /BUY PROC INFO SPACE FOR:- 0 /)DBIL,DNLBL,NPW,EP M*1+PROC /)NAME(2),NAME(1) 6 JMS EVA PRBASE /VADDR OF PROC SK JMS DDA2 /SET INTO DISPL IN PROC ATTRS JMS LDA1 /GET VOCPTR AND S07777 TAD U00001 DAC .+2 JMS COPY /COPY NAME TO LAST 2 WORDS ON PROC VOCPTR /DUMPED HERE AS M*2+VOCPTR(PROC ATTRS) M*4+PROC 2 JMS DIPOL JMP ANAL04 .EJECT /OP PH2 ACTION ROUTINE / OUT(+)_OP(WK(-));WK(+)_-ARGCT(OP) OPOUT XX LAC* WORK /OP(WORK) JMS PUTOUT /OUT(+)_ JMS OPOUT1 /REPLACE OP ON WORK BY -ARGCT(OP) JMP* OPOUT /OP1 PH2 ACTION ROUTINE / WORK(+)_-ARGCT(OP(WORK(-))) OPOUT1 XX LAC* WORK AND S00077 JMS TCA /AC:=-ARGCT DAC* WORK JMP* OPOUT1 /OP2 PH2 ACTION / OPOUT FOLLOWED BY POLOUT OPOUT2 JMS OPOUT JMS POLOUT JMP ANAL04 .EJECT /NQ PH2 ACTION ROUTINE /NONE TO TYPE(Q) NQ XX LAW 777600 AND Q /HOLD SORT,KIND(Q) XOR S00040 /TYPE(Q)_NONE DAC Q JMP* NQ /CQ PH2 ACTION / MARK Q AS COMPLEX CQ LAC Q XOR S40000 /Q_C CQ01 DAC Q JMP ANAL04 /LQ PH2 ACTION / CHANGE SORT(Q) TO VAR AND TYPE(Q) TO LABEL LQ LAC Q AND Z43600 /MASK OUT SORT AND TYPE FIELDS XOR S10020 JMP CQ01 /DSMF PH2 ACTION / DELETE STORAGE MAPPING FUNCTION FROM WORK STACK DSMF LAW -3 TAD DIMA /AC:=-#DIMS-4 CMA /AC:=#DIMS+3 TAD WORK /)DELETE (#DIMS+3) WDS DAC WORK /)FROM WORK STACK JMP ANAL04 /LABPOL PH2 ACTION / PUT LABEL INFO ONTO POL SK LABPOL LAC NAPTR /PICK UP LABEL SK PTR JMS PUTW /PUT ONTO WORK SK JMS LDA1 /LOAD VOCAB PTR DAC NAPTR JMS LDA2 /PUT NAME(2) ON POL SK JMS PUTPOL JMS LDA1 /PUT NAME(1) ON POL SK JMP OPPOL .EJECT /QWA AND ENDQWA PH2 ACTIONS / OUTPUT OP END / PUT Q ON WORK MOVING ARGCT TO END OF STACK ENDQWA LAC U06600 JMS PUTPOL QWA JMS TAKEW DAC ARGCT LAC Q JMS PUTW LAC ARGCT JMP RETURN /QW PH2 ACTION / PUT Q ON WORK QW LAC Q JMP RETURN /WQ PH2 ACTION / TAKE LAST WORD FROM WORK AND PLACE IN Q WQ JMS TAKEW DAC Q JMS MES JMP R-6 AND S20000 /)SET A1 BIT IN CONTROL FIELD XOR* WORK /)OF SV OP AND OF FC OP JMP ARD.SP+3 /ASW PH2 ACTION / MOVE ASSQ TO WORK(+) ASW LAC ASSQ JMP RETURN .EJECT /FLK PH2 ACTION / BUY OT SPACE FOR FOR LINK AND GENERATE OP(FLK,1) / ON POLISH FLK LAC XDICT SZA /EXPAND DICT INFO? LAC C2 /YES TAD C2 TAD POLISH /)LOSE DICT ATTRS FOR DAC POLISH /)CONTROLLED VARIABLE LAC* WORK SAD K2 JMP ANAL04 LAC OTD /CURRENT VALUE OF OTD TO POL(+) JMS PUTPOL ISZ OTD /INCR OTD (1 WORD BOUGHT) LAC U07001 /OP(FLK,1) OPPOL JMS PUTPOL /POL(+)_ JMP ANAL04 OPFC LAC U03601 /OP(FC,1) JMP OPPOL .EJECT /SWD PH2 ACTION SWD JMS TAKEW DAC SP04 CMA /# SW ELEMENTS(=N) DAC .+4 JMS COPY /BUY N WORDS 0 /ON SWITCH SK M*1+SWITCH 0 JMS PUT /APPEND N TO SWITCH SK SWITCH JMS EVA /FIND VADDR OF SWITCH LIST SWBASE JMS PUTW /W(+)_ JMS DDA2 /STORE IN SWITCH ATTRS LAC SP04 JMS PUTW /PUT ARGCT BACK ONTO WORK LAW -2 DAC DIMA JMS DIM /DIM(ATTRS):=1 LAC U06600 JMP OPPOL /OP(END,0)TO POL(+) /FLKPH3 PH2 ACTION /OUTPUT FOR LINK FOR PH3 IF MORE THAN ONE ELEMENT IN FOR LIST FLKPH3 LAC* WORK /LOAD FOR OP AND S00077 /MASK ARG CT SAD C2 /ONLY ONE EL IN FOR LIST? JMP ANAL04 /YES JMP OPPOL-1 /NO,SO OUTPUT FLK OP .EJECT /OTSA PH2 ACTION WHICH BUYS OBJECT TIME SPACE FOR ARRAYS /BUYS ARRAY WORD FOR LOCAL ARRAYS AND OUTPUTS DICT INFO /BUYS DOPE VECTOR AND ARRAY SPACE FOR OWN ARRAYS (NO POLISH OUTPUT) OTSA JMS DIM /SET #DIM INTO ATTRS LAC Q AND S00400 SZA /OWN ARRAY? JMP OTOWN /YES LAC OTD /NO JMS DDA2 /STORE OTD FOR ARRAY WD IN ATTRS XOR S60000 JMS PUTOUT ISZ OTD /BUY 1 WORD OT OTD JMP ANAL04 OTOWN LAC DIMA CMA /NUMBER OF DIMENSIONS TAD C3 /D+3 DAC OTOWN1 LAC OTCD JMS PUT /ADDRESS OF A(L) OWN TAD RESLT /UPDATE OTCD DAC OTCD JMS EVA WKBASE /VIRTUAL ADDRESS OF END OF DAC SP04 /WORK STACK ISZ SP04 /ADDR OF -C(N) JMS COPY M*6+SP04 M*1+OWN /COPY (D+2)WORDS FROM OTOWN1 0 /WORK TO OWN JMS EVA OWBASE /ADDRESS OF END OF DOPE JMS PUT /VECTOR TO ARRAY WORD OWN TAD K1 JMS DDA2 /ADDR OF ARRAY WD TO ATTRS JMP ANAL04 /JUMP BACK TO ANAL04 .EJECT /FIX PH2 ACTION ROUTINE / OUTPUT OP(FIX,1) TO POLISH FIX XX LAC U07601 JMS PUTPOL ISZ Q /MARK Q INTEGER JMP* FIX /FLOAT ROUTINE TO OUTPUT OP(FLOAT,1) TO POLISH FLOAT XX LAC U07701 JMS PUTPOL LAC Q TAD K1 DAC Q JMP* FLOAT /CFLOAT PH2 ACTION / OUTPUT OP(FLOAT,1) TO POLISH & SET COMPLEX BIT IN Q. CFLOAT LAC Q AND S40000 /SET COMPLEX BIT IF NOT ALREADY SET SZA JMP CFL2 LAC S40000 XOR Q DAC Q CFL2 JMS FLOAT JMP ANAL04 .EJECT /DIPOL DICT INFO ONTO POLISH(+) /COPIES DICT ATTRS(VADDR IN NAPTR)ONTO POL REMOVING UPNPTR /WORD AND ATTACHING AN OPERATOR WORD DIPOL XX LAC XDICT SNA /EXPAND DICT INFO? JMP DIPOL4 /NO LAC NAPTR /VADDR OF ATTRS TAD U00001 /OMIT UPNPTR WORD DAC .+2 JMS COPY /COPY 3 WORDS OF DICT INFO 0 /ONTO POLISH(+) M*1+POLISH 3 LAC Y06703 /OP(DICT INFO,3) DIPOL2 JMS PUTPOL /POL(+)_ JMP* DIPOL DIPOL4 JMS LDA3 /LOAD SKTHL WD FROM DICT ATTRS JMS PUTPOL /POL(+)_ JMS LDA2 /LOAD DISP WD AND T77777 /)SET TOP TWO BITS FOR XOR Y00000 /)PUTOUT ROUTINE JMP DIPOL2 .EJECT /DIM SET DIM IN ATTRS FROM DIMA /USED BY OTSA AND PN TO SET DIM IN ATTRS(VADDR IN NAPTR) /ON ENTRY DIMA=-(#DIMS)-1 FOR ARRAYS / =-(#PARAMS)-1 FOR PROCS DIM XX LAC DIMA CMA /AC=#DIMS(PARAMS) JMS MES JMP LL+14 /TO MS 6 BITS DAC ARGCT /HOLD JMS LDA1 /ACCESS DICT INFO WORD 1 AND S07777 /CLEAR DIM FIELD XOR ARGCT /PACK IN DIM DAC* SP00 /STORE RESULT JMP* DIM .EJECT /OTS /OBJECT TIME SPACE ALLOCATOR /ON ENTRY Q CONTAINS DETAILS OF QUANTITY FOR WHICH SPACE HAS /TO BE ALLOCATED /THE ATTRIBUTES OF THE QUANTITY ARE POINTED TO BY VADDR IN NAPTR OTS00 XX LAC Q AND S00400 /M(0) SZA JMP OTSOWN /J TO DEAL WITH OWN VARIABLE LAC Q AND S06011 /M(Y):M(FN):M(S):M(R) TAD Z74000 /IS IT AN ARRAY? SMA /NO JMP OTS02 /YES:ALLOCATE 1 WORD TAD S02000 /IS IT FORMAL BY NAME? SPA /YES JMP OTS04 /NO AND S00010 /IS IT A FORMAL STRING? SNA /YES:ALLOCATE 1 WORD ISZ OTD /NO:ALLOCATE 2 WORDS OTS02 LAC OTD JMS DDA2 /STORE VALUE OF OTD IN ATTRS ISZ OTD /MAKE OTD ADDRESS NEXT SPARE LOCN JMP* OTS00 OTS04 AND C1 /IS IT REAL? SNA /YES:ALLOCATE 3 WORDS JMP OTS02 /NO:ALLOCATE 1 WORD ISZ OTD JMP OTS02-1 /OTSOWN DEALS WITH OBJECT TIME SPACE ALLOCATION FOR / OWN VARIABLES OTSOWN LAC OTCD /PUT CURRENT COMMON DISPL JMS PUT /INTO NEXT OWN LOCN OWN JMS EVA /FIND VADDR OF THIS LOCN OWBASE JMS DDA2 /& STORE IN ATTRS(AS DISPL) ISZ OTCD /STEP COMMON DISPL LAC Q AND C1 /IS Q REAL? SNA /YES JMP* OTS00 ISZ OTCD /ALLOCATE 3 WORDS ISZ OTCD JMP* OTS00 .EJECT /CAFC PH2 CATOM TEST /CHECK ACTUAL FORMAL CORRESPONDENCE /ON ENTRY WORK HOLDS ARGCT (#PARAMS+1,-VE) / AND NAPTR VADDR OF DICT ATTRS OF PROCNAME /ON EXIT PARAM LIST IS EXHAUSTED AND STATE =FALSE /SCRATCHPAD USED:-SP00,SP01,SP02,SP04,SP05 CAFC LAC* WORK /HOLD ARGCT TEMPORARILY DAC SP04 CMA DAC SP05 /HOLD # PARAMS(+) JMS LDA2 /LOAD VADDR OF PROC INFO TAD C7 TAD SP05 /BUMP TO Q FOR FIRST PARAM DAC* WORK /HOLD ON WORK LAC SP04 JMS PUTW /REPLACE ARGCT ON WORK LAC AEXP22 /CHANGE XB IN CASE ANY ACTUAL DAC XB /IS A PARAM-LESS PROC JMP CAFC10 CAFC2 JMS LAM /GET CURRENT VADDR OFF WORK M*1+WORK TAD K1 /BUMP TO VADDR OF NEXT PARAM WD DAC* SP00 /REPLACE OLD VADDR ON WORK DAC SP04 JMS LV4 /LOAD PARAM WD DAC Q /SET Q FOR PRORP JMS PUTW /SK FORMAL Q(SORT=PROC IF PAR NOT SPECD) JMS PRORP /PROCESS ACTUAL PARAM JMS TAKEW DAC FQ /REMEMBER EXPANDED FORMAL S,K,T LAC Q /GET RESULTANT Q FOR ACTUAL PARAM AND S20000 SNA /IS SORT=PROC? JMP CAFC6 /NO TAD S10000 /MARK SORT=VARIABLE JMS OBEY /CHECK PROC IS PARAM-LESS JMP ANAL+4 /IF SO POL(+)_OP(FC,1) CAFC6 XOR Q /AC:=Q FOR ACTUAL:NOT SORT=PROC AND U34177 /CLEAR KIND(Q) XOR FQ /MATCH WITH Q FOR FORMAL PARAM TAD Z77000 SZA /SKIP IF FV & MATCH SAD S01000 /SKIP IF NOT(FN & MATCH) JMP CAFC8 /OK SAD C3 /SKIP IF NOT(FV & ARITH) JMP CAFC7+2 LAW -105+Y /ERROR 69(MISMATCH) CAFC7 JMS PH2ERR JMP CAFC10 LAC Q AND C1 /GET TYPE(Q) SZA JMP CAFC12 JMS FLOAT CAFC8 LAC FQ /LOAD FORMAL S,K,T AND S04004 /MASK ARRAY & BOOLEAN BITS TAD Z74000 SMA!RAR /ARRAY? JMP CAFC14 /YES RTR /LINK:=1 IF BOOLEAN SZL /BOOLEAN? JMP CAFC18 /YES LAC FQ /LOAD FORMAL Q CAFC9 DAC Q /DUMP IN Q FOR Q.SKT CALL JMS Q.SKT /AC:=PACKED FORMAL S,K,T JMS MES JMP R-5 /MOVE TO OPCODE FIELD AND S00700 /MASK TYPE BITS XOR U07000 /COMPLETE OPCODE FIELD & SET B1 DAC SP04 /HOLD LAC Q /LOAD FORMAL Q RTL /)OBTAIN FN,FV BITS RAL /)AND ARGCT FOR INSERTION AND S30001 /)IN OP GIVING FORMAL PAR TYPE XOR SP04 /INSERT OPCODE FIELD JMS PUTPOL /POL(+)_OP(FPT,1) CAFC10 ISZ* WORK /MORE PARAMS? JMP CAFC2 /YES ISZ WORK /REMOVE ARGCT FROM WORK LAC AFC42 DAC XB /RESET XB JMP CARG+2 /WORK(-)(PARAM ADDR):FALSE CAFC12 JMS FIX /OUTPUT FIX OP JMP CAFC8 CAFC14 JMS LAM /LOAD SKT WD FROM ACTUAL DICT INFO M*1+POLISH AND S03777 /HOLD K,H,L XOR W10000 /SET S=VAR,T=INT DAC* SP00 LAC U17201 /LOAD OP (FV,FINT,1) JMP CAFC10-1 CAFC18 LAC FQ /LOAD FORMAL Q AND Z77600 /CHANGE TYPE TO INT XOR C2 JMP CAFC9 .EJECT /PBPL PHASE 2 CATOM TEST TO PROCESS A BOUND PAIR LIST / EXTRACTS DIMENSIONS OF ARRAY FROM BPL OPERATOR /PROCESSES BPL AND COMPUTES DOPE VECTOR(ON TO WORK) FOR OWN ARRAYS PBPL LAC* REVPOL AND S00077 /AC=2*DIM CMA!STL RAR DAC DIMA /DIMA=-D-1 LAC U06600 JMS PUTPOL JMS PRORP /PROCESS BPL LAC Q3 /)SET UP Q FOR DECN DAC Q /)OF ARRAY NAMES AND S00401 /M(O) RCR SNA /OWN ARRAY? JMP PBPL12 /NO:FALSE JMS TAKEW /)YES:DISCARD OP(ASEG) DAC ARGCT /CDVW THIS SECTION CREATES A DOPE VECTOR ON WORK /ENTRY: POL SK HOLDS VADDR(ON INT. SK) OF U(N) / " L(N) / . / . / VADDR(ON INT. SK) OF U(1) / " L(1) / BPL OP _POLISH / WHERE THE BOUND PAIR LIST IS [L(1):U(1),...,L(N):U(N)] /EXIT: WORK SK HOLDS -(NO. OF DIMS) / C(N-1) / . / . / C(1) / C(0) / -A[0] / -C(N) _WORK / WHERE C(I)=(U(I)-L(I)+1)*C(I-1) AND C(0)=1 OR 3 / AND WHERE A[0]=SUM OF L(I)*C(I-1) LAC DIMA TAD C1 /-NUMBER OF DIMENSIONS JMS PUTW /PUT ON WORK STACK DAC A0 DAC SP06 RCL /-2D CMA /2D-1 TAD POLISH /ADDR OF L(N) JMS EVA00 POBASE DAC NAPTR /HOLD VADDR OF L(N) CDVW1 JMS LDA1 /AC:= VADDR OF UPPER BOUND DAC SP04 JMS LV4 /AC:= UPPER BOUND DAC SP05 JMS LDA0 /AC:= VADDR OF LOWER BOUND DAC SP04 JMS LV4 /AC:= LOWER BOUND CMA /-L.B.-1 TAD SP05 /ADD UPPER BOUND TAD C2 /ADD 2 SPA!SNA /RANGE >0? JMP CDVW8 /NO CDVW5 JMS PUTW /YES,PUT RANGE ON WORK LAW -2 TAD NAPTR DAC NAPTR ISZ A0 /ANY MORE DIMENSIONS? JMP CDVW1 /YES LAC Q /NO,REAL INTEGER OR AND C1 /BOOLEAN? STL /IF INTEGER OR BOOLEAN,1 WORD ELEMENT RAL /IF REAL,3 WORD ELEMENT DAC MAP /1 OR 3 INTO MAP JMS EVA WKBASE /VIRTUAL ADDRESS OF THE END DAC SP04 /OF THE WORK STACK CDVW4 ISZ NAPTR ISZ NAPTR JMS LDA0 /VADDR OF LOWER BOUND TO AC DAC SP05 JMS LVM /LOWER BOUND TO AC SP05 SMA /-VE LOWER BOUND? JMP CDVW6 /NO JMS TCA /NEGATE L.B. JMS MULT /MULTIPLY BY APPROP. C JMS TCA /NEGATE RESULT SKP CDVW6 JMS MULT /MULTIPLY ROUTINE TAD A0 DAC A0 /SUM OF L(I)*C(I-1) JMS LV4 /RANGE(I+1) DAC RESLT /INTO CN LAC MAP /C(I) JMS DVM SP04 /LOAD C(I) ONTO WORK STACK LAC RESLT /MULTIPLY R(I+1) AND C(I) TO JMS MULT /FORM DAC MAP /C(I+1) ISZ SP04 ISZ SP06 /ANY MORE DIMENSIONS? JMP CDVW4 /YES,LOOP AGAIN LAC A0 JMS TCA JMS PUTW LAC MAP JMS TCA JMS PUTW /C(N) ONTO WORK STACK LAC POBASE /RESET POLISH DAC POLISH /POINTER LAC ARGCT /ARGCT JMS PUTW /WORK(+)_ JMP TRUE CDVW8 LAW -131 /REPORT ERROR 89 JMS ERR /RANGE -VE LAC C1 JMP CDVW5 /SET RANGE=1 AND RETURN PBPL12 SNL /REAL ARRAY? JMP FALSE /NO LAC S10000 /YES, SO SET BIT IN BPL OP XOR* POLISH DAC* POLISH JMP FALSE .EJECT /MULT /SUBROUTINE USED BY CDVW TO MULTIPLY INT.(+) HELD IN GLOBAL LOCN MAP /(MULTIPLICAND) BY INT.(+) HELD IN AC ON ENTRY (MULTIPLIER). /RESULT IN AC ON EXIT. /SCRATCHPAD USED:- SP00,SP01,SP02,SP03,SP05 MULT XX DZM RESLT /CHECK FOR 0 MULTIPLIER SNA JMP* MULT DAC SP00 /HOLD MULTIPLIER INTO SP00 LAC K19 DAC SP03 /SP03=-19 DEC LAC SP00 MULT1 RAL /SHIFT SP00 1 LEFT ISZ SP03 /INCREMENT SNL /LINK=0? JMP MULT1 /YES,LOOP AGAIN DZM SP05 DZM SP02 MULT2 LAC SP00 /LOAD MULTIPLIER RAR /SHIFT 1 RIGHT DAC SP00 /LOAD BACK SNL /LINK=0? JMP MULT6 /YES DZM SP05 /NO CLA!CLL /AC=0 SAD SP02 /SP02=0? JMP MULT4 /YES LAC MAP /LOAD MULTIPLICAND MULT3 RAL /SHIFT 1 LEFT DAC SP01 ISZ SP05 /INCREMENT COUNT LAC SP05 SAD SP02 /SP02 BITS MOVED? JMP MULT5 /YES LAC SP01 /NO JMP MULT3 /LOOP AGAIN MULT4 LAC MAP /LOAD MULTIPLICAND DAC SP01 MULT5 LAC RESLT TAD SP01 DAC RESLT MULT6 ISZ SP02 ISZ SP03 /MULTIPLICAND FINISHED? JMP MULT2 /NO LOOP AGAIN JMP* MULT /EXIT .EJECT /CQQ PHASE 2 CATOM TEST / CHECK COMPATIBILITY OF THE Q'S ASSOCIATED WITH PAIRS OF / ARGUMENTS & GENERATE RESULTANT Q AS FUNCTION OF OPERATOR / SETS UP CONTROL BITS IN PREC.FIELD OF OPERATOR /USED IN ANALYSIS OF ASSIGNMENTS,IFEX,AND DYADICS /ON ENTRY WORK STACK CONTAINS :-OPERATOR / Q(2ND ARG) / Q(1ST ARG)_WORK / /ON EXIT LOCN Q UPDATED AND OPERATOR UPDATED ON WORK STACK CQQ LAW -114 DAC ERRNO /ERRNO=-76 JMS TAKEW AND S00177 /TYPE(Q(1ST ARG)) DAC Q /_Q JMS TAKEW DAC Q2 /Q2_Q(2ND ARG) AND S40000 /M(C) IN Q2 DAC OP /HOLD IN OP LAC Q2 RAR /LMK _IN (R) IN Q2 LAC Q JMS MES /M(R1),M(R2) TO MS 6 BITS JMP R-6 AND S30000 XOR OP /PACK INTO OPERATOR SAD S20000 /1ST ARG REAL AND 2ND ARG NOT? XOR S40000 /YES, SO SET COMPLEX BIT IN OP XOR* WORK /PACK INTO OP DAC* WORK /REPLACE OP ON WORK BY RESULT DAC OP XOR W00000 /SET SIGN BIT FOR ERROR MODULE DAC VOCPTR /HOLD IN VOCPTR FOR ERRORS LAC Q2 AND S00070 /M(NLS) IN Q2 SZA /2ND ARG N,L, OR S? JMP CQQ12 /YES:ERROR 71 LAC Q AND S00070 SZA /1ST ARG N,L OR S? JMP CQQ14 /YES:ERROR76 LAC Q2 AND S00177 XOR Q /Q_TYPE(Q(1))\TYPE(Q(2)) AND C7 /REMOVE M(X) IF SET SNA /IF BOTH ARGS OF SAME TYPE CQQ01 LAC Q2 /USE TYPE (Q2) AND S00177 DAC Q /Q_Q2(TYPE OF BOTH ARGS) AND S00100 SZA /Q=X? JMP TRUE /YES:EXIT ISZ ERRNO /ERRNO=-75 LAC OP AND S01000 SZA /IS OP=IFEXP,ASS,BOOL? JMP CQQ07 /YES LAW -4 TAD Q SMA /BOTH ARGS ARITHMETIC? JMP CQQ09 /NO CQQ03 LAC OP /YES AND S02000 SZA /IS OP=RELATIONAL? JMP CQQ06 /YES LAC C2 /NO SAD Q /BOTH ARGS INTEGER? JMP TRUE /YES DAC Q LAC OP /NO AND S07700 SAD S04400 /OP='IDIV'? JMP CQQ10+2 /YES:ERROR 75 CQQ04 LAC C1 /NO:Q_REAL DAC Q /RESULTAN TYPE TO Q JMP TRUE /RELATIONAL OP CQQ06 LAW 770000 AND* WORK /HOLD CAA FROM OP TAD S04102 /INJECT (MINUS,2) JMS PUTPOL /POLISH(+)_ LAC C4 /Q_BOOLEAN JMP CQQ04+1 /OP=IFEXP,ASS,BOOLEAN CQQ07 ISZ ERRNO /ERRNO=-74 LAC OP AND S00400 SNA /IS OP=BOOLEAN? JMP CQQ08 /NO LAC C4 /YES SAD Q /BOTH ARGS BOOLEAN? JMP TRUE /YES JMP CQQ10+1 /NO:Q_BOOL ERROR74 /OP=IFEXP OR ASS CQQ08 LAW -4 TAD Q SZA!SMA /BOTH ARGS BOOL OR ARITHMETIC? JMP CQQ10-2 /NO:Q_X:ERROR 72 SAD K1 /ARGS OF DIFFERENT ARITH TYPE? JMP CQQ04 /YES:RESULT TYPE=REAL JMP TRUE /NO:Q IS OK /NON-ARITH ARGS TO ARITH OP CQQ09 SZA /BOTH ARGS BOOLEAN? JMP CQQ11 /NO ISZ ERRNO ISZ ERRNO CQQ10 LAC S00100 /YES:Q_X:ERROR 73 DAC Q LAC ERRNO XOR S04000 /CLEAR ERROR TYPE 4 BIT JMS ERR JMP TRUE CQQ11 DAC Q /Q_ARITH TYPE LAW -115+Y /ERROR 77 JMS ERR JMP CQQ03 /CONTINUE /2ND ARG OF WRONG TYPE CQQ12 LAW -107+Y /ERROR 71 JMS ERR LAC Q AND S00070 /M(NLS)IN Q SZA /1ST ARG N,L OR S? JMP CQQ10 /YES:Q_X:ERROR 76 LAC Q /NO JMP CQQ01+3 CQQ14 LAW -114+Y /ERROR 76 JMS ERR JMP CQQ01 .EJECT /SCANP:SUBROUTINE USED BY PH2 CATOM TESTS FNVP,FNPK /SCAN PARAMETER LIST ON PROC STACK FOR VOCPTR HELD ON REVPOL /ON EXIT:IF FOUND SP00 HOLDS ABS ADDR OF PARAMETER WORD / AND AC HOLDS CONTENTS OF THIS WORD /IF NOT FOUND REVPOL WORD IS DISCARDED AND CONTROL GIVEN / IMMEDIATELY TO 'FALSE'(LINK NOT USED) SCANP XX LAC* REVPOL DAC VOCPTR /HOLD VOCAB PTR FOR ERRORS LAC PROC /GET END OF PROC SK TAD C6 DAC SP04 /ADDR OF # OF PARAMS LAC* SP04 DAC SP01 /# PARAMS (-VE COUNT) JMP SCANP2 /ENTER SCAN SCANP1 ISZ SP04 /STEP THRU PARAMS LAC* SP04 AND V77777 /EXTRACT VPTR FROM PARAM WORD SAD VOCPTR /=VOCAB PTR FOR SPEC? JMP* SCANP /YES:EXIT SCANP2 ISZ SP01 /NO:END OF PARAMS? JMP SCANP1 /NO:CONTINUE SCAN ISZ REVPOL /DISCARD VOCPTR ON REVPOL JMP FALSE .EJECT /FNPV FIND PARAMETER WORD & MARK 'BY VALUE'(SIGN BIT) / IF FOUND,EXIT FALSE IF NOT FOUND FNPV LAC FPLERR SZA /PH1 FAILURE IN FPEL? JMP TRUE /YES,SO IGNORE VALUE PART JMS SCANP /SCAN PARAM LIST ISZ REVPOL /LOSE VOCPTR FROM REVPOL XOR W00000 /MARK'BY VALUE' DAC* SP04 /RESET PARAMETER WORD JMP TRUE /FNPK FIND PARAMETER WORD & SET KIND(Q) FROM SIGN BIT / USE Q TO DECLARE PARAM & SET VADDR OF ATTRS / FOUND INTO PARAM WORD /IF PARAM WORD NOT FOUND EXITS FALSE(IN SCANP) FNPK LAC FPLERR SZA /PH1 FAILURE IN FPEL? JMP FNPK10 /YES JMS SCANP /SCAN PARAM LIST LAC* SP04 RAL /LINK_'BY VALUE' LAW 774177 AND Q XOR S01000 /KIND(Q):='BY VALUE' SNL /IS PARAM BY VALUE? TAD S01000 /NO:MARK Q 'BY NAME' DAC Q /RESULT TO Q LAC SP04 JMS EVA00 PRBASE /CONVERT ABS ADDR OF PARAM WD TO VADDR DAC SP04 /HOLD JMS DEC00 /DECLARE PARAM LAC ATRUE /)RESET DEC LINK DAC DEC00 /)TO TRUE LAC NAPTR /PARAM ATTR TO PARAM LIST JMS DVM SP04 JMP TRUE FNPK10 LAW 774177 AND Q /CLEAR KIND FIELD IN Q XOR S02000 /MARK FORMAL BY NAME DAC Q JMS DEC00 /DECLARE SPEC VARIABLE LAC ATRUE DAC DEC00 /RESET LINK JMP TRUE .EJECT /CARG INCREMENT -VE COUNT ON WORK / TRUE IF THEN NON ZERO / FALSE IF THEN ZERO (REMOVED FROM WORK(-)) CARG ISZ* WORK /INCREMENT ARGCT JMP TRUE /_TRUE IF NOT ZERO LOSECT ISZ WORK /WORK(-) JMP FALSE /CTANR AS CARG EXCEPT NXTRQD MARKED IF TRUE CTANR ISZ* WORK JMP OQK01 /NXTRQD:TRUE JMP CARG+2 /CDIMZ TRUE IF DIM(ATTRS(NAPTR))=0 ELSE FALSE CDIMZ JMS LDA1 AND Z70000 /EXTRACT DIM FROM ATTRS JMP REFV01 /REFV PROCESS NAME ON REVPOL AS A REFERENCE / FALSE IF FAILED(M(X)=1) ELSE TRUE REFV JMS NQ /NONE -> TYPE(Q) JMS PRORP LAC Q AND S00100 /EXTRACT M(X) REFV01 SZA JMP FALSE JMP TRUE /CDIM TRUE IF DIM(ATTRS(NAPTR))=1+ARGCT(WORK)ELSE FALSE CDIM LAC* WORK /-ARGCT-1 CMA DAC ARGCT /ARGCT JMS LDA1 JMS MES JMP RR+14 AND S00077 /AC=DIM SAD ARGCT /DIM=ARGCT? JMP TRUE /YES JMP FALSE /NO .EJECT /CAP PH2 CATOM TEST /CHECK ASSIGNMENT TO PROC NAME CAP JMS LDA2 /LOAD PROC INFO PTR WD SMA /PROC ACTIVE? JMP FALSE /NO TAD C3 /AC:=VADDR OF NPW WD IN PROC INFO DAC SP04 JMS LV4 /LOAD NPW WD SPA /PROC REAL? TAD W00002 /YES, SO ADD 4 TO NPW TAD C2 /NO, SO ADD 2 TO NPW DAC SP00 /HOLD LAC XDICT SNA /EXPAND DICT INFO? JMP CAP06 /NO LAC SP00 JMS DAM /INSERT NEW NPW IN DISPL. WD M*2+POLISH CAP04 JMS LAM /LOAD H,L WD FROM PROC ATTRS M*1+POLISH TAD Z00100 /MARK AS VARIABLE, & INCREMENT HIERARCHY DAC* SP00 /SET IN ATTRS JMP TRUE CAP06 LAC SP00 XOR Y00000 DAC* POLISH JMP CAP04 /TASQ IF ASSQ=0 THEN ASSQ:=TYPE(Q)THEN TRUE / ELSE IF ASSQ=TYPE(Q) THEN TRUE ELSE FALSE TASQ LAC ASSQ SZA /ASSQ=0? JMP TASQ01 /NO LAC Q AND S00177 /TYPE(Q) DAC ASSQ /ASSQ,_ JMP TRUE TASQ01 AND Q SZA /ASSQ=TYPE(Q)? JMP TRUE /YES JMP FALSE /NO /OQK KIND(Q)_OWN:MARK NXTRQD:TRUE OQK LAW 774177 AND Q /CLEAR KIND(Q) XOR S00400 /KIND(Q)_OWN DAC Q OQK01 DZM NXTRQD JMP TRUE .EJECT /OPTQ TYPE(Q)_TYPE(OPCODE):IF VARB THEN FALSE ELSE TRUE OPTQ LAC VOCPTR /ACCESS OPERATOR JMS MES JMP R-6 AND C7 /EXTRACT OPCODE TAD ATYPE /TYPE(OPCODE) DAC .+3 LAC Q AND X77600 /CLEAR TYPE Q &D1 XOR TYPE /TYPE(OPCODE) DAC Q /_Q AND S10000 /M(V) SZA /SKIP IF NOT M(V) JMP FALSE JMP OQK01 /LEVZ TRUE IF L(CHL)=0 ELSE FALSE LEVZ LAC CHL AND S00077 /EXTRACT L FROM CHL JMP REFV01 /STP PROCESS STEP OPERATOR STP LAC PLUS JMS PUTRP /REVPOL(+)_OP(PLUS,2) /ARP PROCESS AFOR OPERATOR ARP LAC U01202 /OP(ASS,2) ARP01 JMS PUTRP /REVPOL(+)_ JMP OQK01 /NEXT REQD :TRUE /UNT PROCESS UNTIL STREAM UNT LAC MIN+1 /OP(MULT,2) JMS PUTRP /REVPOL(+)_ LAC S27776 /CONST(INTEGER 0) JMS PUTRP /REVPOL(+)_ LAC MIN+13 /OP(LE,2) JMS PUTRP /REVPOL(+)_ IFRP LAC NAME+5 /OP(IFS,1) JMP ARP01 /REVPOL(+)_:NXTRQD:TRUE_ /QHOLD PH2 CATOM TEST /HOLD Q IN GLOBAL LOCN Q3 THEN IF OWN THEN TRUE ELSE FALSE QHOLD LAC Q DAC Q3 AND S00400 JMP TASQ01+1 .EJECT /TPI PH2 CATOM TEST /TEST FOR +INT (AS EXPONENT) TPI LAC* REVPOL /LOAD CURRENT REVPOL WD DAC SP04 /HOLD IN CASE INT. SK PTR AND Z70000 SAD S20000 /INT. SK PTR? SKP /YES JMP FALSE /NO JMS LV4 /LOAD INTEGER SPA /+VE? JMP FALSE /NO JMS PRORP /YES, SO PROCESS IT JMP TRUE /CPN PH2 CATOM TEST / CHANGE PROCNAME IF ALIAS GIVEN CPN LAC REVPOL /LOAD REVPOL PTR SAD RPBASE /=BASE? JMP CPN2 /YES, SO EXIT(NO ALIAS GIVEN) JMS TAKERP /REVPOL(-):AC:=VOCAB PTR DAC NAPTR JMS LDA2 /LOAD SECOND WD OF PROCNAME JMS DAM /PROC_ M*1+PROC JMS LDA1 /LOAD FIRST WD OF PROCNAME XOR U00000 /SET BIT 1 AS EXTERNAL FLAG DAC* PROC JMP FALSE CPN2 LAC* PROC JMP .-4 /BIR,IR PH2 CATOM TESTS /MASK BOOLEAN AND/OR(INTEGER,REAL) BITS IN Q BIR LAC C7 SKP IR LAC C3 JMP TASQ01 .EJECT /GNBS /SUBROUTINE TO GET THE NEXT BASIC SYMBOL AND ISSUE IT (AS AN /INTERNAL CODE) IN THE LOCATION BS AND IN THE AC TO THE CALLING PROGRAM GNBS XX LAC BSW SNA /INTERNAL CODE WAITING? JMS GNBS60 /NO,SO GET ONE IN AC AND BSW JMS COPY /)REMEMBER END OF LAST BS LCT1 /)AND START OF CURRENT BS LCT3 /) 4 /) LAC BSW DAC BS SAD U00027 /COLON? JMP GNBS52 /YES,SO SEE IF FOLLOWED BY = SAD U00074 /QUOTE? JMP GNBS25 /YES, SO READ KEYWORD SAD U10025 /LESS THAN? JMP GNBS50 /YES,SO SEE IF FOLLOWED BY = SAD U10020 /GREATER THAN? JMP GNBS51 /YES, SO SEE IF FOLLOWED BY = AND S01400 /MASK LD AND L BITS SAD S01400 /LETTER? JMP GNBS41 /YES SZA /DIGIT? JMP RNUM /YES,SO READ NUMBER LAC BS SAD U00067 /@? JMP RNUM /YES,SO READ NUMBER AND S04000 SZA /%,# OR .? JMP GNBS16 /YES LAC BS /ISSUE INTERNAL CODE IN AC GNBS12 DZM BSW DAC BS /EXIT FROM GNBS LAC LCT1 /) DAC LCT6 /)CORRECT POSN OF END LAC CHPOS1 /)OF CURRENT BS DAC CHPOS6 /) JMP GNBS14 GNBS13 DAC BS LAC LCT2 /) DAC LCT6 /)CORRECT POSN. OF END LAC CHPOS2 /)OF CURRENT BS DAC CHPOS6 /) GNBS14 LAC BS /EXIT WITH BS IN AC SZA /INVALID KEYWORD? JMP* GNBS /NO LAW -45 /YES,ERROR 37 JMS ERR CLA /EXIT WITH BS IN AC JMP* GNBS GNBS16 LAC EXTMRK RAR /L:=1 IF EXTERNAL MODE LAC BS SZL /EXTERNAL MODE? JMP GNBS41 /YES SAD U04033 /%? LAC U00077 /YES,SO LOAD INVALID CODE SAD U14047 /#? LAC U10023 /YES,SO LOAD 'NE' CODE SAD U04034 /.? JMP RNUM /YES,SO READ NUMBER JMP GNBS12 .EJECT /CODE TO READ IN A KEYWORD. NCB STANDS FOR NAME CHAR BLOCK. GNBS25 JMS GNBS64 /OPEN THE NCB GNBS26 JMS GNBS60 /GET NEXT CHAR IN AC AND BSW DAC BS AND S01000 SNA /LETTER OR DIGIT? JMP GNBS27 /NO LAC SP02 /LOAD CHAR COUNT SAD C9 /9? JMP GNBS30 /YES JMS GNBS61 /PACK THE CURRENT CHAR JMP GNBS26 GNBS27 LAC BSW /LOAD CURRENT CHAR SAD U00074 /QUOTE? JMP GNBS31 /YES GNBS30 CLA JMP GNBS13 /EXIT FROM GNBS GNBS31 LAC AAKTAB DAC* C8 /INITIALISE KEYWORD TABLE PTR GNBS32 LAC ANCB DAC SP01 /INITIALISE NCB PTR GNBS33 LAC* AUTO /LOAD CURRENT WORD OF KEYWORD TABLE SAD Z70001 /END OF TABLE? JMP GNBS37 /YES SAD* SP01 /CURRENT KEYWD TABLE WD = CURRENT NCB WD? JMP GNBS35 /YES SMA /CURRENT KEYWD TABLE WD NEGATIVE? JMP GNBS34 /NO LAC* AUTO /LOAD CURRENT KEYWD TABLE WD JMP .-3 GNBS34 LAC* AUTO /SKIP OVER INTERNAL CODE JMP GNBS32 GNBS35 SMA /CURRENT KEYWD TABLE WD NEGATIVE? JMP GNBS36 /NO ISZ SP01 /INCREMENT NCB PTR JMP GNBS33 GNBS36 LAC* AUTO /ISSUE CODE FOR KEYWD FOUND JMP GNBS12 GNBS37 CLA JMP GNBS12 .EJECT /CODE TO READ IN AN IDENTIFIER. NCB STANDS FOR NAME CHAR BLOCK. GNBS41 JMS GNBS64 /OPEN THE NCB GNBS42 JMS GNBS61 /PACK CURRENT CHAR INTO NCB GNBS43 JMS GNBS60 /GET NEXT CHAR IN AC AND BSW DAC BS LAC EXTMRK RAR /L:=1 IF EXTERNAL MODE LAC BS AND S01000 /MASK LD BIT SZA /LETTER OR DIGIT? JMP GNBS47 /YES LAC BS AND S04000 SZA /%,# OR .? SNL /YES,SO SKIP IF IN EXT MODE JMP GNBS44 /ILLEGAL CHAR FOR IDENT FOUND GNBS47 LAC SP02 /LOAD CHAR COUNT SAD C6 /CHAR COUNT = 6? JMP GNBS43 /YES JMP GNBS42 GNBS44 DZM BS /START OF CODE TO CLOSE NCB GNBS45 LAC SP02 /LOAD CHAR COUNT TAD K3 /SUBTRACT 3 SNA /CHAR COUNT = 3 OR 6 ? JMP GNBS46 /YES SMA JMP .-4 JMS GNBS61 /PACK SPACE INTO NCB JMP GNBS45 GNBS46 JMS NSTK /STORE IDENTIFIER ON VOCAB STACK LAC U20037 /ISSUE "IDENTIFIER" CODE JMP GNBS13 /EXIT FROM GNBS .EJECT /CODE TO TREAT :, > AND <. GNBS50 LAW U10024 /LOAD ADDRESS OF INT. CODE FOR <= JMP .+4 GNBS51 LAW U10021 /LOAD ADDR OF CODE FOR >= SKP GNBS52 LAW U00026 /LOAD ADDR OF CODE FOR := TAD U20000 /CHANGE OP FIELD TO LAC DAC GNBS54 JMS GNBS60 /GET NEXT CHAR IN AC AND BSW SAD U10022 /NEXT CHAR IS = ? JMP GNBS54 /YES JMP GNBS13+1 GNBS54 XX /CHANGED DYNAMICALLY TO LAC <=, >= OR := JMP GNBS12 /EXIT FROM GNBS .EJECT /GNBS60 /SUBROUTINE TO GET THE NEXT CHAR, CONVERT IT TO AN INTERNAL CODE /AND ISSUE THE CODE IN THE AC AND IN BSW. SPACES ARE IGNORED. /ILLEGAL CHARS CAUSE AN ERROR MESSAGE ,BUT ARE OTHERWISE /IGNORED GNBS56 XX GNBS57 SAD S00040 /SPACE? JMP GNBS58 /YES TAD ABSS /ADD ASCII CODE OF CHAR DAC SP00 /STORE ADDR OF INTERNAL CODE LAC* SP00 /LOAD INTERNAL CODE SAD U00077 /INVALID CHAR? JMP .+3 /YES DAC BSW JMP* GNBS56 LAW -57+Z /REPORT ERROR 47 JMS ERR GNBS58 JMS GNC /IGNORE IT JMP GNBS57 GNBS60 XX LAC LCT1 /REMEMBER POSN OF LAST MEANINGFUL CHAR DAC LCT2 LAC CHPOS1 DAC CHPOS2 JMS GNC JMS GNBS56 JMP* GNBS60 .EJECT /SUBROUTINE TO PACK THE CHAR HELD IN BS INTO THE THREE WD NAME CHAR /BLOCK (NCB), IN RADIX 50. GNBS61 XX LAC BS AND S00077 /CUT CHAR CODE DOWN TO RADIX 50 (6 BITS) DAC BS LAC SP02 /LOAD CHAR COUNT TAD K3 /FORM (CHAR COUNT - 3) SNA /CHAR COUNT = 3 OR 6 ? JMP GNBS63 /YES SMA JMP .-4 LAC* SP01 /LOAD CURRENT WD OF NCB RCL /MULT CURRENT WD BY 50 (RADIX 8) RTL DAC SP03 RTL TAD SP03 GNBS62 TAD BS /ADD CURRENT CHAR IN RADIX 50 DAC* SP01 /STORE IN CURRENT WD OF NCB ISZ SP02 /INCREMENT CHAR COUNT JMP* GNBS61 GNBS63 LAC* SP01 /LOAD CURRENT WD OF NCB XOR W00000 /SET SIGN BIT DAC* SP01 /STORE IN CURRENT WD AGAIN ISZ SP01 /INCREMENT PTR CLA JMP GNBS62 .EJECT /SUBROUTINE TO OPEN THE NAME CHAR BLOCK (NCB) GNBS64 XX DZM NCB /CLEAR NCB DZM NCB1 DZM NCB2 DZM SP02 /INITIALISE CHAR COUNT LAC ANCB DAC SP01 /SET PTR TO WD 1 OF NCB JMP* GNBS64 .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. /12 BITS OF THE APPROPRIATE REVPOL OPCODE. 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 DAC NAME /INSERT VADDR IN REVOP TABLE JMP* NSTK NSTK14 SNL /NEW NAME ONE WD? JMP NSTK16 /YES LAC NCB1 /PUT SECOND WD OF NEW JMS PUT /NAME ON VOCAB STACK VOCAB NSTK16 LAC NCB JMS PUT /PUT FIRST WD ON VOCAB VOCAB CLA /PUT ZERO DICT PTR WD JMS PUT /ON VOCAB STACK VOCAB LAC VOCAB /LOAD POINTER JMP NSTK13 .EJECT /ISTK /ROUTINE TO SEARCH THE INTEGER STACK FOR A MATCH WITH THE INTEGER HELD /IN NCB. IF NO MATCH IS FOUND THE NEW INTEGER IS PLACED ON THE STACK. /THE DISPLACEMENT OF THE NUMBER FROM THE BASE OF THE STACK IS /INSERTED IN THE L.S. 12 BITS OF NUMI (THE "INTEGER NO." /ENTRY IN THE REVPOL OPCODE TABLE). ISTK XX LAC* WORK /LOAD PREVIOUS REVPOL OP SAD MIN /DYADIC MINUS? JMP ISTK2 /YES SAD NEG /MONADIC MINUS? JMP ISTK4 /YES JMP ISTK6 ISTK2 LAC PLUS /REPLACE - BY + DAC* WORK SKP ISTK4 ISZ WORK /DELETE OP FROM WORK STACK LAC NCB /COMPLEMENT INTEGER JMS TCA DAC NCB ISTK6 LAC INTEGR /LOAD INT STACK PTR TAD K1 /SUBTRACT 1 DAC* C8 /LOAD A-I 10 WITH START VAL FOR TABLE SRCH ISTK8 LAC* AUTO /LOAD NEXT WORD FROM STACK SAD NCB /SAME AS NEW INT. ? JMP ISTK10 /YES LAC* C8 /LOAD ADDR OF CURRENT WD ON STACK TAD C1 SAD INBASE /BASE OF STACK ? SKP /YES JMP ISTK8 /NO, SO REPEAT SEARCH LAC NCB JMS PUT /PUT NEW INT. ON STACK INTEGR LAC INTEGR /LOAD PTR TO INT. POSITION SKP ISTK10 LAC* C8 /LOAD PTR TO INT. POSITION JMS EVA00 .DSA INBASE DAC NUMI JMP* ISTK .EJECT /RSTK /THIS ROUTINE SEARCHES THE REAL STACK FOR A MATCH WITH THE REAL /NUMBER HELD IN THE THREE-WORD NAME CHARACTER BLOCK. IF NO MATCH IS /FOUND THE NEW NUMBER IS ADDED TO THE REAL STACK. THE DISPLACEMENT /OF THE NUMBER FROM THE BASE OF THE STACK IS INSERTED IN THE L.S. /12 BITS OF NUMR(THE "REAL NUMBER" ENTRY IN THE REVPOL OPCODE TABLE). RSTK XX LAC REAL /LOAD VALUE OF REAL STACK PTR JMP RSTK3 RSTK2 LAC REALS TAD C3 /ADD 3 TO REALS RSTK3 DAC REALS SAD RLBASE /REALS=RLBASE ? JMP RSTK8 /YES TAD K1 DAC* C9 /INITIALISE A-I REG 11 LAC AANCB /INITIALISE A-I REG 10 DAC* C8 LAW -3 DAC SP01 RSTK4 LAC* AUTO1 /LOAD WORD FROM STACK SAD* AUTO /SAME AS CORR. WORD IN NEW NUMBER ? SKP /YES JMP RSTK2 /NO, SO TRY NEXT REAL ON STACK ISZ SP01 /THIRD SUCCESSFUL COMPARISON ? JMP RSTK4 /NO LAC REALS /LOAD POINTER RSTK7 JMS EVA00 /CONVERT ADDR TO VADDR .DSA RLBASE DAC NUMR /PLACE VADDR IN REVOP TABLE JMP* RSTK RSTK8 LAC NCB2 JMS PUT /PUT L.S. MANTISSA ON STACK REAL LAC NCB1 JMS PUT /PUT M.S. MANTISSA ON STACK REAL LAC NCB JMS PUT /PUT EXPONENT ON STACK REAL LAC REAL JMP RSTK7 /GO TO INSERT PTR IN OPCODE .EJECT /RNUM:NUMBER CONVERSION /E.N.HAWKINS RNUM DZM RNUMSE /SIGN EXPONENT DZM RNUMA0 /TRIPLE LENGTH MANTISSA (M.S.) DZM RNUMA1 /L.S. DZM RNUMA2 /REAL EXPONENT OR INTEGER NO. DZM RNUMB /DECIMAL EXPONENT DZM RNUMDP /DECIMAL PLACES DZM RNUMST /STATE LAW -20 /NUMBER OF DIGITS DAC RNUMDM /ALLOWED IN MANTISSA LAW -3 /NUMBER OF DIGITS DAC RNUMDE /ALLOWED IN EXPONENT LAC BSW /FIRST SYMBOL JMP RNUM03-1 RNUM01 ISZ RNUMST /ST=ST+1 RNUM02 JMS GNBS60 /NEXT SYMBOL DAC RNUMCH RNUM03 AND S02000 /IS IT A DIGIT SNA JMP RNUM09 LAC RNUM05 /TREE INSTRUCTION RNUM04 TAD RNUMST /MODIFY DAC .+1 /OBEY XX RNUM05 JMP RNUM06 /MODIFIED INST RNUM06 JMP RNUM08 /ST=0 ISZ RNUMST /ST=1 JMP RNUM07 /ST=2 ISZ RNUMST /SY=3 ISZ RNUMST /ST=4 ISZ RNUMDE /ST=5 SKP JMP RNUMEA /TOO MANY EXP DIGITS LAC RNUMB /B RCL /2B DAC RNUMB /2B RTL /8B TAD RNUMB /10B TAD RNUMCH /10B+DIGIT TAD X74743 /CORRECTION DAC RNUMB JMP RNUM02 /ALPHA RNUM07 ISZ RNUMDP /DP=DP+1 RNUM08 ISZ RNUMDM /DIGITS IN MANTISSA SKP JMP RNUMEB /TOO MANY JMS RNUMSZ /2A JMS RNUMSY /COPY TO C JMS RNUMSZ /4A JMS RNUMSZ /8A JMS RNUMSX /10A DZM RNUMC0 /TRIPLE DZM RNUMC1 /LENGTH LAC RNUMCH /DIGIT TAD X74743 /CORRECTION DAC RNUMC2 /STORE JMS RNUMSX /NEW MANTISSA JMP RNUM02 /ALPHA RNUM09 LAC RNUMCH /LABEL BETA SAD U04034 /CHAR =.? JMP RNUM22 /IT IS SAD U00067 /CH=DROP 10 JMP RNUM21 /IT IS LAC RNUM10 /TREE INSTRUCTION JMP RNUM04 /MODIFY AND JUMP RNUM10 JMP RNUM11 /MODIFIED INST RNUM11 JMP RNUM20 /ST=0 JMP RNUMEC /ST=1 ERROR JMP RNUM12 /ST=2 JMP RNUM18 /ST=3 JMP RNUMED /ST =4 RNUM12 CLA /ST=5 ERROR SAD RNUMA0 /A0=0 JMP RNUM15 /IT IS RNUM13 LAW -65 RNUM14 DAC RNUMBE /BE=-53 LAC RNUMB /AC:=B TAD RNUMSE /AC:=B-1 OR B ISZ RNUMSE /SE=-1? CMA /NO:AC:=B-1 OR -B-1 TAD RNUMDP /AC:D+B-1 OR D-B-1 CMA /AC:=-D-B OR B-D DAC RNUMB JMP RNUM24 /EPSILON RNUM15 SAD RNUMA1 /A1=O JMP RNUM17 /IT IS LAC RNUMA1 /TOP BIT A1=O SPA JMP RNUM13 /IT IS RNUM16 LAC RNUMA1 DAC RNUMA0 /A0=A1 LAC RNUMA2 /A1=A2 DAC RNUMA1 DZM RNUMA2 /A2=0 LAW -43 /BE=-35 JMP RNUM14 RNUM17 SAD RNUMA2 /A2=0 JMP RNUM29 /IT IS REAL EXIT LAC RNUMA2 /TOP BIT A2=0 SPA JMP RNUM16 /IT IS NOT DAC RNUMA0 /A0=A2 DZM RNUMA2 /A2=0 LAW -21 /BE=-17 JMP RNUM14 RNUM18 LAC RNUMCH /CH=- SAD U10011 JMP RNUM19 /IT IS SAD U10010 /CH=+ JMP RNUM01 /IT IS JMP RNUMEE /ERROR RNUM19 LAW -1 DAC RNUMSE /SE=-1 JMP RNUM01 /ALPHA DASH RNUM20 LAC RNUMA0 SZA /A0=0 JMP RNUMEF LAC RNUMA1 SZA JMP RNUMEF /ERROR LAC RNUMA2 /A2 NOT SINGLE LENGTH SPA JMP RNUMEF /ERROR JMS ISTK LAC U00235 JMP GNBS13 RNUM21 LAC RNUMST SNA JMP .+4 /ST=0 TAD Z77776 /ST=2 SZA JMP RNUMEG /ERROR LAC C3 /ST=3 DAC RNUMST JMP RNUM02 /ALPHA RNUM22 LAC RNUMST /ST=O SNA JMP RNUM01 /ALPHA DASH JMP RNUMEH /ERROR RNUM23 ISZ RNUMBE /BE=BE+1 NOP /BE CAN GO THRU 0 JMS RNUMSZ /SHIFT(A,1) TO A RNUM24 LAC RNUMA0 /IS BIT OF A 0 RAL / A ZERO SMA JMP RNUM23 /NO,SHIFT AGAIN LAC RNUMB /IS B=0 SNA JMP RNUM26 /YES SMA JMP RNUM25 /B>0 ISZ RNUMB /B+1->B NOP /FOR NEW B=0 LAC RNUMBE TAD C3 /BE=BE+3 DAC RNUMBE JMS RNUMSW /SHIFT(A,-1) TO A JMS RNUMSV /SHIFT (A,-1) TO C JMS RNUMSX /ADD C TO A LAW -3 /SHIFT (A,-4) TO C JMS RNUMSR JMS RNUMSX /ADD C TO A LAW -7 /SHIFT (A,-8) TO C JMS RNUMSR JMS RNUMSX /ADD C TO A LAW -17 /SHIFT(A,-16) TO C JMS RNUMSR JMS RNUMSX /ADD C TO A LAW -37 /SHIFT (A,-32) TO C JMS RNUMSR JMS RNUMSX /ADD C TO A JMP RNUM24 /EPSILON RNUM25 LAW -1 /B =B-1 TAD RNUMB DAC RNUMB LAW -4 /BE=BE-4 TAD RNUMBE DAC RNUMBE JMS RNUMSW /SHIFT(A,-1)TO A LAW -1 /SHIFT (A,-2) TO C JMS RNUMSR JMS RNUMSX /ADD C TO A JMP RNUM24 /EPSILON RNUM26 DZM RNUMC0 /SET UP TRIPLE DZM RNUMC1 /LENGTH LAC W00000 /ROUND OFF DAC RNUMC2 JMS RNUMSX /ROUND LAC RNUMBE /NEGATE BE JMS TCA DAC RNUMA2 /A2_ LAC RNUMA0 /TEST FOR SPILL SPA!CLA!STL /BIT 0(A2)=1? JMP RNUM28 /JUMP IF SPILL RNUM29 JMS RSTK LAC U00236 JMP GNBS13 RNUM28 RTR /SET MANTISSA DAC RNUMA0 /EQUAL A HALF ISZ RNUMA2 /)ADD ONE TO JMP RNUM29 /)FINAL EXPONENT JMP RNUM29 /CAN GO THRU 0 RNUMSW XX /SUBROUTINE TO LAC RNUMA0 /SHIFT THE RCR /TRIPe LENGTH DAC RNUMA0 /MANTISSA ONE LAC RNUMA1 /PLACE TO THE RAR /RIGHT DAC RNUMA1 LAC RNUMA2 RAR DAC RNUMA2 JMP* RNUMSW /EXIT RNUMSY XX /SUBROUTINE TO LAC RNUMA0 /COPY TRIPLE LENGTH DAC RNUMC0 /MANTISSA TO LAC RNUMA1 /TRIPLE LENGTH WORK DAC RNUMC1 /STORE LAC RNUMA2 DAC RNUMC2 JMP* RNUMSY /EXIT RNUMSX XX /SUBROUTINE TO CLL /ADD THE TRIPLE LAC RNUMA2 /LENGTH WORK STORE TAD RNUMC2 /TO THE TRIPLE DAC RNUMA2 /LENGTH ACCUMULATOR GLK TAD RNUMA1 TAD RNUMC1 DAC RNUMA1 GLK TAD RNUMA0 TAD RNUMC0 DAC RNUMA0 JMP* RNUMSX /EXIT RNUMSZ XX /SUBROUTINE TO SHIFT LAC RNUMA2 /THE TRIPLE LENGTH RCL /MANTISSA ONE PLACE DAC RNUMA2 /TO THE LEFT LAC RNUMA1 RAL DAC RNUMA1 LAC RNUMA0 RAL DAC RNUMA0 JMP* RNUMSZ /EXIT RNUMSV XX /SUBROUTINE TO LAC RNUMA0 /SHIFT THE TRIPLE RCR /LENGTH MANTISSA DAC RNUMC0 /ONE PLACE RIGHT BUT LAC RNUMA1 /INTO THE TRIPLE RAR /LENGTH WORK STORE DAC RNUMC1 LAC RNUMA2 RAR DAC RNUMC2 JMP* RNUMSV /EXIT RNUMSR XX /SUBROUTINE TO SHIFT DAC RNUMSQ /THE TRIPLE LENGTH MANTISSA JMS RNUMSV /N PLACES BUT DOING RNUMSP LAC RNUMC0 /THE SHIFT IN THE RCR /TRIPLE LENGTH DAC RNUMC0 /WORK STORE LAC RNUMC1 RAR DAC RNUMC1 LAC RNUMC2 RAR DAC RNUMC2 ISZ RNUMSQ /COUNT SHIFTS JMP RNUMSP JMP* RNUMSR /EXIT RNUMSQ CAL 0 RNUMEA ISZ ISZCT /TOO MANY EXPONENT DIGITS RNUMEB ISZ ISZCT /TOO MANY MANTISSA DIGITS (>15) RNUMEC ISZ ISZCT /NO DIGIT AFTER . RNUMED ISZ ISZCT /NO DIGIT AFTER SIGN OF EXPONENT RNUMEE ISZ ISZCT /INVALID CHAR AFTER @ RNUMEG ISZ ISZCT /@ INVALID HERE RNUMEH LAC ISZCT /. INVALID HERE DZM ISZCT TAD S10047 /SET BIT 5 FOR TYPE 1 ERROR JMS TCA JMS ERR LAC U00077 JMP GNBS13 RNUMEF LAC LCT2 /CORRECT POSN OF END OF CURRENT BS DAC LCT6 LAC CHPOS2 DAC CHPOS6 LAW -46 /INTEGER OUT OF RANGE JMS ERR JMP RNUMEF-2 RNUMB XX RNUMBE XX RNUMCH XX RNUMC0 XX RNUMC1 XX RNUMC2 XX RNUMDE XX RNUMDM XX RNUMDP XX RNUMSE XX RNUMST XX .EJECT /GNC /SUBROUTINE TO GET THE NEXT CHAR FROM THE SOURCE FILE AND ISSUE /IT IN THE LOCATION NC AND IN THE AC TO THE CALLING PROGRAM. /GNC PROVIDES A SOURCE LISTING AT THE SAME TIME. /SCRATCHPAD USED:SP00 GNC XX /NORMAL ENTRY POINT JMP GNC03 GNC01 LAC GNC70 /SWAP BUFFERS DAC SP00 LAC GNC71 DAC GNC70 DAC GNC75 TAD K2 DAC GNC22 /SELECT BUFFER FOR WRITING LAC SP00 DAC GNC71 JMS GNC60 /READ IN NEXT BUFFER LAC* GNC70 /GET BUFFER HEADER WORD AND S00017 /LOOK FOR EOF AND EOM SAD C5 /EOF? SKP /YES SAD C6 /EOM? JMP GNC13 /YES,SO CLOSE INPUT FILE LAC* GNC70 /LOOK FOR READ ERRORS AND S00060 SNA /READ ERROR? JMP .+3 /NO LAW -37+Z /YES:REPORT ERROR 31 JMS ERR ISZ LCT1 /INCREMENT LINE COUNT LAC C5 DAC CHPOS1 /RESET CHARACTER COUNT LAC LIST SZA /LISTING REQUIRED? JMS GNC20 /YES,SO WRITE CURR BUFF TO LDEV ISZ GNC75 /BUMP PTR LAC GNC06 /) TAD C4 /)INITIALISE XCT INSTN DAC GNC08 /) GNC03 JMS UNP5.7 /DO 5-7 UNPACK TO GET CH IN AC DAC NC /HOLD CHARACTER TAD K32 /SUBTRACT 40(8) SPA /AC>0R=0? JMP GNC101 /NO,NON PRINTING CHAR TAD Z77700 /YES,SUBTRACT 100 SPA /AC>OR=0? JMP GNC104 /NO,PRINTING CHARACTER TAD S00100 GNC101 TAD C32 /ADD TO REFORM CHARACTER SAD S00011 /HORIZONTAL TAB? JMP GNC103 /YES SAD S00012 /LINE FEED? JMP GNC03 /YES SAD S00013 /VERTICAL TAB? JMP GNC03 /YES SAD S00014 /FORM FEED? JMP GNC03 /YES SAD S00175 /ALTMODE? JMP GNC12 /YES SAD S00015 /CARRIAGE RETURN? SKP /YES JMP GNC15 /NO,INVALID CHAR .WAIT DATOUT JMP GNC01 GNC103 LAC CHPOS1 /LOAD CHAR COUNT TAD K10 /SUBTRACT 10 SMA /CHAR COUNT >10? JMP .-2 /YES,LOOP CMA /NO,COMPLEMENT AC SPA!SNA /AC>0? TAD C10 /NO ADD 10 TAD CHPOS1 /ADD CHAR COUNT DAC CHPOS1 ISZ CHPOS1 /INCREMENT CHAR CT JMP GNC03 GNC104 ISZ CHPOS1 /INCREMENT CHAR COUNT LAC NC /EXIT WITH CODE IN NC AND AC JMP* GNC GNC12 LAW -57+Z /REPORT ERROR 47 JMS ERR JMP GNC103-3 GNC13 LAC S00140 DAC NC JMP* GNC /EXIT GNC14 .SIXBT ZLSTZ /EXTENSION FOR LISTING FILE GNC15 LAW -57+Z /REPORT ERROR 47 JMS ERR JMP GNC03 GNC18 .SIXBT ZA01Z /EXTENSION FOR INT. CODE FILE .EJECT /GNC20 /SUBROUTINE TO WRITE THE CURRENT BUFFER TO THE LISTING DEVICE GNC20 XX JMS COPY /) M*4+GNC70 /)COPY HDR WD PR TWO WDS M*4+GNC22 /)DOWN CORE 2 LAC* GNC22 /LOAD FIRST WD OF HDR WD PR TAD S01000 /ADD 1 TO WD PR COUNT DAC* GNC22 /REPLACE HDR WD LAC LCT1 JMS BDEC /CONVERT LINE COUNT TO ASCII JMS COPY /PUT LINE COUNT IN LISTING BUFFER NUM3 M*4+GNC70 2 ISZ LCT /INCREMENT LINE COUNT LAC LCT /LOAD LINE COUNT SAD C56 /PAGE FULL? JMS PAGEHD /YES,SO OUTPUT PAGE HDR CAL+2000 DATOUT&777 .DSA 11 GNC22 .DSA 0 .DSA 777712 JMP* GNC20 .EJECT /SUBROUTINE TO INITIATE READING OF NEXT BUFFER GNC60 XX LAC GNC71 DAC GNC61 / .READ DATIN,IOPS,BUFF2,52 CAL+2000 DATIN&777 .DSA 10 GNC61 .DSA 0 .DSA 777714 JMP* GNC60 .EJECT /LOCAL STORAGE FOR ROUTINE GNC GNC70 .DSA GNC73 GNC71 .DSA GNC74 0 0 GNC73 .BLOCK 64 /INPUT BUFFER 0 0 GNC74 .BLOCK 64 /INPUT BUFFER GNC75 0 /PTR TO CURRENT WD IN BUFFER .EJECT /PAGEHD /ROUTINE TO OUTPUT A FORM-FEED FOLLOWED BY A PAGE HEADING PAGEHD XX ISZ PAGECT /INCREMENT PAGE COUNT LAC PAGECT /LOAD PAGE COUNT JMS BDEC /CONVERT TO DECIMAL JMS DLZ /DELETE LEADING ZEROS DAC PAGENO LAC NUM3+1 XOR S25132 /INSERT LF AND CR INTO BUFFER DAC PAGENO+1 .WRITE -3,2,HDBUFF,10 DZM LCT /CLEAR LINE COUNT JMP* PAGEHD HDBUFF 5002 0 FILENM 60000 0 0 22 /HORIZ TAB .ASCII !PAGE ! PAGENO 0 0 .EJECT /ERR /SUBROUTINE TO REPORT AN ERROR,EITHER TO THE ERROR /MODULE,OR TO THE LISTING DEVICE,OR TO THE TELETYPE. /ON ENTRY,AC CONTAINS -(ERROR NO.) ERR 0 ISZ ERRNUM /INCREMENT ERROR CT DZM ENUM+10 /CLEAR ERROR TYPE 4 FLAG DZM ENUM+11 /CLEAR ERROR TYPE 1 FLAG JMS TCA /GET + ERROR NO DAC ENUM+2 /HOLD AND S14000 SAD S04000 /ERROR TYPE 4? ISZ ENUM+10 /YES,SO SET FLAG SAD S10000 /ERROR TYPE 1? ISZ ENUM+11 /YES,SO SET FLAG XOR ENUM+2 /AC:=TRUE ERROR NO DAC ENUM+7 /HOLD ERR01 JMP .+1 /THREE WAY JUMP JMP ERR10 /FIRST TIME ONLY JMP ERR20 /IF ERROR MODULE REQUIRED LAC ENUM+7 /LOAD TRUE ERROR NO JMS BDEC /CONVERT ERR NO TO DECIMAL AND S03777 /CONVERT FIRST CHAR TO NULL DAC ENUM LAC NUM3+1 XOR S00020 /CONVERT TO SPACE,( DAC ENUM+1 /ERR NO NOW PACKED IN BUFFER LAC ENUM+11 SZA /ERROR TYPE 1? JMP ERR07 /YES LAC ENUM+7 /RELOAD ERR NO TAD K49 SMA /ERROR TYPE 2? JMP ERR06 /NO,ERROR TYPE 3 OR 4 JMS PACK /)PACK LINE AND CHAR NOS LCT3 /)OF START OF CURRENT BS ENUM+2 /)INTO BUFFER XOR S00112 /CONVERT LAST CHAR(CR) TO ( DAC ENUM+5 JMS PACK /)PACK LINE AND CHAR NOS LCT6 /)OF END OF CURRENT BS ENUM+6 /)INTO BUFFER JMP ERR08 ERR06 JMS PACKEL /PACK EL DELIMITERS INTO BUFFER JMP ERR08 ERR07 JMS PACK /)PACK LINE AND CHAR NOS LCT1 /)OF CURRENT CHAR ENUM+2 /)INTO BUFFER ERR08 ISZ LCT /INCREMENT LINE COUNT LAC LCT /LOAD LINE CT SAD C56 /END OF PAGE? JMS PAGEHD /YES, SO OUTPUT FF AND PAGE HEADER .WRITE -3,2,ERRBUF,14 .WAIT -3 JMP* ERR ERR10 ISZ EMODE /SET ERROR FLAG FOR ROUTINE PUT ISZ ERR01 /INCREMENT JMP INSTN JMS TOPT 400 /INT CODE OUTPUT? SKP /YES JMP ERR12 /NO LAC UP14 /) TAD K1 /)RE INITIALISE ROUTINE UP DAC UP14 /) LAC* AOPTW /)SET XOR S00400 /)INT CODE BIT DAC* AOPTW /)IN OPTION WORD ERR12 JMS INIT /INITIALISE OUT SK LAC ERRMOD SZA /ERROR MODULE REQUESTED? JMP ERR20 /YES ISZ ERR01 /INCREMENT JMP INSTN AGAIN LAC OUBASE /CLEAR INT CODE BUFFER TAD K1 /(SIZE ALREADY CLEARED IN INIT) DAC OUT JMP ERR01+3 ERR20 LAC ENUM+11 SZA /ERROR TYPE 1? JMP ERR32 /YES LAC ENUM+7 /RE-LOAD TRUE ERROR NO TAD K49 SMA /ERROR TYPE 2? JMP ERR24 /NO,ERROR TYPE 3 OR 4 JMS PCKLCH /)PACK UP POSN OF START LCT3 /)OF CURRENT BS DAC ENUM+3 JMS PCKLCH /)PACK UP POSN OF END LCT6 /)OF CURRENT BS DAC ENUM+4 JMP ERR27 ERR24 JMS PCKLCH /)PACK UP POSN OF START OF LCT5 /)CURRENT ELEMENT DAC ENUM+3 JMS PCKLCH /)PACK UP POSN OF END OF LCT4 /)CURRENT ELEMENT DAC ENUM+4 LAC ENUM+10 SNA /ERROR TYPE 4? JMP ERR27 /NO:TYPE 3 LAC C69 SAD ENUM+7 /ERROR 69? JMP ERR34 /YES LAC VOCPTR /)NORMAL ERROR TYPE 4,SO DAC ENUM+5 /)OUTPUT VOCPTR ERR26 ISZ ERR30 /INCREMENT NO OF WDS TO OUTPUT ERR27 ISZ ERR30 /INCREMENT NO OF WDS TO OUTPUT ERR28 LAC X77600 /LOAD ERROR MSG OPCODE TAD ERR30 /ADD IN ARGCT DAC ENUM+1 JMS COPY /) ENUM+1 /)OUTPUT M*1+OUT /)ERROR MESSAGE ERR30 3 /) LAC C3 /RESET NO OF WDS TO OUTPUT DAC ERR30 JMP* ERR ERR32 JMS PCKLCH /)PACK UP POSN OF LCT1 /)CURRENT CHAR DAC ENUM+3 JMP ERR28 ERR34 LAC* WORK /LOAD NEG COUNT FROM WORK DAC ENUM+5 /OUTPUT -PARAM NO JMP ERR26 ERRBUF 7002 0 .ASCII '**E' .REPT 12 ENUM 0 .EJECT /PACKEL /SUBROUTINE TO PACK ELEMENT DELIMITERS INTO ERR BUFFER. PACKEL XX JMS PACK /)PACK LINE AND CHAR NOS LCT5 /)OF START OF EL ENUM+2 /)INTO BUFFER XOR S00112 /CONVERT LAST CH (CR) TO ( DAC ENUM+5 JMS PACK /)PACK L+CH NOS LCT4 /)OF END OF EL ENUM+6 /)INTO BUFFER JMP* PACKEL .EJECT /PACK /SUBROUTINE TO PACK THE LINE COUNT AND CHAR COUNT GIVEN /BY THE FIRST TRAILING PARAMETER INTO THE TWO BUFFER WD-PRS /GIVEN BY THE SECOND TRAILING PARAMETER /CALLING SEQUENCE:- / JMS PACK / LCNT /ADDR OF APPROP LINE CHAR CT WD PR / BUFFADDR /ADDR OF APPROP BUFFER WD PR PACK XX LAC* PACK DAC PACK90 /REMEMBER ADDR OF LCNT WD ISZ PACK LAC* PACK DAC PACK92 /REMEMBER ADDR OF FIRST BUFF WD LAC* PACK90 /LOAD LINE COUNT JMS BDEC /CONVERT TO ASCII DECIMAL JMS DLZ /DELETE LEADING ZEROS DAC* PACK92 ISZ PACK90 /BUMP TO ADDR OF CHAR CT WD LAC NUM3+1 /LOAD SECOND ASCII WD XOR S06100 /CONVERT TO COMMA,NULL ISZ PACK92 /BUMP TO ADDR OF SECOND BUFF WD DAC* PACK92 LAC* PACK90 /LOAD CHAR CT JMS BDEC /CONVERT TO ASCII DECIMAL JMS DLZ /DELETE LEADING ZEROS ISZ PACK92 /BUMP TO ADDR OF THIRD BUFF WD DAC* PACK92 LAC NUM3+1 XOR S04532 /CONVERT TO ),CR ISZ PACK92 /BUMP TO ADDR OF FOURTH BUFF WD DAC* PACK92 ISZ PACK JMP* PACK /DLZ /SUBROUTINE TO DELETE ANY LEADING ZEROS FROM THE WD-PR NUM3,NUM3+1 /CREATED BY SUBROUTINE BDEC. DLZ XX LAC LZCT SNA!CLL!RAR /ANY LEADING ZEROS? JMP DLZ2 /NO SNL XOR S01401 /DELETE TENS COUNT XOR V00000 /DELETE HUNDREDS COUNT DLZ2 XOR NUM3 JMP* DLZ .EJECT /PCKLCH /ROUTINE TO PACK THE LINE AND CHAR COUNT POINTED TO BY THE /TRAILING PARAMETER INTO THE AC. /CALLING SEQUENCE: / JMS PCKLCH / LCT /ADDR OF APPROP LINE COUNT WD PCKLCH XX LAC* PCKLCH /LOAD ADDR OF LINE COUNT ISZ PCKLCH /BUMP LINK DAC ENUM /HOLD LAC* ENUM /LOAD LINE COUNT DAC ENUM+6 /HOLD ISZ ENUM /BUMP TO ADDR OF CHAR COUNT LAC* ENUM /LOAD CHAR COUNT CLL /)CLEAR LINK AND JMS MES /)ROTATE LEFT JMP LL+13 /11(DEC) TAD ENUM+6 /ADD LINE COUNT JMP* PCKLCH /EXIT .EJECT /EVA /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 /REPORT ERROR 29 AND ABORT JMP ODL01 /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 RL6 /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 LAC SP00 /LOAD RESULT JMP* VTOA /EXIT VTOA90 LAW -30 /REPORT ERROR 24 AND ABORT JMP ODL01 .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 /UP /SUBROUTINE TO MOVE STACKS UP THE CORE WHEN STACK OVERFLOW /OCCURS. IF THE STACKS ARE TOO TIGHTLY PACKED TO BE MOVED /UP TO 6 BUFFER-FULLS OF INTERMEDIATE CODE ARE OUTPUT (UNLESS /THIS WOULD NOT RELIEVE THE JAM,WHEN THE RUN IS ABORTED /AND AN ERROR MESSAGE OUTPUT). /ENTRY LOCN FREQD 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 TAD SIZE /AC:=(NO OF WDS ON OUT SK)-40 SMA /SHOULD BUFFER BE OUTPUT? UP14 JMP UP16 /YES LAW -27 /NO,SO REPORT ERROR 23 JMS ERR JMP P1C2-3 /AND RE-INITIALISE UP15 .INIT INTOUT,1,P1CON /OBEYED ONCE ONLY .ENTER INTOUT,GNC18 /ADDR OF FILENAME SET BY P1CON LAW 777377 /) AND* AOPTW /)SET IC MARKER IN OPT WD DAC* AOPTW /) ISZ UP14 /CHANGE INSTN SKP UP16 JMP UP15 LAW -6 DAC SP02 /SET COUNT FOR # BUFFERS UP18 .WRITE INTOUT,0,UP18,42 /BUFF ADDR SET BY P1CON LAC SIZE TAD K40 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 LAC SIZE /)DECREMENT SIZE BY TAD K40 /)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 SK PTR IN STAT TABLE ISZ SP02 /SIX BUFFERS OUTPUT? SKP /NO JMP* UP /YES,SO EXIT LAW -50 TAD SIZE SMA /CAN ANOTHER BUFFER BE OUTPUT? JMP UP18 /YES JMP* UP /EXIT .EJECT /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 ISZ TOPT SZA /OPTION REQD? ISZ TOPT /NO,SKP LOCATION JMP* TOPT /YES,RETURN .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 .EJECT LDA0 XX JMS LVM /WORD 0 OF DICT ATTRS NAPTR /D,A,UPNPTR JMP* LDA0 LDA1 XX JMS LVM /WORD 1 OF DICT ATTRS M*1+NAPTR /DIM,VOCPTR JMP* LDA1 LDA2 XX JMS LVM /WORD 2 OF DICT ATTRS M*2+NAPTR /DISPL OR STACK PTR JMP* LDA2 LDA3 XX JMS LVM /WORD 3 OF DICT ATTRS M*3+NAPTR /S,K,T,H,L JMP* LDA3 LV4 XX JMS LVM SP04 JMP* LV4 DDA2 XX JMS DVM /)SET DISPL IN M*2+NAPTR /)DICT ATTRS JMP* DDA2 .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 .EJECT /EXPAND SORT,KIND & TYPE FROM DICT ATTRS INTO MARKERS IN Q /ON ENTRY DICT WORD IN AC XSKT XX RTL RAL /SORT TO LS END AC DAC SP00 AND C3 /SORT=1,2&3 TAD ASORT DAC XSKT01 LAC SP00 RTL /KIND TO LS END AC AND C3 /=0,1,2 OR 3 TAD AKIND DAC XSKT01+1 LAC SP00 JMS MES JMP L-5 /TYPE TO LS END OF AC AND C7 /=1 THRU 7 TAD ATYPE DAC XSKT01+2 XSKT01 LAC SORT XOR KIND XOR TYPE DAC Q JMP* XSKT .EJECT Q.SKT1 XX ISZ SP00 /COUNT BITS SHIFTED OFF RAR SNL!CLL JMP .-3 /REPEAT IF BIT=0 LAC SP00 RTL /SP00=BIT CT*4 JMP* Q.SKT1 /COMPRESS Q INTO SKT FOR PACKING INTO DICT INFO Q.SKT XX DZM SP00 LAC Q JMS MES JMP RR+13 /SORT(Q)TO LS END JMS Q.SKT1 /FIND POSN OF SORT BIT TAD K1 DAC SP00 /=SORT-1 LAC Q JMS MES JMP R-7 /KIND(Q) TO LS END JMS Q.SKT1 /FIND POSN OF KIND BIT RAL /LEAVE SPACE FOR 3 BIT TYPE DAC SP00 LAC Q JMS Q.SKT1 /FIND POSN OF TYPE BIT JMS MES /SHIFT RESULTANT SKT JMP L-11 /TO TOP OF AC JMP* Q.SKT .EJECT /POLOUT /ROUTINE TO COPY THE WHOLE OF THE POLISH STACK TO OUT, /INVERTING AT THE SAME TIME. POLOUT XX JMS EVA /)GET VADDR OF FREE END OF .DSA POBASE /)POLISH STACK TAD Y50001 /AC:=-NO.OF WDS TO BE MOVED JMS TCA /NEGATE IT DAC .+4 /SET NO.OF WDS TO COPY JMS COPY M*1+POLISH M*1+OUT 0 JMP* POLOUT /TCA /ROUTINE TO TWO'S COMPLEMENT THE AC TCA XX CMA TAD C1 JMP* TCA /TARG /SUBROUTINE TO CHECK THE NO OF ARGS TO A REVPOL OPERATOR /ENTER AND EXIT WITH NO IN AC TARG XX DAC SP02 /STORE ARG COUNT TAD K63 SPA /TOO MANY ARGS? JMP TARG2 /NO LAW -61 /REPORT ERROR 49 JMS ERR TARG2 LAC SP02 AND S00077 /GET L.S.6 BITS IN CASE OF ERROR JMP* TARG /RETURN WITH NO IN AC /TLPTRS /SUBROUTINE TO SET POINTERS IN LOCATIONS CCODE AND GTNEXT /APPROPRIATE TO TOP LEVEL ANALYSIS TLPTRS XX LAC ACEL DAC CCODE LAC AGNEL DAC GTNEXT JMP* TLPTRS .EJECT /BDEC /ROUTINE TO CONVERT + NO IN AC ON ENTRY TO DECIMAL AND /5-7 PACK IN WD-PR NUM3,NUM3+1. /THE NUMBER IS TREATED MODULO 1000(DEC) /LEADING ZEROS ARE NOT DELETED AND TWO TRAILING SPACES /ARE PACKED INTO THE WD-PR BDEC XX DZM LZCT /CLEAR COUNT OF LEADING ZEROS DZM BDEC10 /CLEAR DECIMAL DIGIT COUNT DZM BDEC11 / ,, TAD K1000 SMA JMP .-2 TAD C1000 BDEC1 TAD K100 /SUBTRACT 100(DEC)FROM ERROR NUMBER SPA /NUMBER NEGATIVE? JMP BDEC2 /YES ISZ BDEC10 /NO:INCREMENT HUNDREDS COUNT JMP BDEC1 /LOOP BDEC2 TAD C100 /ADD 100 (DEC) TO NUMBER BDEC3 TAD K10 /SUBTRCT 10 (DEC) FROM NUMBER SPA!STL /NUMBER NEGATIVE? JMP BDEC4 /YES ISZ BDEC11 /NO:INCREMENT TENS COUNT JMP BDEC3 BDEC4 TAD C10 /ADD 10 (DEC) TO NUMBER & CLEAR LINK RTR RTR XOR S20100 DAC NUM3+1 /STORE 3 BITS+2 SPACES GLK DAC NUM3 /STORE TOP 4 BITS(TOP 3 BITS ZERO) LAC BDEC10 /LOAD HUNDREDS COUNT SNA /ZERO? ISZ LZCT /YES JMS MES /)ROTATE LEFT 7 JMP L-7 /) TAD BDEC11 /ADD TENS COUNT SNA /STILL ZERO? ISZ LZCT /YES RTL RTL /ROTATE LEFT 4 XOR NUM3 /ADD TOP 4 BITS OF UNITS COUNT XOR V01406 /FOLLOWED BY CONVERSION TO ASCII DAC NUM3 /STORE JMP* BDEC /EXIT .EJECT /INIT /SUBROUTINE TO INITIALISE OUT SK INIT XX LAC* S00102 /GET 1ST FREE REG AND S77777 /HOLD 15 BITS TAD C75 DAC OUT /SET OUT SK PTR TAD K39 DAC OUBASE /SET OUBASE DZM SIZE /ZERO NO. OF WDS ON OUT SK TAD K2 DAC UP18+2 /SET L.B. ADDR IN WRITE IN UP TAD K1 DAC BLKADD JMP* INIT .EJECT /UNP5.7 /ROUTINE TO UNPACK INPUT BUFFER UNP5.7 XX GNC07 ISZ GNC08 /BUMP SWITCH TO NEXT CHAR LAC* GNC75 /LOAD CURRENT WORD OF PR GNC08 XCT GNC06+4 GNC10 AND S00177 JMP* UNP5.7 /EXIT WITH 7 BIT CHAR IN AC GNCH1 ISZ GNC75 LAC GNC06 DAC GNC08 /RESET MULTI-WAY SWITCH LAC* GNC75 /LOAD FIRST WORD OF PR RTL /GET FIRST CHAR TO BOTTOM END RTL GNC04 RTL RTL JMP GNC10 GNCH3 RAR /ENTRY FOR THIRD CHAR IN WD PR AND C7 /GET TOP 4 BITS OF CHAR DAC SP00 /STORE ISZ GNC75 /BUMP PTR TO 2ND WD OF PR LAC* GNC75 AND Z00000 /GET BOTTOM 3 BITS OF CHAR XOR SP00 /COMBINE JMP GNC04 GNCH4 RTR RTR GNCH2 RTR RTR JMP GNC10 GNC06 XCT GNC06 /INST TO BE PICKED UP,NOT OBEYED JMP GNCH2 JMP GNCH3 JMP GNCH4 RAR JMP GNCH1 .EJECT /EOP /ROUTINE TO WRITE TO THE TTY OR LISTING DEV "EOP1" FOLLOWED BY /THE NUMBER OF ERRORS FOUND IN PASS1. EOP XX LAC ERRNUM /LOAD NO. OF ERRORS JMS BDEC /CONVERT TO DEC JMS DLZ /DELETE LEADING ZEROS DAC EOPNUM /PUT FIRST WD OF PR IN BUFFER LAC NUM3+1 /LOAD 2ND WD OF PR XOR S04672 /CONVERT TO "),ALTMODE" DAC EOPNUM+1 /PUT 2ND WD OF PR IN BUFFER EOP2 .WRITE DATOUT,2,EOPBUF,6 JMP* EOP EOPBUF 3002 0 .ASCII !EOP1(! EOPNUM 0 0 /BLKSET /SUBROUTINE TO SET UP ABSOLUTE BLOCK # (ON SYSTEM TAPE) /OF START OF PASS 1 BLKSET XX LAC S25500 /SET UP HEADER WORD FOR INT CODE .WRITE DAC* UP18+2 LAC* S00100 /GET ADDR OF BLOCK # DAC FNCC ISZ FNCC LAC* FNCC /GET BLOCK # DAC* BLKADD /PUT IN ALCOM LOCATION JMP* BLKSET /CSTAT /ROUTINE TO COPY THE STAT TABLE TO THE SPACE RESERVED FOR IT AT /THE BOTTOM OF CORE,CLOSE THE INT CODE FILE IF PRESENT /AND OUTPUT EOP1(N) TO THE TTY CSTAT XX LAC* S00102 AND S77777 TAD C5 DAC CSTAT2 JMS COPY INBASE CSTAT2 0 32 JMS TOPT 400 /INT CODE? SKP /YES JMP .+3 /NO .CLOSE INTOUT JMS EOP .WAIT -3 JMP* CSTAT .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 DIBASE /6 DICT PRBASE /7 PROC SWBASE /8 SWITCH RPBASE /9 REVPOL POBASE /10 POLISH WKBASE /11 WORK OWBASE /12 OWN OUT /13 OUBASE /ELTAB /LOOK-UP TABLE TO OBTAIN FROM THE L.S. 6 BITS OF THE CURRENT BASIC /SYMBOL CODE THE ADDR OF THE APPROPRIATE PHASE 1 SYNTAX BLOCK. ELTAB NAME1 TYPE1 TYPE1 TYPE1 GOTO1 IF1 FOR1 VALUE1 TYPE11 SWCH1 PROC1 LSTR1 LSTR1 OWN1 EXT1 .EJECT /TXB2 /LOOK-UP TABLE USED BY PHASE 2 TO OBTAIN FROM THE MIDDLE SIX /BITS OF THE CURRENT REVPOL OPERATOR WORD THE ADDRESS OF THE /APPROPRIATE SYNTAX BLOCK TXB2 POS2 A+TYPE2 A+TYPE2 A+TYPE2 A+TYPE2 A+TYPE2 A+SPEC2 OWN2 A+VAL2 PAR2 A+ASS2 IFEX2 DYAD2 DYAD2 DYAD2 DYAD2 Z77700 777700 DYAD2 DYAD2 DYAD2 A+FOR2 DYAD2 DYAD2 DYAD2 AF2 WH2 STEP2 GOTO2 BEXP2 PC2 A+FC2 A+SV2 DYAD2 DYAD2 DYAD2 DIV2 DYAD2 XPN2 EXT2 NEG2 ARD2 A+PDEC2 ASEG2 A+BPL2 LAB2 A+SW2 Z77600 777600 Z77400 777400 Z77000 777000 Z74000 774000 BEXP2 /ADDRESS CONSTANTS AAINBA INBASE-1 AAKTAB KTAB-1 AANCB NCB-1 AARVOP RVOP-1 AASTIN STINIT-1 ABS BS ABSS BSS-40 ACEL CEL ACTN CTN ADICT=VTOA02+16 AELTAB ELTAB-37 AEXP22 EXP22 AFC42 FC42 AFPEL1 FPEL1 AGLOBL GLOBL-1 AGNBS GNBS AGNEL GNEL AINBA INBASE ALABEL=VTOA02+14 ALANAL LANAL ALPROP LPRORP ANCB NCB AOUT OUT APRORP PRORP APTAB PTAB APUTO PUTOUT APUTP PUTPOL APUTR PUTRP AQ Q ATQ TQ ATRUE TRUE ATXB2 TXB2 .EJECT /TQ /TABLE USED BY THE ACTION PH2 TQ 210240 210220 204201 220240 204220 /SORT /TABLE USED BY SUBROUTINE XSKT SORT 204000 /SORT /1=ARRAY 210000 /2=VARIABLE 220000 /3=PROC KIND 200 /KIND /0=ACTUAL 400 /1=OWN 1000 /2=FORMAL BY VALUE TYPE 2000 /3=FORMAL BY NAME 1 /TYPE /1=REAL 2 /2=INTEGER 4 /3=BOOLEAN 10 /4=STRING 20 /5=LABEL 40 /6=NONE 100 /7=INVALID AKIND XOR KIND ASORT LAC SORT-1 ATYPE XOR TYPE /ELEMENT CODES ASEL=12010 PSEL=12020 IFEL=2030 FOREL=2040 SLIST=450 VALEL=460 OTDEC=1070 TLIST=1500 GOTEL=12211 LBLEL=2021 ARDEC=1212 ARSP=422 FPEL=1003 SWDEC=1204 SCEL=110 BEGEL=20120 ENDEL=130 ELSEL=4140 INVEL=150 XHEL=40160 EXTEL=4170 .EJECT /RVOP: TABLE OF REVERSE POLISH OPCODES, ACCESSED BY A LOOK-UP ON THE /L.S. 6 BITS OF THE CURRENT BASIC SYMBOL CODE. /THE FOLLOWING CODES ARE USED BY OUTOP1 RVOP 246201 /NOT 251402 /AND 261502 /OR 271602 /IMPL 301702 /EQUIV 205300 /BPL(BOUND PAIR LIST) ([) 603777 /SV(SUBSCRIPTED VARIABLE) (]) PLUS 224002 /PLUS(DYADIC +) MIN 224102 /MINUS(DYADIC -) 214202 /MULT(*) 214302 /DIV(/) 214402 /IDIV 204502 /XPN(^) 201101 /PAR (PARENTHESIS PAIR) ( ( ) 603677 /FC(FUNCTION CALL) ( ) ) 232702 /GT(>) 232502 /GE(>=) 232202 /EQ(=) 232602 /NE(#) 232302 /LE(<=) 232102 /LT(<) 201201 /ASS(ASSIGNMENT) (:=) 205401 /LAB(LABEL) (:) 203203 /STEP(STEP UNTIL ELEMENT) 201303 /IFEXP(IF EXP) (THEN) 203102 /WHILE 37776 /FALSE 37775 /TRUE NUMI 20000 /INTEGER STACK PTR NUMR 10000 /REAL STACK PTR NAME 0 /VOCAB STACK PTR 210101 /REAL 210201 /INTEGER 210301 /BOOLEAN 213301 /GOTO 203401 /IFS(IF STATEMENT) (IF) 202401 /FOR 201001 /VALUE 205000 /ARD(ARRAY DEC) (ARRAY) 205501 /SWITCH(DEC) 205101 /PDEC(PROCEDURE DEC) (PROCEDURE) 200501 /LABS(LABEL SPEC) (LABEL) 200401 /STRING(SPEC) 220701 /OWN 204601 /EXTERNAL STRNG 40000 /STRING STACK PTR /THE FOLLOWING CODES ARE USED BY OUTOP2 WITH THE WORK STACK 212000 /ENDC(END OF IF STAT) 215201 /ASEG(ARRAY SEGMENT) 203501 /PC(PROCEDURE CALL) 220001 /POS(MONADIC +) NEG 224701 /NEG(MONADIC -) 203001 /AFOR(SIMPLE FOR LIST ELEMENT) 206000 /ENDP(END OF PROC DEC) 202000 /ENDF(END OF FOR STAT) /THE FOLLOWING CODES ARE USED BY OUTOP2 WITH OUT PTAB 206400 /ELSE 206300 /ENDD(END OF DECS) .EJECT /START OF KEYWORD TABLE. THE KEYWORDS ARE STORED IN RADIX 50 WITH THE /LAST WORD RIGHT JUSTIFIED. THE INTERNAL CODE (ONE WORD) FOR EACH /KEYWORD FOLLOWS ITS RADIX 50 REPRESENTATION. KTAB 470511 /REAL 14 320040 435204 /INTEGER 420135 22 320041 023752 /FOR 220045 474745 /STEP 20 200030 502604 /UNTIL 564 200064 406517 /BEGIN 566 260060 020564 /END 260061 764 /LT 210025 454 /GT 210020 331 /EQ 210022 745 /LE 210024 435 /GE 210021 1065 /NE 210023 556 /IF 220044 477105 /THEN 16 200031 257 /DO 200063 420463 /ELSE 5 260062 427054 /GOTO 17 220043 404442 /ARRAY 101 220047 1152 /OR 210003 4164 /AND 210002 054754 /NOT 210001 463337 /PROCEDURE 411614 103025 220051 412445 /COMMENT 451026 24 200065 504664 /VALUE 1515 220046 445452 /LABEL 324 220052 060546 /OWN 220054 421424 /EXTERNAL 421036 64 220055 474762 /STRING 035167 220053 407347 /BOOLEAN 445711 16 320042 510411 /WHILE 745 200032 475141 /SWITCH 076600 220050 477745 /TRUE 5 200234 422664 /FALSE 1375 200233 434351 /IDIV 26 210014 420775 /EQUIV 576 210005 435130 /IMPL 14 210004 414474 /DATSLOT 474257 24 200076 770001 /EOT .EJECT /LOOK-UP TABLE TO CONVERT 7-BIT ASCII CODES TO INTERNAL CODES. BSS 200072 /SPACE(USED IN COMSTR DECODER) EXC 200071 /!(USED IN STRINGS) 200056 /"(STRING QUOTE) 214047 /# 200077 /$(INVALID) 204033 /% 210002 /&(EQUIV TO 'AND') 200074 /'(KEYWORD QUOTE) 200216 /( 200017 /) 210012 /*(MULTIPLY) 210010 /+ 200057 /, 210011 /- 204034 /. 210013 //(DIVIDE) 203035 /0 203036 /1 203037 /2 203040 /3 203041 /4 203042 /5 203043 /6 203044 /7 203045 /8 203046 /9 200027 /: 260056 /; 210025 /<(EQUIV TO 'LT') 210022 /=(EQUIV TO 'EQ') 210020 />(EQUIV TO 'GT') 200077 /?(INVALID) 200067 /@(TEN TO THE POWER) ALET 201401 /A 101402 /B 201403 /C 1504 /D ELET 11405 /E FLET 201406 /F 201407 /G 201410 /H 201411 /I 201412 /J 201413 /K LLET 21414 /L 1615 /M 201416 /N 3417 /O 5420 /P QLET 201421 /Q 201422 /R SLET 201423 /S TLET 401424 /T 201425 /U 201426 /V 201427 /W 41430 /X 201431 /Y 201432 /Z 200106 /LEFT SQ BRACKET 200077 /BACK SLASH(INVALID) 200007 /RT SQ BRACKET 210015 /^(EXPONENTIATION) 200026 /_(:=) SEXH 200070 /SOURCE EXHAUSTED .EJECT /GLOBAL LOCATIONS (I.E. LOCATIONS USED BY MORE THAN ONE ROUTINE WITH /PRESERVATION OF CONTENTS NEEDED BETWEEN USES). AOPTW XX /ADDR OF OPTION WD ARGCT XX ASSQ XX /Q FOR LHS'S OF ASSIGNMENTS AXW XX /ADDR OF EXTENSION WD IN FILENAME BLOCK BANK XX BLKADD XX /ADDR OF ALCOM WORD GIVING BL # OF PASS1 START BS XX BSW XX CCODE BSW CEL XX CTN XX CTB XX CTA XX CTI XX CV XX /HOLDS VOCPTR TO CONTROLLED VARIABLE DEST PUTOUT DIMA XX /#DIMS OR PARAMS DLST XX /PTR TO PTR TO FREE END OF LABEL OR DICT SK ELANAL 1 ERRORT JMS ERR /HOLDS JMP OR JMS TO REPORT ERRORS EXTMRK XX /EXTERNAL CODE MARKER(1=EXT) FREQD 40 /CONTROLS OPERATION OF ROUTINE UP GTNEXT BSCON LCT 67 /COUNT OF NO OF LINES ON LISTING PAGE LZCT XX /COUNT OF LEADING ZEROS MAP XX /USED BY CDVW AND MULT NC XX NCB XX NCB1 XX NCB2 XX NUM3 XX /)HOLDS ASCII WD-PR XX /)CREATED BY ROUTINE BDEC NXTRQD -1 PA XX /VADDR OF PROC ATTRS DURING DECLARATION Q XX /PHASE 2 CONTROL WORD Q3 XX /USED BY PH2 CATOM TESTS QHOLD & PBPL RESLT XX /USED BY CDVW, MULT AND OTOWN RESULT XX STATE XX STWDAD XX STLIM XX STPTR XX VA1 XX /)HOLD REVPOL VADDRS OF START & END VA2 XX /)OF STEP EXPRESSIONS XB XX /GLOBAL LOCNS INITIALLY ZERO OTCD 0 /OBJECT TIME COMMON DISP MAXOTD 0 /MAX OTD REACHED IN NESTED BLOCKS MAXL 0 /MAX LEVEL REACHED IN NESTED BLOCKS SIZE 0 /NO. OF WDS OF INT. OUTPUT IN CORE ISZCT 0 OTD 0 /OBJECT TIME DISPL. 0 /SPACE FOR VADDR(DICT)WHEN STACKED BY ODL CHL 0 /NEW NAME ATTRS(4 WDS) 0 VOCPTR 0 NAPTR 0 ALTMOD 0 /ALT MODE FLAG DCT 0 /USED IN ROUTINE PUT EMF 0 /DITTO EMODE 0 /DITTO ERRMOD 0 /ERROR MODULE FLAG ERRNUM 0 /NO. OF ERRORS FOUND FPLERR 0 /SET(=1)WHEN PH1 FAILS ON FPEL FOR FOLLOWING /VAL&SPEC ELS(PH2) AND ENDSP(CLEARED) LIST 0 /SOURCE LISTING FLAG PAGECT 0 /COUNT OF NO OF LISTING PAGES PRESET 0 /PRESET PROC FLAG XDICT 0 /EXPAND DICT INFO FLAG .EJECT /LOCATIONS USED TO MAINTAIN LINE AND CHAR COUNTS FOR /CHARACTERS,BASIC SYMBOLS AND ELEMENTS FOR USE /IN ERROR REPORTING. LCT1 0 /POINTS TO CURRENT CHAR CHPOS1 5 LCT2 0 /POINTS TO LAST MEANINGFUL CHAR CHPOS2 0 LCT3 0 /POINTS TO START OF CURRENT BS CHPOS3 0 LCT4 0 /POINTS TO END OF LAST BS CHPOS4 0 LCT5 0 /POINTS TO START OF CURRENT ELEMENT CHPOS5 0 LCT6 0 /POINTS TO END OF CURRENT BS CHPOS6 0 /SCRATCHPAD SP00 XX SP01 XX SP02 XX SP03 XX SP04 XX SP05 XX SP06 XX .EJECT /LOCAL STORAGE ANAL90=CSTAT /USED BY CONTROL ROUTINE ANAL A0=NSTK /USED BY CDVW CDL90=GNBS64 /USED BY PHASE 2 DICTIONARY ROUTINE CDL CDL91=GNBS61 CDL92=OBEY COPYSV=OPOUT /USED BY GENERAL-PURPOSE ROUTINE COPY COPYSC=FIX COPYCT=FLOAT ERRNO=DIPOL /HOLDS ERROR NO.GENERATED BY CATOM TEST CQQ FQ=OTS00 /HOLDS Q FOR FORMAL PARAM IN PH2 CATOM TEST CAFC FSREQD=DIM /FREE SPACE REQD BY ROUTINE UP OP=MULT /HOLDS OPERATOR USED BY CATOM TEST CQQ PACK90=Q.SKT1 /USED BY ROUTINE PACK PACK92=Q.SKT /DITTO PTRADD=TLPTRS /USED BY PUT Q2=UNP5.7 /USED BY PHASE 2 CATOM TEST CQQ REALS=EOP /USED BY RSTK SMF=RSTK /USED BY ROUTINE UP BDEC10=INIT /USED BY ROUTINE BDEC BDEC11=TOPT OUTOP8=P1CON /FOR OP ADDR AND OP IN OUTOP OUTOP9=ISTK /FOR PREC IN OUTOP .EJECT /NUMERICAL CONSTANTS .DEC C1=TYPE+1 C2=TYPE+2 C3=QUAN61-1 C4=TYPE+3 C5=KTAB+40 C6 6 C7 7 C8=TYPE+4 C9 9 C10 10 C11 11 C12=KTAB+1 C13 13 C15=KTAB+43 C21 21 C25 25 C32=TYPE+6 C34 34 C39 39 C40 40 C50 50 C56 56 C69 69 C75 75 C100 100 C1000 1000 K1=GNEL30-3 K2=QUAN21+2 K3=QUAN71+2 K4=SEXP71+2 K5=EXP21-2 K8=GNEL2-8 K9=NAME91-2 K10=IF1+2 K14=FLE61+2 K15=QUAN1-5 K18=BPL21-2 K19=BPL41+2 K23=UP14+1 K24=VTOA90 K26=FORL1+3 K28=FLE41-2 K29=EVA90 K32 LAW -32 K39 LAW -39 K40=UP12 K49=TARG2-2 K63 LAW -63 K64=Z77700 K100 LAW -100 K1000 LAW -1000 .OCT S00010=C8 S00011=C9 S00012=C10 S00013=C11 S00014=KTAB+1 S00015=C13 S00016 16 S00017=KTAB+53 S00020=KTAB+12 S00037 37 S00040 40 S00041 41 S00042 42 S00060 60 S00067 67 S00070 70 S00077 77 S00100=TYPE+7 S00102 102 S00103 103 S00105 105 S00112 112 S00116 116 S00117 117 S00140 140 .IFDEF DOS S00155 155 .ENDC S00175 175 S00176 176 S00177 177 S00200=KIND S00400=KIND+1 S00401 401 S00700 700 S00766=GNC103-3 S01000=KIND+2 S01400 1400 S01401 1401 S02000=TYPE S02766=GNC22-2 S02775 2775 S03700 3700 S03777 3777 S04000=SV12 S04004 4004 S04102 4102 S04400 4400 S04532 4532 S04672 4672 S05400 5400 S06011 6011 S06100 6100 S07700 7700 S07777 7777 S10000=SEXP41 S10020 10020 S10047 10047 S10300 10300 S14000 14000 S17777 17777 S20000=MODL61 S20100 20100 S25132 25132 S27776 27776 S30000 30000 S30001 30001 S40000=COMP11 S60000 60000 S77777 77777 T00000=OWN1 T43777 143777 T70000 170000 T77777 177777 U00000=EXP51+1 U00001 200001 U00017=BSS+11 U00026=BSS+77 U00027=BSS+32 U00057=BSS+14 U00065=KTAB+75 U00067=ELET-5 U00070=BSS+100 U00074=BSS+7 U00076=BSS-2 U00077=BSS+4 U00110=SCIV11 U00130=COMP51 U00140=STAT61 U00150=SCIV1 U00216=BSS+10 U00235 200235 U00236 200236 U00600 200600 U01003=DEC1 U01202 201202 U03601 203601 U04033=EXC+4 U04034=EXC+15 U06100 206100 U06501 206501 U06600 206600 U07000 207000 U07001 207001 U07601 207601 U07701 207701 U07777 207777 U10010=BSS+13 U10011=BSS+15 U10020=BSS+36 U10021=KTAB+35 U10022=BSS+35 U10023=KTAB+37 U10024=KTAB+33 U10025=BSS+34 U14047=EXC+2 U17201 217201 U20000=SORT+2 U20037=QUAN1 U20044=KTAB+41 U20055=KTAB+111 U20120=CB1 U34177 234177 U40160 240160 U50200 250200 U60056=BSS+33 U60060=KTAB+21 U60061=KTAB+23 U60062=KTAB+51 V00000 300000 V01406 301406 V77701 377701 V77777 377777 W00000=EXP21-1 W00001 400001 W00002=QUAN31-1 W00011 400011 W00014 400014 W00015 400015 W00040 400040 W00041 400041 W00042 400042 W00175 400175 W10000 410000 X74743 574743 X77600 577600 X77777 577777 Y00000=EXPS1+1 Y06703 606703 Y50001 650001 Z00000 700000 Z00100 700100 Z43600 743600 Z60000 760000 Z70000 770000 Z70001=BSS-1 Z77776=K2 .EJECT /AUTO-INDEX REGISTERS USED AUTO=10 AUTO1=11 AUTO2=12 AUTO3=13 AUTO4=14 AUTO5=15 /ASSIGNMENTS INTOUT=-13 DATIN=-11 DATOUT=-12 DUMPS=-13 DMPS=-15 IN=0 RNUMA0=NCB1 RNUMA1=NCB2 RNUMA2=NCB A=400000 CC=200000 N=100000 AN=500000 AS=600000 S=CC M=N CX=A Z=10000 Y=14000 TEMP1=SP00 TEMP2=SP01 TEMP=SP02 TEMPFN=SP03 .EJECT /DMP /CODE TO DUMP COMPILER DATA ONTO DATSLOT DMPS=-13 IN DUMP MODE. /ACTIVATED BY ^T (BUT ONLY WHEN DUMP OPTION REQUESTED). DMP .INIT DMPS,1,DMP 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 /) ISZ DMPFN+2 /INCREMENT EXTENSION .ENTER DMPS,DMPFN LAW -2 TAD AINBA DAC DMP92 LAW -17 DAC DMP91 /CT FOR #WRITES DAC DMP90 ISZ DMP90 /CT FOR #SKS DMP02 LAC* DMP92 /BASE CMA /-B-1 ISZ DMP92 TAD* DMP92 /PTR-B-1(-#WDS ON SK) DAC* 17 LAC* DMP92 /PTR DAC* 17 ISZ DMP92 ISZ DMP90 /END OF STAT TABLE? JMP DMP02 /NO, LOOP 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 ISZ DMP93 LAC* DMP93 DAC DMPCA /SET UP ADDR OF SK ISZ 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 /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 RELATIVE BLOCK NO TAD* BLKADD /MAKE ABSOLUTE 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 LAC* OLAY /CHECK PARAMS WHEN WRITING TO SYSTAPE SAD TP1 SKP XX ISZ OLAY LAC* OLAY SAD TP2 SKP XX ISZ OLAY LAC* OLAY SAD TP3 SKP XX ISZ OLAY LAC* OLAY SAD TP4 JMP* SP02 /EXIT TO DTOUT XX .IFDEF %B0 TP1 A+%B0 TP2 %C0-1 TP3 -%L0 TP4 P1C4+3 .ENDC .IFUND %B0 TP1 0 TP2 0 TP3 0 TP4 0 .ENDC S21000 21000 NOWT 0 /LOCATION 0 .IFDEF PDP15 JMP.T1 253 .ENDC .ENDC .EJECT .IFDEF %S2 .IFDEF %S4 DEF=1 .ENDC .ENDC .IFUND DEF /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 LAC AOPTW /GET ADDR OF OPTION WORD DAC DUMPOW DAC* C8 TAD C5 DAC SP02 DAC SP04 DAC DUMPCA LAC* 10 DAC DUMPFN /SET UP FILNAM FOR DUMP FILE LAC* 10 DAC DUMPFN+1 .ENTER DUMPS,DUMPFN / .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 .EJECT .ENDC .IFUND %B0 /REST /ROUTINE TO RESTORE THE STACKS PREVIOUSLY CREATED DURING A RUN WITH /THE PRE-SET PROC OPTION SET. /FILE NAMED "PRESET AL1" IS READ IN DUMP MODE FROM DATSLOT DATIN=-11. REST XX .INIT DATIN,0,REST LAC K14 DAC SP00 /COUNT OF STACKS TO BE READ LAC AOPTW TAD C4 DAC SP01 /ADDR OF WORD HOLDING ADDR OF STAT TABLE DAC* SP01 ISZ* SP01 DAC SP04 /HOLD ADDR OF WORD HOLDING ADDR STAT TABLE DAC STATIN ISZ STATIN /ADDR OF STAT TABLE AFTER RESTORE / .SEEK DATIN,RESTFN CAL DATIN&777 3 RESTFN LAC AGLOBL DAC SP03 /HOLD ADDR OF TOP OF CORE / .READ DATIN,4,LCT1,4 CAL+4000 DATIN&777 10 LCT2 -4 LAC K26 DAC RESTL /LENGTH OF STAT TABLE LAC* SP01 DAC RESTCA /ADDR OF STAT TABLE REST1 .WAIT DATIN / .READ DATIN,4,RESTCA,RESTL /READ STAT TABLE,THEN STACKS CAL+4000 DATIN&777 10 RESTCA 0 RESTL 0 ISZ 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 ISZ RESTCA /ADDR OF READ STACK INTO LAC SP03 /)TOP OF FREE CORE DAC* SP01 /)TO SK BASE ISZ 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 DATIN JMS COPY /)MOVE STAT TABLE NOW CREATED STATIN XX /)INTO PROGRAM AREA INBASE 32 LAC AINBA /)UPDATE ADDR OF STAT TABLE DAC* SP04 /)AT BOTTOM OF CORE JMP* REST RESTFN .SIXBT !PRESETAL1! .ENDC PCH=. /PATCH AREA FOR DEBUGGING .IFUND DOS .BLOCK %S1+%V1-JMP.T1-2 .ENDC .IFDEF DOS .BLOCK %S1+%V1-DMP93-3 .ENDC .SIZE .END START