Directory of image this file is from
This file as a plain text file
/ ############ ######### ######### / ############ ######### ######### / ### ### ### ### ### ### / ### ### ### ### ### ### / ### ### ### ### ### / ### ### ### ### ### / ############ ############### ######### / ############ ############### ######### / ### ### ### ### / ### ### ### ### / ### ### ### ### ### / ### ### ### ### ### / ### ### ### ######### / ### ### ### ######### / / / ######### ######### ### / ######### ######### ### / ### ### ### ### ### / ### ### ### ### ### / ### ### ### ### / ### ### ### ### / ### ############### ### / ### ############### ### / ### ### ### ### / ### ### ### ### / ### ### ### ### ### / ### ### ### ### ### / ######### ### ### ############### / ######### ### ### ############### / / / ######### / ######### / ### ### / ### ### / ### / ### / ######### ######### FROM N.WIRTH / ######### ######### ETH - ZUERICH / ### / ### / ### ### / ### ### / ######### / ######### / / /IMPLEMENTED ON A PDP-8/E COMPUTER WITH 28K-WORDS OF MEMORY /BY /PROF. HEINZ STEGBAUER /HTL-MOEDLING, IN 1979 EJECT P A S C A L - S VERSION=2 /C O R E L A Y O U T : /FIELD 0 0000 - 5777 INTERPRETER / 6000 - 6777 FILE- AND DEVICE BUFFERS / 7000 - 7577 COMPILER (INSYMBOL, NEXTCH) / 7600 - 7777 OS/8 - RESIDENT PART /FIELD 1 0000 - 7577 INTERMEDIATE CODE / 7600 - 7777 OS/8 - RESIDENT PART /FIELD 2 0000 - 3777 SYMBOL-TABLE / 4000 - XXXX STRING-TABLE / XXXX - 6377 CONSTANT-TABLE / 6400 - 7377 ARRAY-TABLE / 7400 - 7777 BLOCK-TABLE /AT COMPILETIME: /FIELD 3 0000 - 3777 NAMES OF SYMBOL-TABLE / 4000 - 7177 FSYS, SET-CONSTANTS, LISTS AND / TABLES, ERROR ROUTINES /FIELD 4 0000 - 6377 COMPILER / 6400 - 7777 AUXILIARY ROUTINES /FIELD 5 0000 - 7777 STACK FOR COMPILER OPERATION /FIELD 6 0000 - 7777 LONG ERROR MESSAGES /AT RUNTIME: /FIELD 3 0000 - 7777 /S T A C K (4K WORDS OF 48 BITS) /FIELD 4 0000 - 7777 /FIELD 5 0000 - 7777 /FIELD 6 0000 - 7777 CODEFIELD=10 TABLEFIELD=20 NAMEFIELD=30 SETFIELD=30 COMPFIELD=40 PUSHFIELD=50 ERRFIELD=60 STACKFIELD=30
/S T R U C T U R E O F T A B L E S : /SYMBOL-TABLE (4 WORDS PER ENTRY, MAX. 512 ENTRIES) /------------ TAB=0000 LINK=TAB /WORD 0, BITS 0-11 OBJ=TAB+1 /WORD 1, BITS 0-5 TYP=TAB+1 /WORD 1, BITS 6-11 REF=TAB+2 /WORD 2, BITS 0-5 NORMAL=TAB+2 /WORD 2, BIT 6 LEV=TAB+2 /WORD 2, BITS 7-11 ADR=TAB+3 /WORD 3, BITS 0-11 /STRING-TABLE (ARRAY[0:N] OF CHAR, 6 BITS/CHAR,FROM 4000 UPWARDS) /------------ /CONSTANT-TABLE (4 WORDS PER ENTRY, FROM 6400 DOWNWARDS) /-------------- /ARRAY-TABLE (8 WORDS PER ENTRY, MAX. 64 ENTRIES) /----------- ATAB=6400 / /WORD 0 UNUSED! INXTYP=ATAB+1 /WORD 1 ELTYP=ATAB+2 /WORD 2 ELREF=ATAB+3 /WORD 3 LOW=ATAB+4 /WORD 4 HIGH=ATAB+5 /WORD 5 ELSIZE=ATAB+6 /WORD 6 SIZE=ATAB+7 /WORD 7 /BLOCK-TABLE (4 WORDS PER ENTRY, MAX. 64 ENTRIES) /----------- BTAB=7400 LAST=BTAB /WORD 0 LASTPAR=BTAB+1 /WORD 1 PSIZE=BTAB+2 /WORD 2 VSIZE=BTAB+3 /WORD 3
/A S S E M B L E R D E F I N I T I O N S: L0001=CLA CLL IAC L0002=CLA STL RTL L0003=CLA STL IAC RAL L0004=CLA CLL IAC RTL L0006=CLA STL IAC RTL L0100=CLA CLL IAC BSW L2000=CLA STL RTR L4000=CLA STL RAR L7777=CLA CLL CMA L7776=CLA CLL CMA RAL L7775=CLA CLL CMA RTL L3777=CLA CLL CMA RAR L5777=CLA CLL CMA RTR
/A R I T H M E T I C D E F I N I T I O N S: /MEMORY REFERENCED INSTRUCTIONS: FIXMRI GET=0000 FIXMRI ADD=1000 FIXMRI SUB=2000 FIXMRI MUL=3000 FIXMRI DIV=4000 FIXMRI MOD=5000 /ALSO: JMP=5000 FIXMRI PUT=6000 /OPERATE CLASS INSTRUCTIONS: NORM=7200 /REAL READREAL=7201 WRITEREAL=7202 TRUNC=7203 ROUND=7206 RSQUARE=7205 ZERO=7204 /BOTH TYPES ABSVAL=7000 NEGATE=7004 WRITELINE=7006 READINTEGER=7001 /INTEGER WRITEINTEGER=7002 FLOAT=7003 ISQUARE=7005 /SKIP - INSTRUCTIONS: SKIP=SKP SKEQ=SZA SKNE=SNA SKLT=SMA SKLE=SMA SZA SKGT=SPA SNA SKGE=SPA AAAAAA=JMS I 44 /ENTER MACRO MODE EEEEEE=0000 /RETURN TO PDP8 MODE INT=0177 REAL=7777
/C O M P I L E R D E F I N I T I O N S: DECIMAL /S Y M B O L S: INTCON=0 REALCON=1 CHARCON=2 STRING=3 NOTSY=4 PLUS=5 MINUS=6 TIMES=7 IDIVSY=8 RDIVSY=9 IMODSY=10 ANDSY=11 ORSY=12 EQL=13 NEQ=14 GTR=15 GEQ=16 LSS=17 LEQ=18 LPARENT=19 RPARENT=20 LBRACK=21 RBRACK=22 COMMA=23 SEMICOLON=24 PERIOD=25 COLON=26 BECOMES=27 CONSTSY=28 TYPESY=29 VARSY=30 FUNCTIONSY=31 PROCEDURESY=32 ARRAYSY=33 RECRDSY=34 PROGRAMSY=35 IDENT=36 BEGINSY=37 IFSYM=38 CASESY=39 REPTSY=40 WHILSY=41 FORSY=42 ENDSY=43 ELSESY=44 UNTILSY=45 OFSY=46 DOSY=47 TOSY=48 DOWNTOSY=49 THENSY=50 /O B J E C T S: KONSTANT=0 VARIABLE=1 TYPE1=2 PROZEDURE=3 FUNKTION=4 /T Y P E S: NOTYP=0 INTS=1 REALS=2 BOOLS=3 CHARS=4 ARRAY=5 RECORD=6 /P R O C E D U R E S: BLOCK=0 STATEMENT=1 ASSIGNMENT=2 COMPOUNDSTATEMENT=3 IFSTATEMENT=4 CASESTATEMENT=5 REPEATSTATEMENT=6 WHILESTATEMENT=7 FORSTATEMENT=8 STANDPROC=9 SELECTOR=10 CALL=11 STANDFCT=12 FACTOR=13 TERM=14 SIMPLEEXPRESSION=15 EXPRESSION=16 CONDECLARE=17 TYPDECLARE=18 VARDECLARE=19 PRODECLARE=20 CONSTANT=21 ARRAYTYP=22 TYPE=23 PARAMETERLIST=24 ONECASE=25 /P R O G R A M P A R A M E T E R S: TMAX=512 /MAX. NUMBER OF IDENTIFIERS AMAX=64 /MAX. NUMBER OF ARRAYS BMAX=64 /MAX. NUMBER OF BLOCKS (PROCEDURES+RECORDS) CMAX=1980 /MAX. SIZE OF INTERMEDIATE CODE CSMAX=30 /MAX. NUMBER OF CASES LMAX=16 /MAX. NUMBER OF LEVELS LLNG=80 /MAX. LENGTH OF INPUT LINE ALNG=8 /NO. OF SIGNIFICANT CHAR'S IN IDENTIFIERS OCTAL
FIELD 0 /P A G E Z E R O : *4 EOF, 0 /END OF FILE SWITCH (BOOLEAN) EOLN, 1 /END OF LINE SWITCH ( - " - ) CC, 0 /CHARACTER-COUNTER ERRSW, 0 /ERROR IN LINE SWITCH *10 XR10, 0 /ONE AUTOINDEX REGISTER *20 PC, 0 /P R O G R A M - C O U N T E R /I N S T R U C T I O N - R E G I S T E R IRF, 0 /OP-CODE IRX, 0 /LEVEL IRY, 0 /ADDRESS OR VALUE /S T A C K - P O I N T E R S B, 0 /BASE INDEX T, 0 /STACK POINTER (SIMPLE INDEX) T3, 0 /= 4*T + 3 (ADDRESS OF WORD 3) T3T, 0 /T3 FOR ROUTINE 'TOSTACK' LOOK, 240 /NEXT CHARACTER (LOOK AHEAD) /----------- PAGE 0 LOC'S OF ARITHMETIC PACKAGE ---------------- *32 BCD, 0 /BINARY CODED DECIMAL DIGIT CHAR, 240 /CURRENT CHARACTER M, 22 /OUTPUT FORMAT PARAMETERS N, 0 /(DEFAULT VALUES: M=18, N=0) ACX, 0 / A C - R E G I S T E R ACS, 0 AC0, 0 AC1, 0 AC2, 0 AC3, 0 INTERPC /POINTER TO MACRO-INTERPRETER MQ1, 0 / M Q - R E G I S T E R MQ2, 0 MQ3, 0 OP0, 0 / O P - R E G I S T E R OP1, 0 OP2, 0 OP3, 0 OPX, 0 OPS, 0 MIN4, -4 /-4 (COUNTING WORDS) MIN44, -44 /-36 (COUNTING BITS) OS8, 7600 H1, 0 /4 GENERAL TEMPORARIES H2, 0 H3, 0 H4, 0 /NEW INSTRUCTIONS USED ALSO BY ARITHMETIC PACKAGE: HALVE=JMS I . /AC:=AC DIV 2 (SHIFT RIGHT) RACR DOUBLE=JMS I . /AC:=2*AC (SHIFT LEFT) RACL CLEAR=JMS I . /AC := 0 CLAC LOAD=CLEAR /AC := CONTENTS OF ACCUMULATOR (12 BIT INT.) READC=JMS I . /GET NEXT CHAR FROM INPUT DEVICE PTREAD, XNEXTCH /XREAD AT RUNTIME PRINTC=JMS I . /SEND CHAR TO OUTPUT DEVICE PTPRINT,XPRINT ZPRINT, XPRINT /CONSTANT POINTER TO XPRINT CRLF=JMS I . XCRLF SNALF=JMS I . /SKIP ON NOT ALFABETIC CHAR. (LETTER) XSNALF SKDIG=JMS I . /SKIP ON DIGIT XSKDIG BREAK=JMS I . /CHECK FOR CTRL-C XBREAK HALT=JMS I . /RUN-TIME ERROR HANDLING PTHALT, ERR21 /XHALT AT RUNTIME /--------------------------------------------------------------- /MACRO INSTRUCTIONS USED BY INTERPRETER: *100 ERROR=JMS I . /NON FATAL COMPILER ERRORS ZERROR FATAL=JMS I . /FATAL COMPILER ERRORS ZFATAL OFTAB=JMS I . /GET INFO FROM SYMBOL-TABLE ZOFTAB OFATAB=JMS I . /GET INFO FROM ARRAY-TABLE ZOFATAB OFBTAB=JMS I . /GET INFO FROM BLOCK-TABLE ZOFTAB OFDISPLAY=JMS I . /GET INFO FROM DISPLAY ZOFDISP TODISPLAY=JMS I . /PUT INFO INTO DISPLAY ZTODISP GETCONST=JMS I . /GET CONSTANT ZOFCONST CONTINUE=JMP I . ILOOP BUMP=JMS I . /MOVE STACK POINTER XBUMP SDF=JMS . /CHANGE TO TOP OF STACK - DATA FIELD 0 XSDF, CDF /VARIABLE! JMP I .-2 POPONE=JMS I . /POP ONE WORD (WORD 3 INTO AC) XPOPONE POPVAL=JMS I . /POP FOUR WORDS XPOPVAL POPNUM=JMS I . /POP NUMBER (=POP 4 WORDS AND UNPACK) XPOPNUM PUSHONE=JMS I . /PUSH ONE WORD XPUSHONE PUSHVAL=JMS I . /PUSH FOUR WORDS XPUSHVAL PUSHNUM=JMS I . /PUSH NUMBER (= PACK + PUSHVAL XPUSHNUM TOSTACK=JMS I . /INSERT ONE WORD INTO STACK[T3T] XTOSTACK OFCODE=JMS I . /GET INTERMEDIATE INSTRUCTION XOFCODE /LOCATIONS USED BY I/O-FILE HANDLING: IBUFFER=6000 /INPUT FILE BUFFER OBUFFER=7000 /OUTPUT FILE BUFFER IDEVBUF=6400 /PAGE OF INPUT DEVICE HANDLER ODEVBUF=6600 /PAGE OF OUTPUT DEVICE HANDLER IDEVH, 0 /ENTRY POINT OF INPUT DEVICE HANDLER ODEVH, 0 /ENTRY POINT OF OUTPUT DEVICE HANDLER NAME, ZBLOCK 4 /NAME OF OUTPUT FILE DEVNO, 0 /OUTPUT DEVICE NUMBER LEMPTY, 0 / -LENGTH OF EMPTY MBLOCKS,0 /COUNTING WRITTEN BLOCKS OBP, OBUFFER /BUFFER POINTER (SEE PUTC) OC3, -3 /3-CHARACTER SWITCH (SEE PUTC) I37, DCA CHAR /HALT PROGRAM - CLOSE OUTPUT FILE TAD [232 /WRITE EOF-MARK PRINTC /FILL REST OF BUFFER WITH ZEROES TAD [OBUFFER CIA TAD OBP SZA CLA JMP .-5 L7777 /COMPUTE ACTUAL LENGTH TAD LEMPTY /OF OUTPUT FILE CIA TAD MBLOCKS DCA ALOF CIF 10 TAD DEVNO JMS I [7700 /CALL USR TO CLOSE OUTPUT FILE 4 NAME ALOF, 0 ERRORD, HALT JMP I OS8 /RETURN TO KEYBOARD MONITOR
/INSTRUCTION DECODER AND DISPATCH ROUTINE *200 ISTART, CLA CLL /STARTING ADDRESS DCA EOF L0001 DCA EOLN TAD [240 DCA CHAR TAD [240 DCA LOOK CLEAR DCA T /INITIALIZE THE STACK: BUMP PUSHVAL /S[1].I := 0 BUMP PUSHVAL /S[2].I := 0 BUMP PUSHVAL /S[3].I := 0 BUMP L0001 OFBTAB;LAST DCA H4 TAD H4 PUSHONE /S[4].I := BTAB[1].LAST DCA B /B := 0 L0001 DCA IRX TODISPLAY /DISPLAY[1] := 0 L0002 OFBTAB;VSIZE TAD MIN2 DCA T BUMP /T := BTAB[2].VSIZE - 1 TAD H4 OFTAB;ADR DCA PC /PC := TAB[ S[4].I ].ADR ILOOP, BREAK CLL /GET CURRENT INSTRUCTION TAD PC OFCODE MQL MQA BSW AND [77 DCA IRF MQA AND [77 DCA IRX STL TAD PC OFCODE DCA IRY ISZ PC /PC := PC + 1 TAD JUMP TAD IRF DCA .+1 HLT /JUMP TO INSTRUCTION ROUTINE JUMP, JMP I ILIST MIN2, -2
/INSTRUCTIONS OF STACK COMPUTER - ADDRESS TABLE: ILIST, I00 /LOAD ADDRESS I01 /LOAD VALUE I02 /LOAD INDIRECT I03 /UPDATE DISPLAY ZBLOCK 4 /CODES 4 - 7 UNUSED! I08 /CALL STANDERD FUNCTION I09 /OFFSET I10 /JUMP I11 /CONDITIONAL JUMP I12 /SWITCH CASE ILOOP /CODE 13 USED INTERNALLY! I14 /FOR1UP I15 /FOR2UP I16 /FOR1DOWN I17 /FOR2DOWN I18 /MARK STACK I19 /CALL I20 /INDEX1 I21 /INDEX I22 /LOAD BLOCK I23 /COPY BLOCK I24 /LITERAL I25 /LOAD CONSTANT I26 /FLOAT I27 /READ I28 /WRITE STRING I29 /WRITE1 (DEFAULT FIELD WIDTH) I30 /WRITE2 ( :M ) I31 /WRITE3 ( :M :N ) I32 /EXIT PROCEDURE I33 /EXIT FUNCTION I34 /LOAD ABSOLUTE I35 /LOGICAL NOT I36 /NEGATE PTI37, 7600 /HALT (BECOMES I37 IF FILE I/O!) I38 /STORE ZBLOCK 11 /CODES 39 - 47 UNUSED! I48 /ARITHMETIC OPERATIONS I49 /COMPARE INTEGERS I50 /COMPARE REALS I51 /LOGICAL OR I52 /LOGICAL AND ZBLOCK 10 /CODES 53 - 60 UNUSED! I61 /ASCII I62 /READLN I63 /WRITELN
/INSTRUCTIONS OF STACK COMPUTER (A) I00, BUMP /LOAD ADDRESS OFDISPLAY TAD IRY PUSHONE CONTINUE I01, BUMP /LOAD VALUE OFDISPLAY TAD IRY POPVAL PUSHVAL CONTINUE I02, BUMP /LOAD INDIRECT OFDISPLAY TAD IRY POPONE POPVAL PUSHVAL CONTINUE I03, TAD IRX /UPDATE DISPLAY CIA TAD IRY DCA H1 TAD B DCA H3 UPDIS, TAD H3 TODISPLAY L7777 TAD IRX DCA IRX L0002 TAD H3 POPONE DCA H3 ISZ H1 JMP UPDIS CONTINUE I08, TAD IRY /CALL STANDARD FUNCTION TAD (JMS I STDFUNCT DCA .+2 POPNUM STFJMS, JMS . / J M S TO REQUESTED FUNCTION PUSHNUM CONTINUE STDFUNCT,XABS /0 XABS /1 XISQU /2 XRSQU /3 XODD /4 XCHR /5 STFJMS /6 XSUCC /7 XPRED /8 XROUND /9 RTRUNC /10 XSIN /11 XCOS /12 XEXP /13 XLOG /14 XSQRT /15 XATN /16 XEOF /17 XEOLN /18 XRAND /19 I09, POPONE /OFFSET TAD IRY PUSHONE CONTINUE I10, TAD IRY /JUMP DCA PC CONTINUE I11, POPONE /CONDITIONAL JUMP CLL RAR TAD IRY SNL DCA PC L7777 BUMP CONTINUE I12, POPVAL /SWITCH CASE L4000 AND AC1 CLL RAL TAD AC3 SZL CIA DCA H1 L7777 BUMP SCASE, CLL TAD IRY OFCODE TAD (-1500 /-1300 SZA CLA ERRORC, HALT /C A S E E R R O R ! STL TAD IRY OFCODE CIA TAD H1 SNA CLA JMP .+4 ISZ IRY ISZ IRY /(INCREMENTS, DOESN'T SKIP!) JMP SCASE IAC STL TAD IRY OFCODE DCA PC CONTINUE /I13 ... INTERNAL CODE (MARKS CASE SWITCH LIST) XEOF, 0 TAD EOF JMP .+3 XEOLN, 0 TAD EOLN LOAD BUMP JMP STFJMS+1 XSUCC, 0 L0001 JMP XCHR+1 XPRED, 0 L7777 JMP XCHR+1 XCHR, 0 TAD AC3 AND [77 LOAD JMP STFJMS+1 PAGE
/INSTRUCTIONS OF STACK COMPUTER (B+C) I14, TAD UPSKIP /FOR1UP SKP I16, TAD DOSKIP /FOR1DOWN DCA FORUD1 L7777 /COMMON ROUTINE: TAD T POPNUM AAAAAAAAAAAAAAAA PUT INT&FORH1 EEEEEEEEEEEEEEEE POPNUM AAAAAAAAAAAAAAAA SUB INT&FORH1 FORUD1, SKGE /OR SKLE JMP FOR1EX GET INT&FORH1 EEEEEEEEEEEEEEEE L7776 TAD T POPONE PUSHNUM CONTINUE FOR1EX, EEEEEEEEEEEEEEEE TAD IRY DCA PC L7775 BUMP CONTINUE /NOTE THE STACK SITUATION: / / S[ T ] ... FINAL VALUE / S[T-1] ... INITIAL VALUE / S[T-2] ... ADDRESS OF CONTROL VARIABLE I15, TAD UPADD /FOR2UP DCA FORUD2 TAD UPSKIP JMP .+4 I17, TAD DOSUB /FOR2DOWN DCA FORUD2 TAD DOSKIP DCA FORUD3 L7776 /COMMON ROUTINE: TAD T POPONE DCA H2 TAD H2 POPNUM AAAAAAAAAAAAAAAA FORUD2, ADD INT&ONE /OR SUB INT&ONE PUT INT&FORH1 EEEEEEEEEEEEEEEE POPNUM AAAAAAAAAAAAAAAA SUB INT&FORH1 FORUD3, SKGE /OR SKLE JMP FOR2EX GET INT&FORH1 EEEEEEEEEEEEEEEE TAD H2 PUSHNUM TAD IRY DCA PC CONTINUE FOR2EX, EEEEEEEEEEEEEEEE L7775 BUMP CONTINUE UPSKIP, SKGE DOSKIP, SKLE UPADD, ADD INT&ONE DOSUB, SUB INT&ONE ONE, 0;0;0;1 FORH1, ZBLOCK 4 MINUS1, -1 BYTE, 77 LEVBITS,17 I18, L0004 /MARK STACK BUMP TAD IRY OFTAB;REF BSW AND BYTE OFTAB;VSIZE TAD MINUS1 PUSHONE BUMP TAD IRY PUSHONE CONTINUE I19, TAD IRY /CALL CIA TAD T DCA H1 L0004 TAD H1 POPONE DCA H2 TAD H2 OFTAB;LEV AND LEVBITS DCA H3 L0001 TAD H3 DCA IRX TAD H1 TODISPLAY L0003 TAD H1 POPONE TAD H1 DCA H4 L0001 TAD H1 DCA T3T TAD PC TOSTACK ISZ T3T TAD H3 DCA IRX OFDISPLAY TOSTACK ISZ T3T TAD B TOSTACK /-------------------- FALL THROUGH PAGE BOUNDARY ------------- CLEAR TAD T CMA CLL TAD H4 SNL CLA JMP .+4 BUMP PUSHVAL JMP .-7 TAD H1 DCA B TAD H2 OFTAB;ADR DCA PC CONTINUE I20, TAD (NOP /INDEX1 SKP I21, TAD (JMS MULTY /INDEX DCA INDEX1 TAD IRY /COMMON ROUTINE: OFATAB;HIGH CMA DCA H1 TAD IRY OFATAB;LOW TAD H1 CIA DCA H2 POPVAL L4000 AND AC1 CLL RAL TAD AC3 SZL CIA TAD H1 CLL TAD H2 DCA RELADR SNL ERRORB, HALT /INDEX OUT OF BOUNDS! INDEX1, NOP /OR JMS MULTY L7777 BUMP POPONE TAD RELADR PUSHONE CONTINUE RELADR=H4 MULTY, 0 TAD IRY OFATAB;ELSIZE CLL RAR MQL TAD (-14 /-12 (BITS) DCA H3 MBIT, SNL JMP .+3 CLL TAD RELADR RAR SWP RAR SWP ISZ H3 JMP MBIT SWP DCA RELADR JMP I MULTY I22, POPONE /LOAD BLOCK DCA H1 L7777 BUMP TAD IRY CMA DCA H2 JMP .+6 BUMP TAD H1 POPVAL PUSHVAL ISZ H1 ISZ H2 JMP .-6 CONTINUE I23, L7777 /COPY BLOCK TAD T POPONE DCA H1 POPONE DCA H2 TAD IRY CMA DCA H3 JMP .+7 TAD H2 POPVAL TAD H1 PUSHVAL ISZ H1 ISZ H2 ISZ H3 JMP .-7 L7776 BUMP CONTINUE I24, BUMP /LITERAL (ADDRESSES ONLY!) TAD IRY LOAD PUSHVAL CONTINUE I25, BUMP /LOAD CONSTANT TAD IRY GETCONSTANT PUSHVAL CONTINUE I61, POPONE /WRITE SPECIAL ASCII PRINTC L7777 BUMP CONTINUE PAGE
/INSTRUCTIONS OF STACK COMPUTER (D) I26, TAD IRY /FLOAT CIA TAD T DCA H1 TAD H1 POPNUM JMS IFLOAT TAD H1 PUSHNUM CONTINUE I27, TAD (JMS I READX-1 /READ TAD IRY DCA .+1 JMS I READX POPONE PUSHNUM JMP EXI27 READX, IINP RINP NOP CINP I28, POPONE /WRITE STRING DCA M L7777 BUMP POPONE CIA DCA N TAD IRY CDF TABLEFIELD JMS WSTRING JMP EXI27 I29, TAD (TAD DFW-1 /WRITE (STANDARD FIELD WIDTH) TAD IRY DCA .+1 TAD DFW DCA M JMP WRGO I30, POPONE /WRITE (SPECIFIED FIELD WIDTH) DCA M L7777 BUMP WRGO, POPNUM L7777 BUMP DCA N TAD (JMS I WRITEX-1 TAD IRY DCA .+1 JMS I WRITEX CONTINUE WRITEX, IOUT ROUT BOUT COUT DFW, 12 22 12 1 I31, POPONE /WRITE ( X :M :N ) DCA N L7777 BUMP POPONE DCA M L7777 BUMP POPNUM JMS I WRITEX+1 /REAL ONLY! EXI27, L7777 BUMP CONTINUE I32, L7776 /EXIT PROCEDURE SKP I33, L7777 /EXIT FUNCTION TAD B DCA T BUMP L0001 TAD B POPONE DCA PC L0003 TAD B POPONE DCA B CONTINUE I34, POPONE /LOAD (ABSOLUTE) POPVAL PUSHVAL CONTINUE I35, POPONE /LOGICAL NOT CLL RAR CML RAL PUSHONE CONTINUE I36, POPNUM /NEGATE JMS XNEG PUSHNUM CONTINUE I38, POPVAL /STORE L7777 BUMP POPONE PUSHVAL L7777 BUMP CONTINUE /I39 - I47 U N U S E D ! /B O O L E A N O U T P U T BOUT, 0 TAD AC3 TAD (-5 DCA N TAD AC3 SNA CLA L0004 TAD (TRUEFALSE^2 JMS WSTRING JMP I BOUT PAGE
/INSTRUCTIONS OF STACK COMPUTER (E) I48, POPNUM /ARITHMETIC: JMS ENTR /INTEGER: L7777 / + 48,1 BUMP / - 48,2 POPNUM / * 48,3 TAD (MRITABL / DIV 48,4 TAD IRY / MOD 48,5 DCA H1 TAD I H1 /REAL: DCA H1 / + 48,10 JMS I H1 / - 48,11 PUSHNUM / * 48,12 CONTINUE / / 48,13 I49, TAD (ISUB-RSUB /COMPARE (INTEGER) I50, TAD (RSUB /COMPARE (REAL) DCA H1 / = 50,7440 POPNUM / <> 50,7450 JMS ENTR / < 50,7500 L7777 / <= 50,7540 BUMP / > 50,7550 POPNUM / >= 50,7510 JMS I H1 /SUBTRACT TAD IRY JMS BOOL LOAD PUSHVAL CONTINUE I51, POPONE /LOGICAL OR DCA H1 L7777 BUMP SDF TAD H1 CMA AND I T3 TAD H1 DCA I T3 CDF CONTINUE I52, POPONE /LOGICAL AND DCA H1 L7777 BUMP SDF TAD H1 AND I T3 DCA I T3 CDF CONTINUE /I53 - I61 U N U S E D ! READC I62, TAD EOLN /READLN SNA CLA JMP .-3 READC CONTINUE I63, CRLF /WRITELN CONTINUE
/AUXILIARY ROUTINES FOR 'WRITE STRING' AND 'BOOLEAN OUTPUT' WSTRING,0 DCA H1 RDF TAD CCDF0 DCA STRFLD CCDF0, CDF 0 TAD M SNA JMP NCHAR TAD N /M-N SPA SNA JMP PARTLY CIA DCA H2 TAD [240 PRINTC ISZ H2 JMP .-3 JMP NCHAR PARTLY, CIA / N-M TAD N /-N DCA N /= -M NCHAR, TAD H1 STL RAR /STRING TABLE STARTS AT 4000! DCA H2 STRFLD, CDF TABLEFIELD TAD I H2 CDF 0 SNL BSW JMS ASCII ISZ H1 ISZ N JMP NCHAR JMP I WSTRING ASCII, 0 AND [77 TAD [240 AND [77 TAD [240 PRINTC JMP I ASCII
/C H A R A C T E R I N P U T AND O U T P U T CINP, 0 READC TAD CHAR AND [77 LOAD JMP I CINP COUT, 0 TAD M SPA SNA L0001 CIA DCA H2 JMP .+3 TAD [240 PRINTC ISZ H2 JMP .-3 TAD AC3 JMS ASCII JMP I COUT PAGE
/STACK INSTRUCTIONS XBUMP, 0 SNA /IF (AC)=0 L0001 /THEN T:=T+1 CLL /ELSE T:=T+(AC) SPA CML TAD T DCA T SZL ERRORA, HALT /S T A C K O V E R F L O W ! TAD T CLL RAR BSW AND (70 TAD (CDF STACKFIELD DCA XSDF /SETUP CHANGE TO STACK FIELD INSTR. TAD T /AND BUILD STL RAL STL RAL DCA T3 /ADDRESS OF TOP ENTRY (LS WORD) JMP I XBUMP ST3, ADDRESS,0 /COMPUTE FULL ADDRESS MQL /OF STACK LOCATION MQA /AND CHANGE DATA FIELD CLL RAR BSW AND (70 TAD (CDF STACKFIELD DCA STCDF MQA STL RAL STL RAL STCDF, CDF STACKFIELD JMP I ADDRESS PACK, 0 /PACK REAL OR INTEGER NUMBER TAD ACX /INTO AC0-4 (FOR PUSHING) DCA AC0 TAD ACS TAD AC1 DCA AC1 JMP I PACK UNPACK, 0 /UNPACK POPPED NUMBER L4000 /(EXTRACT SIGN, EXPONENT) AND AC1 DCA ACS L3777 AND AC1 DCA AC1 TAD AC0 DCA ACX DCA AC0 JMP I UNPACK XPOPONE,0 SNA JMP TOPONE JMS ADDRESS DCA ST3 TAD I ST3 CDF JMP I XPOPONE TOPONE, SDF TAD I T3 CDF JMP I XPOPONE XPUSHONE,0 SDF DCA I T3 CDF JMP I XPUSHONE XPOPVAL,0 SNA JMP TOPVAL JMS ADDRESS TAD MIN4 DCA XR10 TAD I XR10 DCA AC0 TAD I XR10 DCA AC1 TAD I XR10 DCA AC2 TAD I XR10 DCA AC3 CDF JMP I XPOPVAL TOPVAL, TAD T3 SDF JMP XPOPVAL+4 XPUSHVAL,0 SNA JMP ONTOP JMS ADDRESS TAD MIN4 DCA XR10 TAD AC0 DCA I XR10 TAD AC1 DCA I XR10 TAD AC2 DCA I XR10 TAD AC3 DCA I XR10 CDF JMP I XPUSHVAL ONTOP, TAD T3 SDF JMP XPUSHVAL+4 XPOPNUM,0 JMS XPOPVAL JMS UNPACK JMP I XPOPNUM XPUSHNUM,0 MQL JMS PACK MQA JMS XPUSHVAL JMP I XPUSHNUM XTOSTACK,0 DCA PACK /TEMP. SAVE VALUE TAD T3T JMS ADDRESS DCA ST3 TAD PACK DCA I ST3 CDF JMP I XTOSTACK PAGE
/TABLE INSTRUCTIONS ZOFTAB, / AC := TAB[ AC ].REF ZOFBTAB,0 / AC := BTAB[ AC ].REF CLL RTL TAD I ZOFTAB /SELECTOR FOLLOWS CALL DCA LOC ISZ ZOFTAB CDF TABLEFIELD TAD I LOC CDF JMP I ZOFTAB ZOFATAB,0 / AC := ATAB[ AC ].REF CLL RAL CLL RTL TAD I ZOFATAB /SELECTOR FOLLOWS CALL DCA LOC ISZ ZOFATAB CDF TABLEFIELD TAD I LOC CDF JMP I ZOFATAB ZOFDISP,0 / AC := DISPLAY[ IRX ] TAD (DISPLAY TAD IRX DCA LOC TAD I LOC JMP I ZOFDISP ZTODISP,0 / DISPLAY[ IRX ] := AC MQL TAD (DISPLAY TAD IRX DCA LOC MQA DCA I LOC JMP I ZTODISP XOFCODE,0 / AC := CODE[ AC.LINK ] RAL /LINK=0 ... 1ST WORD DCA LOC /LINK=1 ... 2ND WORD CDF CODEFIELD TAD I LOC CDF JMP I XOFCODE LOC, 0 /ADDRESS OF TABLE LOCATION ZOFCONST,0 /ENTER WITH ADDRESS-1 IN AC DCA XR10 CDF TABLEFIELD TAD I XR10 DCA AC0 TAD I XR10 DCA AC1 TAD I XR10 DCA AC2 TAD I XR10 DCA AC3 CDF JMP I ZOFCONST
/PREDEFINED R A N D O M - NUMBER GENERATOR XRAND, 0 TAD DISMOV /DISABLE INTEGER- DCA INTMOV /MULTIPLY-OVERFLOW AAAAAAAAAAAAAAAA GET INT&RN MUL INT&ALFA /MOD 2^35 ! PUT INT&RN NORM /0 < RANDOM: REAL < 1 EEEEEEEEEEEEEEEE TAD ENAMOV /REENABLE DCA INTMOV BUMP JMP I XRAND DISMOV, DCA AC0 ENAMOV, JMSSNAC RN, 0000;3777;7777;7775 /2^35 - 3 (INTEGER) ALFA, 0000;0000;0100;0003 /2^18 + 3 (INTEGER) XODD, 0 L0001 AND AC3 LOAD JMP I XODD XSKDIG, 0 /SKIP ON DIGIT TAD CHAR TAD (-"9-1 CLL TAD ("9+1-"0 DCA BCD SZL CLA ISZ XSKDIG JMP I XSKDIG XPRINT, 0 /INTERNAL PRINTER HANDLER SNA TAD CHAR TLS TSF JMP .-1 TAD [-215 SZA CLA JMP I XPRINT TAD [212 JMP XPRINT+3 SPRINT, 0 /SILENT PRINTER CLA CLL JMP I SPRINT XCRLF, 0 /CARRIAGE RETURN & LINE FEED TAD [215 PRINTC JMP I XCRLF XBREAK, 0 /CHECK ^C AND ABORT KSF JMP I XBREAK CLA KRS AND [177 TAD (-3 SZA CLA JMP I XBREAK JMP I OS8 PAGE
/ A R I T H M E T I C P A C K A G E INTERPC,0000 /PROGRAM COUNTER FOR MACRO-INSTRUCTIONS CPAGE, 7600 SZA CLA NEXTINSTR, ISZ INTERPC /POINT TO NEXT INSTRUCTION TAD I INTERPC /GET CODE SNA /IF CODE=0000 JMP I INTERPC /THEN RETURN TO PDP8-MODE CLL RTL /ELSE SHIFT CODE NXXX RTL AND (7 /TO EXTRACT OPERATION CODE N DCA OPCODE TAD I INTERPC /GET CODE AGAIN, AND (177 /MASK OUT REL.ADDRESS (OR FUNCTION CODE) MQL TAD CPAGE C200, AND INTERPC /CURRENT PAGE BITS MQA /+ RELATIVE ADDRESS DCA OPADDR /= ABS. ADDRESS OF OPERAND (IF MRI) SNL /IF D\I-BIT SET JMP .+3 TAD I OPADDR /THEN DO INDIRECT ADDRESSING DCA OPADDR TAD OPCODE TAD (-7 SNA CLA /IF CODE=7XXX JMP OPRTYP /THEN OPERATE CLASS INSTRUCTION MRITYP, TAD I OPADDR /ELSE MEMORY REFERENCED INSTR.: DCA OPX /LOAD AND UNPACK OPERAND ISZ OPADDR /INTO OP-REGISTER L4000 AND I OPADDR DCA OPS L3777 AND I OPADDR DCA OP1 ISZ OPADDR TAD I OPADDR DCA OP2 ISZ OPADDR TAD I OPADDR DCA OP3 TAD I INTERPC /GET INSTRUCTION CODE AGAIN, AND C200 /CHECK INTEGER\REAL-BIT SZA CLA /AND BUILD A TAD (7 TAD OPCODE TAD (JMS I MRITABL DCA .+1 OPCODE, JMS . / J M S TO THE REQUESTED ROUTINE JMP NEXTINSTR OPADDR, 0 /TABLE OF INTEGER ARITHMETIC ROUTINES: MRITABL,OGET IADD ISUB IMUL IDIV IMOD OPUT /TABLE OF REAL ARITHMETIC ROUTINES: OGET RADD RSUB RMUL RDIV OJUMP OPUT OPRTYP, TAD I INTERPC /DECODE OPERATE INSTRUCTION SNL /BIT3 IS IN LINK (COMPLEMENTED!) JMP SKIPTYP /SKIP INSTR. CODES ARE 74XX, 75XX BSW /OPERATE INSTR. CODES ARE: RTR /7000 - 7006 (INTEGER) CLA MQA /7200 - 7206 (REAL) AND (7 /EXTENDED FUNCTIONS: 70X7 RAL TAD (JMS I OPRTABL DCA .+3 TAD INTERPC /SAVE PC, SINCE OPR'S MAY CAUSE DCA SAVEPC /RECURSIVE CALL OF INTERPRETER (1 LEVEL) OPRJMS, JMS . / J M S TO APPROPRIATE ROUTINE TAD SAVEPC /RESTORE PC DCA INTERPC JMP NEXTINSTR SAVEPC, 0 NOOP=OPCODE /TABLE OF OPERATE CLASS INSTRUCTIONS: OPRTABL,XABS; RNORM IINP; RINP IOUT; ROUT IFLOAT; RTRUNC XNEG; CLAC XISQU; XRSQU XCRLF; XROUND NOOP /LINK TO FUNCTION DISPATCH ROUTINE IFDEF FUNCTS < *.-1 FUNCTS /ENABLED ONLY IF FUNCTION PACKAGE PRESENT > SKIPTYP,JMS BOOL /ALL SKIP INSTR. (INT & REAL) DONE HERE ISZ INTERPC /(SEE ROUTINE 'BOOL' FOR COMMENTS) JMP NEXTINSTR-1 OJUMP, 0 /JUMP (WITHIN MACRO CODE!!!) L7775 TAD OPADDR DCA INTERPC JMP NEXTINSTR+1 OPUT, 0 /STORE CONTENTS OF AC-REGISTER L0004 /AT SPECIFIED MEMORY ADDRESS CIA /-4 (OPADDR WAS MOVED AT MRITYP) TAD OPADDR DCA XR10 TAD ACX DCA I XR10 TAD ACS TAD AC1 DCA I XR10 TAD AC2 DCA I XR10 TAD AC3 DCA I XR10 JMP I OPUT PAGE
/R E A L N U M B E R I N P U T / /ACCEPTS A DECIMAL NUMBER IN ANY FORMAT, /CONVERTS IT TO INTERNAL BYNARY FLOATING POINT NOTATION /AND LEAVES IT IN THE AC-REGISTER. /LEADING BLANKS ARE IGNORED; THE FIRST /NON ACCEPTABLE CHARACTER TERMINATES THE NUMBER. DC=MQ2 /DIGIT COUNTER OC=MQ3 /DIGIT EXCESS COUNTER DP, 0 /DECIMAL POINT POSITION RINP, RETNUM /RETURN ADDR. SINCE COMPILER ENTERS AT 'FRACTN' SKP CLA READC /PASS OVER LEADING BLANKS TAD CHAR TAD (-240 SNA CLA JMP .-4 JMS PMXXX /PROCESS + - I N T E G E R PART TAD OC /COUNT LOOSEN DIGITS (IF THE INTERNAL CIA /REPRESENTATION EXCEEDS 35 BITS, DCA DC /FURTHER DIGITS ARE IGNORED, BUT TAD CHAR /THEIR CONTRIBUTION TO MAGNITUDE TAD (-". /MUST BE CONSIDERED!) SZA CLA /IF INTEGER FOLLOWED BY DECIMAL POINT JMP .+3 READC FRACTN, JMS BCONV /THEN PROCESS F R A C T I O N PART TAD DC /COUNT DIGITS AFTER DEC. POINT CIA DCA DP /TO REMEMBER POSITION OF DEC. POINT JMS IFLOAT /NORMALIZE THE NUMBER TAD CHAR TAD (-"E SZA CLA /IF NEXT CHARACTER IS "E" JMP ADJUST AAAAAAAAAAAAAAAA PUT NUMBUF /THEN STORE NUMBER TEMPORARELY EEEEEEEEEEEEEEEE READC JMS PMXXX /AND PROCESS S C A L E - F A C T O R TAD ACS CLL RAL TAD AC3 /GET IT FROM LOW ORDER WORD OF AC SZL /IF NEGATIVE SIGN CIA /THEN USE 2'S COMPLEMENT TAD DP /ADD IT TO CURRENT POS. OF DEC. POINT DCA DP AAAAAAAAAAAAAAAA GET NUMBUF /RECALL STORED MANTISSA EEEEEEEEEEEEEEEE ADJUST, TAD DP /NOW CONVERT DEC. FLOATING POINT TO JMS SUP1 /TO BINARY FLOATING POINT NOTATION JMP I RINP PMXXX, 0 /SIGNED INTEGER INPUT & CONVERSION CLEAR DCA DC DCA OC TAD CHAR TAD (-"+ SNA JMP .+6 CLL RTR SZA CLA JMP .+4 L4000 DCA ACS READC JMS BCONV JMP I PMXXX BCONV, 0 /UNSIGNED DIGIT STRING INPUT & CONVERSION SKDIG JMP I BCONV TAD AC0 SZA CLA JMP OVER CLL JMS MUL10 TAD BCD DCA OP3 DCA OP2 DCA OP1 JMS BADD ISZ DC SKP OVER, ISZ OC READC JMP BCONV+1
/F L O A T AND T R U N C ROUTINES DISPLC=. IFLOAT, 0 /COMPENSATE TAD (43 /35 BITS DISPLACEMENT OF BINARY POINT DCA ACX /WITH EXPONENT JMS RNORM /AND NORMALIZE JMP I IFLOAT RTRUNC, 0 CLA CLL TAD ACX SPA SNA /IF ABS(AC)<1 OR AC=0 JMP LESS0 /THEN TRUNC(AC):=0 TAD MIN44 DCA DISPLC /-(DISPLACEMENT OF BINARY POINT + 1) SZL CLA /IF ABS(AC)>MAXINT JMP ERROR2 /THEN O V E R F L O W SKP HALVE /ELSE ALIGN MANTISSA ISZ DISPLC JMP .-2 DCA ACX /EXP=0 FOR INTEGERS JMP I RTRUNC LESS0, CLA CLEAR JMP I RTRUNC XROUND, 0 L2000 DCA OP1 DCA OP2 DCA OP3 DCA OPX /X>=0: TAD ACS /ROUND(X) = TRUNC(X+0.5) DCA OPS /X<0: JMS RADD /ROUND(X) = TRUNC(X-0.5) JMS RTRUNC JMP I XROUND PAGE
/R E A L N U M B E R O U T P U T / /PRINTS FLOATING POINT NUMBER X (CONTENTS OF AC-REGISTER) /IN THE FORMAT SPECIFIED BY THE PARAMETERS M,N (PAGE 0) /PERFORMS LIKE THE PASCAL-STATEMENT / W R I T E ( X :M :N ) /M /MINIMUM FIELD WIDTH /N /FRACTION LENGTH S=MQ1 /-NUMBER OF LEADING BLANKS P=MQ2 /-NUMBER OF DIGITS PRECEDING THE DEC. POINT F=MQ3 /-NUMBER OF DIGITS FOLLOWING THE DEC. POINT ROUT, 0 JMS FLCONV /BINARY TO DECIMAL FLOATING POINT JMS EXBCD /EXTRACT BCD-DIGITS OF MANTISSA TAD N SPA SNA /WHICH FORMAT REQUESTED? JMP FLOPNT FIXPNT, CIA / -99999.99999 DCA F /F:=-N TAD DEXP SPA /IF DEXP>0 CLA /THEN P:=-(DEXP+1) CMA /ELSE P:=-1 DCA P L7776 /S:=-(M-N-P-2) TAD F TAD P TAD M CIA DCA S TAD S SMA CLA /IF S>=0 THEN USE FLOATING POINT FORMAT JMP FLOPNT /(NUMBER TOO LARGE FOR FIXED POINT!) L0002 TAD N /ROUNDUP WITH (N+DEXP+1)TH DIGIT TAD DEXP SPA SNA /IF NOT WITHIN THE 11 DIGITS, THEN JMP .+3 TAD (-13 /ROUNDUP WITH 11TH DIGIT SMA CLA TAD (13 JMS UROUND JMP FIXPNT+2 /ROUNDED MANTISSA = 10, CHECK WIDTH! TAD DEXP /BEGINNING AT DIGIT POS. NUMBUF+DEXP SMA /OR NUMBUF IF NUMBER >= 1 CLA JMS XOUT /DO THE FIXED POINT OUTPUT JMP I ROUT FLOPNT, L7777 / -9.999999999E+999 DCA P /P:=-1 TAD M TAD (-12 SPA CLA TAD (12 DCA M /IF M<10 THEN M:=10 TAD (-11 DCA F /F:=-9 TAD M /S:=-(M-17) TAD (-21 CIA DCA S TAD S SPA CLA /IF S>=0 THEN JMP .+7 L7777 /S:=-1 DCA S /F:=-(M-9) TAD M TAD (-11 CIA DCA F L7776 TAD F CIA JMS UROUND /ROUNDUP WITH (-F+1)TH DIGIT STFW, 0022 /NOP (CARRY DOESN'T HARM!) JMS XOUT /OUTPUT THE MANTISSA TAD ("E PRINTC /E TAD DEXP SPA CLA L0002 TAD ("+ PRINTC /+ OR - TAD DEXP SPA CIA /MAKE DEXP POSITIVE JMS LDAC /LOAD IT IN AC-REGISTER (AS INTEGER) L0003 DCA M /SETUP A FIELD WIDTH OF 3, TAD ("0-240 /CHANGE LEADING BLANKS TO ZEROES JMS IOUT /AND USE INTEGER OUTPUT ROUTINE TAD STFW /TO PRINT THE CHARACTERISTIC. DCA M /THEN RESET STANDARD FIELD WIDTH JMP I ROUT /BUFFER FOR BCD-DIGITS: 0 /IMPORTANT! (SEE ROUNDING) NUMBUF, ZBLOCK 13 TEN, 0004 /REAL CONSTANT OF 10.0 2400 0000 0000 OPTEN, 7775 /REAL CONSTANT OF 0.1 (CURRENTLY NOT USED!) 3146 3146 3146 LDAC, CLAC, 0 /LOAD OR CLEAR AC-REGISTER DCA AC3 DCA AC2 DCA AC1 DCA AC0 DCA ACS DCA ACX JMP I CLAC PAGE
/REAL NUMBER OUTPUT - AUXILIARY ROUTINES XDPOS=XR10 /AUTOINDEXING DIGITS /DPOS=EXBCD /SIMPLE POINTER TO DIGITS /DIG0=DOUT /NUMBUF-1 OR NUMBUF-2 (FIRST DIGIT OF MANTISSA) DEXP=BCD /DECIMAL CHARACTERISTIC OF X DCNT=. /DIGIT COUNTER FLCONV, 0 /CONVERT X*2^ACX ---> Z*10^DEXP, DCA DEXP /WITH 1<=Z<10: TAD AC1 SNA CLA /IF NUMBER=0 THEN NO CONVERSION NECESSARY! JMP I FLCONV JMS SUP2 /DO SUPER CONVERSION FLCLP, TAD DEXP DCA DEXP TAD ACX SPA SNA /NOTE INTERNAL BINARY NOTATION: JMP SMALL TAD (-4 / 1 ..... 0.1000B+1 SPA /10 ..... 0.1010B+4 JMP .+5 SZA CLA JMP LARGE TAD AC1 /HIGH ORDER WORD FOR 10 TAD (-2400 /IS 2400 OCTAL! SPA CLA JMP I FLCONV LARGE, AAAAAAAAAAAAAAAA DIV TEN /:10 (OR 'MUL OPTEN' *0.1) EEEEEEEEEEEEEEEE L0001 JMP FLCLP SMALL, AAAAAAAAAAAAAAAA MUL TEN /*10 EEEEEEEEEEEEEEEE L7777 JMP FLCLP DPOS=. EXBCD, 0 /EXTRACT BCD-DIGITS OF MANTISSA TAD ACX CMA DCA DCNT STL /(MIGHT CORRECT ILL 11TH DEC. DIGIT!) DOUBLE /SHIFT OUT FIRST DIGIT ISZ DCNT JMP .-3 TAD (NUMBUF-1 DCA XDPOS TAD (-12 /10 DIGITS REMAINING DCA DCNT DCA I (NUMBUF-1 /LEADING 0 FOR ROUNDING CARRY SKP JMS MUL10 TAD AC0 DCA I XDPOS DCA AC0 ISZ DCNT JMP .-5 TAD (NUMBUF-1 /POINT TO FIRST DIGIT DCA DIG0 JMP I EXBCD UROUND, 0 /ROUNDUP. ENTRY WITH DIGIT NO. TAD DIG0 /WHERE TO START ROUNDING DCA DPOS /IN HARDWARE AC TAD (5 CARRY, TAD (-12 TAD I DPOS SPA CLA JMP OVR10 DCA I DPOS L7777 TAD DPOS DCA DPOS ISZ I DPOS JMP CARRY OVR10, TAD DIG0 CIA TAD DPOS SZA CLA /CARRY TO A NEW FIRST DIGIT? JMP SKIPEX /NO L7777 TAD DIG0 DCA DIG0 ISZ DEXP JMP I UROUND /MANTISSA=10 EXIT SKIPEX, ISZ UROUND /NORMAL EXIT JMP I UROUND XOUT, 0 /OUTPUT. ENTRY WITH DIGIT NO. TAD DIG0 /WHERE TO START PRINTING DCA XDPOS /IN HARDWARE AC TAD (240 PRINTC / -(S) BLANKS ISZ S JMP .-3 TAD ACS SPA CLA TAD ("--240 TAD (240 PRINTC / THE SIGN (- OR BLANK) JMS DOUT / -(P) DIGITS (OR ZERO) ISZ P JMP .-2 TAD (". / THE DECIMAL POINT PRINTC JMS DOUT / -(F) DIGITS (OR ZEROES) ISZ F JMP .-2 JMP I XOUT DIG0=. DOUT, 0 /IF XDPOS POINTS INTO BUFFER TAD XDPOS /THEN PRINT THE DIGIT TAD (-NUMBUF-12 /ELSE PRINT A ZERO CLL TAD (14 CLA TAD I XDPOS SNL CLA TAD ("0 PRINTC JMP I DOUT PAGE
/R E A L A R I T H M E T I C / /RADD: AC:=AC+OP /RSUB: AC:=AC-OP /RMUL: AC:=AC*OP /RDIV: AC:=AC/OP / /RNORM: NORMALIZE AC TO STANDARD FLOATING POINT FORMAT RADD, 0 TAD OP1 SNA CLA /IF OP=0 THEN DON'T WASTE TIME! JMP I RADD TAD AC1 SNA CLA /IF AC=0 THEN SIMPLY ADD! JMP OPMAX TAD ACX /COMPARE MAGNITUDE OF OPERANDS CIA /AND STORE NEGATIVE DIFFERENCE TAD OPX SMA JMP OPMAX DCA RDIV /TO USE AS SHIFT COUNTER ACMAX, TAD OP1 /1/ ABS(AC)>ABS(OP) ---> SHIFT OP RIGHT CLL RAR DCA OP1 TAD OP2 RAR DCA OP2 TAD OP3 RAR DCA OP3 ISZ RDIV JMP ACMAX JMP SETSGN OPMAX, CMA /2/ ABS(OP)>=ABS(AC) DCA RDIV TAD OPX /RESULT IS OF MAGNITUDE OF OP DCA ACX SKP HALVE /SHIFT AC RIGHT ISZ RDIV JMP .-2 SETSGN, JMS OADD /MANTISSAS NOW ALIGNED! - ADD. JMS RNORM /NORMALIZE RESULT JMP I RADD RSUB, 0 JMS OSUB /OP:=-OP JMS RADD /AC:=AC+(-OP) JMP I RSUB OSUB, 0 L4000 TAD OPS DCA OPS JMP I OSUB RMUL, 0 TAD OP1 SNA CLA JMS CLAC TAD AC1 SNA CLA /IF OP=0 OR AC=0 JMP I RMUL /THEN DON'T WASTE TIME! DCA MQ1 DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BMUL') DCA MQ3 TAD OPS /SETUP SIGN OF PRODUCT TAD ACS DCA ACS L7777 TAD OPX /COMPUTE EXPONENT OF PRODUCT TAD ACX DCA ACX L0001 JMS BMUL /MULTIPLY MANTISSAS JMS RNORM JMP I RMUL RDIV, 0 TAD OP1 SNA CLA ERROR0, HALT /D I V I S I O N BY Z E R O ! DCA MQ1 DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BDIV') DCA MQ3 TAD OPS /SETUP SIGN OF QUOTIENT TAD ACS DCA ACS TAD OPX /COMPUTE EXPONENT OF QUOTIENT CIA TAD ACX DCA ACX JMS BDIV /DIVIDE MANTISSAS JMS RNORM JMP I RDIV RNORM, 0 CLA CLL TOOBIG, TAD AC1 AND (4000 /(NO 'L4000' BECAUSE OF LINK!) TAD AC0 SNA CLA /WHILE MANTISSA TOO BIG (>=1) JMP ROUNDUP HALVE /HALVE IT (SHIFT RIGHT) ISZ ACX /AND CORRECT THE EXPONENT (+1) NOP JMP TOOBIG ROUNDUP,SZL /IF A BINARY 1 WAS SHIFTED OUT ISZ AC3 /THEN ROUND MANTISSA JMP NULLAC ISZ AC2 JMP NULLAC ISZ AC1 /(CAN'T SKIP!) JMP RNORM+1 NULLAC, JMS SNAC /CHECK FOR NULL MANTISSA JMP ISNULL TOOSMALL,L2000 AND AC1 SZA CLA /WHILE MANTISSA TOO SMALL (<0.5) JMP ISNULL+1 DOUBLE /DOUBLE IT (SHIFT LEFT) L7777 /AND CORRECT THE EXPONENT (-1) TAD ACX DCA ACX JMP TOOSMALL ISNULL, JMS CLAC L2000 /CHECK FOR OVER- OR UNDERFLOW TAD ACX SMA CLA JMP I RNORM /OKAY! TAD ACX SPA CLA ERROR1, HALT /U N D E R F L O W ! ERROR2, HALT /O V E R F L O W ! PAGE
/I N T E G E R I N P U T AND O U T P U T / / /M /MINIMUM FIELD WITH DI, 0 /-NUMBER OF DIGITS TO PRINT SI, 0 /-NUMBER OF LEADING BLANKS LDBLANK,240 /OR OTHER LEADING CHARACTER NEGATIV,0 /IF NUMBER NEGATIVE THEN -1 ELSE 0 IINP, 0 SKP CLA READC /IGNORE LEADING BLANKS TAD CHAR TAD (-240 SNA CLA JMP .-4 JMS PMXXX /INPUT +-0123456789 AND CONVERT TO BINARY JMS INORM /CHECK OVERFLOW (MAXINT=34359738367) JMP I IINP PTD=IINP IOUT, 0 TAD [240 /KLUDGE! CHOOSE THE LEADING CHARACTER DCA LDBLANK /WITH A TAD (XXX-240 BEFORE CALLING IOUT TAD ACS SPA CLA L7777 DCA NEGATIV TAD (NUMBUF+12 DCA PTD /POINT TO RIGHTMOST POS. OF BUFFER DCA I PTD /STORE A 0 CASE NUMBER=0 DECONV, JMS SNAC JMP OFORM L7777 TAD PTD /DECREMENT POINTER DCA PTD AAAAAAAAAAAAAAAA DIV INT&IO /AC:=AC DIV 10 EEEEEEEEEEEEEEEE TAD MQ3 CLL RAR /GET REST OF ABOVE DIVISION JMP DECONV-1 /AND STORE AS BCD-DIGIT OFORM, TAD (-NUMBUF-12 TAD PTD SMA L7777 /AT LEAST ONE DIGIT TO PRINT (THINK OF 0) DCA DI /DI:=-NUMBER OF DIGITS TAD NEGATIV /TAKE ACCOUNT OF EV. - SIGN TAD M TAD DI SPA /IF FIELD WIDTH < NO. OF DIGITS CLA /THEN SI:=-1 CMA /ELSE SI:=-(FIELD WIDTH - DIGITS) - 1 DCA SI JMP .+3 LDCHAR, TAD LDBLANK PRINTC /LEADING BLANKS ISZ SI JMP LDCHAR EVMINS, ISZ NEGATIV JMP ODIGS TAD ("- PRINTC /MINUS SIGN (IF ANY) ODIGS, TAD I PTD ISZ PTD TAD ("0 PRINTC /DIGIT STRING ISZ DI JMP ODIGS JMP I IOUT INORM, 0 /INTEGER CLEARING HOUSE ROUTINE L4000 AND AC1 TAD AC0 SZA CLA /IF AC0<>0 OR AC1>3777 THEN JMP ERROR2 /O V E R F L O W JMS SNAC DCA ACS /DON'T FORGET THE -0 PROBLEM! JMP I INORM IO, 0000 /INTEGER CONSTANT OF 10 0000 0000 0012
/VARIOUS SECONDARY ROUTINES: XABS, 0 /AC:=ABS(AC) DCA ACS JMP I XABS XNEG, 0 /AC:=-AC (REAL AND INTEGER) L4000 TAD ACS DCA ACS JMS INORM /BUT NOT AC:=-0 ! JMP I XNEG OGET, 0 /COPY CONTENTS OF DCA AC0 /OP-REGISTER INTO AC-REGISTER TAD OP1 /(AC0 IS CLEARED!) DCA AC1 TAD OP2 DCA AC2 TAD OP3 DCA AC3 TAD OPS DCA ACS TAD OPX DCA ACX JMP I OGET ENTR, 0 /COPY CONTENTS OF TAD AC1 /AC-REGISTER INTO OP-REGISTER DCA OP1 /(AC0 UNCHANGED!) TAD AC2 DCA OP2 TAD AC3 DCA OP3 TAD ACS DCA OPS TAD ACX DCA OPX JMP I ENTR BOOL, 0 /ENTER WITH SKIP-INSTRUCTION DCA OSKIP /IN HARDWARE AC JMS SNAC SKP L0001 TAD ACS OSKIP, 0000 SKP CLA L0001 JMP I BOOL /EXIT WITH HARDWARE AC=1 IF TRUE (SKIP) /OR AC=0 IF FALSE PAGE
/I N T E G E R A R I T H M E T I C / /IADD: AC:=AC+OP /ISUB: AC:=AC-OP /IMUL: AC:=AC*OP /IDIV: AC:=AC DIV OP /IMOD: AC:=AC MOD OP IADD, 0 JMS OADD JMS INORM JMP I IADD OADD, 0 TAD ACS TAD OPS SNA CLA /IF BOTH OPERANDS HAVE THE SAME SIGN JMP SAMESGN /THEN SIMPLY ADD THEM JMS CMOP /ELSE COMPLEMENT ONE OF THEM (OP) JMS BADD /AND ADD TAD AC1 /BUT TAKE CARE: SMA CLA /IF RESULT POSITIVE (IN 2'S COMPLEMENT) JMP .+4 /THEN OKAY JMS CMAC /ELSE COMPLEMENT AC TAD OPS /AND USE SIGN OF OP DCA ACS DCA AC0 /NO OVERFLOW IN THIS CASE! JMP I OADD SAMESGN,JMS BADD JMP I OADD ISUB, 0 JMS OSUB /OP:=-OP JMS IADD /AC:=AC+(-OP) JMP I ISUB IMUL, 0 JMS SNOP /IF OP=0 CLEAR /THEN PRODUCT IS 0 DCA MQ1 DCA MQ2 /CLEAR MQ-REGISTER (BMUL NEEDS THAT!) DCA MQ3 TAD OPS /SETUP SIGN OF PRODUCT TAD ACS DCA ACS JMS BMUL /MULTIPLY INTMOV, JMS SNAC /IF HIGH ORDER WORDS OF PRODUCT <>0 SKP JMP ERROR2 /THEN O V E R F L O W ! JMS SWAP /GET LOW ORDER PART INTO AC HALVE /(BMUL GIVES 2*PRODUCT!) JMS INORM JMP I IMUL MODSGN=IMUL IDIV, 0 JMS SNOP JMP I [ERROR0 /D I V I S I O N BY Z E R O ! DOUBLE JMS SWAP /PUT 2*DIVIDEND INTO MQ-REGISTER DCA AC1 /AND CLEAR AC (SEE BDIV INSTRUCTIONS) DCA AC2 DCA AC3 TAD OPS /SETUP SIGN OF QUOTIENT TAD ACS DCA ACS TAD ACS /PATCH: SERVES DCA MODSGN /FOR MOD-FUNCTION JMS BDIV /DIVIDE JMS INORM JMP I IDIV IMOD, 0 JMS IDIV /DIVIDE OP INTO AC JMS SWAP /GET 2*REST FROM MQ-REGISTER HALVE /AND HALVE IT (SEE BDIV INSTR.) TAD MODSGN SPA CLA /IF REST NOT NEGATIVE JMS SNAC JMP MODOK /THEN OKAY JMS BADD /ELSE ADD OP TO MAKE IT POSITIVE JMS CMAC /MORE PRECISELY: AC:=-(AC-OP) MODOK, DCA ACS /SIGN IS + DCA AC0 JMP I IMOD
/FOUR SECONDARY ROUTINES: SNAC, 0 /SKIP ON NONZERO AC TAD AC3 SNA TAD AC2 SNA TAD AC1 SZA CLA ISZ SNAC JMP I SNAC SNOP, 0 /SKIP ON NONZERO OP TAD OP3 SNA TAD OP2 SNA TAD OP1 SZA CLA ISZ SNOP JMP I SNOP CMAC, 0 /2'S COMPLEMENT OF AC CLA CLL TAD AC3 CIA DCA AC3 TAD AC2 CMA SZL IAC CLL DCA AC2 TAD AC1 CMA SZL IAC CLL DCA AC1 JMP I CMAC CMOP, 0 /2'S COMPLEMENT OF OP CLA CLL TAD OP3 CIA DCA OP3 TAD OP2 CMA SZL IAC CLL DCA OP2 TAD OP1 CMA SZL IAC CLL DCA OP1 JMP I CMOP JMSSNAC=JMS SNAC PAGE
/B I N A R Y A D D I T I O N / /AC0!AC1!AC2!AC3 := AC1!AC2!AC3 + OP1!OP2!OP3 TEMP3=. BADD, 0 CLA CLL TAD AC3 TAD OP3 DCA AC3 RAL TAD AC2 TAD OP2 DCA AC2 RAL TAD AC1 TAD OP1 DCA AC1 RAL TAD AC0 DCA AC0 JMP I BADD /B I N A R Y M U L T I P L I C A T I O N / /OP=FACTOR /FLOATING POINT: AC=FACTOR, MQ=0; AC=PRODUCT (HIGH ORDER) /INTEGER: AC=FACTOR, MQ=0; MQ=2*PRODUCT (LOW ORDER) BMUL, 0 TAD MIN44 /-36 DCA BDIV JMS SWAP MULLP, JMS RACR TAD MQ1 RAR DCA MQ1 TAD MQ2 RAR DCA MQ2 TAD MQ3 RAR DCA MQ3 SZL JMS BADD ISZ BDIV JMP MULLP JMP I BMUL
/B I N A R Y D I V I S I O N / /OP=DIVISOR /FLOATING POINT: AC=DIVIDEND, MQ=0; AC=QUOTIENT /INTEGER: AC=0, MQ=2*DIVIDEND; AC=QUOTIENT, MQ=2*REST BDIV, 0 TAD MIN44 /-36 DCA BMUL JMS CMOP DIVLP, CLL /COMPARE AC AND OP TAD AC3 TAD OP3 DCA TEMP3 /SAVE DIFFERENCE RAL TAD AC2 TAD OP2 DCA TEMP2 RAL TAD AC1 TAD OP1 SNL /AC > OP? JMP .+6 DCA AC1 /YES, SETUP DIFFERENCE TAD TEMP2 DCA AC2 TAD TEMP3 DCA AC3 CLA TAD MQ3 /SHIFT IN NEW BIT OF QUOTIENT RAL /AND DOUBLE DIVIDEND DCA MQ3 TAD MQ2 RAL DCA MQ2 TAD MQ1 RAL DCA MQ1 JMS RACL ISZ BMUL JMP DIVLP JMS SWAP JMP I BDIV
/OTHER BINARY OPERATIONS: MUL2, RACL, 0 /SHIFT AC ONE BIT LEFT (=DOUBLE) TAD AC3 /TAKE CARE OF LINK CALLING RACL!!! RAL DCA AC3 TAD AC2 RAL DCA AC2 TAD AC1 RAL DCA AC1 TAD AC0 RAL DCA AC0 JMP I RACL TEMP2=. MUL10, 0 /AC TIMES 10 JMS ENTR /LINK MUST BE 0 ON ENTRY!!! JMS MUL2 JMS MUL2 JMS BADD JMS MUL2 JMP I MUL10 RACR, 0 /SHIFT AC ONE BIT RIGHT (=HALVE) TAD AC0 CLL RAR DCA AC0 TAD AC1 RAR DCA AC1 TAD AC2 RAR DCA AC2 TAD AC3 RAR DCA AC3 JMP I RACR SWAP, 0 /SWAP AC- AND MQ-REGISTER TAD AC1 MQL TAD MQ1 DCA AC1 TAD AC2 SWP DCA MQ1 TAD MQ2 DCA AC2 TAD AC3 SWP DCA MQ2 TAD MQ3 DCA AC3 MQA DCA MQ3 JMP I SWAP PAGE
/ A R I T H M E T I C P A C K A G E /OPTION: / S U P E R C O N V E R S I O N O V E R L A Y /POWERS OF TEN TABLE: P1E1, 0004;2400;0000;0000 / 1.0E+001 0007;3100;0000;0000 / 1.0E+002 0016;2342;0000;0000 / 1.0E+004 0033;2765;7020;0000 / 1.0E+008 0066;2160;6744;6770 / 1.0E+016 0153;2356;1326;6501 / 1.0E+032 0325;3023;6017;5120 / 1.0E+064 0652;2235;6443;7114 / 1.0E+128 P1E256, 1523;2523;7565;7735 / 1.0E+256 3245;3430;6320;2565 / 1.0E+512 (SERVES AS A GUARD) P1E2N, 0 /POINTER INTO TABLE DECP, 0 /DECIMAL CHARACTERISTIC /DEXP=BCD / --- " --- (SEE 'FLCONV') SUP1, 0 /INPUT CONVERSION (OVERLAYS 'ADJUST') SPA /IF DECIMAL CHARACTERISTIC >= 0 JMP .+4 DCA DECP /THEN STORE AS IT IS TAD (MUL P1E1 /AND SETUP FOR MULTIPLY JMP .+4 /WITH POWERS OF 10 CIA DCA DECP /ELSE MAKE IT POSITIVE TAD (DIV P1E1 /AND SETUP FOR DIVIDE DCA MD1E2N /BY POWERS OF 10 ADJLP, TAD DECP SNA /WHILE DECP<>0 DO: JMP I SUP1 CLL RAR /DECP:=DECP DIV 2 DCA DECP SNL /IF DECP WAS ODD JMP .+4 AAAAAAAAAAAAAAAA MD1E2N, MUL . /THEN MULTIPLY WITH (DIVIDE BY) 1.0E+2N EEEEEEEEEEEEEEEE L0004 TAD MD1E2N /POINT TO NEXT POWER OF TEN DCA MD1E2N JMP ADJLP SUP2, 0 /OUTPUT CONVERSION (OVERLAYS 'FLCONV') AAAAAAAAAAAAAAAA PUT XAC /SAVE NUMBER IN AC EEEEEEEEEEEEEEEE TAD XAC /GET BINARY EXPONENT SPA /(2'S COMPLEMENT!) CIA /AND LOAD IT AS POSITIVE INTEGER LOAD /INTO AC-REGISTER AAAAAAAAAAAAAAAA/NOTE: LG(2) IS APPROXIMATED BY 1233/4096 MUL INT&O1233 /*1233 EEEEEEEEEEEEEEEE L4000 AND XAC CLL RAL TAD AC2 /DIV 4096 SZL /IF XAC<0 CMA /THEN DEXP := -XAC*1233 DIV 4096 - 1 DCA DEXP /ELSE DEXP := XAC*1233 DIV 4096 AAAAAAAAAAAAAAAA GET XAC /RESTORE NUMBER EEEEEEEEEEEEEEEE TAD DEXP CIA JMS SUP1 /DO CONVERSION TO DECIMAL FLOATING POINT JMP I SUP2 XAC, ZBLOCK 4 O1233, 0000;0000;0000;2321 /1233 (INTEGER) TRUEFALSE, TEXT /TRUEFALSE/ XISQU, 0 /AC := AC^2 (INTEGER) JMS ENTR JMS IMUL JMP I XISQU XRSQU, 0 /AC := AC^2 (REAL) JMS ENTR JMS RMUL JMP I XRSQU PAGE
/********************** / S Q U A R E R O O T / / AC := SQRT(AC) /********************** XSQRT, 0 TAD ACS SPA CLA ERROR3, HALT /SQUARE ROOT OF N E G A T I V E NUMBER! TAD AC1 SNA CLA JMP I XSQRT /DON'T WASTE TIME FOR SQRT(0)! L0001 TAD ACX /TRANSFORM ARGUMENT TO THE FORM SPA SZL / 2^(2*N) * F WITH 0.25 <= F < 1 CML RAR DCA ROOTX /SAVE N SNL /IF ODD(EXPONENT) L7777 /THEN ACX:=-1 (0.25 <= F < 0.5) DCA ACX /ELSE ACX:= 0 (0.5 <= F < 1 ) AAAAAAAAAAAAAAAA PUT SQARG /SAVE F EEEEEEEEEEEEEEEE TAD ACX /COMPUTE INITIAL VALUE X0 FOR NEWTON: DCA OPOINT5 /X0:=F + 0.25 (0.25 <= F < 0.5) L7777 /X0:=F/2 + 0.5 (0.5 <= F < 1 ) DCA ACX AAAAAAAAAAAAAAAA ADD OPOINT5 EEEEEEEEEEEEEEEE L7775 /3 ITERATION LOOPS GUARANTEE DCA NEWTON /FULL PRECISION! (MAX. ERROR: 8.0E-13) SQLOOP, AAAAAAAAAAAAAAAA PUT X123 GET SQARG DIV X123 ADD X123 /X[I+1] := (F/X[I] + X[I])/2 EEEEEEEEEEEEEEEE L7777 /HALVE BY ACX:=ACX - 1 TAD ACX DCA ACX ISZ NEWTON /IF DONE 3 LOOPS JMP SQLOOP TAD ROOTX /THEN INSERT EXPONENT N OF ROOT TAD ACX DCA ACX JMP I XSQRT NEWTON=. /LOOP COUNTER OPOINT5,0000 /CONSTANT OF 0.5 OR 0.25 (EXPONENT WORD 2000 /SET AT EXECUTION TIME) 0000 0000 SQARG, 0 /REDUCED ARGUMENT F 0 0 0 X123, 0 /TEMPORARY FOR APPROXIMATE VALUE 0 0 0 ROOTX, 0 /TEMPORARY FOR ROOT EXPONENT N
/********************************** / N A T U R A L L O G A R I T H M / / AC := LN(AC) /********************************** /TABLE OF CONSTANTS: A0, 0001 /1.84375 3540 0000 0000 LNA0, 0000 /0.611801541106 2344 7603 2325 A1, 0001 /1.65625 3240 0000 0000 LNA1, 0000 /0.504556010752 2011 2512 4551 A2, 0001 /1.5 3000 0000 0000 LNA2, 7777 /0.405465108108 3174 6217 5457 A3, 0001 /1.375 2600 0000 0000 LNA3, 7777 /0.318453731119 2430 3057 0207 A4, 0001 /1.25 2400 0000 0000 LNA4, 7776 /0.223143551314 3443 7737 0746 A5, 0001 /1.1875 2300 0000 0000 LNA5, 7776 /0.171850256927 2577 6301 6051 A6, 0001 /1.09375 2140 0000 0000 LNA6, 7775 /0.0896121586897 2674 1512 1271 A7, 0001 /1.03125 2040 0000 0000 LNA7, 7773 /0.0307716586668 3740 5154 1636 PAGE XLOG, 0 TAD ACS TAD AC1 SPA SNA CLA ERROR4, HALT /LOGARITHM OF ZERO OR NEGATIVE NUMBER! AAAAAAAAAAAAAAAA PUT LNARG /SAVE ARGUMENT X = 2^N * F EEEEEEEEEEEEEEEE DCA LNARG /REDUCE TO FRACTION PART (0.5 <= F < 1) CLL TAD ACX /GET N (IN TWO'S COMPLEMENT!) SPA CIA STL JMS LDAC /LOAD IT AS INTEGER RAR DCA ACS AAAAAAAAAAAAAAAA FLOAT /CONVERT TO REAL MUL LN2 /TIMES LN(2) PUT LNTEMP /AND SAVE IT EEEEEEEEEEEEEEEE LNLOOP, TAD LNARG+1 /FOR FURTHER REDUCTION OF THE ARGUMENT AND BIT234 /SELECT THE APPROPRIATE MULTIPLIERS A(K) CLL RTR /AND THEIR LOGARITHMS FROM A TABLE, RTR /ACCORDING TO THE RANGE OF F. TAD (A0 DCA PTAK L0004 TAD PTAK DCA PTLNAK AAAAAAAAAAAAAAAA GET LNTEMP SUB I PTLNAK /SUBTRACT LN( A(K) ) TO COMPENSATE PUT LNTEMP GET I PTAK /THE MULTIPLICATION WITH A(K) MUL LNARG /F' = A(K)* .... *F PUT LNARG EEEEEEEEEEEEEEEE TAD ACX SNA CLA JMP LNLOOP /IT IS GUARANTEED, THAT AFTER NO MORE AAAAAAAAAAAAAAAA/THAN T H R E E E MULTIPLICATIONS SUB ONEPT0 /F' FITS IN THE RANGE PUT LNARG / 0 <= F'-1 < 2^(-5) MUL LTC6 /NOW COMPUTE LN(F') VIA TAYLOR SERIES ADD LTC5 MUL LNARG ADD LTC4 MUL LNARG ADD LTC3 MUL LNARG ADD LTC2 MUL LNARG ADD ONEPT0 MUL LNARG ADD LNTEMP /LN(X) = N*LN(2) - LN(A(K)) ... + LN(F') EEEEEEEEEEEEEEEE JMP I XLOG BIT234, 1600 /MASK TO EXTRACT BITS 00XXX0000000 PTAK, A0 /POINTER INTO TABLE PTLNAK, LNA0 / --- " --- LNARG, 0 /ARGUMENT REGISTER 0 0 0 LNTEMP, 0 /TEMPORARY 0 0 0 LN2, 0000 /0.69314718 2613 4413 7676 LTC6, 7776 / -1/6 6525 2525 2525 LTC5, 7776 / 1/5 3146 3146 3146 LTC4, 7777 / -1/4 6000 0000 0000 LTC3, 7777 / 1/3 2525 2525 2525 LTC2, 0000 / -1/2 6000 0000 0000
/**************************************** / E X P O N E N T I A L F U N C T I O N / / AC := EXP(AC) /**************************************** ONEPT0, EX0B8, 0001 / 2^(0/8) = 1 2000 0000 0000 EX1B8, 0001 / 2^(1/8) 2134 5340 7437 EX2B8, 0001 / 2^(2/8) 2301 5770 1214 EX3B8, 0001 / 2^(3/8) 2457 7553 2515 EX4B8, 0001 / 2^(4/8) 2650 1171 4637 EX5B8, 0001 / 2^(5/8) 3053 1625 0212 EX6B8, 0001 / 2^(6/8) 3272 1176 3126 EX7B8, 0001 / 2^(7/8) 3526 0143 3476 PAGE XEXP, 0 DCA TWO2N TAD (ONEPT0 DCA TWO2M8 AAAAAAAAAAAAAAAA SKNE JMP EXP0 /EXP(0)=1 MUL LOG2E /X*LB(2) .... EXP(X) = 2^(X*LB(2)) PUT EXTEMP TRUNC /SPLIT PRODUCT INTO PUT INT&TWO2N-3 /INTEGER PART N FLOAT SUB EXTEMP /AND FRACTION F (0 <= F < 1) NEGATE SKLT JMP .+7 ADD ONEPT0 EEEEEEEEEEEEEEEE TAD TWO2N CMA DCA TWO2N AAAAAAAAAAAAAAAA SKNE JMP EXP0 EEEEEEEEEEEEEEEE L0003 TAD ACX SPA SNA /IF F>=1/8 THEN SPLIT F INTO JMP APPROX CMA CLL / M/8 + R (0 < M < 8, 0 <= R < 1/8) DCA EXREST DOUBLE ISZ EXREST JMP .-2 TAD AC0 CLL RTL TAD (ONEPT0 DCA TWO2M8 /POINT TO 2^(M/8) IN TABLE DCA AC0 TAD (-4 DCA ACX JMS RNORM /NORMALIZE APPROX, AAAAAAAAAAAAAAAA/COMPUTE 2^R BY A CONTINUED FRACTION SKNE JMP EXP0 PUT EXREST GET EXD3 DIV EXREST ADD EXREST PUT EXTEMP GET EXC3 DIV EXTEMP SUB EXREST ADD EXB3 PUT EXTEMP GET EXA3 DIV EXTEMP SUB ONEPT0 SKIP EXP0, GET ONEPT0 MUL I TWO2M8 /MULTIPLY WITH 2^(M/8) EEEEEEEEEEEEEEEE TAD ACX TAD TWO2N /INSERT 2^N DCA ACX JMS RNORM /CHECK FOR OVERFLOW JMP I XEXP /EXP(X) = 2^N * 2^(M/8) * 2^R TWO2M8, 0 /POINTER TO TABLE EXTEMP, 0 /ARGUMENT AND TEMPORARY 0 0 0 EXREST, 0 /TEMPORARY REGISTER 0 0 0 TWO2N, 0000 /HOLDS N (MUST BE HERE!!!) LOG2E, 0001 /1.442695040889 2705 2435 4512 EXA3, 0006 /34.624680981335 2123 7726 1367 EXB3, 0005 /17.312340490668 2123 7726 1367 EXC3, 0007 /-104.068449050280 7201 0605 7007 EXD3, 0005 /20.813689810056 2464 0467 7155
/**************************** / S I N E AND C O S I N E / / AC := SIN(AC) / AC := COS(AC) = SIN(AC+PI/2) /**************************** XCOS, 0 AAAAAAAAAAAAAAAA ADD PIS2 EEEEEEEEEEEEEEEE JMS XSIN JMP I XCOS OPT5, 0000 /0.5 2000 0000 0000 PIS2, 0001 / PI/2 3110 3755 2421 PI, 0002 / PI 3110 3755 2421 COS2, 0003 /-PI^2/2! 6357 2363 1157 SIN3, 0003 /-PI^3/3! 6452 7363 4611 PAGE COS4, 0003 / PI^4/4! 2017 0174 1006 SIN5, 0002 / PI^5/5! 2431 5361 4734 COS6, 0001 /-PI^6/6! 6527 2361 7617 SIN7, 0000 /-PI^7/7! 6313 2263 1630 COS8, 7776 / PI^8/8! 3607 6501 5044 SIN9, 7775 / PI^9/9! 2501 7015 1040 COS10, 7773 /-PI^10/10! 7233 2174 5210 SCARG=EXTEMP /ARGUMENT REGISTER XSIN, 0 TAD ACS /SIN(-X) = -SIN(X), THUS DCA SCS /SAVE SIGN DCA ACS /AND MAKE ARGUMENT POSITIVE AAAAAAAAAAAAAAAA/NOW REDUCE ARGUMENT: DIV PI / X/PI = N + F (0 <= F < 1) PUT SCARG /SIN(X) = (-1)^N * SIN(PI*F) TRUNC EEEEEEEEEEEEEEEE L0001 AND AC3 /IF ODD(N) THEN CHANGE SIGN CLL RTR TAD SCS DCA SCS AAAAAAAAAAAAAAAA FLOAT SUB SCARG /-F SKNE JMP SCRET EEEEEEEEEEEEEEEE TAD ACX SZA CLA /IF F>=0.5 THEN JMP .+4 AAAAAAAAAAAAAAAA ADD ONEPT0 /F := 1 - F EEEEEEEEEEEEEEEE/ SIN(PI*F) = SIN(PI*(1-F)) DCA ACS /NOW ARG. REDUCED TO 0 <= F <= 0.5 L0002 TAD ACX SPA CLA /IF F<0.125 JMP TAYSIN /THEN USE SINE-SERIES AAAAAAAAAAAAAAAA/ELSE SIN(PI*F) = COS(PI*(0.5-F)) SUB OPT5 EEEEEEEEEEEEEEEE DCA ACS /F := 0.5 - F L0002 TAD ACX SPA CLA /IF F<0.125 JMP TAYCOS-1 /THEN USE COSINE-SERIES DIRECTLY L7777 /ELSE COS(PI*F) = 2 * COS(PI*F/2)^2 - 1 TAD ACX DCA ACX /F := F/2 (1/16 <= F <= 3/16) L7777 DCA HFLAG /SET HALVE ARGUMENT FLAG TAYCOS, AAAAAAAAAAAAAAAA PUT SCARG MUL SCARG PUT FQU /SQUARE ARG. MUL COS10 ADD COS8 MUL FQU ADD COS6 MUL FQU ADD COS4 MUL FQU ADD COS2 MUL FQU ADD ONEPT0 EEEEEEEEEEEEEEEE ISZ HFLAG /WAS F>=0.125? JMP SCRET+1 AAAAAAAAAAAAAAAA/YES PUT FQU MUL FQU / (COS^2 - SUB OPT5 / - 0.5) EEEEEEEEEEEEEEEE ISZ ACX / *2 HFLAG, NOP JMP SCRET+1 TAYSIN, AAAAAAAAAAAAAAAA PUT SCARG MUL SCARG PUT FQU MUL SIN9 ADD SIN7 MUL FQU ADD SIN5 MUL FQU ADD SIN3 MUL FQU ADD PI MUL SCARG SCRET, EEEEEEEEEEEEEEEE TAD AC1 SZA CLA TAD SCS /INSERT SIGN (AVOID -0 !) DCA ACS JMP I XSIN SCS, 0 /SIGN OF RESULT FQU, 0 /TEMPORARY FOR SQUARES ARG. 0 0 0 PAGE
/******************** / A R C T A N G E N T / / AC := ARCTAN(AC) /******************** XATN, 0 TAD ACX TAD (14 SPA CLA /IF ARGUMENT VERY SMALL ( < 2^(-12) ) JMP I XATN /THEN ARCTAN(X)=X TAD ACS DCA ATNS /SAVE SIGN ... ARCTAN(-X) = -ARCTAN(X) DCA ACS /AND MAKE ARGUMENT POSITIVE AAAAAAAAAAAAAAAA PUT ATARG EEEEEEEEEEEEEEEE TAD ACX SPA SNA CLA /IF X>=1 JMP .+7 AAAAAAAAAAAAAAAA GET ONEPT0 /THEN X := 1/X DIV ATARG /ARCTAN(X) = PI/2 - ARCTAN(1/X) PUT ATARG EEEEEEEEEEEEEEEE/NOW ARGUMENT REDUCED TO 0 < X <= 1 L7777 DCA GT1FLAG /FLAG ARGUMENT > 1 TAD ACX SPA CLA /IF X>=0.5 THEN USE ADD.THEOREM: JMP ATN05 ISZ ATARG /2*X ADDFLAG,NOP AAAAAAAAAAAAAAAA/ARCTAN(X) = ARCTAN(0.5) + ARCTAN( ... ) ADD TWOPT0 /X := (2*X-1)/(X+2) PUT EXTEMP GET ATARG SUB ONEPT0 DIV EXTEMP PUT ATARG /ARGUMENT RANGE NOW 0 < X < 0.5 EEEEEEEEEEEEEEEE L7777 ATN05, DCA ADDFLAG AAAAAAAAAAAAAAAA/COMPUTE ARCTAN(X) BY CONTINUED FRACTION MUL ATARG PUT FQU ADD ATB3 PUT EXTEMP GET ATA3 DIV EXTEMP ADD ATB2 ADD FQU PUT EXTEMP GET ATA2 DIV EXTEMP ADD ATB1 ADD FQU PUT EXTEMP GET ATA1 DIV EXTEMP ADD ATB0 ADD FQU PUT EXTEMP GET ATA0 MUL ATARG DIV EXTEMP EEEEEEEEEEEEEEEE ISZ ADDFLAG /CORRECT RESULT IF NECESSARY JMP .+4 AAAAAAAAAAAAAAAA ADD ATN0P5 EEEEEEEEEEEEEEEE ISZ GT1FLAG /WAS X>1 ? JMP .+6 L4000 /YES DCA ACS / -ARCTAN(X) AAAAAAAAAAAAAAAA ADD PIS2 / +PI/2 EEEEEEEEEEEEEEEE TAD ATNS DCA ACS /INSERT SIGN JMP I XATN ATNS, 0 /TEMPORARY FOR SIGN GT1FLAG,0 ATARG, 0 /ARGUMENT REGISTER 0 0 0 ATA0, 0004 /12.37469388 3057 7537 4017 ATA1, 0007 /-80.34270560 6405 3673 4343 ATA2, 0001 /-1.191447224 6304 0253 6665 ATA3, 7775 /-0.078335428 6403 3451 4461 ATB0, 0005 /26.27277525 3221 3522 3121 ATB1, 0003 /6.36441688 3135 1757 0565 ATB2, 0002 /2.104518952 2065 4070 1015 ATB3, 0001 /1.258464113 2410 5255 0370 ATN0P5, 7777 /ARCTAN(0.5) 3553 0634 0530 TWOPT0, 0002 /2.0 2000 0000 0000 PAGE
/I N P U T - O U T P U T ROUTINES FOR STANDARD FILES GETC, 0 CLA CLL TAD LOOK DCA CHAR ISZ IC3 JMP G12 G3, L7775 DCA IC3 L7776 TAD IBP DCA IBP TAD I IBP ISZ IBP K377, AND (7400 /FIRST LITERAL ON THIS PAGE ---> 0377 CLL RTL RTL DCA CHECK TAD I IBP AND (7400 TAD CHECK RTL RTL RAL JMP GEXIT G12, TAD IBP AND K377 SZA CLA JMP GEXIT-1 TAD (IBUFFER DCA IBP JMS I IDEVH 0200 IBUFFER IBLOCK, 0 JMP RDERR ISZ IBLOCK L7776 DCA IC3 TAD I IBP GEXIT, ISZ IBP JMS CHECK JMP GETC+4 JMP I GETC RDERR, SMA CLA JMP GEXIT-3 FATAL0, FATAL /FATAL READ ERROR! IC3, -3 IBP, IBUFFER PUTC, 0 SNA TAD CHAR DCA CHECK TAD CHECK ISZ OC3 JMP PUT12 DCA CC L7776 TAD OBP DCA OBP JMS PUT3L JMS PUT3R L7775 DCA OC3 TAD OBP AND K377 SZA CLA JMP PUXIT ISZ MBLOCKS SKP JMP ERRORD JMS I ODEVH 4200 OBUFFER OBLOCK, 0 JMP ERRORD ISZ OBLOCK TAD [OBUFFER DCA OBP JMP PUXIT PUT12, AND K377 DCA I OBP ISZ OBP PUXIT, TAD CHECK TAD [-215 SZA CLA JMP I PUTC TAD [212 JMP PUTC+1 PUT3L, PUT3R, 0 TAD CC CLL RTL RTL DCA CC TAD CC AND (7400 TAD I OBP DCA I OBP ISZ OBP JMP I PUT3R /OC3, 0 /ON PAGE 0! /OBP, 0 / - " - CHECK, 0 AND [177 SNA JMP I CHECK TAD (-15 SNA JMP CR TAD (15-32 SNA JMP CR-2 TAD (-6 CLL TAD [240 DCA LOOK CHEXIT, DCA EOLN SNL ISZ CHECK JMP I CHECK L0001 /END OF FILE DCA EOF CR, TAD [240 /END OF LINE DCA LOOK L0001 /LINK=0! JMP CHEXIT PAGE
/THE ORGANIZATION OF THE FOLLOWING PAGES OF FIELD 0 /DEMANDS SOME EXPLANATION: / AT COMPILE TIME / AT RUNTIME / / / / /06000--------------------------/-------------------------------/ / STARTUP CODE, THEN / / / / I N P U T / /06200- I N P U T (SOURCE) -----/----- -----/ / F I L E B U F F E R / F I L E B U F F E R / / / / /06400--------------------------/-------------------------------/ / / INPUT / / I N P U T (SOURCE) / DEVICE HANDLER / /06600- -----/-------------------------------/ / D E V I C E / OUTPUT / / H A N D L E R / DEVICE HANDLER / /07000--------------------------/-------------------------------/ / / / / COMPILER PROCEDURES: / O U T P U T / /07200----- -----/----- -----/ / I N S Y M B O L / F I L E B U F F E R / / / / /07400----- AND -----/-------------------------------/ / / RUNTIME ERRORS / / N E X T C H / / /-------------------------------/-------------------------------/ /AT COMPILATION TIME FOUR PAGES OF FIELD 6 ARE USED AS FOLLOWS: /66400--- TEMPORARY STORAGE OF INPUT DEVICE HANDLER / /66600--- TEMPORARY STORAGE OF OUTPUT DEVICE HANDLER / /67400--- RUNTIME ERRORS / /67600--- INITIALIZATION OF RUNTIME SYSTEM /DURING INITIALIZATION OF THE RUNTIME SYSTEM /THE FIRST THREE PAGES ARE SWAPPED INTO THEIR PLACE IN FIELD 0!
/#############################################################/ /#############################################################/ /##### #####/ /##### S T A R T #####/ /##### #####/ /#############################################################/ /#############################################################/ /IMPORTANT POINTS OF PROGRAM FLOW: /S T A R T (06000) /STARTING ADDRESS OF ENTIRE SYSTEM, /PROCESS I/O-SPECIFICATIONS /M A I N (40200) /START OF COMPILER PROGRAM /E X P L A I N (60200) /COMPILATION REPORT /I N I T (67600) /INITIALIZATION OF RUNTIME SYSTEM /I S T A R T (00200) /START OF INTERPRETER /ONCE ONLY CODE!!! USR=200 *IBUFFER START, CLA CLL /S T A R T I N G A D D R E S S CIF 10 JMS I [7700 /LOCK USR IN MEMORY 10 TAD (1000 /RESET JOB STATUS WORD DCA I (7746 CD, CIF 10 JMS I (USR /CALL THE COMMAND DECODER 5 2023 /ASSUMED INPUT EXTENSION: .PS JMS HEADER CDF 10 TAD I (7600 SNA /OUTPUT FILE SPECIFIED? JMP NOOUT DCA DEVNO /YES, SAVE DEVICE NUMBER TAD (7600 DCA XR10 TAD I XR10 /TRANSFER THE FILENAME DCA NAME TAD I XR10 DCA NAME+1 TAD I XR10 DCA NAME+2 TAD I XR10 DCA NAME+3 CDF 0 CIF 10 TAD DEVNO JMS I (USR /FETCH OUTPUT DEVICE HANDLER 1 OHEP, ODEVBUF /1 PAGE ONLY! JMP CDERR CIF 10 TAD DEVNO JMS I (USR /OPEN OUTPUT FILE 3 SBNO, NAME LEMP, 0 JMP CDERR TAD OHEP /GET ENTRY POINT DCA ODEVH TAD SBNO /GET STARTING BLOCK NUMBER DCA I (OBLOCK TAD LEMP /GET LENGTH OF EMPTY DCA LEMPTY TAD LEMPTY SZA TAD (-1 /SETUP BLOCK COUNTER DCA MBLOCKS /(=0 IF NOT A FILE DEVICE) SKP NOOUT, ISZ IHEP /ALLOW 2-PAGE INPUT HANDLER /IF NO OUTPUT FILE SPECIFIED! CDF 10 TAD I (7621 SNA /INPUT FILE SPECIFIED? JMP NOINP /NO, USE INTERN KEYBOARD HANDLER! CDF 0 CIF 10 JMS I (USR /FETCH INPUT DEVICE HANDLER 1 IHEP, IDEVBUF JMP CDERR CDF 10 TAD I (7622 /GET STARTING BLOCK NUMBER CDF 60 DCA I (IIBLOCK TAD IHEP /GET ENTRY POINT DCA I (IIDEVH NOINP, CDF 0 /SAVE DEVICE HANDLERS TAD I F0T6 /IN FIELD 6 TO MAKE ROOM CDF 60 /FOR HANDLER OF SOURCE FILE DCA I F0T6 ISZ F0T6 ISZ C400 JMP .-6 CDF 10 TAD I (7617 SNA /SOURCE FILE SPECIFIED? JMP CDERR CDF 0 CIF 10 JMS I (USR /FETCH HANDLER OF SOURCE FILE 1 SHEP, IDEVBUF+1 JMP CDERR TAD SHEP /GET ENTRY POINT DCA IDEVH CDF 10 TAD I (7620 CDF 0 DCA I (IBLOCK JMP STARTC F0T6, IDEVBUF C400, -400 PAGE
STARTC, CDF 10 /CHECK /S - OPTION TAD I (7644 CDF 0 AND (40 SNA CLA JMP .+3 TAD (SPRINT DCA PTPRINT CDF CIF COMPFIELD JMP I (MAIN /START COMPILER CDERR, CLA CLL CDF CIF 0 CRLF TAD I CTEXT SNA JMP .+7 BSW JMS ASCII TAD I CTEXT JMS ASCII ISZ CTEXT JMP CDERR+3 CRLF JMP I (7605 CTEXT, .+1 TEXT /DATEIANGABEN FEHLERHAFT BZW. UNVOLLSTAENDIG (EV. AUCH SYSTEMFEHLER)!/ 0 PAGE
/K E Y B O A R D I N P U T H A N D L E R *IDEVBUF XREAD, 0 CLA CLL TAD LOOK DCA CHAR TAD EOLN SZA CLA JMP XLINE REXIT, TAD I BP ISZ BP JMS CHECK JMP .-3 JMP I XREAD ERASE, TAD [215 JMS I ZPRINT XLINE, TAD (IBUFFER DCA BP TAD ("? JMS I ZPRINT TAD [240 JMS I ZPRINT XCHAR, JMS KEYBOARD DCA I BP TAD I BP TAD (-377 SNA CLA / 'RUBOUT'? JMP RUBOUT TAD I BP TAD (-203 SNA / 'CTRL-C'? JMP I OS8 TAD (203-212 SNA / 'LINE FEED'? JMP REPLAY TAD (212-215 SNA / 'RETURN'? JMP RETURN TAD (215-225 SNA / 'CTRL-U'? JMP ERASE TAD (225-232 SNA / 'CTRL-Z'? JMP EOFILE TAD (232-240 SPA CLA JMP XCHAR TAD I BP JMS I ZPRINT ISZ BP JMP XCHAR RUBOUT, TAD ("\ JMS I ZPRINT TAD BP TAD (-IBUFFER SNA CLA JMP YCHAR L7777 TAD BP DCA BP TAD I BP JMS I ZPRINT YCHAR, JMS KEYBOARD DCA I BP TAD I BP TAD (-377 SNA CLA JMP RUBOUT+2 TAD ("\ JMS I ZPRINT JMP XCHAR+2 REPLAY, TAD BP TAD (-IBUFFER SNA JMP XCHAR CIA DCA RC TAD (IBUFFER DCA BP TAD [215 JMS I ZPRINT TAD ("? JMS I ZPRINT TAD [240 JMS I ZPRINT TAD I BP JMS I ZPRINT ISZ BP ISZ RC JMP .-4 JMP XCHAR EOFILE, TAD [240 JMS I ZPRINT TAD ("E JMS I ZPRINT TAD ("O JMS I ZPRINT TAD ("F JMS I ZPRINT RETURN, TAD [215 JMS I ZPRINT TAD (IBUFFER DCA BP JMP REXIT KEYBOARD,0 KSF JMP .-1 KRB AND [177 SNA JMP KEYBOARD+1 TAD (200 JMP I KEYBOARD BP, IBUFFER RC=KEYBOARD PAGE
/H E A D E R L I N E *ODEVBUF HEADER, 0 /ONCE ONLY CODE! CDF 10 TAD I (7666 /GET DATE WORD FROM MONITOR CDF 0 SNA JMP WHEAD-1 MQL TAD (HDATE DCA XR10 MQA /YEAR AND (7 TAD (116 /78 JMS YYMMDD MQA /MONTH BSW RTR AND (17 JMS YYMMDD MQA /DAY RTR RAR AND (37 JMS YYMMDD SKP DCA HDATE WHEAD, TAD (PASCAL-1 DCA XR10 TAD I XR10 SNA WHEND, JMP .+3 /BECOMES: JMP WHEXIT PRINTC JMP .-4 TAD H240 PRINTC ISZ BLANKS JMP .-3 TAD (JMP WHEXIT DCA WHEND JMP WHEAD+2 WHEXIT, CRLF CRLF JMP I HEADER YYMMDD, 0 DCA DAT01 DCA DAT10 JMP .+3 DCA DAT01 ISZ DAT10 TAD DAT01 TAD (-12 SMA JMP .-5 CLA ISZ XR10 TAD DAT10 TAD H260 DCA I XR10 TAD DAT01 TAD H260 DCA I XR10 JMP I YYMMDD H215=. PASCAL, 215;"P;240;"A;240;"S;240;"C;240;"A;240;"L 240;"-;240;"S;240;240;240 "C;"O;"M;"P;"I;"L;"E;"R H240, 240 "V H260, "0 VERSION+"0 0000 HTLMOE, "H;"T;"L;"-;"M;"O;"E;"D;"L;"I;"N;"G HDATE, ", /BECOMES: 0000 IF NO DATE SPECIFIED 240 0000 /YEAR 0000 "- 0000 /MONTH 0000 "- DAT10, 0000 /DAY DAT01, 0000 BLANKS, -30 /BECOMES 0000 PAGE
/BEGIN OF COMPILER PROGRAM: T H E S C A N N E R NEXTCH=READC SY0=H1 /FIELD 0 REPRESENTATIVE OF 'SY' KSY=H2 SPS=H3 K=H4 INTORINP=PC *7000 INSY0, SKP CLA NEXTCH TAD CHAR TAD [-240 SNA CLA JMP .-4 SNALF JMP WSYMBOL SKDIG JMP SPSYM NUMBER, TAD (FRACTN DCA INTORINP DCA SY0 /0=INTCON JMS IINP TAD CHAR TAD (-". SZA CLA JMP ECHAR NEXTCH TAD CHAR TAD (-". SNA CLA JMP RETNUM-2 REALGO, L0001 DCA SY0 /1=REALCON TAD OC CIA DCA DC JMP I INTORINP ECHAR, ISZ INTORINP TAD CHAR TAD (-"E SNA CLA JMP REALGO JMP RETNUM TAD (": DCA CHAR RETNUM, JMS PACK TAD (NUM-1 RETID, DCA XR10 CDF COMPFIELD TAD AC0 DCA I XR10 TAD AC1 DCA I XR10 TAD AC2 DCA I XR10 TAD AC3 DCA I XR10 RETSYM, TAD SY0 CDF CIF COMPFIELD JMP I (EXSY3 WSYMBOL,DCA K /USE AC FOR ID IN FIELD 0 CLEAR AZ09, TAD K TAD (-ALNG SMA CLA JMP .+4 L0100 /=2*AC0, LINK=0 JMS CPACK ISZ K NEXTCH SKDIG SNALF JMP AZ09 L0001 /BUILD HASH-CODE TAD AC0 BSW RTL CLA TAD AC0 BSW TAD AC1 AND [77 RAL MQL /IN MQ MQA TAD (KSYTABLE DCA KSY MQA CLL RTL TAD (HASHTABLE-1 DCA XR10 CDF NAMEFIELD TAD I XR10 CIA TAD AC0 SZA CLA JMP XIDENT TAD I XR10 CIA TAD AC1 SZA CLA JMP XIDENT TAD I XR10 CIA TAD AC2 SZA CLA JMP XIDENT TAD I XR10 CIA TAD AC3 SZA CLA JMP XIDENT TAD I KSY JMP RETSYM+1 XIDENT, TAD (IDENT DCA SY0 TAD (ID-1 JMP RETID PAGE
SPSYM, TAD CHAR TAD (CHARTABLE-240 DCA SPS CDF NAMEFIELD TAD I SPS CDF 0 SNA JMP ILLCHAR SPA JMP DBLCHAR RETSPS, DCA SY0 NEXTCH TAD SY0 RETSNGL,CDF CIF COMPFIELD JMP I (EXSY3 ILLCHAR,ERROR;30 /24 JMP I (INSY0+1 DBLCHAR,DCA .+3 NEXTCH TAD CHAR HLT /JMP X JMPCOL=JMP . CCOL, TAD (-"= SZA CLA JMP .+3 TAD (BECOMES JMP RETSPS TAD (COLON JMP RETSNGL JMPLSS=JMP . CLSS, TAD (-"= SNA JMP .+6 TAD ("=-"> SNA CLA JMP .+4 TAD (LSS JMP RETSNGL L0004 /LEQ=NEQ+4 TAD (NEQ JMP RETSPS JMPGTR=JMP . CGTR, TAD (-"= SNA CLA JMP .+3 TAD (GTR JMP RETSNGL TAD (GEQ JMP RETSPS JMPPER=JMP . CPER, TAD (-". SNA CLA JMP .+3 TAD (PERIOD JMP RETSNGL TAD (COLON JMP RETSPS JMPLPAR=JMP . CLPAR, TAD (-"* SNA CLA JMP .+3 TAD (LPARENT JMP RETSNGL NEXTCH TAD CHAR TAD (-"* SZA CLA JMP .-4 NEXTCH TAD CHAR TAD (-") SZA CLA JMP .-10 JMP I (INSY0+1 JMPAPOS=JMP I . CAPOS CPACK, 0 TAD K RAR DCA CPP TAD CHAR AND [77 SZL JMP .+3 BSW JMP .+5 MQL TAD I CPP AND [7700 MQA DCA I CPP CDF 0 JMP I CPACK CPP, 0 XSNALF, 0 TAD CHAR TAD (-"Z-1 CLL TAD ("Z+1-"A SNL CLA ISZ XSNALF JMP I XSNALF PAGE
DISPLAY=7400 /-------- D I S P L A Y --------/ /DISPLAY,ZBLOCK 20 /AT RUNTIME ONLY /---------------------------------/ CAPOS, AND [77 LOAD DCA K SKP LBL2, NEXTCH TAD CHAR TAD (-"" SZA CLA JMP .+6 NEXTCH TAD CHAR TAD (-"" SZA CLA JMP LBL3 STL CDF COMPFIELD TAD I (SX CDF TABLEFIELD JMS CPACK ISZ K TAD EOLN SNA CLA JMP LBL2 DCA K LBL3, L0002 /2=CHARCON DCA SY0 L7777 TAD K SNA JMP RETNUM SPA CLA JMP ERR38 ISZ SY0 /3=STRING CDF COMPFIELD TAD I (SX LOAD TAD K DCA I (SLENG TAD I (SX TAD K DCA I (SX TAD I (SX STL RAR CIA TAD I (C SPA CLA FATAL7, FATAL JMP RETNUM ERR38, ERROR;46 /38 JMP .+3 ERR21, ERROR;25 /21 CLEAR JMP RETNUM ZERROR, 0 CLA CLL TAD I ZERROR CIF SETFIELD JMS I (F3ERROR JMP I ZERROR ZFATAL, 0 TAD ZFATAL CDF CIF SETFIELD JMP I (F3FATAL
XNEXTCH,0 BREAK ISZ LL JMP NCH TAD ERRSW SNA CLA JMP NLN TAD (ERRLINE-1 DCA XR10 CDF SETFIELD TAD I XR10 CDF 0 TAD [240 PRINTC ISZ ERRSW JMP .-6 CRLF NLN, TAD EOF SZA CLA FATAL9, FATAL /PROGRAM INCOMPLETE! DCA CC TAD (5 DCA M CDF COMPFIELD TAD I (LC CDF 0 LOAD JMS IOUT PRINTC /CHAR = 240 ! PRINTC NCH, ISZ CC TAD EOLN SNA CLA JMP .+6 CRLF L7777 DCA LL JMS GETC JMP I XNEXTCH JMS GETC PRINTC JMP I XNEXTCH LL, 0 PAGE
FIELD 2 *TAB /ENTRIES FOR PREDEFINED SYMBOLS: -1; VARIABLE^100+NOTYP; 0040; 0 0; KONSTANT^100+BOOLS; 0040; 0 1; KONSTANT^100+BOOLS; 0040; 1 2; TYPE1^100+REALS; 0040; 1 3; TYPE1^100+CHARS; 0040; 1 4; TYPE1^100+BOOLS; 0040; 1 5; TYPE1^100+INTS; 0040; 1 6; FUNKTION^100+REALS; 0040; 0 7; FUNKTION^100+REALS; 0040; 2 10; FUNKTION^100+BOOLS; 0040; 4 11; FUNKTION^100+CHARS; 0040; 5 12; FUNKTION^100+INTS; 0040; 6 13; FUNKTION^100+CHARS; 0040; 7 14; FUNKTION^100+CHARS; 0040; 10 15; FUNKTION^100+INTS; 0040; 11 16; FUNKTION^100+INTS; 0040; 12 17; FUNKTION^100+REALS; 0040; 13 20; FUNKTION^100+REALS; 0040; 14 21; FUNKTION^100+REALS; 0040; 15 22; FUNKTION^100+REALS; 0040; 16 23; FUNKTION^100+REALS; 0040; 17 24; FUNKTION^100+REALS; 0040; 20 25; FUNKTION^100+BOOLS; 0040; 21 26; FUNKTION^100+BOOLS; 0040; 22 27; PROZEDURE^100+NOTYP; 0040; 1 30; PROZEDURE^100+NOTYP; 0040; 2 31; PROZEDURE^100+NOTYP; 0040; 3 32; PROZEDURE^100+NOTYP; 0040; 4 33; PROZEDURE^100+NOTYP; 0040; 5 34; PROZEDURE^100+NOTYP; 0040; 6 35; FUNKTION^100+REALS; 0040; 23 36; PROZEDURE^100+NOTYP; 0040; 0
FIELD 3 /N A M E S OF S Y M B O L - T A B L E /THE FOLLOWING NAMES ARE PREDEFINED: *0 TEXT /@@@@@@@@/ *.-1 TEXT /FALSE@@@/ *.-1 TEXT /TRUE@@@@/ *.-1 TEXT /REAL@@@@/ *.-1 TEXT /CHAR@@@@/ *.-1 TEXT /BOOLEAN@/ *.-1 TEXT /INTEGER@/ *.-1 TEXT /ABS@@@@@/ *.-1 TEXT /SQR@@@@@/ *.-1 TEXT /ODD@@@@@/ *.-1 TEXT /CHR@@@@@/ *.-1 TEXT /ORD@@@@@/ *.-1 TEXT /SUCC@@@@/ *.-1 TEXT /PRED@@@@/ *.-1 TEXT /ROUND@@@/ *.-1 TEXT /TRUNC@@@/ *.-1 TEXT /SIN@@@@@/ *.-1 TEXT /COS@@@@@/ *.-1 TEXT /EXP@@@@@/ *.-1 TEXT /LN@@@@@@/ *.-1 TEXT /SQRT@@@@/ *.-1 TEXT /ARCTAN@@/ *.-1 TEXT /EOF@@@@@/ *.-1 TEXT /EOLN@@@@/ *.-1 TEXT /READ@@@@/ *.-1 TEXT /READLN@@/ *.-1 TEXT /WRITE@@@/ *.-1 TEXT /WRITELN@/ *.-1 TEXT /HALT@@@@/ *.-1 TEXT /ASCII@@@/ *.-1 TEXT /RANDOM@@/ *.-1 TEXT /@@@@@@@@/
/F S Y S AND S E T - C O N S T A N T S *4000 /---------------- FSYS, ZBLOCK 5 / M U S T BE AT 4000!!! /---------------- S1US2, ZBLOCK 5 SET0, 0;0;0;0;0 SET1, CONBGS, 7140;0000;0000;4000;0000 SET2, TYPBGS, 0000;0000;0006;4000;0000 SET3, BLOBGS, 0000;0000;0370;2000;0000 SET4, FACBGS, 7200;0020;0000;4000;0000 SET5, STATBGS,0000;0000;0000;3740;0000 SET6, 0000;0001;1000;0000;0000 SET7, 0000;0000;0370;6000;0000 SET8, 0140;0000;0000;0000;0000 SET9, 0000;0012;1000;0002;0000 SET10, 0000;0013;0000;0002;0000 SET11, 0000;0001;4000;4020;0000 SET12, 0000;0000;4000;4020;0000 SET13, 0000;0000;0040;4000;0000 SET14, 0000;0010;0000;0000;0000 SET15, 0000;0010;4000;0000;0000 SET16, 0000;0001;0000;4000;0000 SET17, 0000;0000;5000;0000;0000 SET18, 0000;0000;0000;4000;0000 SET19, 0000;0001;4000;4000;0000 SET20, 0000;0000;4000;0000;0000 SET21, 0000;0003;0000;0000;0000 SET22, 0000;0024;2000;0000;0000 SET23, 0000;0011;1000;0000;0000 SET24, 0000;0011;0000;0000;0000 SET25, 7000;0000;0000;0000;0000 SET26, 0037;0000;0000;0000;0000 SET27, 0140;4000;0000;0000;0000 SET28, 0000;3740;0000;0000;0000 SET29, 0000;2000;0400;0000;0000 SET30, 0000;0000;4000;0020;0000 SET31, 0000;0000;4000;3740;0000 SET32, 0000;0000;0000;0001;1000 SET33, 0000;0000;0000;0010;0000 SET34, 0000;0001;1000;0002;0000 SET35, 0000;0000;4000;0004;0000 SET36, 0000;0000;0000;0001;0000 SET37, 0000;0000;0400;0001;6000 SET38, 0000;0000;0000;0001;6000 SET39, 0000;0000;0000;0000;6000 SET40, 0000;0000;0000;7740;0000 SET41, 0000;0020;5000;0000;0000 SET42, 0000;0000;0030;0000;0000 SET43, 0000;0000;0000;2000;0000 SET44, 0000;0000;0370;3740;0000 SET45, 0000;0000;2000;0000;0000 SET46, 0000;0001;4000;4000;0000
/WORD- AND BIT-POSITION TABLE USED BY SET-ROUTINES: SETTABL,0;4000 0;2000 0;1000 0;0400 0;0200 0;0100 0;0040 0;0020 0;0010 0;0004 0;0002 0;0001 1;4000 1;2000 1;1000 1;0400 1;0200 1;0100 1;0040 1;0020 1;0010 1;0004 1;0002 1;0001 2;4000 2;2000 2;1000 2;0400 2;0200 2;0100 2;0040 2;0020 2;0010 2;0004 2;0002 2;0001 3;4000 3;2000 3;1000 3;0400 3;0200 3;0100 3;0040 3;0020 3;0010 3;0004 3;0002 3;0001 4;4000 4;2000 4;1000 4;0400 4;0200 4;0100 4;0040 4;0020 4;0010 4;0004 4;0002 4;0001
/H A S H - T A B L E OF K E Y W O R D S HASHTABLE=. DECIMAL /ADDRESSES SPECIFIED IN DECIMAL! ZBLOCK 128^4 /CLEAR UNUSED LOCATIONS! KSYTABLE=. /REMEMBER END OF HASHTABLE *2^4+HASHTABLE TEXT /AND/ *5^4+HASHTABLE TEXT /ARRAY/ *8^4+HASHTABLE TEXT /DIV/ *9^4+HASHTABLE TEXT /DO/ *10^4+HASHTABLE TEXT /END/ *13^4+HASHTABLE TEXT /FOR/ *16^4+HASHTABLE TEXT /CASE/ *18^4+HASHTABLE TEXT /IF/ *19^4+HASHTABLE TEXT /FUNCTION/ *20^4+HASHTABLE TEXT /ELSE/ *22^4+HASHTABLE TEXT /BEGIN/ *27^4+HASHTABLE TEXT /MOD/ *29^4+HASHTABLE TEXT /NOT/ *30^4+HASHTABLE TEXT /OF/ *31^4+HASHTABLE TEXT /OR/ *37^4+HASHTABLE TEXT /DOWNTO/ *39^4+HASHTABLE TEXT /PROCEDUR/ *41^4+HASHTABLE TEXT /TO/ *44^4+HASHTABLE TEXT /VAR/ *45^4+HASHTABLE TEXT /CONST/ *46^4+HASHTABLE TEXT /REPEAT/ *47^4+HASHTABLE TEXT /PROGRAM/ *51^4+HASHTABLE TEXT /TYPE/ *60^4+HASHTABLE TEXT /UNTIL/ *66^4+HASHTABLE TEXT /RECORD/ *68^4+HASHTABLE TEXT /THEN/ *70^4+HASHTABLE TEXT /WHILE/
/S Y M B O L - V A L U E S OF K E Y W O R D S *KSYTABLE ZBLOCK 128 /FOR SAFETY! PUSHTABLE=. /REMEMBER END OF KSYTABLE *2+KSYTABLE ANDSY *5+KSYTABLE ARRAYSY *8+KSYTABLE IDIVSY *9+KSYTABLE DOSY *10+KSYTABLE ENDSY *13+KSYTABLE FORSY *16+KSYTABLE CASESY *18+KSYTABLE IFSYM *19+KSYTABLE FUNCTIONSY *20+KSYTABLE ELSESY *22+KSYTABLE BEGINSY *27+KSYTABLE IMODSY *29+KSYTABLE NOTSY *30+KSYTABLE OFSY *31+KSYTABLE ORSY *37+KSYTABLE DOWNTOSY *39+KSYTABLE PROCEDURESY *41+KSYTABLE TOSY *44+KSYTABLE VARSY *45+KSYTABLE CONSTSY *46+KSYTABLE REPTSY *47+KSYTABLE PROGRAMSY *51+KSYTABLE TYPESY *60+KSYTABLE UNTILSY *66+KSYTABLE RECRDSY *68+KSYTABLE THENSY *70+KSYTABLE WHILSY OCTAL
/P U S H T A B L E /CONTAINS THE NECESSARY INFORMATIONS (USED BY PUSHJUMP AND POPJUMP) /TO CALL THE COMPILER PROCEDURES RECURSIVELY, /TO SAVE THE LOCAL VARIABLES, TO PASS EVENTUAL PARAMETERS /AND RETURN CONTROL TO MAINLINE. / /FOR EACH PROCEDURE THERE IS ONE ENTRY OF 4 WORDS: /WORD 1: ADDRESS OF FIRST LOCAL VARIABLE (= 1ST PARAMETER) - 1 /WORD 2: - NUMBER OF LOCAL VAR'S (LOCATIONS) TO SAVE /WORD 3: NUMBER OF PARAMETERS ( + FSYS IF 1ST ONE IS A SET) / ( + 100*NO. OF VAR-PARAMETERS) /WORD 4: STARTING ADDRESS OF PROCEDURE *PUSHTABLE /BLOCK ISFUN-1; -5; FSYS+2; XBLOCK /STATEMENT 0; 0; FSYS; XSTATEMENT /ASSIGNMENT LV-1; -6; 2; XASSIGNMENT /COMPOUNDSTATEMENT 0; 0; 0; XCOMPOUND /IFSTATEMENT IXTYP-1; -4; 0; XIFSTATEMENT /CASESTATEMENT CASETAB-1; -137; 0; XCASESTATEMENT /REPEATSTATEMENT RXTYP-1; -3; 0; XREPEAT /WHILESTATEMENT WXTYP-1; -4; 0; XWHILE /FORSTATEMENT FXTYP-1; -6; 0; XFORSTATEMENT /STANDPROC PRCN-1; -5; 1; XSTPROC /SELECTOR SELVAR-1; -5; FSYS+200+1; XSELECT /CALL CALI-1; -5; FSYS+1; XCALL /STANDFCT FCTN-1; -2; 1; XSTFUN /FACTOR FACVAR-1; -3; FSYS+200+1; XFACTOR /TERM TRMXTYP-1; -4; FSYS+1; XTERM /SIMPLEEXPRESSION SIMXTYP-1; -4; FSYS+1; XSIMPLE /EXPRESSION EXPRVAR-1; -6; FSYS+200+1; XEXPRESSION /CONDECLARE CONREC-1; 0; 0; XCONDECL /TYPDECLARE DECTP-1; 0; 0; XTYPDECL /VARDECLARE VARTP-1; 0; 0; XVARDECL /PRODECLARE PROFUN-1; -1; 0; XPRODECL /CONSTANT CCON-1; 0; FSYS+1; XCONSTANT /ARRAYTYP ARRVAR-1; -6; 200+1; XARRAYTYP /TYPE TYPVAR-1; -12; FSYS+300+1; XTYPE /PARAMETERLIST PARTP-1; 0; 0; XPARAM /ONECASE 0; 0; 0; XONECASE
/TABLE OF S P E C I A L S Y M B O L S / /ONE ENTRY FOR EACH ASCII CHARACTER: / =0 ... FOR ILLEGAL CHAR'S / >0 ... (=SYMBOL VALUE) FOR SINGLE SPECIAL CHAR'S / <0 ... (=JMP TO ROUTINE) FOR DOUBLE CHAR'S, COMMENTS OR STRINGS CHARTABLE=. /SPACE ! " # $ % & ' ( ) * + , - . / 0 0 JMPAPOS NEQ 0 0 ANDSY 0 JMPLPAR RPARENT TIMES PLUS COMMA MINUS JMPPER RDIVSY ZBLOCK "9-"0+1 /DIGITS ARE PROCESSED SEPARATELY! /: ; < = > ? @ JMPCOL SEMICOLON JMPLSS EQL JMPGTR 0 0 ZBLOCK "Z-"A+1 /LETTERS ARE PROCESSED SEPARATELY! /[ \ ] ^ _ LBRACK 0 RBRACK 0 0
/C O M P I L E R E R R O R S (NOT FATAL) /ERROR LINE BUFFER: ERRLINE,"#-240; "#-240; "#-240; "#-240; "#-240; 0; 0 ZBLOCK LLNG PAGE /ERROR ROUTINE: ERRNO, 0 /ERROR NUMBER ERRN01, 0 /ERROR NUMBER - UNITS ERRN10, 0 /ERROR NUMBER - TENS ERRPOS, 0 /POSITION OF ERROR ERRP, 0 ERRC, 0 /ERRSW, 0 /IN FIELD 0 /ERRSUM,0 /IN FIELD 6 F3ERROR,0 DCA ERRNO RDF TAD (CDF CIF DCA ERRCDI CDF 0 TAD I (CC TAD (ERRLINE+5 DCA ERRPOS TAD I (ERRSW CDF SETFIELD SZA CLA JMP ERRENT TAD (ERRLINE+5 DCA ERRP TAD (-LLNG DCA ERRC ISZ ERRP DCA I ERRP ISZ ERRC JMP .-3 ERRENT, TAD ERRNO DCA ERRN01 DCA ERRN10 JMP .+3 DCA ERRN01 ISZ ERRN10 TAD ERRN01 TAD (-12 /-10 SMA JMP .-5 CLA TAD I ERRPOS SZA CLA JMP ERREXIT /NO ROOM! TAD ("#-240 DCA I ERRPOS ISZ ERRPOS TAD ERRN10 SNA JMP .+4 TAD ("0-240 DCA I ERRPOS ISZ ERRPOS TAD ERRN01 TAD ("0-240 DCA I ERRPOS TAD ERRPOS TAD (-ERRLINE CMA CDF 0 DCA I (ERRSW ERREXIT,CDF ERRFIELD ISZ I ERRNO /REMEMBER THIS ERROR ISZ I (ERRSUM /COUNT ERRORS ERRCDI, CDF CIF 0 JMP I F3ERROR PAGE
/C O M P I L E R E R R O R S (FATAL) FATADR, 0 FATPOS, 0 F3FATAL,DCA FATADR TAD FHEAD DCA FTEXT JMS FCRLF JMS FCRLF JMS FMESG TAD FLIST DCA FATPOS ISZ FATPOS TAD I FATPOS TAD FATADR SZA CLA JMP .-4 TAD FATPOS TAD FMFL DCA FATPOS TAD I FATPOS DCA FTEXT JMS FMESG JMS FCRLF CDF CIF ERRFIELD JMP I .+1 FXPLAIN FPRINT, 0 TLS TSF JMP .-1 CLA CLL JMP I FPRINT FCRLF, 0 TAD F215 JMS FPRINT TAD F212 JMS FPRINT JMP I FCRLF FMESG, 0 TAD I FTEXT BSW JMS FASCII TAD I FTEXT JMS FASCII ISZ FTEXT JMP FMESG+1 FASCII, 0 AND F77 SNA JMP I FMESG TAD F240 AND F77 TAD F240 JMS FPRINT JMP I FASCII FTEXT, 0 FLIST, FATLIST-1 FMFL, FATMESG-FATLIST FHEAD, FNN F215, 215 F212, 212 F240, 240 F77, 77 FATLIST,-FATAL0-1 -FATAL1-1 -FATAL2-1 -FATAL3-1 -FATAL4-1 -FATAL5-1 -FATAL6-1 -FATAL7-1 -FATAL8-1 -FATAL9-1 -FATALC-1 FATMESG,F00 F01 F02 F03 F04 F05 F06 F07 F08 F09 F0C FNN, TEXT /KOMPILATION ABGEBROCHEN - / F00, TEXT /MAGNETBAND-LESEFEHLER!/ F01, TEXT /ZU VIELE NAMEN!/ F02, TEXT /ZU VIELE PROZEDUREN UND\ODER RECORDS!/ F03, TEXT /ZU VIELE KONSTANTE!/ F04, TEXT /ZU VIELE ARRAYS!/ F05, TEXT /ZU VIELE UNTERPROGRAMMEBENEN!/ F06, TEXT /PROGRAMM ZU GROSS!/ F07, TEXT /ZU VIEL TEXT!/ F08, TEXT /PROGRAMM ZU KOMPLEX!/ F09, TEXT /PROGRAMM UNVOLLSTAENDIG!/ F0C, TEXT /ZU VIELE CASE-MARKEN!/ PAGE
FIELD 4 /P A G E Z E R O /LOC'S 1 - 7 USED FOR TEMPORARY STORAGE! *7 L, 0 *10 /XR10, /AUTOINDEX REGISTER (SEE FIELD 0!) 0 XR11, 0 / --- " --- XR12, 0 *20 LC, 0 /L O C A T I O N C O U N T E R TEMP, 0 /I N S T R U C T I O N - R E G I S T E R /IRX, 0 /LEVEL /IRY, 0 /ADDRESS OR VALUE /I N D I C E S T O T A B L E S /B, /BLOCK TABLE 0001 /T, /SYMBOL TABLE 0037 A, /ARRAY TABLE 0 C, /CONSTANT TABLE ATAB-1 SX, /STRING TABLE 0 J, 0 /TEMPORARY FOR T JA, 0 /TEMPORARY FOR A JB, 0 /TEMPORARY FOR B LO, 0 /LOW BOUND OF ARRAY HI, 0 /HIGH BOUND OF ARRAY SLENG, 0 /LENGTH OF STRING SY, 0 /C U R R E N T S Y M B O L ID, 0;0;0;0 /C U R R E N T I D E N T I F I E R NUM, 0;0;0;0 /C O N S T A N T N U M B E R *50 /U N P A C K E D E N T R Y OF SYMBOL TABLE LINK0, 0 OBJ0, 0 TYP0, 0 REF0, 0 NORM0, 0 LEV0, 0 ADR0, 0 JW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHEND') *50 /U N P A C K E D E N T R Y OF ARRAY TABLE INXTP0, 0 ELTYP0, 0 ELREF0, 0 LOW0, 0 HIGH0, 0 ELSIZ0, 0 SIZE0, 0 JAW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHAEND') /LOCAL VAR'S OF PROCEDURE B L O C K ISFUN, 0 LEVEL, 0 DX, 0 PRT, 0 PRB, 0 /LOCAL VAR'S OF PROCEDURE F A C T O R FACVAR, 0 FACXTYP,0 FACXREF,0 /LOCAL VAR'S OF PROCEDURE C A L L CALI, 0 CALXTYP,0 CALXREF,0 CALASTP,0 CALCP, 0 /LOCAL VAR'S OF P U S H J U M P AND P O P J U M P LOCAL, 0 LENGTH, 0 PARAM, 0 /M A C R O I N S T R U C T I O N S USED BY COMPILER *100 /ERROR=JMS I . /PARALLEL DEFINED WITH FIELD 0! XERROR /FATAL=JMS I . / -"- XFATAL /OFTAB=JMS I . / -"- XOFTAB /OFATAB=JMS I . / -"- XOFATAB /OFBTAB=JMS I . / -"- XOFBTAB /OFDISPLAY=JMS I . / -"- XOFDISP /TODISPLAY=JMS I . / -"- XTODISP /GETCONSTANT=JMS I . / -"- XOFCONST TOTAB=JMS I . /PUT INFO INTO SYMBOL TABLE XTOTAB TOATAB=JMS I . /PUT INFO INTO ARRAY TABLE XTOATAB TOBTAB=JMS I . /PUT INFO INTO BLOCK TABLE XTOBTAB WITHTABDO=JMS I . /GET AND UNPACK ENTRY OF SYMBOL TABLE XWITHTAB ENDWITH=JMS I . /PACK AND STORE ENTRY OF SYMBOL TABLE XENDWITH WITHATABDO=JMS I . /GET AND UNPACK ENTRY OF ARRAY TABLE XWITHATAB ENDAWITH=JMS I . /PACK AND STORE ENTRY OF ARRAY TABLE XENDAWITH TOCODE=JMS I . /INSERT ADDRESS INTO CODE[LC].IRY XTOCODE EMIT=JMS I . /OUTPUT INSTRUCTION OF INTERMEDIATE CODE XEMIT ENTER=JMS I . /ENTER ITEM INTO SYMBOL TABLE XENTER ENTERVARIABLE=JMS I . /ENTER VARIABLE INTO SYMBOL TABLE XENTVAR ENTERARRAY=JMS I . /INTO ARRAY TABLE XENTARR ENTERBLOCK=JMS I . /INTO BLOCK TABLE XENTBLO ENTERCONSTANT=JMS I . /INTO CONSTANT TABLE XENTCON SIGNEDINTEGER=JMS I . /MAKE SIGNED 12-BIT INTEGER OF (NUM) XSGNINT TEST=JMS I . /CHECK AND SKIP TO LEGAL FOLLOW SYMBOL XTEST TESTSEMICOLON=JMS I . XTSTSEM SKIP=JMS I . /SKIP TO LEGAL FOLLOW SYMBOL XSKIP SKIPIFSYIN=JMS I . /SKIP NEXT INSTR. IF SY IN SETX INSET UNION=JMS I . /SET UNION XUNION IFSY=JMS I . /IF SY=SYMBOL THEN NEXT INSTR. ELSE SKIP XIFSY IFSYNOT=JMS I . /IF SY<>SYMBOL THEN NEXT INSTR. ELSE SKIP XIFSYNOT LOCATE=JMS I . /LOCATE IDENTIFIER IN SYMBOL TABLE XLOCATE PUSHJUMP=JMS I . /RECURSIVE PROCEDURE CALL XPUSHJUMP POPJUMP=JMS I . /RETURN FROM PROCEDURE XPOPJUMP RESULTTYPE=JMS I . XRESULT INSYMBOL=JMS I . /SCANNER XINSYMBOL /LOCAL VAR'S OF PROCEDURE T Y P E TYPVAR, 0 TP, 0 RF, 0 SZ, 0 ELTP, 0 ELRF, 0 ELSZ, 0 OFFSET, 0 TT0, 0 TT1, 0 /LOCAL VAR'S OF PROCEDURE W H I L E - STATEMENT WXTYP, 0 WXREF, 0 WLC1, 0 WLC2, 0
/M A I N P R O G R A M OF COMPILER *200 MAIN, INSYMBOL IFSYNOT;PROGRAMSY;JMP MAIN3 INSYMBOL IFSYNOT;IDENT;JMP MAIN2 INSYMBOL IFSY;LPARENT;JMP .+4 ERROR;11 /9 JMP ENDOFH IOFILES,INSYMBOL IFSY;IDENT;JMP .+4 ERROR;2 /2 SKP INSYMBOL IFSY;COMMA;JMP IOFILES ENDOFH, IFSY;RPARENT;JMP .+4 ERROR;4 /4 SKP INSYMBOL MAINBL, TAD (BTAB+3 DCA XR10 CDF TABLEFIELD TAD T DCA I XR10 L0001 DCA I XR10 DCA I XR10 DCA I XR10 CDF COMPFIELD PUSHJUMP;BLOCK SET44 0 /FALSE 1 IFSYNOT;PERIOD;ERROR;26 /22 EMIT;45 /(37) CDF CIF ERRFIELD JMP I (EXPLAIN /DO THE COMPILATION REPORT MAIN2, ERROR;2 /2 JMP MAINBL MAIN3, ERROR;3 /3 JMP MAINBL
/EXTENSION OF P U S H J U M P AND P O P J U M P ROUTINES VARIN, 0 TAD PARAM AND (700 SNA JMP I VARIN BSW CIA DCA LENGTH ISZ LOCAL L7777 TAD I LOCAL DCA XR11 TAD I XR11 DCA I XR10 ISZ LENGTH JMP .-3 JMP I VARIN VARTM, 0 DCA VARVAR TAD PARAM AND (700 SNA JMP I VARTM BSW CIA DCA VARIN TAD VARIN DCA VARVAR TAD LOCAL DCA XR10 L7777 TAD I XR10 DCA XR11 DCA XR12 /USE LOC'S 1 - 7 FOR TEMP. STORAGE TAD I XR10 DCA I XR12 ISZ VARIN JMP .-3 JMP I VARTM VAREX, 0 TAD VARVAR SNA CLA JMP I VAREX DCA XR10 TAD I XR10 DCA I XR11 ISZ VARVAR JMP .-3 JMP I VAREX VARVAR, 0 PAGE
/PROCEDURE C O N S T A N T / --------------- / /CALL: PUSHJUMP;CONSTANT / SETX / C /ADDRESS / /LOCAL VAR'S: FSYS CCON, 0 SIGN, 0 XCONSTANT, DCA I CCON TAD CCON DCA XR10 DCA I XR10 DCA I XR10 DCA I XR10 DCA I XR10 TEST;CONBGS;FSYS;62 /50 SKIPIFSYIN;CONBGS JMP CON6 IFSYNOT;CHARCON;JMP .+4 L0004 /4=CHARS DCA I CCON JMP CON4 DCA SIGN /+ SKIPIFSYIN;SET8 JMP CON1 IFSY;MINUS;L4000 DCA SIGN INSYMBOL CON1, IFSYNOT;IDENT;JMP CON2 LOCATE SNA JMP CON5-1 DCA J OFTAB;OBJ MQL MQA BSW AND [77 TAD (-KONSTANT SNA CLA JMP .+4 ERROR;31 /25 JMP CON5-1 MQA AND [77 DCA I CCON OFTAB;ADR DCA NUM+3 DCA NUM+2 DCA NUM+1 DCA NUM L7776 /2=REALS TAD I CCON SZA IAC /1=INTS SZA CLA JMP CON3 TAD NUM+3 GETCONSTANT JMP CON3 CON2, IFSY;INTCON;JMP CON3-2 IFSY;REALCON;JMP CON3-3 SKIP;FSYS;62 /50 JMP CON5 L0001 IAC DCA I CCON CON3, TAD SIGN TAD NUM+1 DCA NUM+1 CON4, TAD CCON DCA XR10 TAD NUM DCA I XR10 TAD NUM+1 DCA I XR10 TAD NUM+2 DCA I XR10 TAD NUM+3 DCA I XR10 INSYMBOL CON5, TEST;FSYS;SET0;6 /6 CON6, POPJUMP;CONSTANT PAGE
/PROCEDURE A R R A Y T Y P / --------------- / /CALL: PUSHJUMP;ARRAYTYP / REF /ADDRESS / SIZE /ADDRESS / /LOCAL VAR'S: ARRVAR, 0 AREF, 0 ARSZ, 0 ALTP, 0 ALRF, 0 ALSZ, 0 LOWB, ZBLOCK 5 HIGHB, ZBLOCK 5 MULT=HIGHB XARRAYTYP, PUSHJUMP;CONSTANT FSYS+SET9 LOWB L7776 /2=REALS TAD LOWB SZA CLA JMP ARR1 ERROR;33 /27 L0001 /1=INTS DCA LOWB DCA LOWB+1 DCA LOWB+2 DCA LOWB+3 DCA LOWB+4 ARR1, IFSY;COLON;JMP .+4 ERROR;15 /13 SKP INSYMBOL PUSHJUMP;CONSTANT FSYS+SET10 HIGHB TAD HIGHB CIA TAD LOWB SNA CLA JMP ARR2 ERROR;33 /27 TAD LOWB+1 DCA HIGHB+1 TAD LOWB+2 DCA HIGHB+2 TAD LOWB+3 DCA HIGHB+3 TAD LOWB+4 DCA HIGHB+4 ARR2, SIGNEDINTEGER;LOWB DCA LO SIGNEDINTEGER;HIGHB DCA HI TAD LOWB ENTERARRAY TAD A DCA AREF IFSYNOT;COMMA;JMP ARR3 INSYMBOL TAD [ARRAY DCA ALTP PUSHJUMP;ARRAYTYP ALRF /ALSZ JMP ARR4 ARR3, IFSY;RBRACK;JMP .+5 ERROR;14 /12 IFSY;RPARENT;INSYMBOL IFSY;OFSY;JMP .+4 ERROR;10 /8 SKP INSYMBOL PUSHJUMP;TYPE FSYS ALTP /ALRF /ALSZ ARR4, TAD AREF DCA JA WITHATABDO TAD LOW0 CIA TAD HIGH0 IAC DCA TEMP TAD ALSZ CIA DCA MULT TAD TEMP ISZ MULT JMP .-2 DCA ARSZ TAD ARSZ DCA SIZE0 TAD ALTP DCA ELTYP0 TAD ALRF DCA ELREF0 TAD ALSZ DCA ELSIZ0 ENDAWITH POPJUMP;ARRAYTYP PAGE
/PROCEDURE T Y P E / ------- / /CALL: PUSHJUMP;TYPE / SETX / TYP /ADDRESS / REF / --"-- / SIZE / --"-- / /LOCAL VAR'S (ON PAGE ZERO!): / FSYS / TYPVAR, 0 / TP, 0 / RF, 0 / SZ, 0 / ELTP, 0 / ELRF, 0 / ELSZ, 0 / OFFSET, 0 / TT0, 0 / TT1, 0 XTYPE, DCA TP /0=NOTYP DCA RF DCA SZ TEST;TYPBGS;FSYS;12 /10 SKIPIFSYIN;TYPBGS POPJUMP;TYPE IFSYNOT;IDENT;JMP TYP1 LOCATE SNA JMP TYP1-2 DCA J WITHTABDO TAD OBJ0 TAD [-TYPE1 SNA CLA JMP .+4 ERROR;35 /29 JMP TYP1-2 TAD TYP0 DCA TP TAD REF0 DCA RF TAD ADR0 DCA SZ TAD TYP0 SNA CLA ERROR;36 /30 INSYMBOL JMP TYP7 TYP1, IFSYNOT;ARRAYSY;JMP TYP2 INSYMBOL IFSY;LBRACK;JMP .+5 ERROR;13 /11 IFSY;LPARENT;INSYMBOL TAD [ARRAY DCA TP PUSHJUMP;ARRAYTYP RF /SZ JMP TYP7 TYP2, INSYMBOL ENTERBLOCK L0006 /6=RECORD DCA TP TAD B DCA RF TAD LEVEL TAD [-LMAX SNA CLA FATAL5, FATAL ISZ LEVEL TAD B TODISPLAY DCA OFFSET TYP3, SKIPIFSYIN;SET46;JMP TYP6 IFSYNOT;IDENT;JMP TYP5 TAD T DCA TT0 SKP INSYMBOL ENTERVARIABLE IFSY;COMMA;JMP .-4 IFSY;COLON;JMP .+4 ERROR;5 /5 SKP INSYMBOL TAD T DCA TT1 PUSHJUMP;TYPE FSYS+SET11 ELTP /ELRF /ELSZ TYP4, TAD TT0 CIA TAD TT1 SPA SNA CLA JMP TYP5 ISZ TT0 TAD TT0 WITHTABDO TAD ELTP DCA TYP0 TAD ELRF DCA REF0 TAD [40 DCA NORM0 TAD OFFSET DCA ADR0 TAD OFFSET TAD ELSZ DCA OFFSET ENDWITH JMP TYP4 PAGE TYP5, IFSY;ENDSY;JMP TYP6 IFSY;SEMICOLON;JMP .+5 ERROR;16 /14 IFSY;COMMA;INSYMBOL TEST;SET12;FSYS;6 /6 JMP TYP3 TYP6, TAD RF DCA JB TAD OFFSET TOBTAB;VSIZE TAD OFFSET DCA SZ TOBTAB;PSIZE INSYMBOL L7777 TAD LEVEL DCA LEVEL TYP7, TEST;FSYS;SET0;6 /6 POPJUMP;TYPE
/PROCEDURE C O N D E C L / ------------- / /CALL: PUSHJUMP;CONDECL /NO ARG'S! / /LOCAL VAR'S: CONREC, ZBLOCK 5 XCONDECL, INSYMBOL TEST;SET18;BLOBGS;2 /2 CDEC1, IFSYNOT;IDENT;POPJUMP;CONDECL ENTER;KONSTANT INSYMBOL IFSY;EQL;JMP .+5 ERROR;20 /16 IFSY;BECOMES;INSYMBOL PUSHJUMP;CONSTANT FSYS+SET19 CONREC TAD T WITHTABDO TAD CONREC /TYP DCA TYP0 DCA REF0 L7776 TAD CONREC SZA IAC SZA CLA JMP .+4 ENTERCONSTANT;CONREC SKP TAD CONREC+4 DCA ADR0 ENDWITH TESTSEMICOLON JMP CDEC1
/PROCEDURE T Y P D E C L / ------------- / /CALL: PUSHJUMP;TYPDECL /NO ARG'S! / /LOCAL VAR'S: DECTP, 0 DECRF, 0 DECSZ, 0 DT1, 0 XTYPDECL, INSYMBOL TEST;SET18;BLOBGS;2 /2 TDEC1, IFSYNOT;IDENT;POPJUMP;TYPDECL ENTER;TYPE1 TAD T DCA DT1 INSYMBOL IFSY;EQL;JMP .+5 ERROR;20 /16 IFSY;BECOMES;INSYMBOL PUSHJUMP;TYPE FSYS+SET19 DECTP /DECRF /DECSZ TAD DT1 WITHTABDO TAD DECTP DCA TYP0 TAD DECRF DCA REF0 TAD DECSZ DCA ADR0 ENDWITH TESTSEMICOLON JMP TDEC1 PAGE
/PROCEDURE P A R A M E T E R L I S T / ------------------------- / /CALL: PUSHJUMP;PARAMETERLIST /NO ARG'S! / /LOCAL VAR'S: PARTP, 0 PARRF, 0 PARSZ, 0 PT0, 0 VALPAR, 0 XPARAM, INSYMBOL DCA PARTP DCA PARRF DCA PARSZ TEST;SET13;FSYS+SET14;7 /7 PAR1, SKIPIFSYIN;SET13 JMP PAR5 IFSYNOT;VARSY;JMP .+3 INSYMBOL SKP TAD [40 DCA VALPAR TAD T DCA PT0 ENTERVARIABLE IFSYNOT;COMMA;JMP .+4 INSYMBOL ENTERVARIABLE JMP .-5 IFSY;COLON;JMP .+4 ERROR;5 /5 JMP PAR3 INSYMBOL IFSY;IDENT;JMP .+4 ERROR;2 /2 JMP PAR2 LOCATE DCA J INSYMBOL TAD J SNA CLA JMP PAR2 WITHTABDO TAD OBJ0 TAD [-TYPE1 SNA CLA JMP .+4 ERROR;35 /29 JMP PAR2 TAD TYP0 DCA PARTP TAD REF0 DCA PARRF TAD VALPAR SZA CLA JMP .+3 L0001 SKP TAD ADR0 DCA PARSZ PAR2, TEST;SET15;FSYS+SET16;16 /14 PAR3, TAD PT0 CIA TAD T SPA SNA CLA JMP PAR4 ISZ PT0 TAD PT0 WITHTABDO TAD PARTP DCA TYP0 TAD PARRF DCA REF0 TAD VALPAR DCA NORM0 TAD DX DCA ADR0 TAD LEVEL DCA LEV0 ENDWITH TAD DX TAD PARSZ DCA DX JMP PAR3 PAR4, IFSY;RPARENT;JMP PAR6 IFSY;SEMICOLON;JMP .+5 ERROR;16 /14 IFSY;COMMA;INSYMBOL TEST;SET13;FSYS+SET14;6 /6 JMP PAR1 PAR5, IFSY;RPARENT;JMP PAR6 ERROR;4 /4 JMP .+6 PAR6, INSYMBOL TEST;SET17;FSYS;6 /6 POPJUMP;PARAMETERLIST PAGE
/PROCEDURE V A R D E C L / ------------- / /CALL: PUSHJUMP;VARDECL /NO ARG'S! / /LOCAL VAR'S: VARTP, 0 VARRF, 0 VARSZ, 0 VT0, 0 VT1, 0 XVARDECL, INSYMBOL IFSYNOT;IDENT;POPJUMP;VARDECL TAD T DCA VT0 ENTERVARIABLE IFSYNOT;COMMA;JMP .+4 INSYMBOL ENTERVARIABLE JMP .-5 IFSY;COLON;JMP .+4 ERROR;5 /5 SKP INSYMBOL TAD T DCA VT1 PUSHJUMP;TYPE FSYS+SET19 VARTP /VARRF /VARSZ VAR1, TAD VT0 CIA TAD VT1 SPA SNA CLA JMP VAR2 ISZ VT0 TAD VT0 WITHTABDO TAD VARTP DCA TYP0 TAD VARRF DCA REF0 TAD LEVEL DCA LEV0 TAD DX DCA ADR0 TAD [40 DCA NORM0 ENDWITH TAD VARSZ TAD DX DCA DX JMP VAR1 VAR2, TESTSEMICOLON JMP XVARDECL+1
/PROCEDURE P R O D E C L / ------------- / /CALL: PUSHJUMP;PRODECL /NO ARG'S! / /LOCAL VAR'S: PROFUN, 0 /SEE BELOW! XPRODECL, IFSY;FUNCTIONSY;L0001 DCA PROFUN INSYMBOL IFSY;IDENT;JMP .+7 ERROR;2 /2 DCA ID DCA ID+1 DCA ID+2 DCA ID+3 TAD (PROZEDURE TAD PROFUN DCA .+2 ENTER;00 /FUNCTION OR PROCEDURE TAD T DCA J OFTAB;NORMAL AND (7737 TAD [40 TOTAB;NORMAL INSYMBOL L0001 TAD LEVEL DCA .+5 PUSHJUMP;BLOCK FSYS+SET20 PROFUN, 0 0 IFSY;SEMICOLON;JMP .+4 ERROR;16 /14 SKP INSYMBOL TAD [40 TAD PROFUN DCA .+2 EMIT;00 /*** (32) OR (33) ***/ POPJUMP;PRODECL PAGE
/PROCEDURE S E L E C T O R / --------------- / /CALL: PUSHJUMP;SELECTOR / SETX / V /ADDRESS / /LOCAL VAR'S: FSYS SELVAR, 0 SELVTYP,0 SELVREF,0 SELXTYP,0 SELXREF,0 XSELECT, IFSYNOT;PERIOD;JMP SEL2 INSYMBOL /FIELD SELECTOR IFSY;IDENT;JMP .+4 ERROR;2 /2 JMP SEL5 TAD SELVTYP TAD [-RECORD SNA CLA JMP .+4 ERROR;37 /31 JMP SEL1 TAD SELVREF OFBTAB;LAST DCA J JMS ENTID JMS CHKID JMP .+5 OFTAB;LINK DCA J JMP .-5 TAD J SNA CLA ERROR;0 /0 WITHTABDO TAD TYP0 DCA SELVTYP TAD REF0 DCA SELVREF TAD ADR0 SNA JMP SEL1 DCA IRY EMIT;11 /*** (9) ***/ SEL1, INSYMBOL JMP SEL5 SEL2, IFSYNOT;LBRACK;ERROR;13 /11 SEL3, INSYMBOL PUSHJUMP;EXPRESSION FSYS+SET21 SELXTYP TAD SELVTYP TAD [-ARRAY SNA CLA JMP .+4 ERROR;34 /28 JMP SEL4 TAD SELVREF /ARRAY INDEX DCA JA OFATAB;INXTYP CIA TAD SELXTYP SNA CLA JMP .+4 ERROR;32 /26 JMP SEL6 TAD JA DCA IRY OFATAB;ELSIZE CLL RAR /1 SCOMPARES! SZA CLA L0001 TAD (24 DCA .+2 EMIT;00 /*** (20) OR (21) ***/ SEL6, OFATAB;ELTYP DCA SELVTYP OFATAB;ELREF DCA SELVREF SEL4, IFSY;COMMA;JMP SEL3 IFSY;RBRACK;JMP .+5 ERROR;14 /12 IFSY;RPARENT;INSYMBOL SEL5, SKIPIFSYIN;SET22 SKP JMP XSELECT TEST;FSYS;SET0;6 /6 POPJUMP;SELECTOR PAGE
/FUNCTION R E S U L T T Y P E / ------------------- / /CALL: TAD XTYP / MQL / TAD YTYP / RESULTTYPE / /RETURNS RESULTTYPE IN ACCUMULATOR XRESULT,0 SZA SWP SNA JMP I XRESULT TAD [-2 /HERE: XTYP<>0 AND YTYP<>0, XTYP IN AC SMA SZA JMP RES33 SWP /YTYP IN AC TAD [-2 SMA SZA JMP RES33 SNA /HERE ONLY INTS OR REALS, YTYP IN AC JMP .+5 /(7777 ... INTS, 0000 ... REALS) SWP SZA CLA JMP RES1 /INTS - INTS JMP .+5 /REALS - INTS SWP SNA CLA JMP .+5 /REALS - REALS L0001 /INTS - REALS DCA IRY EMIT;32 /*** (26,0) OR (26,1) ***/ IAC RES1, IAC JMP I XRESULT RES33, CLA CLL ERROR;41 /33 JMP I XRESULT
/PROCEDURE C A L L / ------- / /CALL: PUSHJUMP;CALL / SETX / I /VALUE / /LOCAL VAR'S (ON PAGE ZERO!): / FSYS / CALI, 0 / CALXTYP,0 / CALXREF,0 / CALASTP,0 / CALCP, 0 XCALL, TAD CALI DCA IRY EMIT;22 /*** (18,I) ***/ TAD CALI OFTAB;REF BSW AND [77 OFBTAB;LASTPAR DCA CALASTP TAD CALI DCA CALCP IFSYNOT;LPARENT;JMP CAL5 CAL1, INSYMBOL TAD CALASTP CIA TAD CALCP SMA CLA JMP CAL4-2 ISZ CALCP TAD CALCP OFTAB;NORMAL AND [40 SNA CLA JMP CAL3 PUSHJUMP;EXPRESSION /VALUE PARAMETER FSYS+SET23 CALXTYP TAD CALCP OFTAB;TYP AND [77 DCA TEMP TAD TEMP CIA TAD CALXTYP SZA CLA JMP CAL2 TAD CALCP OFTAB;REF BSW AND [77 CIA TAD CALXREF SZA CLA JMP CAL36 TAD CALXTYP TAD [-ARRAY SZA JMP .+5 TAD CALXREF OFATAB;SIZE JMP .+7 CLL RAR /6=RECORD SZA CLA JMP CAL4 TAD CALXREF OFBTAB;VSIZE DCA IRY EMIT;26 /*** (22,SIZE) ***/ JMP CAL4 CAL2, L7777 /1=INTS TAD CALXTYP SZA CLA JMP .+10 L7776 /2=REALS TAD TEMP SZA CLA JMP .+4 EMIT;32 /*** (26,0) ***/ JMP CAL4 TAD CALXTYP SZA CLA JMP CAL36 JMP CAL4 PAGE CAL3, IFSY;IDENT;JMP .+4 /VARIABLE PARAMETER ERROR;2 /2 JMP CAL4 LOCATE DCA J INSYMBOL TAD J SNA CLA JMP CAL4 WITHTABDO L7777 /1=VARIABLE TAD OBJ0 SZA CLA ERROR;45 /37 TAD TYP0 DCA CALXTYP TAD REF0 DCA CALXREF TAD LEV0 DCA IRX TAD ADR0 DCA IRY TAD NORM0 SNA CLA IAC DCA .+2 EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/ SKIPIFSYIN;SET22 JMP .+5 PUSHJUMP;SELECTOR FSYS+SET23 CALXTYP TAD CALCP OFTAB;TYP AND [77 CIA TAD CALXTYP SZA CLA JMP CAL36 TAD CALCP OFTAB;REF BSW AND [77 CIA TAD CALXREF SZA CLA CAL36, ERROR;44 /36 JMP CAL4 ERROR;47 /39 CAL4, TEST;SET24;FSYS;6 /6 IFSY;COMMA;JMP CAL1 IFSY;RPARENT;JMP .+4 ERROR;4 /4 SKP INSYMBOL CAL5, TAD CALASTP CIA TAD CALCP SPA CLA ERROR;47 /39 TAD CALI OFTAB;REF DCA TEMP TAD TEMP BSW AND [77 OFTAB;PSIZE TAD (-1 DCA IRY EMIT;23 /*** (19,PSIZE-1) ***/ TAD TEMP AND [17 CIA TAD LEVEL SPA SNA CLA JMP CAL6 TAD LEVEL DCA IRX /SWAPPED CONTENTS OF IRX AND IRY HERE! TAD TEMP /(SEE INTERPRETER AT I03) AND [17 DCA IRY EMIT;3 /*** (3,LEV1,LEV2) ***/ CAL6, POPJUMP;CALL PAGE
/PROCEDURE S T A N D F C T / --------------- / /CALL: PUSHJUMP;STANDFCT / N /VALUE / /LOCAL VAR'S: FCTN, 0 /NUMBER OF STANDARD FUNCTION FCTJ, 0 XSTFUN, TAD FCTN TAD (-20 /-16 SMA SZA CLA JMP STF17 IFSY;LPARENT;JMP .+4 ERROR;11 /9 SKP INSYMBOL TAD J /J IS SET IN FACTOR DCA FCTJ PUSHJUMP;EXPRESSION FSYS+SET14 FACXTYP TAD FCTJ DCA J L7776 TAD FCTN SMA SZA CLA JMP STF1 /FCTN: 0,2 L0004 /4=FUNKTION BSW /(MUST INSERT OBJ TAD FACXTYP /ALONG WITH TYP!) TOTAB;TYP L7776 /2=REALS TAD FACXTYP SNA CLA ISZ FCTN JMP STF2 STF1, TAD FCTN TAD (-10 SPA SNA CLA JMP STF2 /FCTN: 4,5,6,7,8 L7777 /FCTN: 9,10,11, ... ,16 TAD FACXTYP /1=INTS SNA CLA EMIT;32 /*** (26,0) ***/ STF2, TAD (TSET TAD FCTN DCA TEMP TAD FACXTYP STL RAL TAD (SETTABLE DCA ARGXTYP TAD I TEMP CDF SETFIELD AND I ARGXTYP CDF COMPFIELD SNA CLA JMP STF3 TAD FCTN DCA IRY EMIT;10 /*** (8,N) ***/ JMP .+5 STF3, TAD FACXTYP SZA CLA ERROR;60 /48 IFSY;RPARENT;JMP .+4 ERROR;4 /4 SKP INSYMBOL STF4, OFTAB;TYP /(J STILL OKAY!?) AND [77 DCA FACXTYP POPJUMP;STANDFCT STF17, TAD FCTN DCA IRY EMIT;10 /*** (8,17) OR (8,18) OR (8,19) ***/ JMP STF4 /TABLE OF LEGAL ARGUMENT TYPES: TSET, 3000 /0 3000 3000 /2 3000 2000 /4 2000 /5 2600 /6 0200 /7 0200 /8 3000 /9 3000 3000 3000 3000 3000 3000 3000 /16 ARGXTYP,0 PAGE
/PROCEDURE F A C T O R / ----------- / /CALL: PUSHJUMP;FACTOR / SETX / X /ADDRESS / /LOCAL VAR'S (ON PAGE ZERO!): / FSYS / FACVAR, 0 / FACXTYP,0 / FACXREF,0 XFACTOR,DCA FACXTYP /0=NOTYP DCA FACXREF TEST;FACBGS;FSYS;72 /58 FAC1, SKIPIFSYIN;FACBGS POPJUMP;FACTOR IFSYNOT;IDENT;JMP FAC2 LOCATE DCA J INSYMBOL WITHTABDO TAD OBJ0 TAD (JMP I FACTABL DCA .+1 HLT FACTABL,FKON FVAR FTYP FPRO FFUN FKON, TAD TYP0 DCA FACXTYP DCA FACXREF TAD ADR0 DCA IRY L7777 /1=INTS TAD TYP0 CLL RAR /2=REALS SNA CLA IAC TAD (30 DCA .+2 EMIT;00 /*** (24,ADR) OR (25,ADR) ***/ JMP FAC3 FVAR, TAD TYP0 DCA FACXTYP TAD REF0 DCA FACXREF TAD LEV0 DCA IRX TAD ADR0 DCA IRY SKIPIFSYIN;SET22 JMP FVAR1 TAD NORM0 SNA CLA IAC DCA .+2 EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/ PUSHJUMP;SELECTOR FSYS FACXTYP TAD FACXTYP TAD [-4 /STANTYPS = NOTYP(0) ... CHAR(4) SPA SNA CLA EMIT;42 /*** (34) ***/ JMP FAC3 FVAR1, DCA .+11 /F=0 TAD FACXTYP TAD [-4 SPA SNA CLA ISZ .+5 /F:=F+1 (IN STANTYPS!) TAD NORM0 SNA CLA ISZ .+2 /F:=F+1 EMIT;00 /*** (F,LEV,ADR) ***/ JMP FAC3 FTYP, FPRO, ERROR;54 /44 JMP FAC3 FFUN, TAD TYP0 DCA FACXTYP TAD LEV0 SNA CLA JMP STFUN TAD J DCA .+4 PUSHJUMP;CALL FSYS 0 JMP FAC3 STFUN, TAD ADR0 DCA .+3 PUSHJUMP;STANDFCT 0 JMP FAC3 PAGE FAC2, SKIPIFSYIN;SET25 JMP FAC23 L7776 /2=CHARCON TAD SY SNA CLA JMP FAC21 L0001 TAD SY DCA FACXTYP /INTS OR REALS ENTERCONSTANT;NUM-1 DCA IRY EMIT;31 /*** (25,C) ***/ JMP FAC22 FAC21, L0004 /4=CHARS DCA FACXTYP TAD NUM+3 DCA IRY EMIT;30 /*** (24,NUM) ***/ FAC22, DCA FACXREF INSYMBOL JMP FAC3 FAC23, IFSYNOT;LPARENT;JMP FAC24 INSYMBOL PUSHJUMP;EXPRESSION FSYS+SET14 FACXTYP IFSY;RPARENT;JMP .+4 ERROR;4 /4 JMP FAC3 INSYMBOL JMP FAC3 FAC24, IFSYNOT;NOTSY;JMP FAC3 INSYMBOL PUSHJUMP;FACTOR FSYS FACXTYP L7775 /3=BOOLS TAD FACXTYP SZA CLA JMP .+4 EMIT;43 /*** (35) ***/ JMP FAC3 TAD FACXTYP SZA CLA ERROR;40 /32 FAC3, TEST;FSYS;FACBGS;6 /6 JMP FAC1 PAGE
/PROCEDURE T E R M / ------- / /CALL: PUSHJUMP;TERM / SETX / X /ADDRESS / /LOCAL VAR'S: FSYS TRMXTYP,0 TRMYTYP,0 TRMYREF,0 TRMOP, 0 XTERM, TAD TRMXTYP DCA .+4 PUSHJUMP;FACTOR FSYS+SET26 0 TRM1, SKIPIFSYIN;SET26 POPJUMP;TERM TAD SY DCA TRMOP INSYMBOL PUSHJUMP;FACTOR FSYS+SET26 TRMYTYP TAD TRMOP TAD (JMP I OPTABL-TIMES DCA .+1 HLT OPTABL, XTIMES XIDIV XRDIV XIMOD XAND XTIMES, TAD I TRMXTYP MQL TAD TRMYTYP RESULTTYPE DCA I TRMXTYP TAD I TRMXTYP SNA JMP TRM1 /NOTYP TAD (-1 SZA CLA TAD (12-3 /REALS TAD (3 /INTS DCA IRY EMIT;60 /*** (48,3) OR (48,12) ***/ JMP TRM1 XRDIV, L0001 DCA IRY L7777 /1=INTS TAD I TRMXTYP SZA CLA JMP .+5 EMIT;32 /*** (26,1) ***/ L0002 /2=REALS DCA I TRMXTYP DCA IRY L7777 /1=INTS TAD TRMYTYP SZA CLA JMP .+5 EMIT;32 /*** (26,0) ***/ L0002 /2=REALS DCA TRMYTYP L7776 /2=REALS TAD I TRMXTYP SZA CLA JMP XNOTYP-1 L7776 TAD TRMYTYP SZA CLA JMP XNOTYP-1 TAD (13 DCA IRY EMIT;60 /*** (48,13) ***/ JMP TRM1 XIDIV, XIMOD, L7777 /1=INTS TAD I TRMXTYP SZA CLA JMP XNOTYP-2 L7777 TAD TRMYTYP SZA CLA JMP XNOTYP-2 TAD TRMOP CLL RAR DCA IRY EMIT;60 /*** (48,4) OR (48,5) ***/ JMP TRM1 XAND, L7775 /3=BOOLS TAD I TRMXTYP SZA CLA JMP XNOTYP L7775 TAD TRMYTYP SZA CLA JMP XNOTYP EMIT;64 /*** (52) ***/ JMP TRM1 CLA IAC IAC XNOTYP, TAD [40 DCA ERRTYP TAD I TRMXTYP SZA CLA TAD TRMYTYP SZA CLA ERROR ERRTYP, 00 /32, 33 OR 34 DCA I TRMXTYP /0=NOTYP JMP TRM1 PAGE
/PROCEDURE S I M P L E E X P R E S S I O N / ------------------------------- / /CALL: PUSHJUMP;SIMPLEEXPRESSION / SETX / X /ADDRESS / /LOCAL VAR'S: FSYS SIMXTYP,0 SIMYTYP,0 SIMYREF,0 SIMOP, 0 XSIMPLE,SKIPIFSYIN;SET8 JMP SIM1 TAD SY DCA SIMOP INSYMBOL TAD SIMXTYP DCA .+4 PUSHJUMP;TERM FSYS+SET8 0 L7776 /2=REALS TAD I SIMXTYP SPA SNA CLA JMP .+4 ERROR;41 /33 JMP SIM2 TAD SIMOP TAD (-MINUS SNA CLA EMIT;44 /*** (36) ***/ JMP SIM2 SIM1, TAD SIMXTYP DCA .+4 PUSHJUMP;TERM FSYS+SET27 0 SIM2, SKIPIFSYIN;SET27 POPJUMP;SIMPLEEXPRESSION TAD SY DCA SIMOP INSYMBOL PUSHJUMP;TERM FSYS+SET27 SIMYTYP TAD SIMOP TAD (-ORSY SZA CLA JMP SIM3 L7775 /3=BOOLS TAD I SIMXTYP SZA CLA JMP NOTBOOL L7775 TAD SIMYTYP SZA CLA JMP NOTBOOL EMIT;63 /*** (51) ***/ JMP SIM2 NOTBOOL,TAD I SIMXTYP SZA CLA TAD SIMYTYP SZA CLA ERROR;40 /32 DCA I SIMXTYP /0=NOTYP JMP SIM2 SIM3, TAD I SIMXTYP MQL TAD SIMYTYP RESULTTYPE DCA I SIMXTYP TAD I SIMXTYP SNA JMP SIM2 CLL RAR /NOW: 0...INTS, 1...REALS! SZA CLA TAD (7 TAD [-4 TAD SIMOP /+ ... 5, - ... 6 DCA IRY EMIT;60 /*** (48,1) OR (48,2) OR (48,10) OR (48,11) ***/ JMP SIM2 PAGE
/PROCEDURE E X P R E S S I O N / ------------------- / /CALL: PUSHJUMP;EXPRESSION / SETX / X /ADDRESS / /LOCAL VAR'S: FSYS EXPRVAR,0 XTYP, 0 XREF, 0 YTYP, 0 YREF, 0 OP, 0 XEXPRESSION, PUSHJUMP;SIMPLEEXPRESSION FSYS+SET28 XTYP SKIPIFSYIN;SET28 POPJUMP;EXPRESSION TAD SY DCA OP INSYMBOL PUSHJUMP;SIMPLEEXPRESSION FSYS YTYP L7776 /2=REALS TAD XTYP SNA JMP EXPR1 TAD [-2 /2+2=4=CHARS SMA SZA CLA JMP EXPR1 TAD XTYP CIA TAD YTYP SNA CLA JMP IEXPR EXPR1, L0001 DCA IRY L7777 /1=INTS TAD XTYP SZA CLA JMP .+5 EMIT;32 /*** (26,1) ***/ L0002 /2=REALS DCA XTYP DCA IRY L7777 /1=INTS TAD YTYP SZA CLA JMP .+5 EMIT;32 /*** (26,0) ***/ L0002 /2=REALS DCA YTYP L7776 /2=REALS TAD XTYP SZA CLA JMP ILLTYP L7776 TAD YTYP SZA CLA JMP ILLTYP REXPR, L0001 IEXPR, TAD (61 DCA I61R62 TAD OP TAD (TAD RELTABL-EQL DCA .+1 0000 /TAD RELTABL (MODIFIED INSTR.!) DCA IRY EMIT I61R62, 00 /*** (49,OP) OR (50,OP) ***/ EXPR3, L0003 /3=BOOLS DCA XTYP POPJUMP;EXPRESSION ILLTYP, ERROR;43 /35 JMP EXPR3 RELTABL,SZA SNA SPA SNA SPA SMA SMA SZA PAGE
/PROCEDURE A S S I G N M E N T / ------------------- / /CALL: PUSHJUMP;ASSIGNMENT / LEV /VALUE / ADR /- " - / /LOCAL VAR'S: LV, 0 AD, 0 AXTYP, 0 AXREF, 0 AYTYP, 0 AYREF, 0 XASSIGNMENT, OFTAB;TYP /J IS SET IN STATEMENT AND [77 DCA AXTYP OFTAB;REF BSW AND [77 DCA AXREF TAD LV DCA IRX TAD AD DCA IRY OFTAB;NORMAL AND [40 SNA CLA IAC DCA .+2 EMIT;00 /*** (0,LV,AD) OR (1,LV,AD) ***/ SKIPIFSYIN;SET22 JMP .+5 PUSHJUMP;SELECTOR FSYS+SET29 AXTYP IFSY;BECOMES;JMP .+5 ERROR;63 /51 IFSY;EQL;INSYMBOL PUSHJUMP;EXPRESSION FSYS AYTYP TAD AXTYP CIA TAD AYTYP SZA CLA JMP ASS1 TAD AXTYP TAD [-ARRAY SPA CLA JMP ASS2-2 TAD AXREF /ARRAY- OR RECORD-VARIABLE CIA TAD AYREF SZA CLA JMP ASSERR TAD AXTYP TAD [-ARRAY SZA CLA JMP .+5 TAD AXREF /ARRAY OFATAB;SIZE JMP .+4 TAD AXREF /RECORD OFBTAB;VSIZE DCA IRY EMIT;27 /*** (23,SIZE) ***/ JMP ASS2 ASS1, L7776 /2=REALS TAD AXTYP SZA CLA JMP ASS3 L7777 /1=INTS TAD AYTYP SZA CLA JMP ASS3 EMIT;32 /*** (26,0) ***/ EMIT;46 /*** (38) ***/ ASS2, POPJUMP;ASSIGNMENT ASS3, TAD AXTYP SZA CLA TAD AYTYP SZA CLA ASSERR, ERROR;56 /46 JMP ASS2
/PROCEDURE C O M P O U N D S T A T E M E N T / --------------------------------- / /CALL: PUSHJUMP;COMPOUNDSTATEMENT /NO ARG'S! / /NO LOCAL VAR'S! XCOMPOUNDSTATEMENT, INSYMBOL PUSHJUMP;STATEMENT FSYS+SET30 SKIPIFSYIN;SET31 JMP CMP1 IFSY;SEMICOLON;JMP XCOMPOUNDSTATEMENT ERROR;16 /14 JMP XCOMPOUNDSTATEMENT+1 CMP1, IFSY;ENDSY;JMP .+4 ERROR;71 /57 SKP INSYMBOL POPJUMP;COMPOUNDSTATEMENT PAGE
/PROCEDURE C A S E L A B E L / ----------------- / /CALL: JMS CASELABEL /NOT RECURSIVE! / /LOCAL VAR'S: LAB, ZBLOCK 5 CASELABEL, 0 PUSHJUMP;CONSTANT FSYS+SET6 LAB TAD LAB CIA TAD I CCXTYP SZA CLA JMP LABERR TAD I CCI DCA XR11 TAD XR11 TAD CLIMIT SNA CLA FATALC, FATAL /TOO MUCH CASE-LABELS! SIGNEDINTEGER;LAB DCA TEMP TAD TEMP DCA I XR11 TAD LC DCA I XR11 TAD XR11 DCA I CCI TAD CTABM1 DCA XR11 TAD I XR11 ISZ XR11 CIA TAD TEMP SZA CLA JMP .-5 TAD XR11 CIA TAD I CCI SZA CLA ERROR;1 /1 JMP I CASELABEL LABERR, ERROR;57 /47 JMP I CASELABEL CCI, CI CCXTYP, CXTYP CLIMIT, -2^CSMAX-CASETAB+1 CTABM1, CASETAB-1
/PROCEDURE C A S E S T A T E M E N T / ------------------------- / /CALL: PUSHJUMP;CASESTATEMENT /NO ARG'S! / /LOCAL VAR'S: CASETAB, ZBLOCK CSMAX^2 EXITTAB, ZBLOCK CSMAX CXTYP, 0 CXREF, 0 CLC1, 0 CI, 0 CJ, 0 XCASESTATEMENT, INSYMBOL TAD (CASETAB-1 DCA CI TAD (EXITTAB-1 DCA CJ PUSHJUMP;EXPRESSION FSYS+SET34 CXTYP L7776 /2=REALS TAD CXTYP SNA JMP .+3 TAD [-2 /2+2=4=CHARS (LAST STANTYP) SMA SZA CLA ERROR;27 /23 TAD LC DCA CLC1 EMIT;14 /*** (12) ***/ IFSY;OFSY;JMP CAS1 ERROR;10 /8 SKP CAS1, INSYMBOL PUSHJUMP;ONECASE IFSY;SEMICOLON;JMP CAS1 TAD CLC1 TOCODE TAD (CASETAB-1 DCA XR11 CAS2, TAD XR11 CIA TAD CI SNA CLA JMP CAS3 TAD I XR11 DCA IRY EMIT;15 /*** (13) ***/ JMP CAS2 CAS3, EMIT;12 /*** (10) ***/ TAD (EXITTAB-1 DCA XR11 CAS4, TAD XR11 CIA TAD CJ SNA CLA JMP CAS5 TAD I XR11 TOCODE JMP CAS4 CAS5, IFSY;ENDSY;JMP .+4 ERROR;71 /57 SKP INSYMBOL POPJUMP;CASESTATEMENT
/PROCEDURE O N E C A S E / ------------- / /CALL: PUSHJUMP;ONECASE /NO ARG'S! / /NO LOCAL VAR'S! (USES SOME VAR'S OF 'CASESTATEMENT') XONECASE, SKIPIFSYIN;CONBGS JMP ONE2 SKP ONE1, INSYMBOL JMS CASELABEL IFSY;COMMA;JMP ONE1 IFSY;COLON;JMP .+4 ERROR;5 /5 SKP INSYMBOL PUSHJUMP;STATEMENT FSYS+SET30 ISZ CJ TAD LC DCA I CJ EMIT;12 /*** (10) ***/ ONE2, POPJUMP;ONECASE PAGE
/PROCEDURE I F S T A T E M E N T / --------------------- / /CALL: PUSHJUMP;IFSTATEMENT /NO ARG'S! / /LOCAL VAR'S: IXTYP, 0 IXREF, 0 ILC1, 0 ILC2, 0 XIFSTATEMENT, INSYMBOL PUSHJUMP;EXPRESSION FSYS+SET32 IXTYP TAD IXTYP SNA JMP .+5 TAD [-BOOLS SZA CLA ERROR;21 /17 TAD LC DCA ILC1 EMIT;13 /*** (11) ***/ IFSY;THENSY;JMP .+5 ERROR;64 /52 IFSY;DOSY;INSYMBOL PUSHJUMP;STATEMENT FSYS+SET33 IFSYNOT;ELSESY;JMP IF1 INSYMBOL TAD LC DCA ILC2 EMIT;12 /*** (10) ***/ TAD ILC1 TOCODE /*** CODE[ILC1] := LC ***/ PUSHJUMP;STATEMENT FSYS TAD ILC2 TOCODE /*** CODE[ILC2] := LC ***/ POPJUMP;IFSTATEMENT IF1, TAD ILC1 JMP .-4 /*** CODE[ILC1] := LC ***/
/PROCEDURE R E P E A T S T A T E M E N T / ----------------------------- / /CALL: PUSHJUMP;REPEATSTATEMENT /NO ARG'S! / /LOCAL VAR'S: RXTYP, 0 RXREF, 0 RLC1, 0 XREPEAT,TAD LC DCA RLC1 INSYMBOL PUSHJUMP;STATEMENT FSYS+SET35 SKIPIFSYIN;SET31 JMP REP1 IFSY;SEMICOLON;JMP XREPEAT+2 ERROR;16 /14 JMP XREPEAT+3 REP1, IFSYNOT;UNTILSY;JMP REPERR INSYMBOL PUSHJUMP;EXPRESSION FSYS RXTYP TAD RXTYP SNA JMP .+5 TAD [-BOOLS SZA CLA ERROR;21 /17 TAD RLC1 DCA IRY EMIT;13 /*** (11,RLC1) ***/ JMP .+3 REPERR, ERROR;65 /53 POPJUMP;REPEATSTATEMENT
/PROCEDURE W H I L E S T A T E M E N T / --------------------------- / /CALL: PUSHJUMP;WHILESTATEMENT /NO ARG'S! / /LOCAL VAR'S (ON PAGE ZERO!): / WXTYP, 0 / WXREF, 0 / WLC1, 0 / WLC2, 0 XWHILESTATEMENT, INSYMBOL TAD LC DCA WLC1 PUSHJUMP;EXPRESSION FSYS+SET36 WXTYP TAD WXTYP SNA JMP .+5 TAD [-BOOLS SZA CLA ERROR;21 /17 TAD LC DCA WLC2 EMIT;13 /*** (11) ***/ IFSY;DOSY;JMP .+4 ERROR;66 /54 SKP INSYMBOL PUSHJUMP;STATEMENT FSYS TAD WLC1 DCA IRY EMIT;12 /*** (10,WLC1) ***/ TAD WLC2 TOCODE /*** CODE[WLC2] := LC ***/ POPJUMP;WHILESTATEMENT PAGE
/PROCEDURE F O R S T A T E M E N T / ----------------------- / /CALL: PUSHJUMP;FORSTATEMENT /NO ARG'S! / /LOCAL VAR'S: FXTYP, 0 FXREF, 0 CVT, 0 FLC1, 0 FLC2, 0 FF, 0 XFORSTATEMENT, INSYMBOL IFSYNOT;IDENT;JMP FOR2 LOCATE DCA J INSYMBOL TAD J SNA CLA JMP FOR1+2 WITHTABDO L7777 /1=VARIABLE TAD OBJ0 SZA CLA JMP FOR1 TAD TYP0 DCA CVT TAD LEV0 DCA IRX TAD ADR0 DCA IRY EMIT;0 /*** (0,LEV,ADR) ***/ L7776 /2=REALS TAD CVT SNA JMP .+3 TAD [-2 /2+2=4=CHARS (LAST STANTYP) SMA SZA CLA ERROR;22 /18 JMP FOR3 FOR1, ERROR;45 /37 L0001 /1=INTS DCA CVT JMP FOR3 FOR2, SKIP;FSYS+SET37;2 /2 FOR3, IFSYNOT;BECOMES;JMP FOR4 INSYMBOL PUSHJUMP;EXPRESSION FSYS+SET38 FXTYP TAD FXTYP CIA TAD CVT SZA CLA ERROR;23 /19 JMP FOR5 FOR4, SKIP;FSYS+SET38;63 /51 FOR5, TAD (16 /14 DCA FF SKIPIFSYIN;SET39 JMP FOR6 IFSY;DOWNTOSY;L0002 TAD (16 DCA FF INSYMBOL PUSHJUMP;EXPRESSION FSYS+SET36 FXTYP TAD FXTYP CIA TAD CVT SZA CLA ERROR;23 /19 JMP FOR7 FOR6, SKIP;FSYS+SET36;67 /55 FOR7, TAD LC DCA FLC1 TAD FF DCA .+2 EMIT;00 /*** (14) OR (16) ***/ IFSY;DOSY;JMP .+4 ERROR;66 /54 SKP INSYMBOL TAD LC DCA FLC2 PUSHJUMP;STATEMENT FSYS TAD FLC2 DCA IRY L0001 TAD FF DCA .+2 EMIT;00 /*** (15,FLC2) OR (17,FLC2) ***/ TAD FLC1 TOCODE /*** CODE[FLC1] := LC ***/ POPJUMP;FORSTATEMENT PAGE
/PROCEDURE S T A N D P R O C / ----------------- / /CALL: PUSHJUMP;STANDPROC / I /VALUE / /LOCAL VAR'S: PRCN, 0 SPXTYP, 0 SPXREF, 0 SPYTYP, 0 SPYREF, 0 XSTPROC,TAD PRCN TAD (JMP I STPRTAB-1 DCA .+1 HLT STPRTAB,SPREAD SPREAD SPWRITE SPWRITE SPHALT SPASCII SPREAD, IFSYNOT;LPARENT;JMP SPR3 SPR1, INSYMBOL IFSY;IDENT;JMP .+4 ERROR;2 /2 JMP SPR2 LOCATE DCA J INSYMBOL TAD J SNA CLA JMP SPR2 WITHTABDO L7777 /1=VARIABLE TAD OBJ0 SNA CLA JMP .+4 ERROR;45 /37 JMP SPR2 TAD TYP0 DCA SPXTYP TAD REF0 DCA SPXREF TAD LEV0 DCA IRX TAD ADR0 DCA IRY TAD NORM0 SNA CLA IAC DCA .+2 EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/ SKIPIFSYIN;SET22 JMP .+5 PUSHJUMP;SELECTOR FSYS+SET24 SPXTYP L7775 /3=BOOLS TAD SPXTYP SNA JMP SPR2-2 TAD (-1 /4=CHARS (LAST STANTYP) SMA SZA CLA JMP SPR2-2 TAD SPXTYP DCA IRY EMIT;33 /*** (27,TYP) ***/ JMP SPR2 ERROR;50 /40 SPR2, TEST;SET24;FSYS;6 /6 IFSY;COMMA;JMP SPR1 IFSY;RPARENT;JMP .+4 ERROR;4 /4 SKP INSYMBOL SPR3, L7776 /-2 TAD PRCN SNA CLA EMIT;76 /*** (62) ***/ POPJUMP;STANDPROC
SPASCII,IFSYNOT;LPARENT;JMP SPASC2 SPASC1, INSYMBOL PUSHJUMP;EXPRESSION FSYS+SET24 SPXTYP L7777 /1=INTS TAD SPXTYP SZA CLA ERROR;53 /43 EMIT;75 /*** (61) ***/ IFSY;COMMA;JMP SPASC1 IFSY;RPARENT;JMP .+4 ERROR;4 /4 SKP INSYMBOL SPASC2, POPJUMP;STANDPROC SPHALT, EMIT;45 /*** (37) ***/ POPJUMP;STANDPROC PAGE
SPWRITE,IFSYNOT;LPARENT;JMP SPW5 SPW1, INSYMBOL IFSYNOT;STRING;JMP SPW2 TAD SLENG DCA IRY EMIT;30 /*** (24,SLENG) ***/ TAD NUM+3 DCA STRNUM INSYMBOL IFSYNOT;COLON;JMP SPW1A INSYMBOL PUSHJUMP;EXPRESSION FSYS+SET24 SPYTYP L7777 /1=INTS TAD SPYTYP SZA CLA ERROR;53 /43 JMP .+3 SPW1A, EMIT;30 /*** (24,0) ***/ TAD STRNUM DCA IRY EMIT;34 /*** (28,NUM) ***/ JMP SPW4 STRNUM, 0 SPW2, PUSHJUMP;EXPRESSION FSYS+SET23 SPXTYP TAD SPXTYP TAD [-CHARS SMA SZA CLA ERROR;51 /41 IFSYNOT;COLON;JMP SPW3+1 INSYMBOL PUSHJUMP;EXPRESSION FSYS+SET23 SPYTYP L7777 /1=INTS TAD SPYTYP SZA CLA ERROR;53 /43 IFSYNOT;COLON;JMP SPW3 L7776 /2=REALS TAD SPXTYP SZA CLA ERROR;52 /42 INSYMBOL PUSHJUMP;EXPRESSION FSYS+SET24 SPYTYP L7777 /1=INTS TAD SPYTYP SZA CLA ERROR;53 /43 EMIT;37 /*** (31) ***/ JMP SPW4 SPW3, L0001 TAD (35 DCA .+4 TAD SPXTYP DCA IRY EMIT;00 /*** (29,TYP) OR (30,TYP) ***/ SPW4, IFSY;COMMA;JMP SPW1 IFSY;RPARENT;JMP .+4 ERROR;4 /4 SKP INSYMBOL SPW5, TAD PRCN TAD [-4 SNA CLA EMIT;77 /*** (63) ***/ POPJUMP;STANDPROC PAGE
/PROCEDURE S T A T E M E N T / ----------------- / /CALL: PUSHJUMP;STATEMENT / SETX / /NO LOCAL VAR'S! XSTATEMENT, SKIPIFSYIN;SET40 JMP STAT2 IFSYNOT;IDENT;JMP STAT1 LOCATE DCA J INSYMBOL TAD J SNA CLA JMP STAT2 WITHTABDO TAD OBJ0 TAD JMPOBJ DCA .+1 HLT OBJTABL,IDCON IDVAR IDTYP IDPRO IDFUN JMPOBJ, JMP I OBJTABL IDCON, IDTYP, ERROR;55 /45 JMP STAT2 IDVAR, TAD LEV0 DCA .+5 TAD ADR0 DCA .+4 PUSHJUMP;ASSIGNMENT 0 0 JMP STAT2 IDPRO, TAD LEV0 SNA CLA JMP IDPRO1 TAD J DCA .+4 PUSHJUMP;CALL FSYS 0 JMP STAT2 IDPRO1, TAD ADR0 DCA .+3 PUSHJUMP;STANDPROC 0 JMP STAT2 IDFUN, OFDISPLAY CIA TAD REF0 SZA CLA JMP IDTYP L0001 TAD LEV0 DCA .+3 PUSHJUMP;ASSIGNMENT 0 0000 /ALWAYS 0! JMP STAT2 STAT1, TAD SY TAD STATNO DCA .+2 PUSHJUMP;00 STAT2, TEST;FSYS;SET0;16 /14 POPJUMP;STATEMENT STATNO, COMPOUNDSTATEMENT-BEGINSY
/PROCEDURE B L O C K / --------- / /CALL: PUSHJUMP;BLOCK / SETX / ISFUN /VALUE / LEVEL /VALUE / /LOCAL VAR'S (ON PAGE ZERO!): / FSYS / ISFUN, 0 / LEVEL, 0 / DX, 0 / PRT, 0 / PRB, 0 MAXLEV, -LMAX /CONSTANT TOFAT5, FATAL5 C0005, 5 BLK1, BLO1 BLK2, BLO2 BLK2M2, BLO2-2 XBLOCK, TAD C0005 DCA DX TAD T DCA PRT TAD LEVEL TAD MAXLEV SMA SZA CLA JMP I TOFAT5 /TOO MUCH LEVELS! TEST;SET41;FSYS;7 /7 ENTERBLOCK TAD B TODISPLAY TAD B DCA PRB TAD PRT WITHTABDO DCA TYP0 /0=NOTYP TAD PRB DCA REF0 ENDWITH IFSY;LPARENT;PUSHJUMP;PARAMETERLIST TAD PRB DCA JB TAD T TOBTAB;LASTPAR TAD DX TOBTAB;PSIZE TAD ISFUN SNA CLA JMP I BLK2 IFSYNOT;COLON;JMP I BLK2M2 INSYMBOL IFSYNOT;IDENT;JMP I BLK1 LOCATE DCA J INSYMBOL TAD J SNA CLA JMP BLO2 OFTAB;OBJ BSW AND [77 TAD [-2 /2=TYPE1 SNA CLA JMP .+4 ERROR;35 /29 JMP BLO2 OFTAB;TYP AND [77 DCA TEMP TAD TEMP TAD [-4 SPA SNA CLA JMP .+4 ERROR;17 /15 JMP BLO2 TAD PRT DCA J L0003 /3=PROZEDURE TAD ISFUN BSW TAD TEMP TOTAB;TYP JMP BLO2 BLO1, SKIP;FSYS+SET20;2 /2 JMP BLO2 ERROR;5 /5 BLO2, IFSY;SEMICOLON;JMP .+4 ERROR;16 /14 SKP INSYMBOL BLO3, IFSY;CONSTSY;PUSHJUMP;CONDECL IFSY;TYPESY;PUSHJUMP;TYPDECL IFSY;VARSY;PUSHJUMP;VARDECL TAD PRB DCA JB TAD DX TOBTAB;VSIZE BLO4, SKIPIFSYIN;SET42 JMP .+4 PUSHJUMP;PRODECL JMP BLO4 TEST;SET43;SET44;70 /56 SKIPIFSYIN;STATBGS JMP BLO3 TAD PRT DCA J TAD LC TOTAB;ADR BLO5, INSYMBOL PUSHJUMP;STATEMENT FSYS+SET30 SKIPIFSYIN;SET31 JMP BLO6 IFSY;SEMICOLON;JMP BLO5 ERROR;16 /14 JMP BLO5+1 BLO6, IFSY;ENDSY;JMP .+4 ERROR;71 /57 SKP INSYMBOL TEST;FSYS+SET45;SET0;6 /6 POPJUMP;BLOCK PAGE
/M A C R O - I N S T R U C T I O N S : /P U S H J U M P /RECURSIVE CALL OF COMPILER PROCEDURES /CALL: PUSHJUMP;NAME /P O P J U M P /RETURN FROM PROCEDURE /CALL: POPJUMP;NAME /LOCAL, 0 /START OF LOCAL VARIABLES - 1 /LENGTH, 0 / - NO. OF LOC'S TO PUSH (EXCL. FSYS) /PARAM, 0 /NO. OF PARAMETERS + 4000 (IF 1ST ONE IS A SET) PSTART, 0 /STARTING ADDRESS OF PROCEDURE PPP, 0 /STACK POINTER (POINTS ALWAYS TO 1ST FREE LOC.) CONTROL,0 CLL RTL TAD (PUSHTABLE-1 DCA XR10 CDF SETFIELD TAD I XR10 DCA LOCAL TAD I XR10 DCA LENGTH TAD I XR10 DCA PARAM TAD I XR10 DCA PSTART CDF COMPFIELD JMP I CONTROL PUSH, 0 CDF PUSHFIELD DCA I PPP CDF COMPFIELD ISZ PPP JMP I PUSH FATAL8, FATAL /PROGRAMM TOO COMPLEX ---> STACK FULL! POP, 0 L7777 TAD PPP DCA PPP CDF PUSHFIELD TAD I PPP CDF COMPFIELD JMP I POP XPUSHJ, 0 TAD I XPUSHJ ISZ XPUSHJ JMS CONTROL TAD LENGTH SNA CLA JMP PUFSYS TAD LOCAL DCA XR10 TAD I XR10 JMS PUSH /PUSH LOCAL VARIABLES (IF ANY) ISZ LENGTH JMP .-3 PUFSYS, TAD PARAM SMA CLA JMP GETPAR L3777 /FSYS-1 DCA XR10 TAD [-5 DCA LENGTH CDF SETFIELD TAD I XR10 JMS PUSH /PUSH FSYS (IF NECESSARY) ISZ LENGTH JMP .-4 GEFSYS, L4000 /GET SET-ARGUMENT (IF PRESENT) DCA SETA TAD I XPUSHJ SPA DCA SETA /<0: FSYS OR SETX ONLY TAD SETA />0: FSYS+SETX DCA SETB ISZ XPUSHJ UNION SETA, FSYS SETB, SET0 FSYS GETPAR, TAD PARAM /GET PARAMETERS AND [77 SNA JMP RECALL CIA DCA LENGTH TAD LOCAL DCA XR10 TAD I XPUSHJ ISZ XPUSHJ DCA I XR10 ISZ LENGTH JMP .-4 JMS VARIN /PASS VAR-PARAMETERS (IF ANY) RECALL, TAD XPUSHJ JMS PUSH /PUSH RETURN ADDRESS JMP I PSTART /AND J U M P TO PROCEDURE XPOPJUMP,0 TAD I XPOPJUMP JMS CONTROL JMS POP /GET RETURN ADDRESS DCA PSTART TAD PARAM SMA CLA JMP POVAR TAD (FSYS+4 DCA PUSH /(MIS)USE THIS FREE LOC. TAD [-5 DCA CONTROL JMS POP /POP FSYS (IF IT WAS PUSHED) CDF SETFIELD DCA I PUSH L7777 TAD PUSH DCA PUSH ISZ CONTROL JMP .-7 CDF COMPFIELD POVAR, JMS VARTM /TEMP. STORE VAR-PARAMETERS TAD LENGTH SNA JMP I PSTART CIA TAD LOCAL DCA PUSH JMS POP /POP LOCAL VARIABLES (IF ANY) DCA I PUSH L7777 TAD PUSH DCA PUSH ISZ LENGTH JMP .-6 JMS VAREX /PASS VAR-PARAMETERS (IF ANY) JMP I PSTART /R E T U R N PAGE
/M A C R O - I N S T R U C T I O N S : /O F D I S P L A Y /AC := DISPLAY[LEVEL] /T O D I S P L A Y /DISPLAY[LEVEL] := AC /O F T A B /AC := TAB[AC].SEL, IF AC=0 GET TAB[J].SEL /T O T A B /TAB[J].SEL := AC /O F A T A B /AC := ATAB[AC].SEL, IF AC=0 GET ATAB[JA].SEL /T O A T A B /ATAB[JA].SEL := AC /O F B T A B /AC := BTAB[AC].SEL, IF AC=0 GET BTAB[JB].SEL /T O B T A B /BTAB[JB].SEL := AC /W I T H T A B D O /GET AND UNPACK TAB[AC] OR TAB[J] /E N D W I T H /PACK AND STORE UNPACKED ENTRY OF TAB XOFDISP,0 TAD (DISPLAY TAD LEVEL DCA QQ TAD I QQ JMP I XOFDISP XTODISP,0 MQL TAD (DISPLAY TAD LEVEL DCA QQ MQA DCA I QQ JMP I XTODISP XOFTAB, 0 SNA TAD J CLL RTL TAD I XOFTAB DCA QQ ISZ XOFTAB CDF TABLEFIELD TAD I QQ CDF COMPFIELD JMP I XOFTAB XTOTAB, 0 MQL TAD J CLL RTL TAD I XTOTAB DCA QQ ISZ XTOTAB CDF TABLEFIELD MQA DCA I QQ CDF COMPFIELD JMP I XTOTAB XOFATAB,0 SNA TAD JA CLL RAL CLL RTL TAD I XOFATAB DCA QQ ISZ XOFATAB CDF TABLEFIELD TAD I QQ CDF COMPFIELD JMP I XOFATAB QQ=. XTOATAB,0 MQL TAD XTOATAB DCA XTOTAB TAD JA CLL RAL JMP XTOTAB+3 XOFBTAB,0 SNA TAD JB CLL RTL TAD I XOFBTAB DCA QQ ISZ XOFBTAB CDF TABLEFIELD TAD I QQ CDF COMPFIELD JMP I XOFBTAB XTOBTAB,0 MQL TAD XTOBTAB DCA XTOTAB TAD JB JMP XTOTAB+3 XWITHTAB,0 SNA TAD J CLL RTL DCA JW /SYMBOL TABLE STARTS AT 0000 ! TAD JW DCA XR10 CDF TABLEFIELD TAD I JW DCA LINK0 TAD I XR10 MQL MQA BSW AND [77 DCA OBJ0 MQA AND [77 DCA TYP0 TAD I XR10 MQL MQA BSW AND [77 DCA REF0 MQA AND [40 DCA NORM0 MQA AND [17 DCA LEV0 TAD I XR10 DCA ADR0 CDF COMPFIELD JMP I XWITHTAB XENDWITH,0 TAD JW DCA XR10 CDF TABLEFIELD TAD LINK0 DCA I JW TAD OBJ0 BSW TAD TYP0 DCA I XR10 TAD REF0 BSW TAD NORM0 TAD LEV0 DCA I XR10 TAD ADR0 DCA I XR10 CDF COMPFIELD JMP I XENDWITH PAGE
/M A C R O - I N S T R U C T I O N S : /W I T H A T A B D O /GET AND UNPACK ATAB[JA] /E N D A W I T H /PACK AND STORE UNPACKED ENTRY OF ATAB /E M I T /EMIT INTERMEDIATE CODE (F,IRX,IRY) /CALL: EMIT;F /T O C O D E /CODE[AC].IRY := LC /E N T E R C O N S T A N T /ENTER REAL OR INTEGER INTO CONSTANT TABLE /CALL: ENTERCONSTANT;ADDRESS-1 XWITHATAB,0 TAD JA CLL RAL CLL RTL TAD (ATAB DCA JAW TAD JAW DCA XR10 TAD [-7 DCA QR TAD (DCA INXTP0 DCA .+3 CDF TABLEFIELD TAD I XR10 0000 /DCA INXTP0 (MODIFIED INSTR.!) ISZ .-1 ISZ QR JMP .-4 CDF COMPFIELD JMP I XWITHATAB XENDAW, 0 TAD JAW DCA XR10 TAD [-7 DCA QR TAD (TAD INXTP0 DCA .+2 CDF TABLEFIELD 0000 /TAD INXTP0 (MODIFIED INSTR.!) DCA I XR10 ISZ .-2 ISZ QR JMP .-4 CDF COMPFIELD JMP I XENDAW XEMIT, 0 TAD LC CLL RAL DCA XTOCODE TAD I XEMIT /GET OP-CODE BSW TAD IRX CDF CODEFIELD DCA I XTOCODE ISZ XTOCODE TAD IRY DCA I XTOCODE CDF COMPFIELD ISZ LC TAD LC TAD (-CMAX SMA SZA CLA FATAL6, FATAL /PROGRAM TOO LONG! DCA IRX DCA IRY JMP I XEMIT QR=. XTOCODE,0 STL RAL DCA XEMIT CDF CODEFIELD TAD LC DCA I XEMIT CDF COMPFIELD JMP I XTOCODE CENTRY=XWITHATAB CTEMP=XENDAW FOUR=XEMIT XENTCON,0 TAD I XENTCON DCA XR10 ISZ XENTCON TAD C TAD [-4 DCA CENTRY TAD SX STL RAR CIA TAD CENTRY SPA CLA FATAL3, FATAL /TOO MUCH CONSTANTS! TAD [-4 DCA FOUR TAD CENTRY DCA XR12 TAD I XR10 CDF TABLEFIELD DCA I XR12 CDF COMPFIELD ISZ FOUR JMP .-5 TAD CENTRY DCA CTEMP CDF TABLEFIELD SEARCH, L0004 TAD CTEMP DCA CTEMP TAD CTEMP TAD (-ATAB+1 SMA CLA JMP NOTFOUND TAD [-4 DCA FOUR TAD CENTRY DCA XR10 TAD CTEMP DCA XR12 TAD I XR10 CIA TAD I XR12 SZA CLA JMP SEARCH ISZ FOUR JMP .-6 TAD CTEMP /FOUND JMP .+4 NOTFOUND,TAD CENTRY DCA C TAD CENTRY CDF COMPFIELD JMP I XENTCON PAGE
/M A C R O - I N S T R U C T I O N S : /E N T E R /ENTER OBJEJT INTO SYMBOL TABLE /CALL: ENTER;OBJ /E N T E R V A R I A B L E /E N T E R B L O C K /E N T E R A R R A Y /S I G N E D I N T E G E R /MAKE 12-BIT SIGNED INTEGER OF CONSTANT /CALL: SIGNEDINTEGER;ADDRESS-1 XENTER, 0 TAD T TAD (-TMAX SMA CLA FATAL1, FATAL /SYMBOL TABLE FULL! JMS ENTID OFDISPLAY OFBTAB;LAST DCA J TAD J DCA L JMS CHKID JMP .+5 OFTAB;LINK DCA J JMP .-5 TAD J SNA CLA JMP .+4 ERROR;1 /1 JMP I XENTER ISZ T TAD T JMS ENTID TAD I XENTER MQL L3777 TAD T STL RTL /4*T - 1 DCA XR10 CDF TABLEFIELD TAD L /LINK DCA I XR10 MQA BSW /OBJ, TYP (0=NOTYP) DCA I XR10 TAD LEVEL /REF=0, NORMAL=0, LEVEL DCA I XR10 DCA I XR10 /ADR=0 CDF COMPFIELD OFDISPLAY DCA JB TAD T TOBTAB;LAST JMP I XENTER XENTVAR,0 IFSY;IDENT;JMP .+4 ERROR;2 /2 JMP I XENTVAR ENTER;VARIABLE INSYMBOL JMP I XENTVAR XENTBLO,0 TAD B TAD (-BMAX SMA CLA FATAL2, FATAL /TOO MUCH BLOCKS! ISZ B TAD B DCA JB TOBTAB;LAST TOBTAB;LASTPAR JMP I XENTBLO ATP=XENTBLO XENTARR,0 DCA ATP TAD LO CIA TAD HI SPA CLA ERROR;33 /27 TAD A TAD (-AMAX SMA CLA FATAL4, FATAL ISZ A TAD A DCA JA TAD ATP TOATAB;INXTYP TAD LO TOATAB;LOW TAD HI TOATAB;HIGH JMP I XENTARR XSGNINT,0 L0001 /LINK=0! TAD I XSGNINT ISZ XSGNINT DCA XR10 TAD I XR10 SZA TAD [4000 /LINK=1? ---> NEGATIVE SZA CLA JMP ERR49 TAD I XR10 SZA CLA JMP ERR49 TAD I XR10 SPA JMP ERR49 SZL CIA JMP I XSGNINT ERR49, ERROR;61 /49 JMP I XSGNINT PAGE
/-------- D I S P L A Y --------/ / *7400 IFNZRO DISPLAY-. <PARALLEL DEFINED IN FIELD 0 AND FIELD 4 !!!> 1 /DISPLAY[0] := 1 ZBLOCK 17 /---------------------------------/ /M A C R O - I N S T R U C T I O N S : /L O C A T E /LOCATE IDENTIFIER IN SYMBOL TABLE /EXITS WITH TABLE INDEX IN AC /E N T I D /TAB[AC].NAME := ID /C H K I D /SKIP IF TAB[J].NAME <> ID /G E T C O N S T A N T /NUM := CTAB[AC] XLOCATE,0 TAD LEVEL DCA L JMS ENTID NSCOPE, TAD L TAD (TAD DISPLAY DCA .+1 0000 /TAD DISPLAY (MODIFIED INSTR.!) OFBTAB;LAST DCA J JMS CHKID JMP .+5 OFTAB;LINK DCA J JMP .-5 L7777 TAD L DCA L TAD J SZA JMP I XLOCATE TAD L SMA CLA JMP NSCOPE ERROR;0 0 JMP I XLOCATE ENTID, 0 CLL RTL TAD (-1 DCA XR10 CDF NAMEFIELD TAD ID DCA I XR10 TAD ID+1 DCA I XR10 TAD ID+2 DCA I XR10 TAD ID+3 DCA I XR10 CDF COMPFIELD JMP I ENTID CHKID, 0 TAD J CLL RTL TAD (-1 DCA XR10 CDF NAMEFIELD TAD I XR10 CIA TAD ID SZA CLA JMP NOTEQL TAD I XR10 CIA TAD ID+1 SZA CLA JMP NOTEQL TAD I XR10 CIA TAD ID+2 SZA CLA JMP NOTEQL TAD I XR10 CIA TAD ID+3 SZA CLA NOTEQL, ISZ CHKID CDF COMPFIELD JMP I CHKID XOFCONST,0 DCA XR10 CDF TABLEFIELD TAD I XR10 DCA NUM TAD I XR10 DCA NUM+1 TAD I XR10 DCA NUM+2 TAD I XR10 DCA NUM+3 CDF COMPFIELD JMP I XOFCONST XERROR, 0 CLA CLL TAD I XERROR CIF SETFIELD JMS I (F3ERROR JMP I XERROR XFATAL, 0 TAD XFATAL CDF CIF SETFIELD JMP I (F3FATAL XINSYMBOL,0 CDF CIF 0 JMP I (INSY0 EXSY3, DCA SY JMP I XINSYMBOL PAGE
/M A C R O - I N S T R U C T I O N S : /T E S T S E M I C O L O N /S K I P /CALL: SKIP;SETX;N /T E S T /CALL: TEST;SETX;SETY;N /S K I P I F S Y I N /CALL: SKIPIFSYIN;SETX /I F S Y /CALL: IFSY;SYMBOL /I F S Y N O T /CALL: IFSYNOT;SYMBOL /U N I O N /CALL: UNION;SET1;SET2;S1US2 XTSTSEM,0 IFSY;SEMICOLON;JMP .+6 ERROR;16 /14 SKIPIFSYIN;SET6 SKP INSYMBOL TEST;SET7;FSYS;6 /6 JMP I XTSTSEM XSKIP, 0 TAD I XSKIP JMS FSYSUSETX DCA .+11 ISZ XSKIP TAD I XSKIP DCA .+2 ERROR;00 /N SKP INSYMBOL SKIPIFSYIN;00 JMP .-3 JMP I XSKIP XTEST, 0 TAD I XTEST JMS FSYSUSETX DCA .+3 ISZ XTEST SKIPIFSYIN;00 SKP JMP XTST1 TAD .-3 DCA S1 TAD I XTEST JMS FSYSUSETX DCA S2 ISZ XTEST UNION S1, 0 S2, 0 S1US2 TAD I XTEST DCA .+3 SKIP;S1US2;00 /N XTST1, ISZ XTEST JMP I XTEST FSYSUSETX, 0 SPA JMP I FSYSUSETX TAD [4000 DCA .+3 UNION FSYS 0 S1US2 TAD .-1 JMP I FSYSUSETX INSET, 0 TAD SY CLL RAL TAD (SETTABLE DCA S2 TAD I INSET ISZ INSET CDF SETFIELD TAD I S2 DCA S1 /ADDRESS OF RELATIVE SET WORD ISZ S2 /ADDRESS OF BIT POS. REL. TO SY TAD I S1 AND I S2 SZA CLA ISZ INSET CDF COMPFIELD JMP I INSET XIFSY, 0 TAD SY CIA TAD I XIFSY SZA CLA ISZ XIFSY ISZ XIFSY JMP I XIFSY XIFSYNOT,0 TAD SY CIA TAD I XIFSYNOT SNA CLA ISZ XIFSYNOT ISZ XIFSYNOT JMP I XIFSYNOT XSA=XIFSY /NORMAL LOC. XSB=XR10 /AUTO INDEX XSU=XR12 / - " - FIVE=XIFSYNOT XUNION, 0 TAD I XUNION DCA XSA ISZ XUNION L7777 TAD I XUNION DCA XSB ISZ XUNION L7777 TAD I XUNION DCA XSU ISZ XUNION TAD [-5 DCA FIVE CDF SETFIELD TAD I XSA CMA AND I XSB TAD I XSA DCA I XSU ISZ XSA ISZ FIVE JMP .-7 CDF COMPFIELD JMP I XUNION PAGE
/L O N G E R R O R M E S S A G E S FIELD 6 *0 ZBLOCK 73 /ERROR COUNTERS 7777 /GUARD ERRSUM, 0 /NUMBER OF DETECTED ERRORS *100 /ADDRESS LIST OF ERROR MESSAGES E00 E01 E02 E03 E04 E05 E06 E07 E08 E09 E10 E11 E12 E13 E14 E15 E16 E17 E18 E19 E20 E21 E22 E23 E24 E25 E26 E27 E28 E29 E30 E31 E32 E33 E34 E35 E36 E37 E38 E39 E40 E41 E42 E43 E44 E45 E46 E47 E48 E49 E50 E51 E52 E53 E54 E55 E56 E57 E58 *200 EXPLAIN,CLA CLL TAD ERRSUM SNA CLA JMP EXCOMP JMS ECRLF JMS ECRLF TAD (EHEAD DCA ETEXT JMS EMESG JMS ECRLF JMS ECRLF DCA ENN SKP ELINE, ISZ ENN TAD I ENN SPA JMP EXOS8 SNA CLA /SKP CLA ---> PRINT ALL! JMP ELINE CLA IAC BSW /L0100 TAD ENN DCA ETEXT TAD I ETEXT DCA ETEXT JMS EMESG JMS ECRLF JMP ELINE FXPLAIN,CLA CLL TAD ERRSUM SZA CLA JMP EXPLAIN+5 EXOS8, CLA CLL JMS ECRLF CDF CIF 0 JMP I (7605 ENN, 0 EXCOMP, JMS ECRLF JMS ECRLF TAD (EOKAY DCA ETEXT JMS EMESG JMS ECRLF JMS ECRLF CDF CIF 60 JMP I (INIT /INITIALIZE RUNTIME SYSTEM EPRINT, 0 TLS TSF JMP .-1 CLA CLL JMP I EPRINT ECRLF, 0 TAD (215 JMS EPRINT TAD (212 JMS EPRINT JMP I ECRLF EMESG, 0 TAD I ETEXT BSW JMS EASCII TAD I ETEXT JMS EASCII ISZ ETEXT JMP EMESG+1 EASCII, 0 AND (77 SNA JMP I EMESG TAD (240 AND (77 TAD (240 JMS EPRINT JMP I EASCII ETEXT, 0 EOKAY, TEXT /KOMPILATION EINWANDFREI!/ EHEAD, TEXT /ERKLAERUNG DER FEHLER:/ PAGE
/L O N G E R R O R M E S S A G E S / /(MADE INVISIBLE BY 'XLIST' TO SAVE PAPER IN ASSEMBLY LISTING!) XLIST E00,TEXT / 0 DIESER NAME WURDE NICHT VEREINBART./ E01,TEXT / 1 NAME IM GUELTIGKEITSBEREICH MEHRFACH VEREINBART./ E02,TEXT / 2 NAME FEHLT!/ E03,TEXT / 3 JEDES PROGRAMM MUSS MIT DEM WORTSYMBOL 'PROGRAM' BEGINNE/ *.-1 TEXT /N./ E04,TEXT / 4 RUNDE RECHTSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./ E05,TEXT / 5 DOPPELPUNKT FEHLT. IN VEREINBARUNGEN FOLGT DEM : EIN TYP/ *.-1 TEXT /NAME./ E06,TEXT / 6 SYNTAXFEHLER! ANGEZEIGTES SYMBOL HIER NICHT KORREKT./ E07,TEXT / 7 LISTE DER FORMALPARAMETER FEHLERHAFT (NAME ODER WORTSYMB/ *.-1 TEXT /OL 'VAR')./ E08,TEXT / 8 DAS WORTSYMBOL 'OF' FEHLT./ E09,TEXT / 9 RUNDE LINKSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./ E10,TEXT /10 TYPVEREINBARUNG FEHLERHAFT (NAME, 'ARRAY' ODER 'RECORD')./ E11,TEXT /11 ECKIGE LINKSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./ E12,TEXT /12 ECKIGE RECHTSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./ E13,TEXT /13 SYMBOL .. FEHLT (LEERZEICHEN ZWISCHEN DEN PUNKTEN UNZULA/ *.-1 TEXT /ESSIG)./ E14,TEXT /14 STRICHPUNKT FEHLT!/ E15,TEXT /15 FUNKTIONSWERT KANN NUR VOM TYP INTEGER, REAL, BOOLEAN OD/ *.-1 TEXT /ER CHAR SEIN./ E16,TEXT /16 SYMBOL = FEHLT (IN VEREINBARUNGEN IST := UNZULAESSIG)./ E17,TEXT /17 NACH 'IF', 'WHILE' ODER 'UNTIL' MUSS EIN BOOL'SCHER AUSD/ *.-1 TEXT /RUCK STEHEN./ E18,TEXT /18 ZAEHLVARIABLE BEI 'FOR'-ANWEISUNG MUSS VOM TYP INTEGER, / *.-1 TEXT /CHAR ODER BOOLEAN SEIN./ E19,TEXT /19 ANFANGSWERT, ENDWERT UND ZAEHLVARIABLE MUESSEN VOM GLEIC/ *.-1 TEXT /HEN TYP SEIN./ E20,TEXT /20 DER STANDARDNAME 'OUTPUT' MUSS IM PROGRAMMKOPF GESCHRIEB/ *.-1 TEXT /EN WERDEN./ E21,TEXT /21 ZAHL IST ZU GROSS! (MAXINT=34359738367, REALS ABS. KLEIN/ *.-1 TEXT /ER ALS 1.0E+308)/ E22,TEXT /22 PUNKT AM PROGRAMMENDE FEHLT! (WORTSYMBOLE 'BEGIN' UND 'E/ *.-1 TEXT /ND' NICHT PAARWEISE?)/ E23,TEXT /23 AUSDRUCK NACH 'CASE' MUSS VOM TYP INTEGER, CHAR ODER BOO/ *.-1 TEXT /LEAN SEIN./ E24,TEXT /24 ILLEGALES ZEICHEN!/ E25,TEXT /25 BEI KONSTANTENVEREINBARUNG MUSS NACH = EINE KONSTANTE OD/ *.-1 TEXT /. EIN KONST.NAME STEHEN./ E26,TEXT /26 DER AUSDRUCK FUER EINEN FELD-INDEX MUSS VOM VEREINBARTEN/ *.-1 TEXT / INDEX-TYP SEIN./ E27,TEXT /27 BEREICHSGRENZEN BEI FELDVEREINBARUNG FEHLERHAFT (UG<=OG?/ *.-1 TEXT / GLEICHER TYP?)/ E28,TEXT /28 JEDE INDIZIERTE VARIABLE MUSS ALS ARRAY VEREINBART WERDE/ *.-1 TEXT /N./ E29,TEXT /29 TYPNAME FEHLT (IN PARAMETERLISTEN SIND ALLG. TYPVEREINBA/ *.-1 TEXT /RUNGEN VERBOTEN)./ E30,TEXT /30 DIESER TYP WURDE NICHT VEREINBART./ E31,TEXT /31 JEDE VARIABLE MIT KOMPONENTEN-SELEKTOR MUSS ALS RECORD V/ *.-1 TEXT /EREINBART WERDEN./ E32,TEXT /32 'NOT', 'AND' UND 'OR' VERLANGEN OPERANDEN VOM TYP BOOLEA/ *.-1 TEXT /N./ E33,TEXT /33 TYP DIESES AUSDRUCKS UNBESTIMMT (GANZES ARRAY IN ARITHM./ *.-1 TEXT /OPERATIONEN UNZULAESSIG)./ E34,TEXT /34 'DIV' UND 'MOD' VERLANGEN OPERANDEN VOM TYP INTEGER./ E35,TEXT /35 TYPEN DER VERGLEICHSOPERANDEN UNVERTRAEGLICH./ E36,TEXT /36 AKTUAL- UND FORMALPARAMETER MUESSEN VOM GLEICHEN TYP SEI/ *.-1 TEXT /N./ E37,TEXT /37 VARIABLE ERFORDERLICH!/ E38,TEXT /38 EIN STRING MUSS MINDESTENS EIN ZEICHEN ENTHALTEN./ E39,TEXT /39 ANZAHL DER AKTUAL- UND FORMALPARAMETER MUSS UEBEREINSTIM/ *.-1 TEXT /MEN./ E40,TEXT /40 STANDARDPROZEDUR READ NUR FUER TYP INTEGER, REAL UND CHA/ *.-1 TEXT /R VORGESEHEN./ E41,TEXT /41 BEI WRITE SIND NUR DIE TYPEN INTEGER, REAL, BOOLEAN UND / *.-1 TEXT /CHAR ZULAESSIG./ E42,TEXT /42 WRITE(X:M:N) IST NUR FUER WERTE VOM TYP REAL ZULAESSIG./ E43,TEXT /43 M UND N BEI WRITE(X:M:N) MUESSEN INTEGER-AUSDRUECKE SEIN./ E44,TEXT /44 TYP- ODER PROZEDURNAMEN SIND IN AUSDRUECKEN UNZULAESSIG./ E45,TEXT /45 EINE ANWEISUNG KANN NICHT MIT EINEM KONST-, TYP- ODER FU/ *.-1 TEXT /NKTIONSNAMEN BEGINNEN./ E46,TEXT /46 TYPUNVERTRAEGLICHKEIT BEI WERTZUWEISUNG./ E47,TEXT /47 'CASE'-MARKEN MUESSEN VOM GLEICHEN TYP WIE DER 'CASE'-AU/ *.-1 TEXT /SDRUCK SEIN./ E48,TEXT /48 TYP DES ARGUMENTS BEI DIESER STANDARDFUNKTION UNZULAESSI/ *.-1 TEXT /G./ E49,TEXT /49 ARRAY-INDIZES UND 'CASE'-MARKEN SIND AUF -2048 < X < 204/ *.-1 TEXT /8 BEGRENZT./ E50,TEXT /50 EINE KONSTANTE KANN NICHT MIT DEM BEZEICHNETEN SYMBOL BE/ *.-1 TEXT /GINNEN./ E51,TEXT /51 SYMBOL := FEHLT (LEERZEICHEN ZWISCHEN : UND = UNZULAESSI/ *.-1 TEXT /G)./ E52,TEXT /52 DAS WORTSYMBOL 'THEN' FEHLT./ E53,TEXT /53 DAS WORTSYMBOL 'UNTIL' FEHLT./ E54,TEXT /54 DAS WORTSYMBOL 'DO' FEHLT./ E55,TEXT /55 DAS WORTSYMBOL 'TO' ODER 'DOWNTO' FEHLT./ E56,TEXT /56 DAS WORTSYMBOL 'BEGIN' FEHLT./ E57,TEXT /57 DAS WORTSYMBOL 'END' FEHLT./ E58,TEXT /58 EIN FAKTOR MUSS MIT NAME, KONSTANTE, 'NOT' ODER LINKSKLA/ *.-1 TEXT /MMER BEGINNEN./ XLIST
/R U N T I M E E R R O R S (ALWAYS FATAL!) *DISPLAY /-------- D I S P L A Y --------/ ZBLOCK 20 /---------------------------------/ XHALT, 0 CLA CLL TAD ZPRINT DCA PTPRINT /SWITCH TO TERMINAL OUTPUT! TAD (HLTLIST-1 DCA HTEXT ISZ HTEXT TAD I HTEXT TAD XHALT SZA CLA JMP .-4 ISZ HTEXT TAD I HTEXT DCA HTEXT CRLF CRLF JMS HMESG TAD (HLTAT DCA HTEXT JMS HMESG L0001 DCA M L7777 TAD PC LOAD JMS IOUT CRLF JMP I OS8 HMESG, 0 TAD I HTEXT SNA JMP I HMESG BSW JMS ASCII TAD I HTEXT JMS ASCII ISZ HTEXT JMP HMESG+1 HTEXT, 0 HLTLIST,-ERROR0-1; HLT0 -ERROR1-1; HLT1 -ERROR2-1; HLT2 -ERROR3-1; HLT3 -ERROR4-1; HLT4 -ERRORA-1; HLTA -ERRORB-1; HLTB -ERRORC-1; HLTC -ERRORD-1; HLTD HLT0, TEXT /DIVISION BY 0 / HLT1, TEXT /UNDERFLOW / HLT2, TEXT /OVERFLOW/ HLT3, TEXT /SQRT/ HLT4, TEXT /LN/ HLTA, TEXT /MEMORY FULL / HLTB, TEXT / INDEX/ HLTC, TEXT /CASE/ HLTD, TEXT /FILE/ HLTAT, TEXT / ERROR AT / PAGE
/I N I T I A L I Z A T I O N OF R U N T I M E - S Y S T E M INIT, CLA CLL CDF 10 TAD I (7621 CDF 0 SNA CLA /IF INPUT FILE SPECIFIED JMP INITKB TAD IIDEVH /THEN SETUP FILE INPUT DCA I (IDEVH TAD IIBLOCK DCA I (IBLOCK TAD (JMP ERRORD DCA I (FATAL0 TAD (IBUFFER DCA I (IBP L7775 DCA I (IC3 TAD (GETC SKP INITKB, TAD (XREAD /ELSE KEYBOARD INPUT DCA I (PTREAD CDF 10 TAD I (7600 CDF 0 SNA CLA /IF OUTPUT FILE SPECIFIED JMP INITPR TAD (I37 /THEN SETUP FILE OUTPUT DCA I (PTI37 TAD (PUTC SKP INITPR, TAD (XPRINT /ELSE USE PRINTER DCA I (PTPRINT TAD (XHALT DCA I (PTHALT /ACTIVATE RUNTIME ERRORS INITDH, CDF 60 /TRANSFER DEVICE HANDLER(S) TAD I F6T0 /AND RUNTIME ERROR ROUTINE CDF 0 /TO THEIR PLACE IN FIELD 0 DCA I F6T0 ISZ F6T0 ISZ C1200 JMP .-6 INITST, TAD (CDF CIF 0 /CHANGE STARTING ADDRESS DCA I (7744 /TO START OF INTERPRETER TAD (ISTART DCA I (7745 DCA I (7746 /CORRECT JOB STATUS WORD CDF 10 /(MAKE IT RESTARTABLE) TAD I (7643 AND (20 /CHECK /H - OPTION CDF CIF 0 SZA CLA JMP I (7600 /RETURN TO OS8 MONITOR JMP I (ISTART /START INTERPRETER IIDEVH, 0 IIBLOCK,0 F6T0, IDEVBUF C1200, -1200 PAGE