X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Fpass2.pa;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Fpass2.pa;h=0a6b273ff5a9480891abcfa4217919923d78dc51;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/os8/v3d/sources/fortran/all/pass2.pa b/sw/os8/v3d/sources/fortran/all/pass2.pa new file mode 100644 index 0000000..0a6b273 --- /dev/null +++ b/sw/os8/v3d/sources/fortran/all/pass2.pa @@ -0,0 +1,4679 @@ +/3 OS/8 FORTRAN (PASS TWO) +/ +/ VERSION 4A PT 16-MAY-77 +/ +/ OS/8 FORTRAN COMPILER - PASS 2 +/ +/ BY: HANK MAURER +/ UPDATED BY: R. LARY + M. HURLEY +/ +/ +/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +VERSON=4 + /SEE F4.PA FOR LIST OF MAINTENANCE RELEASE CHANGES -S.R. +/ALSO, ADDED SAFETY CDF 0 TO BUMP ROUTINE TO FIX BUG +/MASSAGED LINK IN THAT AREA TO GET ROOM +/ALSO, +/ FIXED BUG RE DN ERROR PRINTING WRONG LINE NUMBER +/ +/ +/CHANGES FOR OS/8 V3D AND OS/78 BY P.T. +/.PATCH LEVEL FOR PASS2 IS IN LOCATION 327 + + IFNDEF OVERLY + IFNZRO OVERLY + *2 /V3C +TEM, 1 /V3C +LINENO, 1 /LINE NUMBER +VERS, -VERSON /VERSION NUMBER +ERRPTR, 5001 /POINTER TO THE ERROR LIST +FILDEV, 0 /THIS IS THE FILE DESCRIPTOR +FILBLK, 0 /FOR RALF +X10, COMREG-1 /INTER PASS COM REGION +X11, 0 +X12, 0 +X13, 0 +X14, 0 +X15, 0 +X16, 0 +X17, 0 /AUTO INDEX REGISTERS +ENTRY, 0 /THINGS USED BY SYMBOL + /TABLE FIDDLER +OENTRY, 0 +BUCKET, 0 +TYPE, 0 +TEMP, 0 /GENERAL TEMPS +TEMP2, 0 +ARG1, 0 /ARGS AND TYPES +BASE1, 0 +TYPE1, 0 +ARG2, 0 +BASE2, 0 +TYPE2, 0 +TMPCNT, 1 /TEMP COUNT +TMPMAX, 0 /MAX TEMP COUNT +LITNUM, 0 /LITERAL DISPLACEMENT + TMPBLK=2 + OUBUF=4400 + COMREG=4600 + STACK1=4700 + OVRLAY=5000 + NPOVLY=700 + XRBUFR=6600 + STACK=7000 /STACK-5 CAN'T BE 0 + INBUF=7200 + NPPAS3=1600 +ARG, 0 /TEMP FOR CODE +AC, 0 /AC FOR MULTIPLY ROUTINE +XR, 0 /XR CHAR FOR OADDR +MQ, 0 /MQ FOR MULTIPLY ROUTINE +XRNUM, 0 /TEMP USED IN XR STUFF +WHATAC, 0 /POINTER TO VAR +WHATBS, 0 /JUST STORED +FREEXR, 0 /NUMBER OF FREE + /INDEX REG +DIMPTR, 0 /POINTER TO DIM INFO + /AFTER GETSS +NARGS, 0 /ARG COUNT FOR SS VAR + /COMPILE +GLABEL, 1 /GENERATED LABEL COUNTER +STKLVL, STACK /STACK LEVEL (CHANGED + /BY DO) +COMMA, 254 /, +PLUS, 253 /+ +IFLABL, 0 /HOLDS LABEL FOR LOG IF +DOTEMP, 7000 /DO LOOP TEMP COUNTER +BINARY, 0 /BINARY IO=1, FORMATTED=0 +INPUT, 0 /INPUT=1 OUTPUT=0 FOR IO STMTS +PROGNM, 0 /POINTER TO PROG/FUNC NAME +FUNCTN, 0 /0=MAIN, 1=FUNC, -2=SUBR +ARGLST, 0 /POINTER TO ARG LIST +DATASW, 0 /=1 IF THIS IS A DATA STMT +GCTEMP, 0 /TEMP USED BY GENCAL +EXTLIT, 0 /EXTERNAL LITERALS LIST +ELCNT, 0 /AND COUNT +IOLOOP, 0 /IO LOOP SWITCH +ARGIO, 0 /ARG IO SWITCH +F1LNAM, 0617;2224;2216;2415 /FILE NAME FORTRN.TM +DEVH, 7607 /DEVICE HANDLER ADDRESS +ACSWIT, 0 /IS NON ZERO IF CALLING AN ARG +IOSTMT, 0 /SET 1 IF IN IO STMT + /(FOR IMPLIED LOOPS) +FMODE, 1 /1 IF IN F OR D MODE (0 IF E) +ASFSWT, 0 /1 IF ASF PROLOG, -1 IF + /ASF END, 0 OTHER +JSRLBL, 0 /LABEL NUMBER FOR CALLS TO ARGS +DPUSED, 0 /=1 IF DP HARDWARE USED +QM4, -4 +Q260, 260 +QTTYOU, TTYOUT +QERMSG, ERMSG +QNEXT, NEXT +QNEXTM, NEXT-2 +QUCODE, UCODE +QCODE, CODE +QINWOR, INWORD +QONUMB, ONUMBR +QSAVEA, SAVEAC +Q6M3, +Q5, 5 +QGENCO, GENCOD +QM6, -6 +QOPCOD, OPCOD +QOPCDE, OPCODE +QOADDR, OADDR +Q17, 17 +QTTYMS, TTYMSG +QXRTBL, XRTABL +QCHKXR, CHEKXR +QGENSF, GENSTF +QGENSE, GENSTE +QOSNUM, OSNUM +QCRLF, CRLF +QOTAB, OTAB +QOUTSY, OUTSYM +QGARG, GARG +Q20, 20 +Q40, 40 +QOUTNA, OUTNAM +QLITRL, LITRL +Q200, 200 +Q255, 255 +Q3, 3 +QOLABE, OLABEL +QGETSS, GETSS +Q256, 256 +QSAVAC, SAVACT +QSKPIR, SKPIRL +QGENCA, GENCAL +QLOADA, LOADA +QMUL12, MUL12 +QGARGS, GARGS +QOINS, OINS +QOCHAR, OCHAR +QNUMBR, NUMBRO +QXRBUF, XRBUFR +QTTYP2, TTYP2C +QTTCRL, TTCRLF +QM63, -63 +Q7605, 7605 +RELCD, 0 +QLABEL, NLABEL +P0F1, 5274 /101-2605 +P0F2, VERROR + / OUTPUT UTILTIY ROUTINES + PAGE +OCNT, +CRLF, 0 /OUTPUT CR LF + TAD (215 + JMS I QOCHAR + TAD (212 + JMS I QOCHAR + TAD (200 + KRS + TAD (-203 + SNA CLA + KSF /CHECK FOR ^C + JMP I CRLF + JMP I (7605 +NCHAR, +OSNUM, 0 /PRINT STMT NUMBER + IAC /SKIP POINTER WORD + DCA NAMPTR + TAD (6211 /ALWAYS IN FIELD 1 + DCA NAMCDF + TAD OSNUM /SAVE ENTRY POINT + DCA OUTNAM + TAD (243 /GET FIRST CHAR (ALWAYS #) + JMP L6201 /GO PRINT NAME +TTCHAR, +OUTSYM, 0 /PRINT OPCODE + DCA NAMPTR /SAVE POINTER TO STUFF + TAD L6201 /ALWAYS FIELD 0 + DCA NAMCDF + TAD OUTSYM /SAVE ENTRY + DCA OUTNAM + JMP NAMCDF /PRINT REST +ONUMT, +OUTNAM, 0 /OUTPUT NAME + DCA NAMPTR /SAVE ADDRESS OF NAME + RDF /GET FIELD OF NAME + TAD L6201 + DCA NAMCDF /SAVE AS CDF + TAD I NAMPTR /GET FIRST CHAR (ALREADY ASCII) + ISZ NAMPTR /SKIP OVER TYPE AND DIM PTR + ISZ NAMPTR +L6201, CDF + JMS I QOCHAR /OUTPUT CHAR + ISZ NAMPTR +NAMCDF, 0 + TAD I NAMPTR /GET NEXT TWO CHARS + CDF + SNA /IS NAME DONE ? + JMP I OUTNAM /YES + DCA NCHAR /SAVE TWO CHARS + TAD NCHAR + RTR /GET UPPER CHAR + RTR + RTR + TAD (240 + AND (77 + TAD (240 + JMS I QOCHAR /OUTPUT IT + TAD NCHAR /NOW DO LOWER + AND (77 + SNA + JMP I OUTNAM /NAME DONE + TAD (240 + AND (77 + TAD (240 + JMP L6201+1 /GO AND OUTPUT IT +ONUMBR, 0 /OUTPUT OCTAL NUMBER + DCA ONUMT /SAVE TEMPORARILY + TAD QM4 /4 DIGITS + DCA OCNT +OLOOP, TAD ONUMT + CLL RTL + RAL + DCA ONUMT + TAD ONUMT + RAL + AND (7 + TAD Q260 + JMS I QOCHAR + ISZ OCNT + JMP OLOOP + JMP I ONUMBR +TTYP2C, 0 /PRINT 2 CHARS ON THE TTY + DCA TTCHAR + TAD TTCHAR + RTR + RTR + RTR + JMS CONVRT + TAD TTCHAR + JMS CONVRT + JMP I TTYP2C +NAMPTR, +CONVRT, 6401 /CONVERT TO ASCII + AND (77 + SZA + TAD (240 + AND (77 + TAD (240 + JMS I QTTYOUT + JMP I CONVRT +TTCRLF, 0 + TAD (215 + JMS I QTTYOUT + TAD (212 + JMS I QTTYOUT + JMP I TTCRLF +TTYMSG, 0 /PRINT 2 CHAR ERROR MESSAGE + CDF + TAD I TTYMSG + ISZ TTYMSG /PRINT ERROR MESSAGE + JMS I QERMSG +FATAL, JMP I QNEXT /FATAL ERROR MESSAGE + TAD I FATAL + JMS I QERMSG + JMP I Q7605 /RETURN TO PS8 +DP2C1, TEXT '.+2,1' +NEG, JMS I QUCODE /NEGATE CODE + NEGTBL-1 + JMP I QNEXT + PAGE + / OPCODE JUMP TABLE + + TAD TEMP2 + SKP /CODE ALREADY READ +NEXT, JMS I QINWORD /GET NEXT INPUT WORD + TAD (XPUSH /INDEX INTO JUMP TABLE + DCA TEMP2 + CDF 10 + TAD I TEMP2 + CDF 0 + DCA TEMP2 /GET JUMP ADDRESS + JMP I TEMP2 /GO THERE + /OPTIMIZING RELATIONAL CODE FOR OS/8 F4 +/COMPLIMENTS OF R.L. + +LE, STL RTL /2 +LT, TAD QM4 /GENERATE -4 FOR LT, -2 FOR LE + JMP GE+1 /GO TO COMMON RELATIONAL CODE +GT, STL RTL +GE, IAC /GENERATE 1 FOR GE, 3 FOR GT + DCA RELCD /ALL THIS FUNNY STUFF IS BECAUSE SOME + JMS I QCODE /OF THE RELATIONAL SKELETONS OPTIMIZE BY + LETABL-6;5 /PERFORMING THE RELATIONAL ON THE NEGATIVE + TAD RELCD /OF THE FAC - WHEN THIS HAPPENS SPECIAL + SPA /CODE IN THE SKELETON DOES AN "ISZ RELCD", + CIA /CHANGING ABS(RELCD) TO ITS OPPOSITE RELATIONAL + JMP RELGEN /E.G. GE(1) TO LE(2), LE(-2) TO GE(-1) + +EQ, CLA IAC /SINCE EQ AND NE ARE SIGN-INDEPENDENT, +NE, DCA RELCD /WE DON'T NEED THAT KLUDGE BUT FOR COMPATIBILITY + JMS I QCODE /WITH RTPS THE OS/8 FORTRAN SYSTEM FUNCTION + EQTABL-6;5 /"#CEQ" WORKS THE WRONG WAY - IT PRODUCES + CLA IAC /A 1.0 IF THE COMPLEX AC WAS (0.,0.) + AND RELCD /AND A 0.0 OTHERWISE - SO WE HAVE TO REVERSE + SZA CLA /THE SENSE OF COMPLEX .EQ. AND .NE. RELATIONS. +RELGM1, TAD Q5 +RELGEN, DCA RELCD /STORE "FINAL" RELCD + JMS I QINWORD /GENTLY PROBE AHEAD IN THE INPUT + DCA TEMP2 + TAD TEMP2 + TAD (XPUSH-XLOGIF + SNA CLA /IF THIS WAS THE TOP RELATION OF A LOGICAL IF, + JMP LIFOPT /WE'RE IN A POSITION TO OPTIMIZE + TAD RELCD /OTHERWISE OUTPUT A CALL TO THE + CLL RAL /ROUTINE CORRESPONDING TO THE RELATIONAL + TAD (LTRNE + DCA .+3 + CLA IAC + JMS I (OJSR /GENERATE A JSA #XX + 0 + JMP I QNEXTM2 /PROCESS THE WHATCHIMACALLIT + +LIFOPT, TAD TYPE1 /SEE IF WE SHOULD GENERATE A "STARTF" FIRST + AND Q17 /ONLY WORRY ABOUT D.P. + TAD QM4 /SINCE THE ROUTINE #CEQ DOES A STARTF + DCA FMODE /FMODE=0 ONLY IF ARGS WERE D.P. + JMS I QGENSF /GENERATE STARTF IF NECESSARY + JMP I .+1 + LIFBGN+1 /GO TO LOGICAL IF PROCESSOR + +EQV, JMS I QCODE /.EQV. LOGICAL OPERATOR + EQVTBL-6;0 + JMP RELGM1 + / PASS TWO OUTPUT ROUTINE +OCHAR, 0 /OUTPUT A CHAR TO THE + /RALF INPUT FILE + AND (377 + DCA OUTEMP /SAVE CHAR + ISZ OUJUMP /BUMP THREE WAY SWITCH +OUJUMP, JMP . + JMP CHAR1 + JMP CHAR2 + TAD OUTEMP /HIGH FOUR BITS GO INTO + CLL RTL /THE HIGH ORDER BITS OF THE + RTL /FIRST WORD OF THE TWO WORD PAIR + AND (7400 /SEE NOTE * BELOW + TAD I OUPOLD /COMBINE WITH OTHER BITS + DCA I OUPOLD + TAD OUTEMP /THE OTHER FOUR BITS OF THIS CHAR + CLL RTR /GO INTO THE HIGH ORDER FOUR + RTR /BITS OF THE SECOND + /WORD OF THE PAIR + RAR + AND (7400 + TAD I OUPTR + DCA I OUPTR + TAD OUJMP /RESET 3 WAY BRANCH + DCA OUJUMP + ISZ OUPTR /BUMP BUFFER POINTER + ISZ OUWDCT /AND DOUBLE WORD COUNTER + JMP I OCHAR /BUFFER NOT FULL + JMS OUDUMP /DUMP IT + JMP I OCHAR +CHAR2, TAD OUPTR /SAVE FIRST WORD POINTER + DCA OUPOLD + ISZ OUPTR /GO TO SECOND WORD +CHAR1, TAD OUTEMP /STORE CHAR 1 OR 2 + DCA I OUPTR + JMP I OCHAR +OUTEMP, +OUDUMP, 0 /BUMP THE DUFFER + TAD OSIZE /ANY ROOM LEFT ? + SNA + JMP OUERR + IAC + DCA OSIZE /YES, ITS OK + JMS I DEVH /WRITE + 4200 /CONTROL WORD + OUBUF /BUFFER POINTER +OBLOCK, 0 /BLOCK NUMBER + JMP OUERR /ERROR + ISZ OBLOCK /INCREMENT BLOCK NUMBER + ISZ FILSIZ /AND FILE SIZE + TAD OBLOCK-1 /SET BUFFER POINTER + DCA OUPTR + TAD (-200 /SET DOUBLE WORD COUNT + DCA OUWDCT + JMP I OUDUMP +OUERR, JMS I (FATAL /FATAL OUTPUT ERROR + 1706 +/ * THE PONY EXPRESS STARTED IN 1860 AND ONLY RAN +/ FOR 19 MONTHS WHILE LOSING $200,000. +OUPOLD, 0 +OUPTR, OUBUF +OUJMP, JMP OUJUMP +OUWDCT, -200 +OSIZE, 0 +DD1, TEXT '1' + PAGE + / READ FROM FORTRN.TM + +INWORD, 0 /READ A WORD FROM INPUT FILE + ISZ INBCNT /ANYTHING LEFT IN BUFFER ? + JMP NOREAD /YES + ISZ INRCNT /ANYTHING LEFT IN FILE? + SKP + JMP I (END /NO, END OF PROG + JMS I DEVH /READ NEXT BLOCK +X200, 0200 + INBUF +INBLOK, 0 + JMP INERR /INPUT ERROR + ISZ INBLOK /BUMP BLOCK NUMBER + TAD (-400 /RESET COUNTER + DCA INBCNT + TAD INBLOK-1 /RESET POINTER + DCA INBPTR +NOREAD, TAD I INBPTR /GET WORD FROM BUFFER + ISZ INBPTR /BUMP BUFFER POINTER + JMP I INWORD +INERR, JMS I (FATAL /FATAL INPUT ERROR + 1105 +INBCNT, -1 /FORCE READ FIRST TIME +INBPTR, 0 +INRCNT, 0 + / CODE UTILITIES +GETSS, 0 /GET POINTER TO DIM INFO + CDF 10 + IAC + DCA DIMPTR /ADDR OF TYPE WORD + TAD I DIMPTR + ISZ DIMPTR /MOVE TO DIM/EQUIV POINTER + AND X200 /EQUIV INFO ? + SNA CLA + JMP .+3 /NONE + TAD I DIMPTR /SKIP EQUIV INFO + DCA DIMPTR + TAD I DIMPTR /ADDRESS OF DIM INFO + JMP I GETSS +NUMBRO, 0 /OUTPUT 15 BIT OCTAL NUMBER + TAD AC /IS HIGH DIGIT 0 ? + SNA + JMP .+3 /YES, PRINT 4 DIGITS ONLY + TAD Q260 /MAKE IT ASCII + JMS I QOCHAR /PUT IT + TAD MQ /NOW LOW FOUR DIGITS + JMS I QONUMBR + JMP I NUMBRO +UCODE, 0 /GEN CODE FOR UNARY OPERATORS + JMS I QSAVEAC /SAVE AC IF NEEDED + JMS GARG + JMP OTERR /OPERATOR/TYPE ERROR + TAD ARG1 /IS ARG IN AC ? + SNA CLA + TAD Q5 /YES, USE SECOND HALF OF TABLE + TAD TYPE1 + TAD I UCODE /PLUS TABLE ADDRESS + DCA USKEL + CDF 10 + TAD I USKEL /ADDR OF SKELETON + SNA + JMP OTERR /0 MEANS BAD + /OPERATOR/TYPE COMBO + DCA USKEL /SAVE SKELETON ADDR + JMS I QGENCOD /GO DO THE CODE +USKEL, 0 + DCA I X16 /RESULT IN AC + ISZ X16 /BUMP STACK POINTER + ISZ X16 /TYPE IS ALREADY THERE + ISZ UCODE /FIX RET ADDR + JMP I UCODE +GARG, 0 /GET ONE ARG + CLL CMA RTL /BACK UP ONE ENTRY + TAD X16 + DCA X16 + TAD X16 /USABLE POINTER + DCA X15 + TAD I X15 /GET OPERAND + DCA ARG1 + TAD I X15 + DCA TYPE1 + TAD I X15 + DCA BASE1 + TAD TYPE1 /CHECK TYPE + TAD QM6 + SMA CLA + JMP I GARG /TAKE ERROR EXIT + ISZ ARG2 /MAKE SURE ARG2 ISN'T ZERO + JMS I (MPTRA1 /MOVE THE POINTER IF + /THERE IS ONE + ISZ GARG + JMP I GARG + +TTYOUT, 0 /OUTPUT TO THE TTY + TLS + TSF + JMP .-1 + CLA + KSF + JMP I TTYOUT /NO KEYBOARD FLAG + KRB + AND (177 /ACCEPT PARITY ASCII + TAD (-3 /^C ? + SNA + JMP I Q7605 /YES, BACK TO PS8 + TAD (3-17 /^O ? + SZA CLA + JMP I TTYOUT /NO, RETURN + DCA TTYOUT+1 /KILL OUTPUT STUFF + DCA TTYOUT+2 + DCA TTYOUT+3 + JMP I TTYOUT /RETURN + LTRNE, TEXT '#NE' + TEXT '#GE' + TEXT '#LE' + TEXT '#GT' + TEXT '#LT' + TEXT '#EQ' + PAGE + / SOME TEXT + +P2, TEXT '+2' +XVAL, TEXT '#VAL' +DP4, TEXT '.+4' +FADD, TEXT 'FADD' +FLDA, TEXT 'FLDA' +FSUB, TEXT 'FSUB' + / SAVE AC ROUTINES +SAVACT, 0 /SAVE TOP OF STACK IF + /NECESSARY + TAD SAVACT /SAVE RETURN ADDR + DCA SAVEAC + CLL CMA RAL + JMP SAVEAC+2 /BACK UP ONLY ONE ENTRY +SAVEAC, 0 /STORE AC IF NEEDED + TAD (-5 /LOOK AT STACK TWO DOWN + TAD X16 + DCA SATEMP + TAD I SATEMP /IF 0, RESULT WAS LEFT IN AC + SZA CLA + JMP I SAVEAC /NO, NO STORE NEEDED + TAD TMPCNT /STORE TEMP NUMBER + DCA I SATEMP + ISZ SATEMP /MOVE TO TYPE WORD + TAD I SATEMP /GET TYPE + JMS SAVE /GO DO ACTUAL STORE + JMP I SAVEAC +SAVE, 0 /SAVE AC + DCA ACSTOR /THIS IS THE TYPE + TAD ACSTOR /IS IT COMPLEX OR DOUBLE? + TAD QM4 + SNA + JMP NOC /ITS DOUBLE + IAC + SZA CLA + JMP NOCORD /NO + JMS I QGENCOD /STARTE; FLDA #CAC + SEGCAC-1 +NOC, JMS ACSTOR /%FSTA #TMP+XXXX + JMS TMPBMP /THIS USE TWO TEMPS + JMP I SAVE +NOCORD, JMS ACSTOR /%FSTA #TMP+XXXX + JMP I SAVE + SATEMP, +ACSTOR, 0 /GENERATES FSTA TEMP+XXXX + JMS I QOPCOD /OUTPUT %FSTA %TEMP+XXXX + FSTA + JMS I QOADDR + TMPCNT /TMPCNT CONTAINS THE + /ARG NUMBER + JMS TMPBMP /BUMP TEMPORARY NUMBER + JMP I ACSTOR + +TMPBMP, 0 /ROUTINE TO BUMP TEMPORARIES + TAD TMPCNT /BIGGER THAN MAX? + CIA CLL + TAD TMPMAX + SZL CLA + JMP .+3 /GO BUMP TEMP CNT + TAD TMPCNT /NEW TEMP MAX + DCA TMPMAX + ISZ TMPCNT /INCR TEMP COUNT + JMP I TMPBMP + / PUSH ARG ONTO STACK +PUSH, JMS SAVEAC /GO SAVE AC IF NEEDED + JMS I QINWORD /GET ADDR OF NEW VAR + DCA TEMP /SAVE IT + TAD TEMP /PUSH IT + DCA I X16 + ISZ TEMP /GO TO TYPE + CDF 10 + TAD I TEMP /GET TYPE + CDF + AND Q17 /PUSH TYPE + DCA I X16 /ONTO STACK +CKPDL, DCA I X16 /ZERO BASE WORD + TAD X16 /IS STACK FULL ? + CIA CLL + TAD (STACK+177 + SZL CLA + JMP I QNEXT /NO, OK + TAD STKLVL /RESET STACK LEVEL + DCA X16 + JMS I QTTYMSG /PRINT MESSAGE + 2004 +DPUSH, JMS I QINWORD /GET THE VAR NAME PTR + DCA I X16 /PUSH IT + JMS I QINWORD /NOW GET THE DISPLACEMENT + JMP CKPDL-1 /GO CHECK FOR OVERFLOW +STARTF, TEXT 'STARTF' + / ARITHMETIC IF +ARTHIF, JMS I QUCODE /GET ARG INTO AC + AIFTBL-1 + JMS I QGENSF /DO ALL TRANSFERS IN FMODE + TAD (JLT /FIRST OPCODE + DCA AJUMP +AIFLUP, JMS I QINWORD /GET NEXT INPUT + DCA TEMP2 /SAVE IT IN CASE ITS NOT LABEL + TAD TEMP2 + CLL + TAD (XPUSH-XLAST /IS IT A LABEL ? + SNL CLA + JMP I QNEXTM2 /NO, PROCEED + JMS I QOPCDE +AJUMP, 0 /OUTPUT CORRECT JUMP + TAD TEMP2 + CDF 10 + JMS I QOSNUM /NOW THE LABEL + JMS I QCRLF + ISZ AJUMP /MOVE TO NEXT OPCODE + ISZ AJUMP + JMP AIFLUP +DOT, TEXT '.' +DP8, TEXT '.+10' + PAGE + / PICK UP TOP TWO ARGS + +GARGS, 0 /GET TOP 2 ARGS FROM STACK + TAD X16 + TAD QM6 /BACK TWO OPERANDS + DCA X15 + TAD X15 + DCA X16 /AND OFFICIALLY POP THE STACK + TAD I X15 /GET FIRST ARG + DCA ARG1 + TAD I X15 /AND TYPE + DCA TYPE1 + TAD I X15 + DCA BASE1 /AND FIRST BASE (IN + /CASE OF SS) + TAD I X15 /NOW SECOND ARG + DCA ARG2 + TAD I X15 + DCA TYPE2 + TAD I X15 + DCA BASE2 + TAD TYPE1 /TYPES MUST BE LT 6 + TAD QM6 + SMA CLA + JMP I GARGS /RETURN BAD + TAD TYPE2 + TAD QM6 + SPA CLA + ISZ GARGS /FIX RETURN + JMS MPTRA1 /GET ARG1 POINTER IF NEEDED + TAD ARG2 /IS ARG2 A POINTER + TAD (-61 + SZA CLA + JMP I GARGS /NO, RETURN + TAD ARG1 /IS ARG1 IN THE AC ? + SZA CLA + JMP .+5 /NO + TAD TMPCNT /YES, STORE THE AC + DCA ARG1 + TAD TYPE1 /GET TYPE + JMS I (SAVE + TAD BASE2 /MOVE POINTER FROM TEMP + /TO BASE+3 + DCA ARG2 + JMS I QGENCOD + MPTR3-1 + TAD (62 /ARG IS NOW POINTED TO + /BY BASE+3 + DCA ARG2 + JMP I GARGS +MPTRA1, 0 /MOVE ARG1 POINTER TO BASE + TAD ARG1 + TAD (-61 + SZA CLA + JMP I MPTRA1 + TAD ARG2 + SZA CLA + JMP .+5 + TAD TMPCNT + DCA ARG2 + TAD TYPE2 /GET THE TYPE + JMS I (SAVE + TAD BASE1 + DCA ARG1 + JMS I QGENCOD + MPTR0-1 + TAD (61 + DCA ARG1 /SET ARG1 TO IND0 + JMP I MPTRA1 + / BINARY OPERATORS +CODE, 0 /GENERATE CODE FOR + /BINARY OPERATORS + JMS GARGS /GET OPERANDS + JMP OTERR /BAD TYPE OPERATOR COMBO + TAD TYPE1 /INDEX INTO TYPE CHECK TABLE + CLL RTL + TAD TYPE1 + TAD TYPE2 + CLL RAL + TAD (TYPMIX-14 /POINTER TO CORRECT ENTRY + DCA SKEL + CDF 10 + TAD I SKEL /RESULTING TYPE + SNA + JMP TYPERR /THIS MIX IS ILLEGAL + DCA TYPE1 /SAVE RESULT TYPE + ISZ SKEL /GET INDEX INTO + /SKELETON TABLE + TAD I SKEL + CDF + TAD I CODE /PLUS BASE GIVES ADDR + /OF M,AC CASE + DCA SKEL + CDF 10 + TAD I SKEL /IS THIS TYPE OPER + /COMBO LEGAL ? + SNA CLA + JMP OTERR /NO + ISZ CODE /POINTS TO RESULTING TYPE + TAD ARG2 + SZA CLA + ISZ SKEL /SECOND ARG IS IN MEMORY + TAD ARG1 + SNA CLA /SKIP ON M,M CASE + ISZ SKEL /MOVE TO AC,M CASE + TAD I SKEL /PICK UP POINTER TO SKELETON + DCA SKEL + JMS I QGENCOD /GO DO THE CODE +SKEL, 0 + DCA I X16 /RESULT IS IN THE AC + TAD I CODE + SNA /IS TYPE SAME AS ARGS ? + TAD TYPE1 /YES + DCA I X16 /STORE IT + DCA I X16 /ZERO BASE WORD + TAD I CODE /IS TYPE SAME AS ARGS ? + SZA + DCA FMODE /NO, WE'RE NOW IN FMODE + JMP I CODE +TYPERR, JMS BUMP /PUT FALSE VALUE ONTO STACK + JMS I QTTYMSG /OUTPUT ERROR + 1524 +OTERR, JMS BUMP /PUT FALSE VALUE ONTO STACK + JMS I QTTYMSG + 1724 +XDPP6, TEXT '#DPT+6' +XFIX, TEXT '#FIX' + PAGE + / CODE GENERATOR (FROM SKELETONS) + +GENCOD, 0 /CODE GENERATOR ROUTINE + CDF + TAD X14 + DCA TEMP14 /FIX COMPLEX FUNCTION BUG + TAD I GENCOD /GET SKELETON ADDRESS + ISZ GENCOD +MPOPUP, DCA X14 /HERE ON MACRO END + DCA MRETN +CODLUP, CDF 10 /STUFF IS IN FIELD 1 + TAD I X14 /GET OPCODE + CDF + SNA + JMP ENDM /IS IT END OF A MACRO ? + SPA + JMP MACRO /ITS A MACRO REFERENCE + DCA .+2 /SAVE OPCODE + JMS I QOPCOD /OUTPUT IT + 0 + CDF 10 + TAD I X14 /ADDRESS ? + CDF + SNA + JMP NOADDR /NO OPERAND FOR THIS INSTR + SPA + JMP DOADDR /ADDRESS IS AN OPERAND + DCA TEMP + JMS I QOTAB /ADDRESS IS A SPECIFIC + TAD TEMP + JMS I QOUTSYM +NOADDR, JMS I QCRLF + JMP CODLUP /DO NEXT LINE +DOADDR, IAC /IS IT ARG1 ? + SZA CLA + JMP ITSA2 /NO, ITS ARG2 + JMS I QOADDR /OUTPUT ARG1 ADDRESS FIELD + ARG1 + JMP CODLUP +ITSA2, JMS I QOADDR /OUTPUT ARG2 ADDRESS + ARG2 /FIELD + JMP CODLUP +MACRO, TAD Q5 /CODES BETWEEN -1 AND -5 ARE SPECIAL + SPA + JMP .+4 /NOT ONE OF THEM + TAD (JMP MJTBL + DCA .+1 + HLT /GO TO PROPER ROUTINE + DCA MSTART /SAVE START OF MACRO + TAD X14 /SAVE RETURN ADDRESS + DCA MRETN + TAD MSTART /GO DO MACRO + DCA X14 + JMP CODLUP + ENDM, TAD MRETN /WAS THIS A MACRO ? + SZA + JMP MPOPUP /YES - GET OUT OF IT + TAD TEMP14 + DCA X14 /RESTORE X14 FOR FUNCAL + JMP I GENCOD /AND EXIT + +LOADA1, JMS I (LOADA /GENERATE LOAD + ARG1 /IF NECESSARY + JMP CODLUP +LOADA2, JMS I (LOADA /GENERATE LOAD + ARG2 /IF NECESSARY + JMP CODLUP +DOSTE, JMS I QGENSE /STARTE IF IN F MODE + JMP CODLUP +SGNNEG, ISZ RELCD /CHANGE SIGN OF RELATIONAL OPERATOR + JMP CODLUP + MSTART=TEMP +MRETN, 0 /MACRO RETURN ADDRESS +TEMP14, 0 + +MJTBL, JMP SGNNEG /-5 - NEGATE RELATIONAL SIGN + JMP LOADA2 /-4 - LOAD ARG 2 + JMP LOADA1 /-3 - LOAD ARG 1 + JMP DOSTE /-2 - START E MODE + JMS I QGENSF /-1 - START F MODE + JMP CODLUP + +XSET, TEXT 'SETX' +ZEROC1, TEXT '0,1' + / GOTO'S AND ASSIGN +CGOTO, JMS GTSTUF /LOOK AT INDEX + JMS I QGENCOD /OUTPUT COMPUTED GOTO CODE + CGTCOD-1 + JMS I QINWORD /GET COUNT + CIA + DCA TEMP2 +CGTLUP, JMS JAGEN + ISZ TEMP2 + JMP CGTLUP + JMP I QNEXT +GOTO, JMS I QGENSF /ALL TRANSFERS IN F MODE + JMS JAGEN + JMP I QNEXT + +JAGEN, 0 + JMS I QOPCDE /OUTPUT JA'S + JA + JMS I QINWORD /GET THE LABEL + CDF 10 + JMS I QOSNUM /OUTPUT IT AS THE ADDRESS + JMS I QCRLF + JMP I JAGEN + +GTSTUF, 0 + JMS I QGARG /GET THE ARG + JMP GTTYPE + CLL CMA RTL /CHECK THE TYPE + TAD TYPE1 + SMA CLA + JMP GTTYPE /NOT INTEGER OR REAL + TAD ARG1 /IS IT IN THE AC ? + SNA CLA + JMP I GTSTUF /YES ALREADY + JMS I QGENCOD + GI-1 /LOAD THE INDEX + JMP I GTSTUF +GTTYPE, JMS I QTTYMSG /GOTO TYPE ERROR + 0726 +JAC, TEXT 'JAC' +FSTA, TEXT 'FSTA' +FNEG, TEXT 'FNEG' + PAGE + / ADDRESS FIELD OUTPUT +OADDR, 0 /OUTPUT ADDRESS FIELD + TAD I OADDR /GET ADDRESS OF PARAMETERS + DCA ARG + ISZ OADDR + TAD I ARG /GET VALUE OF ARG + CLL + TAD (-52 /IS IT A TEMP REFNCE + SNL + JMP TMPREF /YES, 1-51 + TAD (52-61 /IS IT AN ARRAY REFERENCE ? + SZL + JMP SSREF /YES, 52-60 IS XR1-XR7 + SNA + JMP IND0 /INDIRECT THROUGH 0 + TAD (61-7000 /CHECK FOR DO TEMP + SZL + JMP DOTMP + TAD (7000-62 + SNA + JMP IND3 /INDIRECT THROUGH 3 + TAD (63 + DCA TEMP + CDF 10 + TAD I TEMP /IS THIS AN ARG ? + AND Q20 + CDF + SZA CLA + JMP INDARG /YES, REF IT INDIRECTLY + JMS I QOTAB + CDF 10 + TAD I TEMP /LOOK AT TYPE WORD + AND (50 /IS IT LIT OR STMT NO.? + SNA + JMP OUTA /NO, JUST OUTPUT ADDRESS + AND Q40 + SNA CLA + JMP OUTSN /OUTPUT STMT NUMBER + JMP OUTLIT /OUTPUT LITERAL +OUTA, TAD PROGNM /IS THIS THE FUNCTION NAME ? + CIA + TAD TEMP + SNA CLA + JMP FUNNAM /YES, REFERENCE #VAL INSTEAD +OUTA2, CLA CMA /SIMPLE LOCAL VARIABLE REFNCE + TAD TEMP /ADDRESS OF VAR + JMS I QOUTNAM /INTO ADDR FIELD + JMS I QCRLF + JMP I OADDR /END OF ADDRESS +OUTLIT, ISZ TEMP /MOVE TO LITERAL NUMBER + TAD I TEMP + DCA TEMP /DISPLACEMENT FROM %LITRL + CDF + TAD QLITRL /OUTPUT #LIT+ + JMS I QOUTSYM + TAD TEMP /DISPLACEMENT + JMS I QONUMBR + JMP OADRET-1 +FUNNAM, TAD (XVAL /#VAL + JMS I QOUTSYM + JMP OADRET-1 +SSREF, TAD (270 /MAKE IT AN ASCII DIGIT + DCA XR + ISZ ARG /POINT TO THE BASE WORD + TAD I ARG /GET THE ADDR OF THE BASE + DCA ARG + CDF 10 + TAD ARG + IAC /GO TO TYPE OF BASE VAR + DCA TEMP2 + TAD I TEMP2 /IS IT AN ARG TO THE SUBR ? + AND Q20 + SNA CLA + JMP NOTARG /NO, NO INDIRECT STUFF + CDF + JMS SIT + TAD ARG /VAR NAME + CDF 10 + JMS I QOUTNAM + TAD COMMA + JMS I QOCHAR + TAD XR /XR NUMBER + JMS I QOCHAR + JMS I QCRLF +OADRET, JMP I OADDR +IND3, TAD (XBASP3-XBASE /INDIRECT THRU #BASE+3 +IND0, TAD (XBASE /INDIRECT THRU #BASE + DCA TEMP + JMS SIT + TAD TEMP + JMP FUNNAM+1 +OUTSN, CLA CMA /OUTPUT STMT NUMBER + TAD TEMP + JMS I QOSNUM /OUTPUT THE NUMBER + TAD (P2 /+2 (HACK FOR FORMAT) + JMP FUNNAM+1 +INDARG, JMS SIT /INDIRECT INDICATOR + CDF 10 + JMP OUTA2 /OUTPUT ARG NAME +SIT, 0 + TAD (245 /% (INDIRECT) + JMS I QOCHAR + JMS I QOTAB + JMP I SIT +CEQ, TEXT '#CEQ' +XBAC1P, TEXT '#BASE,1+' +XUE, TEXT '#UE' + PAGE + / ADDRESS FIELD OUTPUT + +NOTARG, TAD I TEMP2 /GET TYPE WORD + DCA TEMP /SAVE IT + TAD TEMP + ISZ TEMP2 + AND Q200 /EQUIVALENCED ? + SNA CLA + JMP .+3 + TAD I TEMP2 /SKIP EQUIV INFO BLOCK + DCA TEMP2 + CLL CML RTL + TAD I TEMP2 /ADDRESS OF MAGIC NUMBER + DCA TEMP2 + TAD I TEMP2 /MAGIC NUMBER ITSELF + DCA TEMP2 + CDF + JMS I QOTAB /TAB + TAD ARG /OUTPUT VARIABLE MINUS CONST + JMS VMC + TAD COMMA + JMS I QOCHAR + TAD XR /N + JMS I QOCHAR + JMS I QCRLF /END OF LINE + JMP OADRET +DOTMP, DCA TEMP /ADDRESS RELATIVE TO %DOTMP + JMS I QOTAB + TAD (DOTMPN /OUTPUT #DOTMP + JMS I QOUTSYM + JMP PLUSN /GO OUTPUT +XXXX +TMPREF, CLA + TAD I ARG /BUMP TEMPS BACK CORRECTLY (?) + DCA TMPCNT + JMS I QOTAB /TAB + CLA CMA + TAD I ARG /GET NUMBER + DCA TEMP /INTO TEMP + IFNZRO TMPBLK-2 + CLL STA RAL /V3C -2 (-TMPBLK) + /V3C LINK SET + TAD TEMP /V3C (SAVES A LITERAL) + SNL /V3C + DCA TEMP /YES, SAVE ALTERED DISPLACEMENT + SNL CLA /V3C + TAD (TEMPN2-TEMPN /USE %TEMPX + TAD (TEMPN /USE %TEMP + JMS I QOUTSYM +PLUSN, TAD PLUS /PLUS CONSTANT + JMS I QOCHAR + TAD TEMP /DISPLACEMENT TIMES THREE + CLL RAL + TAD TEMP + JMS I QONUMBR /OUT IT + JMS I QCRLF + JMP OADRET + / UTILITIES +VMC, 0 /OUTPUT VARIABLE MINUS CONST + CDF 10 + JMS I QOUTNAM /PUT VAR NAME + TAD Q255 /- + JMS I QOCHAR + TAD TEMP /THIS CONTAINS THE TYPE + JMS SKPIRL /SKIP ON I,R OR L + TAD Q3 /USE SIX WORDS PER ENTRY + TAD Q3 /REAL, INTEGER, OR + /LOGICAL 3 WORDS + DCA MQ + TAD TEMP2 + JMS MUL12 /DO MULTIPLY + JMS I QNUMBRO /OUTPUT 15 BIT NUMBER + JMP I VMC +SC, +SKPIRL, 0 /SKIP ON TYPE I R OR L + AND Q17 /ISOLATE TYPE CODE + TAD QM4 /IS IT DOUBLE ? + SZA + IAC /NO, IS IT COMPLEX ? + SZA CLA + ISZ SKPIRL /NEITHER, SKIP + JMP I SKPIRL /RETURN +MUL12, 0 /12 BIT MULTIPLY + DCA OPRND + TAD (-15 + DCA SC + JMP STMUL +M12LUP, TAD AC + SNL + JMP .+3 + CLL + TAD OPRND + RAR +STMUL, DCA AC + TAD MQ + RAR + DCA MQ + ISZ SC + JMP M12LUP + JMP I MUL12 +OPRND, +BUMP, 0 /PUT FALSE ENTRY ONTO STACK + CDF 0 /V3C IMPORTANT PROTECTION + DCA I X16 + ISZ X16 + ISZ X16 /THIS PREVENTS UNDER + /FLOWING THE STACK + JMP I BUMP /AFTER SOME ERRORS +EXTERN, TEXT 'EXTERN' +CADD, TEXT '#CAD' +CNEG, TEXT '#CNG' +CMUL, TEXT '#CML' +JLE, TEXT 'JLE' +ORG, TEXT 'ORG' +STARTE, TEXT 'STARTE' +XDPTMP, TEXT '#DPT' + PAGE + / RANDOM CODE GENERATORS + +ERROR, JMS I QINWORD /GET ERROR CODE + JMS I QERMSG /PRINT IT + JMP I QNEXT +EOSTMT, TAD DATASW /WAS THIS A DATA STMT ? + SNA CLA + JMP OPTMYZ /NO + DCA DATASW /KILL SWITCH + JMS I QOPCDE + ORG /ORIGIN BACK TO THE PROGRAM + TAD GLABEL + JMS I QOLABEL + JMS I QCRLF + ISZ GLABEL /BUMP LABEL GENERATOR +OPTMYZ, CLA /CHANGED TO CLA IAC IF /O + JMS I QXRTBL /CLEAR TABLE OR RESET FLAGS + ISZ LINENO /BUMP LINE NUM + TAD LINENO /DISPLAY IN MQ + 7421 /FOR COOLNESS + CLA /FOR NON-EAE FOLKS + TAD STKLVL /RESET STACK LEVEL + DCA X16 + JMS IFEND /LOOK FOR END OF LOGICAL IF + JMS I (ASFEND /END OF A.S.F. DEFINITION ? +DEBUG, JMP I QNEXT /OVERLAYED IF NO /N SWITCH + JMS I QOPCDE /OUTPUT LDX NNNN,0 + LDX + TAD LINENO /THIS IS THE CURRENT ISN + JMS I QONUMBR + TAD COMMA + JMS I QOCHAR + TAD Q260 + JMS I QOCHAR + JMS I QCRLF + JMP I QNEXT +IFEND, 0 /OUTPUT IF END LABEL IF + TAD IFLABL /WAS THIS END OF LOG IF + SNA + JMP I IFEND /OUTPUT DEBUG STUFF + JMS I QLABEL /OUPTUT THE LABEL + JMS I QGENSF /ALL LOGICAL IFS MUST + /END IN FMODE + DCA WHATAC /CAN'T DEPEND ON + /AC HERE + JMS I QXRTBL /OR XR'S EITHER + DCA IFLABL /KILL THE SWITCH + JMP I IFEND +OPCOD, 0 /TAB OPCODE + DCA WHATAC /AC HAS JUST BEEN + /MODIFIED + JMS I QOTAB + TAD I OPCOD + ISZ OPCOD + JMS I QOUTSYM + JMP I OPCOD +DIV, JMS I QSAVACT /IF SECOND OPERAND IN AC, SAVE IT + JMS I QCODE /DIVIDE + DIVTBL-6;0 + CLA CMA /WERE BOTH VARS INTEGER? + TAD TYPE1 + SZA CLA + JMP I QNEXT /NO + JMS I QGENCOD + A0FN-1 /ALN 0;FNORM + JMP I QNEXT +LIFBGN, DCA RELCD /ENTER HERE IF LAST OPCODE NOT A RELATIONAL + JMS I QGARG /ENTER HERE FROM RELATIONAL OPTIMIZER + JMP NOTLOG + TAD TYPE1 /MUST BE LOGICAL + TAD (-5 + SZA CLA + JMP NOTLOG + TAD ARG1 /IS IT IN AC ? + SNA CLA + JMP .+3 + JMS I QGENCOD + GI-1 + JMS I QINWORD /IS IT IF(...)GOTO XX ? + DCA TEMP2 + TAD TEMP2 + TAD (XPUSH-XGOTO + SNA CLA + JMP IFGOTO /YES, TREAT AS SPECIAL CASE + TAD GLABEL /SET IF LABEL + DCA IFLABL + TAD RELCD + CIA + TAD Q5 /GENERATE THE OPPOSITE JUMP + JMS RELJMP /AROUND THE TARGET OF THE IF + TAD GLABEL + JMS I QOLABEL + ISZ GLABEL /INCREMENT LABEL GENERATOR + JMS I QCRLF + JMP I QNEXTM2 +IFGOTO, TAD RELCD + JMS RELJMP /GENERATE TRUE RELATIONAL JUMP IF "IF()GOTO" + JMS I QINWORD /GET THE LABEL + CDF 10 + JMS I QOSNUM + JMS I QCRLF + JMP I QNEXT +NOTLOG, JMS I QTTYMSG + 1411 + +RELJMP, 0 + CLL RAL + TAD (JNE + DCA .+2 + JMS I QOPCDE + 0 + JMP I RELJMP + +FMUL, TEXT 'FMUL' +FDIV, TEXT 'FDIV' +CAC, TEXT '#CAC' +LITRL, TEXT '#LIT+' +TEMPN, TEXT '#TMP' + PAGE + / DO LOOP COMPILER + +DOBEGN, JMS I QSAVACT /FOR EXPR IN LOOP PARAMS + TAD X16 /SET NEW STACK LEVEL + DCA STKLVL + JMS I QGARGS /GET LIMIT AND STEP + JMP DPERR /ERROR IN DO PARMS + JMS DOPARM /DO PARAMETER STUF FOR LIMIT + ARG1 + JMS DOPARM + ARG2 /AND THEN FOR STEP + TAD ARG1 /REPLACE ALTERRED STACK + /ENTRIES + DCA I X16 + ISZ X16 /REST OF ARG1 OK + TAD GLABEL /SAVE LOOP LABEL + DCA I X16 + TAD ARG2 + DCA I X16 + ISZ X16 + ISZ X16 + JMS I QCRLF /CRLF BEFORE LABL + TAD GLABEL + JMS I QLABEL /OUPTUT LOOP LABEL + ISZ GLABEL /INCR LABEL GENERATOR + DCA WHATAC /FORGET AC AND + JMS I QXRTBL /XR'S AT DO BEGIN + JMP I QNEXT +DOSTOR, JMS I QGARGS /LOOK AT INDEX AND + JMP DPERR /INITIAL VALUE + CLL CMA RTL /MUST BE INTEGER OR + TAD TYPE1 /REAL (L=1 AC=-3) + SZL CLA /SKIP IF >2 + CLL CMA RTL /L=1 AC=-3 + TAD TYPE2 + SZL CLA /L=0 IS BAD + JMP I (STORE+2 /DO STORE IF OK +DPERR, JMS I QTTYMSG /ERROR IN LIMITS + 0420 /DP +DOFINI, JMS I QXRTBL /DON'T OPTIMIZE XR USAGE + /IN SUCCESSIVE IMPLIED DO LOOPS + TAD IOSTMT /INSIDE IO STMT ? + SNA CLA + JMS IFEND /IF NOT, END IF FIRST + JMS I QINWORD /GET THE INDEX + DCA ARG1 + TAD ARG1 /GET THE TYPE WORD ADR + IAC + DCA TYPE1 + CDF 10 + TAD I TYPE1 + CDF + AND Q17 + DCA TYPE1 /TYPE OF INDEX VAR + TAD QM6 + TAD STKLVL /BACK UP THE STACK + DCA X16 + TAD X16 /RESET THE STACK LEVEL + DCA STKLVL + TAD I X16 /GET THE FINAL VALUE + DCA DOARG + ISZ X16 + TAD I X16 /GET THE LOOP LABEL + DCA DARG + TAD I X16 /GET THE STEP + DCA ARG2 + TAD I X16 /WHICH DO FIN CODE ? + CLL CML RAL + TAD TYPE1 + TAD QM6 + SNA CLA + TAD (DOFIN1-DOFIN0 /INDEX=I, STEP=R + TAD (DOFIN0-1 /ALL OTHER CASES + DCA .+2 + JMS I QGENCOD /DO FINISH CODE + 0 + JMS I QOPCOD /SUBTRACT UPPER LIMIT + FSUB + JMS I QOADDR + DOARG + JMS I QOPCDE /NOW THE JLT %%LOOP + JLE + TAD DARG /OUTPUT LABEL + JMS I QOLABEL + JMS I QCRLF + TAD STKLVL /FIX X16 INCASE MULTIPLE DO ENDER + DCA X16 + JMP I QNEXT +DOARG, +DOPARM, 0 /SUBR FOR DO PARAMETERS + TAD I DOPARM + ISZ DOPARM /GET THE PARM POINTER + DCA DARG + CLL CML RTL /GET ADDR OF TYPE WORD + TAD DARG + DCA TYPE + CLL CMA RTL /CHECK TYPE + TAD I TYPE + SMA CLA + JMP DPERR /NOT I OR R + TAD I DARG + SNA + JMP STRTMP /ARG ALREADY IN AC + TAD QM63 /IS IT ARRAY REF? + SPA CLA + JMP SVLIMT /YES, SAVE LIMIT + TAD I DARG /REGET SYM ADDR + DCA X10 /ADR OF TYPE WORD + CDF 10 + TAD I X10 /MAYBE ITS A LIT? + CDF + AND Q40 + SZA CLA + JMP I DOPARM /YES, ITS LITERAL + /WE'RE ALWAYS IN F MODE HERE + /SINCE THE LAST THING + /WAS A DO STORE +SVLIMT, JMS I QOPCOD /OTHERWISE LOAD IT + FLDA + JMS I QOADDR +DARG, 0 +STRTMP, TAD DOTEMP /SET ARG TO NEXT DO TEMP + DCA I DARG + JMS I QOPCOD /GENERATE STORE + FSTA + ISZ DOTEMP /BUMP DO TEMP + TAD DARG + DCA .+2 + JMS I QOADDR /DO TEMP ADDRESS FIELD + 0 + JMP I DOPARM + PAGE + / SUBSCRIPT REFERENCE COMPILER + +ARGS, JMS I QINWORD /COMPILE ARGUMENT LIST + CMA + DCA NARGS /NUMBER OF ARGS + TAD NARGS /GET ADDRESS OF SUBSCRIPTED VAR + CLL RAL + TAD NARGS /ENTRY ON THE STACK + TAD X16 + DCA X15 + TAD X15 /SAVE POINTER TO START + /OF THIS ENTRY + DCA X14 /FOR POSSIBLE FUTURE USE + ISZ NARGS /NOW ITS THE 2'S COMPLEMENT + NOP + TAD I X15 /FETCH SS VARIABLE + DCA BASE1 + TAD I X15 /ITS TYPE + DCA TYPE1 + TAD BASE1 /STORE BASE WORD + DCA I X15 + TAD BASE1 /GET ADDR OF TYPE WORD + IAC + DCA TEMP + CDF 10 /GET TYPE WORD + CLL CML RTR /TEST DIM BIT + AND I TEMP + SNA CLA + JMP TRYCAL /SOME KIND OF CALL + TAD BASE1 /NOW GET ADDRESS OF DIM INFO + JMS I QGETSS + DCA ARG1 /RETURNS WITH FIELD SET + TAD I ARG1 /CORRECT NUMBER OF DIMENSIONS? + TAD NARGS + CDF + SZA CLA + JMP DIMERR /NO + ISZ ARG1 /SKIP TOTAL SIZE + ISZ ARG1 /SKIP MAGIC NUMBER + ISZ ARG1 /AND ASSOCIATED LITERAL + DCA XRNUM /START WITH XR 1 + TAD (-10 /SEVEN XRS + DCA XRCNT /COUNT FOR SEARCH + DCA FREEXR /ZERO FREE XR INDICATOR +XRCHEK, CDF + ISZ XRCNT /ANY MORE XR EXPRS TO TEST ? + SKP /YES, GO CHECK THEM + JMP COMPSS /NO, MUST COMPILE + /XR ERPRESSION + ISZ XRNUM /BUMP XR NUMBER + TAD XRNUM + CLL RTL /TIMES 16 + CLL RTL + TAD (XRBUFR-1 /PLUS BASE (-1) + DCA X13 + TAD I X13 /LOOK AT THE + SPA /INDICATOR + JMP .+3 /-1=USED BY THIS STMT + SZA CLA /IF ZERO GO TO + /MTXR (EVENTUALLY) + TAD FREEXR /ANY FREE BEFORE THIS ONE ? + SZA CLA + JMP NOTMT /YES, ALREADY FOUND ONE + TAD XRNUM /THIS WILL BE + DCA FREEXR /THE XR WE USE + JMP XRCHEK /GO LOOK AT NEXT +NOTMT, TAD X13 /SAVE FLAG ADDRESS + DCA XRFLAG /IN CASE WE NEED IT LATER + TAD I X13 /POINTER TO THE DIM INFO + DCA TEMP2 + CDF 10 + TAD I TEMP2 /SAME NUMBER OF DIMS ? + TAD NARGS + SZA CLA + JMP XRCHEK /NO, THIS XR WONT DO + TAD NARGS /SET COUNTER + DCA DCNT + TAD ARG1 /POINTER TO DIM FACTORS + DCA X12 + ISZ TEMP2 /SKIP THREE WORDS + ISZ TEMP2 + ISZ TEMP2 +DCHEK, ISZ DCNT /ANY MORE ? + SKP + JMP SSCHEK /DIMS OK, CHECK SS + ISZ TEMP2 /GET TO NEXT DIM + TAD I TEMP2 /ARE THEY EQUAL ? + CIA + TAD I X12 + SZA CLA + JMP XRCHEK /NO, GO TRY NEXT ONE + JMP DCHEK +SSCHEK, TAD NARGS /COUNT AGAIN + CDF + DCA DCNT + CLL CMA RAL /-2 + TAD X16 /ADDR OF START OF TOP + /SS ON STACK + JMP .+3 +SSC2, CLL CMA RTL /-3 + TAD XTMP /BACK UP TO NEXT LOWER SS + DCA XTMP /LINK IS ALWAYS ZERO HERE + TAD I XTMP /GET NEXT SS (WORKING + /RIGHT TO LEFT) + TAD (-61 /IS IT A VAR OR LITERAL? + SNL CLA + JMP XRCHEK /WE'RE JUST + /LOOKING FOR AN EMPTY + TAD I XTMP /RE GET SS POINTER + CIA + TAD I X13 /ARE THEY THE SAME ? + SZA CLA + JMP XRCHEK /NO + ISZ DCNT + JMP SSC2 /KEEP CHECKING + TAD XRNUM /THEY MATCH, STICK IN + /THE XR NUMBER + TAD (51 + DCA I X14 + CLL CML RTL + TAD X14 /PURGE SS FROM STACK + DCA X16 + CLA CMA /SET FLAG TO + /'USED BY THIS STMT' + DCA I XRFLAG + JMP I QNEXT +DCNT, 0 +XRFLAG, 0 +XTMP, 0 + PAGE + / SUBSCRIPT REFERENCE COMPILER + +COMPSS, TAD FREEXR /GET XR EXPR AREA + CLL RTL /BY MULTIPLYING + /THE NUMBER + CLL RTL /BY 16 + TAD (XRBUFR /AND ADDING THE + /BASE ADDRESS + DCA XREPTR /THIS IS IT + CLA CMA /SET USED BY THIS + /STMT FLAG + DCA I XREPTR + ISZ XREPTR + CLL CMA RTL /STORE THE DIB POINTER + TAD ARG1 + DCA I XREPTR + TAD NARGS /GET ADDR OF POINTER TO LAST + CMA /DIMENSION FACTOR + TAD ARG1 + DCA ARG1 /SINCE WE USE THEM IN + /REVERSE ORDER + JMS I QSAVEAC /STORE AC IF NEEDED + /FOLLOWING INSTRUCTION REMOVED FOR OPTOMIZATION +/ JMS I QGENSF /ALL SUBSCRIPTS AR I OR R + TAD (FLDA /LOAD FIRST SS + SKP +CSSLUP, TAD (FADD /ADD ALL SUBSEQUENT ONES + DCA OPC + CLL CMA RTL /BACK UP STACK BY ONE ENTRY + TAD X16 + DCA X16 + TAD X16 /GET A WORKING POINTER + DCA X15 + TAD I X15 /GET THE NEXT SUBSCRIPT + DCA ARG2 + CLL CMA RAL /MUST BE INTEGER + TAD I X15 + SMA CLA + JMP DIMERR + TAD I X15 + DCA BASE2 + TAD ARG2 /STORE THE SS INTO THE + /XR EXPR + ISZ XREPTR /INCREMENT FIRST + DCA I XREPTR + TAD ARG2 /IS ARG2 THE AC (ONLY + /POSSIBLE IF + SNA CLA /ITS THE RIGHTMOST + /SUBSCRIPT) + JMP NLODSS /YES, DON'T LOAD IT + JMS I QOPCOD /OUTPUT LOAD OR ADD +OPC, 0 /THIS LOCATION TELLS + /THE STORY + JMS I QOADDR /FOLLOWED BY THE OPERAND + ARG2 /POINTED TO BY ARG2 +NLODSS, ISZ NARGS /ANY MORE SUBSCRIPTS ? + JMP MORESS /YES, GO COMPILE THEM + TAD FREEXR /ANY FREE INDEX REG? + SZA CLA + JMP ASGNXR /YES, GO USE IT + TAD (61 /ITS A SPECIAL POINTER ENTRY + DCA I X14 + ISZ X14 + TAD TMPCNT /SAVE TEMP NUMBER + DCA I X14 /BEFORE WE BLOW X14 + JMS I (GENPTR /GENERATE POINTER TO THE ARG + JMS I QGENCOD /BACK TO FMODE + SF-1 + JMS I (ACSTOR /GENERATE STORE AC + JMP I QNEXT +DIMERR, JMS I QTTYMSG /SS NOT OF CORRECT NUMBER + 2323 +XRCNT, 0 +TRYCAL, TAD ASFSWT /ASF DEFINITION + SMA SZA CLA + JMP DEFASF /YES, GO OUTPUT PROLOG + TAD I TEMP /IS IT A FUNCTION OR AN ARG? + CDF + AND (1420 + SNA + JMP DIMERR /NO, SOME KIND OF ERROR + AND Q20 + DCA ACSWIT /SAVE THE AC SWITCH + JMP FUNCAL /STANDARD FUNCTION CALL +MORESS, JMS I QGENSF /MUST USE SINGLE PRECISION FOR MULTIPLY + JMS I QOPCOD /MULTIPLY BY DIM FACTOR + FMUL + CDF 10 + TAD I ARG1 /PICK UP FACTOR ADDRESS + CDF + DCA ARG2 + CLA CMA + TAD ARG1 /MOVE BACK ONE + DCA ARG1 + JMS I QOADDR /OUTPUT MULTIPLY ADDRESS + ARG2 + JMP CSSLUP /LOOP ON NEXT SS +ASGNXR, JMS I QOPCDE /OUTPUT ATX N + ATX + TAD FREEXR /GET NUMBER OF FREE XR + TAD Q260 + JMS I QOCHAR + JMS I QCRLF + TAD FREEXR + TAD (51 /COMPUTE PROPER NUMBER + DCA I X14 /PUT IT INTO TOP OF STACK + JMP I QNEXT +XREPTR, 0 + / RANDOM TEXT +OTAB, 0 + TAD (211 + JMS I QOCHAR + JMP I OTAB +FCLA, TEXT 'FCLA' +STARTD, TEXT 'STARTD' +TEMPN2, TEXT '#TMPX' +CSUB, TEXT '#CSB' +CDIV, TEXT '#CDV' + PAGE + / GENERAL CALL GENERATOR + +GENCAL, 0 /GENERATE A CALL; ALL ARGS ON STACK + /X15 POINTS TO START OF STACK INFO + /NARGS IS NEG NUMBER OF ARGS + /FUNCTION NAME IS FIRST ON STACK + TAD I GENCAL /GET FUN NAME SWITCH + DCA FNSWIT + TAD X15 /NEW STACK VALUE + DCA X16 + TAD X15 /WORKING POINTER + DCA ARG2 + TAD NARGS /WORKING COUNTER + SNA + JMP OUTJSR /NO ARGS, PUT JSR + DCA TYPE2 +CHKPTR, ISZ ARG2 /MOVE TO NUMBER + TAD ARG2 + IAC /ADDR OF TYPE WORD + DCA BASE2 + TAD I BASE2 /GET TYPE + DCA TYPE1 /TYPE OF ARG FOR GENPTR + ISZ BASE2 /POINT TO BASE WORD + TAD I BASE2 + DCA BASE1 /FOR GENPTR + TAD I ARG2 /GET ARG NUMBER + CLL + TAD (-52 /IS IT INDEXED ? + SNL + JMP NOTINX /NO, ITS A TEMP + TAD (52-61 /IS IT INDIRECT ? + SZL + JMP INXR /NO, ITS IN AN XR + SNA + JMP INTMP /POINTER IN A TEMP + TAD (62 /GET TO TYPE WORD + DCA GCTEMP + CDF 10 + TAD I GCTEMP /IS IT AN ARG + CDF + AND (1020 /ARG OR EXTERNAL ? + SNA + JMP NOTINX+1 /NEITHER + AND Q20 + SZA CLA + JMP ARGARG /ARG SQUARED + JMP EXTARG /EXTERNAL ARG +NOTINX, CLA + ISZ ARG2 /BUMP POINTER + ISZ ARG2 + ISZ TYPE2 /INCR COUNT + JMP CHKPTR +OUTJSR, TAD JSRLBL /DOES IT GET A LABEL ? + SNA + JMP .+3 /NO + JMS I QLABEL /OUPTUT THE LABEL+COMMA + DCA JSRLBL /KILL SWITCH + TAD X16 /ADDR OF POINTER TO FUN NAME + DCA TEMP +FNSWIT, 0 /REAARANGED** + JMP I (IOFUN /IO FUNCTION CALL + JMS I QOPCDE /OUTPUT THE JSR + JSR + TAD I TEMP /NOW THE SUBR NAME + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + TAD NARGS /ANY ARGS ? + SNA CLA + JMP I GENCAL /NO, END OF CALL + JMS I QOPCDE /JUMP AROUND THE ARGS + JA + TAD Q256 + JMS I QOCHAR /. + TAD PLUS + JMS I QOCHAR /+ + CLL CLA CMA RAL /-2 + TAD NARGS /-N-2 + CLL CMA RAL /2*N+2 + JMS I QONUMBR +IOONLY, JMS I QCRLF + TAD X16 /WORKING POINTER + DCA X15 +PTRLST, TAD I X15 /GET NEXT ARG + SZA + JMP SARG /SIMPLE ARG + CLL CML RTL + TAD X15 /ADDR OF GENERATED + /LABEL NUMBER + DCA TEMP + TAD I TEMP /OUTPUT #GXXXX (THE + /GENERATED LABEL) + JMS I QLABEL /OUPTUT THE LABEL + JMS I QGENCOD + JADP2-1 /GENERATE A DUMMY JA + JMP BARGLP +SARG, DCA ARG2 /STORE THE ARG NUMBER + JMS I QOPCOD /OUTPUT JA ARG + JA + JMS I QOADDR /NOW ADDRESS FIELD + ARG2 +BARGLP, ISZ X15 /BUMP POINTER + ISZ X15 + ISZ NARGS /BUMP COUNT + JMP PTRLST + JMP I GENCAL +INTMP, TAD I BASE2 /GET TEMP NUMBER + DCA ARG1 /THAT PTR IS STORED IN + JMS I QGENCOD /PICK UP POINTER + LDASTD-1 +STRPTR, JMS I QOPCDE /NOW STORE THE POINTER + FSTA + TAD GLABEL /OUTPUT THE LABEL + JMS I QOLABEL + JMS I QCRLF + TAD GLABEL /SAVE THE LABEL NUMBER + DCA I BASE2 + DCA I ARG2 /ZERO ARG NUMBER + ISZ GLABEL /INCREMENT LABEL NUMBER + JMS I QGENCOD /BACK TO F MODE + SF-1 + JMP NOTINX /CONTINUE LOOP +NLABEL, 0 + JMS I QOLABEL + TAD COMMA + JMS I QOCHAR + JMP I NLABEL + PAGE + / GENERATE SUBROUTINE CALL + +FUNCAL, JMS I QSAVEAC /SAVE NEXT TO LAST IF NEEDED + JMS I QSAVACT /SAVE LAST IF NEEDED + JMS I QGENSF /ALL CALLS DONE IN F MODE + DCA I X14 /RESULT RETURNED IN AC + TAD ACSWIT /IS THE SUBR AN ARG ? + SNA CLA + JMP MAKCAL /NO, ITS EASIER + JMS I QOPCOD /GET THE JSR TO THE SUBR + FLDA + JMS I QOADDR + BASE1 /BY GETTING THE VALUE + /OF THE ARG + JMS I QGENCOD /STARTD + SD-1 + JMS I QOPCDE /STORE IT AHEAD + FSTA + TAD GLABEL /INTO THE JSR + ISZ GLABEL + DCA JSRLBL /SET THE SWITCH + TAD JSRLBL + JMS I QOLABEL + JMS I QCRLF + JMS I QGENCOD /STARTF + SF-1 +MAKCAL, ISZ BASE1 /MOVE TO TYPE WORD + CDF 10 + TAD I BASE1 /GET TYPE OF FUNCTION + CDF + JMS I QSKPIRL /WHAT MODE WILL WE LEAVE IN? + DCA FMODE /PROBABLY E + JMS I QGENCAL /GO GENERATE THE CALL + SKP + 0 /THIS IS A FREE LOCATION + JMP I QNEXT +ARGARG, JMS I QOPCDE /%FLDA + FLDA + TAD I ARG2 /POINTER + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMS I QGENCOD /%SD + SD-1 + CDF 10 + CLL CML RTR /IS IT AN ARRAY ? + AND I GCTEMP + CDF + SNA CLA + JMP STRPTR /GO STORE THE POINTER + TAD I ARG2 /GET THE LITERAL NUMBER + JMS I QGETSS + TAD Q3 + DCA GCTEMP + TAD I GCTEMP + DCA OLABEL /SAVE IT + CDF + JMS I QOPCDE /%FADD LITERAL + FADD + TAD QLITRL + JMS I QOUTSYM + TAD OLABEL /XXXX + JMS I QONUMBR + JMS I QCRLF + JMP STRPTR /GO STORE THE POINTER +INXR, TAD (270 /MAKE AN ASCII CHAR + DCA XR + JMS I QOPCDE /XTA + XTA + TAD XR + JMS I QOCHAR /N + JMS I QCRLF + TAD BASE1 /FIND ADDR OF MAGIC + /NUMBER LITERAL + JMS I QGETSS + CDF + TAD Q3 + DCA ARG1 + JMS I (GENPTR /GENERATE THE POINTER + JMP STRPTR /GO STORE THE POINTER +EXTARG, TAD I ARG2 /MAKE AN ENTRY IN THE EXT + CDF 10 /LITERAL LIST + DCA I X17 + TAD DOTEMP /USE DO TEMPS FOR THIS + DCA I X17 + CDF + TAD DOTEMP /SINCE OADDR CAN HANDLE THEM + DCA I ARG2 + ISZ DOTEMP /BUMP COUNT + ISZ ELCNT /ALSO EXT LIT COUNT + JMP NOTINX /BACK TO PROCESSING ARGS + / UTILITY ROUTINES +OLABEL, 0 /OUTPUT #GXXXX FOR GEN'D LABELS + DCA TEMP + TAD (243 + JMS I QOCHAR + TAD (307 + JMS I QOCHAR + TAD TEMP + JMS I QONUMBR + JMP I OLABEL +OPCODE, 0 /TAD OPCODE TAB + DCA WHATAC /THIS INSTRUCTION ZAPS AC + JMS I QOTAB + TAD I OPCODE + ISZ OPCODE + JMS I QOUTSYM + JMS I QOTAB + JMP I OPCODE +M1C2, TEXT '-1,2' +GENSTE, 0 /GENERATE STARTE IF IN + /F MODE + TAD FMODE /LOOK AT THE SWITCH + SNA CLA + JMP I GENSTE /ALREADY IN E MODE + DCA FMODE /CLEAR THE SWITCH + JMS I QOPCOD /GENERATE THE STARTE + STARTE + JMS I QCRLF /CAN'T USE GENCOD FOR THAT + JMP I GENSTE +D0, TEXT '0' +DOTMPN, TEXT '#DOTMP' + PAGE + / OPCODES AND OTHER TEXT + +XBASE, TEXT '#BASE' +XBASP3, TEXT '#BASE+3' +DP3C0, TEXT '.+3,0' +JXN, TEXT 'JXN' +ALN, TEXT 'ALN' +ATX, TEXT 'ATX' +XTA, TEXT 'XTA' +LDX, TEXT 'LDX' +XREW, TEXT '#REW' +XENDF, TEXT '#ENDF' +XBAK, TEXT '#BAK' +XEXIT, TEXT '#EXIT' +XRTN, TEXT '#RTN' + JNE, TEXT 'JNE' + TEXT 'JGE' + TEXT 'JLE' + TEXT 'JGT' +JLT, TEXT 'JLT' /MUST BE IN THIS ORDER!! + TEXT 'JEQ' +JA, TEXT 'JA' + +JSR, TEXT 'JSR' +JSA, TEXT 'JSA' /MUST BE IN THIS ORDER! +TRAP3, TEXT 'TRAP3' + / POINTER GENERATOR +GENPTR, 0 /GENERATE A POINTER + JMS I QOPCOD /MULTIPLY BY 3. OR 6. + FMUL + TAD TYPE1 /D OR C ? + JMS I QSKPIRL /SKIP ON I, R, OR L + TAD Q6M3 + TAD (THREE + DCA TEMP /POINTER TO CORRECT LITERAL + JMS I QOADDR + TEMP + JMS I QGENCOD /ALN 0; STARTD + A0SD-1 + JMS I QOPCDE /FADD THE BASE LITERAL + FADD + ISZ BASE1 /GET ADDR OF TYPE WORD + CDF 10 + TAD I BASE1 /GET TYPE WORD + AND Q20 + SNA CLA + JMP NIARG /NOT AN ARG + CMA + TAD BASE1 + JMS I QOUTNAM /IF AN ARG, THE LITERAL + /IS THE ARG + JMP OSF +NIARG, CDF + TAD QLITRL /OTHERWISE ITS IN THE + /LITERAL BLOCK + JMS I QOUTSYM + CDF 10 + TAD I ARG1 /LITERAL NUMBER + CDF + JMS I QONUMBR +OSF, JMS I QCRLF + JMP I GENPTR + / MORE RANDOM CODE GENERATORS +STOP, JMS I QGENCOD /CALL EXIT + STPCOD-1 + JMP I QNEXT +FORMAT, JMS I QINWORD /NUMBER OF WORDS OF TEXT + CMA + DCA TEMP + JMS I QOPCDE /JA AROUND THE STUFF + JA + TAD Q256 + JMS I QOCHAR /. + TAD PLUS + JMS I QOCHAR + CLL CMA RAL /.+2+NWORDS + TAD TEMP + CMA + JMP .+3 +FMTLUP, JMS I QOTAB /TA + JMS I QINWORD /GET NEXT WORD + JMS I QONUMBR /OUTPUT IT + JMS I QCRLF + ISZ TEMP + JMP FMTLUP + JMP I QNEXT + +DFRTTM, 0 /ROUTINE TO DELETE "SYS:FORTRN.TM" + CLA IAC + CIF 10 + JMS I Q200 + 4 + FTRNTM + 0 + NOP + JMP I DFRTTM + +EQUDOT, TEXT '=.' +XPAUSE, TEXT '#PAUSE' + PAGE + /REWIND, ENDFILE, BACKSPACE + +REWIND, TAD (XREW-XENDF +ENDFIL, TAD (XENDF-XBAK +BAKSPC, TAD (XBAK + DCA REBSUB + JMS I QUCODE + AIFTBL-1 /GET UNIT INTO FAC + JMS I QGENSF /FORCE F MODE + CLA STL RTL + JMS I (OJSR +REBSUB, 0 + JMP I QNEXT + / DATA STATEMENT STUFF +DATAST, TAD X16 /SAVE STACK + DCA DSTACK + TAD DATASW /MULTIPLE DATA STMT ? + SZA CLA + JMP FIXDAT-2 /YES, DON'T OUTPUT LABEL + ISZ DATASW /SET DATA SWITCH + JMS I QOTAB /DEFINE ORIGIN SYMBOL + TAD GLABEL + JMS I QOLABEL + TAD (EQUDOT /#GXXXX=. + JMS I QOUTSYM + JMS I QCRLF + CLA CMA /SET VAR TO NONE LEFT + DCA NUMELM +FIXDAT, TAD QXRBUFR /USE XR BUFFER FOR DATA BUFFER + DCA DATPTR + CMA + DCA RCOUNT /SET REPETITION COUNT TO 1 + JMP I QNEXT +DREPTC, JMS I QINWORD /GET REPETITION COUNT + CIA + DCA RCOUNT + JMP I QNEXT +DATELM, JMS I QINWORD /GET SIZE OF ELEMENT + CIA + DCA TEMP + JMS I QINWORD /GET ELEMENT + DCA I DATPTR + ISZ DATPTR /INTO DATA BUFFER + ISZ TEMP + JMP .-4 + JMP I QNEXT +ENDELM, TAD QXRBUFR /SETUP POINTER + DCA TEMP +MORELM, ISZ NUMELM /ANY MORE FOR THIS VAR? + JMP SAMVAR /YES + TAD DSTACK /CHECK FOR MISMATCH + CIA + TAD X16 + SNA CLA + JMP DLERR /OOOPS + ISZ DSTACK /GET TO NEXT VAR + JMS I QOPCDE /%ORG VAR + ORG + TAD I DSTACK /GET VAR + DCA TEMP2 + TAD TEMP2 + ISZ DSTACK /MOVE TO THE DISPLACEMENT + CDF 10 /OUTPUT VAR + JMS I QOUTNAM + CMA + DCA NUMELM /ASSUME UNDIMENSIONED + CDF 10 + ISZ TEMP2 /MOVE TO TYPE WORD + TAD I TEMP2 /GET TYPE + JMS I QSKPIRL /SKIP ON I R L + CLL CMA RTL /YES + TAD (-3 + DCA ELMSIZ /NUMBER OF WORDS PER ELEMENT + CLL CML RTR + AND I TEMP2 + CDF + SNA CLA + JMP GOTSIZ /NOT DIMENSIONED + CLA IAC /IF DISP = 7777 , WHOLE ARRAY + TAD I DSTACK /LOOK AT DISPLACEMENT + SZA CLA + JMP GOTSIZ+1 /ONLY ONE ELEMENT OF THE ARRAY + CMA + TAD TEMP2 /GET TOTAL SIZE + JMS I QGETSS + IAC + DCA TEMP2 + TAD I TEMP2 + CIA /THIS IS THE NUMBER OF ELEMENTS + DCA NUMELM + CDF +GOTSIZ, DCA I DSTACK /ZERO DISPLACEMENT + TAD PLUS /OUTPUT +XXXX + JMS I QOCHAR + TAD ELMSIZ /MULTIPLY DISP BY 3 OR 6 + CIA + DCA MQ + TAD I DSTACK /GET DISP + JMS I QMUL12 + JMS I QNUMBRO /OUTPUT THE ORG ALTERATION + JMS I QCRLF + ISZ DSTACK /MOVE TO NEXT ENTRY +SAMVAR, TAD ELMSIZ /GET SET TO PICK UP AN ELEMENT + DCA NARGS + JMS I QOTAB + JMP .+3 /SKIP ; FIRST TIME +ELMLUP, TAD (273 /SEMICOLON + JMS I QOCHAR + TAD I TEMP /GET A WORD FROM THE BUFFER + ISZ TEMP + JMS I QONUMBR + ISZ NARGS /ONE DATA LIST ELEMENT MUST FILL + JMP ELMLUP /ONE VARIABLE LIST ELEMENT + JMS I QCRLF /I.E. ONE ARRAY ELEMENT + TAD DATPTR /IS THIS DATA ELEMENT EXHAUSTED? + CIA CLL + TAD TEMP + SNL CLA + JMP MORELM /MORE LEFT + ISZ RCOUNT /REPEAT ? + JMP ENDELM /YES + JMP FIXDAT /NO, BACK FOR MORE DATA +DLERR, JMS I QTTYMSG /DATA LIST ERROR + 0414 + ELMSIZ=ARG1 + NUMELM=TYPE1 + DSTACK=BASE1 + DATPTR=ARG2 + RCOUNT=TYPE2 + PAGE + / END STATEMENT PROCESSING + +END, TAD FUNCTN /WHAT WAS IT ? + SZA CLA + JMP .+3 /SUBR, RETURN + TAD (STPCOD-1 /MAIN PROG, CALL EXIT + DCA .+2 + JMS I QGENCOD + RTNCOD-1 + TAD DOTEMP /ANY DO TEMPS ? + TAD M7000 + SPA SNA + JMP .+3 /NO + JMS OTMPS /OUTPUT THEM +XDOTMP, DOTMPN + CLA + TAD TMPMAX /ANY EXTRA TEMPS ? + TAD (-TMPBLK + SPA SNA + JMP .+4 + IAC /OUTPUT THEM + 1 + JMS OTMPS + TEMPN2 + CLA + TAD ELCNT /ANY EXTERNAL LITERALS? + SNA + JMP END2 /NO + CIA + DCA ELCNT + TAD EXTLIT /PICK UP THE POINTER + DCA X17 +ELLOOP, CDF 10 + TAD I X17 /GET SYMBOL NAME + DCA TEMP + TAD I X17 /AND DO TEMP NUMBER + CDF + TAD (-7000 /MINUS BASE + DCA TEMP2 + JMS I QOPCDE /ORIGIN + ORG + TAD XDOTMP /OUTPUT #DOTMP + JMS I QOUTSYM + TAD PLUS /+ + JMS I QOCHAR + TAD TEMP2 /DISP + CLL CML RAL /*2+1 + TAD TEMP2 /*3+1 + JMS I QONUMBR + JMS I QCRLF + JMS I QOPCDE /NOW OUTPUT JSR NAME + JSR + TAD TEMP + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + ISZ ELCNT + JMP ELLOOP +END2, TAD (232 /^Z + JMS I QOCHAR + JMS I (OUDUMP /DUMP BUFFER + CIF 10 + JMS I (7700 /GET USR + 10 + CIF 10 + CLA IAC + JMS I Q200 /CLOSE OUTPUT FILE + 4 + F1LNAM +FILSIZ, 0 + JMP OUERR /BADDDDIE + TAD FILSIZ /FIX INPUT LIST + CLL RTL + RTL + JMP FINAL +ERMSG, 0 /PRINT ERROR MESSAGE ON THE TTY + DCA TEMP /SAVE THE CODE + TAD QM4 /BACK UP THE ERROR + TAD ERRPTR /POINTER + DCA X10 + CDF 10 + DCA I X10 /ZERO END OF LIST + TAD TEMP /NOW STICK IN THE CODE + DCA I X10 + TAD X10 /SAVE THE NEW POINTER + DCA ERRPTR + TAD LINENO /NOW THE LINE NUMBER + DCA I X10 + CDF + TAD TEMP /PRINT ERROR CODE + JMS I QTTYP2C + JMS I QTTYP2C /NOW SOME SPACES + TAD QTTYOUT /FUDGE THE OUTPUT + /ROUTINE POINTER + DCA QOCHAR /SO THAT ONUMBR GOES TO + /THE TTY + TAD LINENO /PRINT THE LINE NUMBER + JMS I QONUMBR + TAD (OCHAR /FIXUP OUTPUT POINTER + DCA QOCHAR + JMS I QTTCRLF + JMS I QGENCOD /TRAP IF ERROR EXECUTED + ERCODE-1 + JMP I ERMSG +M7000, +OTMPS, -7000 /OUTPUT TEMP BLOCK + DCA TEMP /SAVE SIZE + TAD I OTMPS + ISZ OTMPS + JMS I QOUTSYM /OUTPUT NAME + TAD COMMA + JMS I QOCHAR + JMS I QOPCDE /ORG + ORG + TAD Q256 /. + JMS I QOCHAR + TAD PLUS + JMS I QOCHAR + TAD TEMP + CLL RAL + TAD TEMP /SIZE TIMES THREE + JMS I QONUMBR + JMS I QCRLF + JMP I OTMPS + PAGE + / CHAIN TO RALF +/ PASS2O VERSION 4A PT 16-MAY-77 +/CHANGES FOR OS/8 V3D AND OS/78 BY P.T. +/FIXED THE Q OPTION +/PATCH LEVEL IS IN LOCATION 26131 + IFZERO OVERLY < /ANOTHER SCORE FOR PAL8 + *OVRLAY + NOPUNCH> + IFNZRO OVERLY < /TO TAKE THE LEAD + FIELD 2 + ENPUNCH + *OVRLAY> /LATE IN THE FINAL QUARTER +GORALF, TAD FILDEV /GET SIZE AND DEVICE WORD + DCA I (7617 /PUT IT AWAY + ISZ (7617 /BUMP POINTER + TAD FILBLK /GET ORIGIN OF FIE + DCA I (7617 /STORE IT + ISZ (7617 + DCA I (7617 /ZERO END OF LIST + TAD I RALFSV + CDF 0 + SPA CLA /WAS /A SPECIFIED? + JMP I (7605 /YES - GET OUT + CLA IAC +CHNLKP, CIF 10 + JMS I Q200 + 2 /LOOKUP RALF.SV + RALFNM +RALFSV, 7643 + JMP I (7605 + TAD (6 /** + DCA CHNLKP+2 + JMP CHNLKP +RALFNM, 2201;1406;0000;2326 /RALF.SV +PASS3N, 2001;2323;6300;2326 /PASS3.SV + +ADD, JMS I QCODE /GENERATE CODE FOR ADD + ADDTBL-6;0 + JMP I QNEXT + / EXP OPERATOR +ETYPE, 0 +EXP, JMS I QSAVACT /SAVE AC IF ITS SECOND ARG + JMS I QGARGS /GET THE TWO ARGS + JMP I (OTERR /TYPE/OPERATOR ERROR + TAD TYPE1 /GET PLACE IN TABLE + CLL RTL + TAD TYPE1 /TYPE1 TIMES TEN + TAD TYPE2 /** + CLL RAL + TAD (EXPTBL-15 /POINTER TO ENTRY MINUS ONE + DCA X10 + CDF 10 + TAD I X10 /GET RESULTING TYPE + SNA + JMP I (OTERR /BAD IF THIS WORD IS ZERO + DCA ETYPE /SAVE THE TYPE + TAD I X10 /GET THE SUBR NAME + CDF + DCA I (ESUBR+2 /PUT IT INTO ITS PLACE + TAD TYPE1 /GET INTO CORRECT MODE + JMS SETMOD + TAD ARG1 /IS ARG 1 ALREADY IN THE AC + SNA CLA + JMP .+5 /YES, SKIP THE LOAD + JMS I QOPCOD /OTHERWISE LOAD IT + FLDA + JMS I QOADDR + ARG1 + JMS I QOINS /FSTA #BASE + FSTA;XBASE + TAD TYPE2 /SET MODE FOR ARG 2 + JMS SETMOD + JMS I QOPCOD /NOW LOAD IT + FLDA + JMS I QOADDR + ARG2 + JMS I QOINS /EXTERN FOR THE SUBR + EXTERN;ESUBR + JMS I QOINS /JSA TO THE SUBR + JSA;ESUBR + DCA I X16 /RESULT IS THE AC + TAD ETYPE /WITH THIS AS THE TYPE + DCA I X16 + DCA I X16 + TAD ETYPE /SET FMODE CORRECTLY + JMS I QSKPIRL + SKP + CLA IAC /RETURNED IN F MODE + DCA FMODE + JMP I QNEXT +SETMOD, /SET MODE TO CORRESPOND + /TO THE ARG +VOVER, VERSON /VERSION NUMBER FOR OVERLAY + JMS I QSKPIRL /SKIP IF WE WANT F MODE + JMP .+3 /SET TO E MODE + JMS I QGENSF /SET TO F MODE + JMP I SETMOD + JMS I QGENSE + JMP I SETMOD +FINAL, CIA + IAC + DCA FILDEV /SAVE RALF INPUT SPEC + CMA + DCA I X7746 /DON'T SAVE CORE ARROUND CHAIN + JMS I (DFRTTM /DELETE FORTRN.TM + CDF 10 + TAD I Q7605 /IS THERE A LISTING FILE? + SNA CLA + JMP GORALF /NO, JUST CHAIN TO RALF + CIF 10 + CDF + CLA IAC + JMS I Q200 /FIND PASS 3 + 2 + PASS3N +PAS3SV, 0 + JMP I Q7605 + TAD PAS3SV-1 /MOVE BLOCK TO CHAIN COMMAND + IAC /SKIP OVER CORE CONTROL BLOCK + DCA X7746 + JMS I DEVH /READ IN PASS 3 + NPPAS3 +SPASS3, 400 +X7746, 7746 + JMP I Q7605 + JMP I SPASS3 /GO DO PASS 3 + PAGE + / I/O OPEN AND CLOSE + +STRTIO, 0 /ROUTINE FOR STARTING IO STMT + ISZ IOSTMT /SET IOSTMT SWITCH + /(INCASE OF IMPLIED LOOPS) + JMS I QSAVEAC /SAVE AC + JMS I QSAVACT /IF NECESSARY + TAD I STRTIO /GET NUMBER OF ARGS + DCA NARGS /SAVE IT + ISZ STRTIO /MOVE TOHE NME + TAD NARGS /BACKUP STACK BY THIS MUCH + TAD NARGS /THREE OR SIX + TAD NARGS + TAD X16 + DCA X15 + TAD X15 + DCA TEMP /FUNCTION NAME GOES HERE + JMS I QOPCDE /EXTERN FOR SUBR + EXTERN + TAD I STRTIO /GET SUBROUTINE NAME + JMS I QOUTSYM /OUTPUT IT + JMS I QCRLF + TAD I STRTIO /PUT NAME + DCA I TEMP /ONTO STACK + JMS I QGENSF /ALL CALLS IN F MODE + JMS I QGENCAL /GENERATE THE CALL + NOP + JMP I QNEXT /NOTHING FOR R CLOSE +FMTRD1, IAC /START FORMATTED READ + DCA INPUT /SET INPUT = 1 + DCA BINARY /AND BINARY = 0 + JMS STRTIO /GO MAKE THE CALL + -2;XREADO +FMTWR1, DCA INPUT /SET SWITCHES + DCA BINARY + JMS STRTIO + -2;XWRITO +BINRD1, CLA IAC + DCA BINARY + CLA IAC + DCA INPUT + JMS STRTIO + -1;XRUO +BINWR1, DCA INPUT + CLA IAC + DCA BINARY + JMS STRTIO + -1;XWUO +WCLOSE, CLA STL RTL /TRAP3 HERE TOO** + JMS OJSR /OUTPUT TRAP3 #WUC + XWUC + DCA IOSTMT /KILL IO SWITCH + JMP I QNEXT +OJSR, 0 /OUTPUT EXTERN THEN JSR OR TRAP3 + CLL RAL /AC ON ENTRY IS 0 (JSR), 1 (JSA) OR 2 (TRAP3). + TAD (JSR + DCA OJSROP + JMS I QOPCDE /FIRST EXTERN + EXTERN + TAD I OJSR + JMS I QOUTSYM + JMS I QCRLF + JMS I QOPCDE /THEN JSR +OJSROP, 0 + TAD I OJSR + ISZ OJSR + JMS I QOUTSYM + JMS I QCRLF + JMP I OJSR + +XWUC, TEXT '#RENDO' /** +XREADO, TEXT '#READO' +XWRITO, TEXT '#WRITO' +XRUO, TEXT '#RUO' +XWUO, TEXT '#WUO' +RDRTNE, TEXT /#RSVO/ +RDDRTN, TEXT /#RFDV/ +FTRNTM, 0617;2224;2216;2415 /FORTRN.TM + DNA, JMS I QCODE /AND CODE + ANDTBL-6;0 + JMP I QNEXT +PURGE, JMS I QGARG /LOOK AT THE TOP OF STACK + JMP I (IOTYPE /BAD TYPE + TAD ARG1 /IT MUST BE A SCALAR REFNCE + CLL + TAD QM63 + SNL CLA + JMP I (IOTYPE /BAD TYPE + JMP I QNEXT +PAUZE, JMS I QUCODE /GET ARG INTO FAC + AIFTBL-1 + JMS I QGENCOD /OUTPUT JSR + PAZCOD-1 + JMP I QNEXT + PAGE + /DIRECT ACCESS I/O + +DARD1, CLA IAC /SET SWITCHES + DCA INPUT + CLA IAC + DCA BINARY /SAME AS UNFORMATTED + JMS I (STRTIO /GENERATE CALL + -2;XRDAO +DAWR1, DCA INPUT /SAME AS UNFORMATTED WRITE OPEN + CLA IAC + DCA BINARY + JMS I (STRTIO /CALL + -2;XWDAO +DEFFIL, TAD XDFARG /FAKE A CALL + DCA I (STRTIO /TO SKIP THE ISZ IOSTMT + JMP I (STRTIO+2 +XDFARG, .+1 + -4;XDEF +XDEF, TEXT '#DEF' +XRDAO, TEXT '#RDAO' +XWDAO, TEXT '#WDAO' + / RANDOM UNFITTING STUFF +RETURN, JMS I QGENCOD /JA #RTN + RTNCOD-1 + JMP I QNEXT +GENSTF, 0 /GENERATE STARTF IF IN E MODE + TAD FMODE /LOOK AT THE SWITCH + SZA CLA + JMP I GENSTF /ALREADY THERE + ISZ FMODE /SET SWITCH + JMS I QOPCOD /OUTPUT STARTF + STARTF + JMS I QCRLF + JMP I GENSTF /RETURN +NOT, JMS I QUCODE /.NOT. + NOTTBL-1 + JMP I (RELGM1 +SUB, JMS I QCODE /SUBTRACT + SUBTBL-6;0 + JMP I QNEXT +MUL, JMS I QCODE /MULTIPLY + MULTBL-6;0 + JMP I QNEXT +ASFDEF, CLA IAC /SET SWITCH FOR ASF PROLOG + DCA ASFSWT + JMP I QNEXT +OINS, 0 /OUTPUT TAB OPCODE TAB + /ADDRESS CRLF + DCA WHATAC /ZAPS AC + JMS I QOTAB + TAD I OINS /GET OPCODE + ISZ OINS + JMS I QOUTSYM + JMS I QOTAB + TAD I OINS /GET ADDRESS + SZA + JMS I QOUTSYM + JMS I QCRLF /END LINE + ISZ OINS + JMP I OINS + / CODE GENERATOR FOR STORE +STORE, JMS I QGARGS /GET ARGS FOR STORE + JMP I (OTERR + TAD ARG1 /KILL ANY XR + /EXPRS. INVOLVING + JMS I QCHKXR /THE VARIABLE BEING STORED + TAD ARG2 /IS SECOND ARG IN AC ? + SNA CLA + TAD Q5 /YES, ADD 5 TO TYPE2 + TAD TYPE2 + DCA TYPE2 + TAD TYPE1 /TYPE1 TIMES TEN + CLL RTL + TAD TYPE1 + CLL RAL + TAD TYPE2 /PLUS TYPE2 + TAD (STRTBL-13 /PLUS TABLE BASE + DCA SSKEL /GIVES ENTRY ADDRESS + CDF 10 + TAD I SSKEL /POINTER TO SKELETON + DCA SSKEL + JMS I QGENCOD /GENERATE CODE +SSKEL, 0 + TAD ASFSWT /IS THIS END OF ASF ? + SZA CLA + JMP I QNEXT /YES, DON'T DO A STORE + TAD TYPE1 /MODE IS THE SAME + JMS I QSKPIRL /AS THE VARIABLE STORED IN + SKP + CLA IAC + DCA FMODE + JMS I QOPCOD /OUTPUT STORE + FSTA + JMS I QOADDR /ADDRESS FIELD + ARG1 + TAD ARG1 /REMEMBER THE AC + CIA + DCA WHATAC /(REMEMBER THE + TAD BASE1 /ALAMO ?) + CIA /(WOULD YOU + DCA WHATBS /BELIEVE THE MAINE ???) + ISZ ARG1 /GO TO TYPE WORD + CDF 10 + CLL /IF ARG1 IS + TAD ARG1 /A SS'D REFNCE + TAD QM63 /DON'T + SZL CLA /BOTHER CHECKING + TAD I ARG1 /LOOK AT SOME BITS + CDF + AND (3400 /DIM,EXT, OR ASF ? + SNA CLA + JMP I QNEXT + JMS I QTTYMSG /ATTEMPT TO STORE IN + 1720 /EXTERNAL OR ASF +FLDAP, TEXT 'FLDA%' + PAGE + /ARITHEMTIC STATEMENT FUNCTIONS (BLAH!) + +DEFASF, CDF /A.S.F. PROLOG + TAD FMODE /SAVE CPU MODE + DCA ASFMOD /SINCE WE JUMP ARROUND + TAD X14 /SET STACK POINTER + TAD (3 /SO THAT ASF NAME STAYS + DCA X16 + CLA CMA /SET ASF SWITCH + DCA ASFSWT + TAD TMPMAX /USE UNIQUE TEMPS + IAC + DCA TMPCNT /FOR ALL ASF'S + JMS I QXRTBL /AND FORGET XR'S + JMS I QOPCDE /JA AROUND + JA + TAD GLABEL /SAVE ARROUND LABEL + DCA ASFSKP + ISZ GLABEL /BUMP LABEL GENERATOR + TAD ASFSKP /PUT LABEL AS ADDRESS OF JA + JMS I QOLABEL + JMS I QCRLF + TAD GLABEL /FUNCTIONS XR'S O HERE + JMS I QLABEL /OUPTUT THE LABEL + JMS I QOINS /#GXXXX, ORG .+10 + ORG;DP8 + TAD BASE1 /NOW OUTPUT FUNCTION NAME + CDF 10 + JMS I QOUTNAM + TAD COMMA /AS TAG + JMS I QOCHAR /OF START OF FUNCTION + JMS I QOPCDE /SETX + XSET + TAD GLABEL /TO THE GENERATED LABEL + ISZ GLABEL + JMS I QOLABEL + JMS I QCRLF + JMS I QOINS /LDX 0,1 + LDX;ZEROC1 + JMS I QGENCOD /STARTD + SD-1 /JUST LIKE A SUBROUTINE + /ISN'T IT ? + JMS I QOINS /FLDA #BASE + FLDA;XBASE /GET RETURN JUMP + JMS I QOPCDE /STORE IT AHEAD + FSTA + TAD GLABEL /USING GENERATED LABEL + JMS I QOLABEL + JMS I QCRLF +ASFARG, JMS I QOINS /FLDA% #BASE,1+ + FLDAP;XBAC1P /GET ARG POINTER + JMS I QOINS /FSTA #BASE+3 + FSTA;XBASP3 /SAVE IT + TAD I X15 /GET PARAMETER + DCA ARG2 + TAD I X15 + DCA TYPE2 + ISZ X15 + TAD TYPE2 /IS IT SINGLE OR DOUBLE? + JMS I QSKPIRL + JMP ASFASE /DOUBLE + JMS I QGENCOD /STARTF + SF-1 + CLA IAC +ARGSV, DCA FMODE /SET FMODE APPROPRIATELY + JMS I QOINS /FLDA% #BASE+3 + FLDAP;XBASP3 /GET THE VALUE + JMS I QOPCOD + FSTA /AND SAVE IT + JMS I QOADDR + ARG2 + ISZ NARGS /ANY MORE ARGS ? + SKP + JMP I QNEXT /NO, END OF ASF PROLOG + JMS I QGENCOD /STARTD + SD-1 + JMP ASFARG /NEXT ARG +ASFASE, JMS I QGENCOD /STARTE + SE-1 + JMP ARGSV +ASFEND, 0 /HANDLE END OF A.S.F. + TAD ASFSWT /IS THIS END OF ASF ? + SNA CLA + JMP PTCH /V3C NO + DCA ASFSWT /CLEAR SWITCH + JMS I QOINS /RESET XR'S + XSET;ZXR + TAD GLABEL /OUTPUT SPACE FOR RETURN ADDR + ISZ GLABEL + JMS I QLABEL /OUPTUT THE LABEL + JMS I QOINS /ORG .+2 + ORG;DOTP2 + TAD ASFSKP /OUTPUT SKIP ARROUND LABEL + JMS I QLABEL /OUPTUT THE LABEL + JMS I QCRLF + TAD ASFMOD /RESET MODE SWITCH + DCA FMODE + TAD TMPMAX /UNIQUE TEMPS + IAC + DCA TEM /V3C MUST BE USED + JMS I QXRTBL /AND XR'S LOST +PTCH, TAD TEM /V3C + DCA TMPCNT /V3C + JMP I ASFEND /RETURN +ASFMOD, 0 +ASFSKP, 0 +IOFUN, JMS I QOPCDE /CALLED BY TRAP3,NOT JSR** + TRAP3 + TAD I TEMP + JMS I QOUTSYM /OUTPUT THE IO FUNCTION NAME + JMP I (IOONLY /DO SOME OTHER STUFF +ESUBR, TEXT '#EXPXX' /THIS WILL BE THE CORRECT NAME + PAGE + / I/O LIST ELEMENT + +IOLMNT, JMS I QGARG /GET THE ARG + JMP IOTYPE /TYPE ERROR + DCA IOLOOP /CLEAR LOOP SWITCH + CLL STA RTL /-3 + TAD TYPE1 + DCA TYPE1 /TYPE1 = 0 IF COMPLEX, 1 IF D.P. + TAD ARG1 /ADDR OF TYPE WD + CLL IAC + DCA ARG2 + TAD ARG1 /LOOK AT ARG + TAD QM63 + SNL CLA + JMP NOLOOP /NOT ARRAY OUTPUT + CDF 10 + CLL CML RTR /IS IT DIMENSIONED ? + AND I ARG2 + CDF + SNA CLA + JMP NOLOOP /NO, NO LOOP + ISZ IOLOOP /SET SWITCH + TAD ARG1 /GET TO SS + JMS I QGETSS + IAC /TOTAL SIZE WORD + DCA BASE1 + TAD I ARG2 /IS THIS ARRAY AN ARG ? + AND Q20 + DCA ARGIO /SET SWITCH + TAD I BASE1 /IS IT VARIABLY DIMENSIONED ? + SNA + JMP I (VDAIO /YES, MUST COMPUTE SIZE + DCA BASE2 /SAVE SIZE + CDF + JMS I QOPCDE /PUT SIZE IN XR 1 + LDX + TAD Q255 + JMS I QOCHAR /- + TAD BASE2 + JMS I QONUMBR + TAD COMMA + JMS I QOCHAR + TAD (261 + JMS I QOCHAR + JMS I QCRLF + TAD ARGIO /IS IT AN ARG ? + SZA CLA + JMP I (ARGIOA /YES +OLLABL, TAD GLABEL /OUTPUT LABEL + JMS I QOLABEL + DCA I (XRBUFR+20 /KILL XR1 ENTRY + TAD COMMA + JMS I QOCHAR +NOLOOP, TAD INPUT /INPUT OR OUTPUT ? + SNA CLA + JMP OUTV /OUTPUT + JMS FIXCAL /SET PTR FOR OJSR** + JMS I (DUMSUB /NOW THE STORE + FSTA + TAD ARG1 /KILL ASSOCIATED + JMS I QCHKXR /XR EXPRESSIONS +CDSFLP, TAD TYPE1 /IS IT C OR D ? + CLL RAR + SZA CLA + JMP ENDLUP /NO, NO STARTE + JMS I QGENCOD + SF-1 +ENDLUP, TAD IOLOOP /IS THERE A LOOP ? + SNA CLA + JMP I QNEXT /NO, DO NEXT LIST ELEMENT + JMS I QOPCDE /YES, OUTPUT JXN + JXN + TAD GLABEL + ISZ GLABEL /OUTPUT LABEL + JMS I QLABEL /OUPTUT THE LABEL + TAD (261 + JMS I QOCHAR + TAD PLUS /OUTPUT PLUS (FOR + /INCREMENT DUMMY) + JMS I QOCHAR + JMS I QCRLF + JMP I QNEXT /DO NEXT LIST ELEMENT +OUTV, TAD TYPE1 /D OR C ? + CLL RAR + SZA CLA + JMP .+3 /NO, NO STARTF NECCESSARY + JMS I QGENCOD + SE-1 + JMS I (DUMSUB /OUTPUT FLDA + FLDA + JMS FIXCAL + JMP CDSFLP /THEN STARTF AND JXN IF ANY +FIXCAL, 6401 + TAD TYPE1 /IF VARIABLE IS COMPLEX, + CIA /OR IF VARIABLE IS DOUBLE AND + SZA /I/O IS BINARY, + TAD BINARY /GENERATE A JSR #RFDV + SNA CLA /ELSE GENERATE A TRAP3 #RSVO + JMP BINDIO + CLA STL RTL /SET PTR + JMS I (OJSR /NOW GO DO IT + RDRTNE /HERE'S THE NAME + JMP I FIXCAL +BINDIO, JMS I (OJSR + RDDRTN + JMP I FIXCAL + +IOTYPE, JMS I QTTYMSG /IO TYPE ERROR + 1124 +DEFLBL, JMS I QCRLF /CRLF BEFORE LABL + JMS I QGENSF /ENTER F MODE BEFORE ALL LABELS + JMS I QINWORD /GET THE LABEL + CDF 10 + JMS I QOSNUM /OUTPUT IT + TAD COMMA + JMS I QOCHAR + JMS I QXRTBL /KILL XR TABLE + DCA WHATAC /AND AC AT LABEL + JMP I QNEXT + PAGE + / I/O LIST ELEMENT + +VDAIO, CLL CMA RAL /GET ADDR OF NUMBER OF DIMS + TAD BASE1 + DCA X10 + TAD I X10 /GET DIM COUNT + CIA + DCA NARGS + ISZ X10 /SKIP SIZE + ISZ X10 /AND MAGIC NUMBER + ISZ X10 /AND LITERAL NUMBER + TAD (FLDA /LOAD FIRST DIM + SKP +GSIZLP, TAD (FMUL /MULTIPLY THE REST + DCA OPCIO + CDF 10 + TAD I X10 /GET THE NEXT DIMENSION + DCA TYPE2 + CDF + JMS I QOPCOD /OUTPUT OPCODE +OPCIO, 0 + JMS I QOADDR /NOW THE DIMENSION + TYPE2 + ISZ NARGS + JMP GSIZLP /KEEP GOING + JMS I QOPCOD /NEGATE THE FAC + FNEG + JMS I QCRLF + JMS I QGENCOD /PUT THE COUNT INTO XR1 + ATX1-1 +ARGIOA, JMS I QGENCOD /PUT -1 INTO XR 2 + LXM1C2-1 + JMS I QOPCDE /LOAD THE ARG POINTER - + FLDA /CONST + DCA I (XRBUFR+40 /KILL XR 2 ENTRY + TAD ARG1 + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMS I QOPCDE /NOW ADD THE MAGIC NUMBER + FADD + TAD QLITRL /OUTPUT #LIT+XXXX + JMS I QOUTSYM + CDF 10 + ISZ BASE1 + ISZ BASE1 + TAD I BASE1 + CDF + JMS I QONUMBR + JMS I QCRLF + JMS I QOPCDE + FSTA /NOW STORE IN #BASE+3 + TAD (XBASP3 + JMS I QOUTSYM + JMS I QCRLF + JMS I QGENCOD /STARTF + SF-1 + JMP I (OLLABL /NOW THE INSIDE OF THE LOOP +DUMSUB, 0 /OUTPUT FLDA OR FSTA + /WITH SE IF NEEDED + TAD I DUMSUB /GET THE OPCODE + DCA LDASTA + ISZ DUMSUB + TAD TYPE1 /MUST WE SE ? + CLL RAR /TYPE1 IS 0 IF C, 1 IF D + SNA CLA + TAD Q3 /MULTIPLIER IS 6 + TAD Q3 /OR 3 + DCA MQ + JMS I QOPCOD /FLDA OR FSTA +LDASTA, 0 + TAD IOLOOP /IS IT A LOOP ? + SNA CLA + JMP EZVAR /NO + TAD ARGIO /IS IT AN ARG ? + SZA CLA + JMP IBASP3 /YES, INDIRECT THROUGH #BASE+3 + JMS I QOTAB + TAD ARG1 + CDF 10 /OUTPUT NAME + JMS I QOUTNAM + TAD (255 /- + JMS I QOCHAR + TAD BASE2 /NEGATIVE OF SIZE + CIA + JMS I QMUL12 /TIMES 6 OR 3 + JMS I QNUMBRO + TAD COMMA /COMMA SEVEN + JMS I QOCHAR + TAD (261 + JMS I QOCHAR + JMS I QCRLF + JMP I DUMSUB /RETURN +EZVAR, JMS I QOADDR /ITS A SCALAR + ARG1 + JMP I DUMSUB +IBASP3, TAD (245 /INDIRECT THROUGH #BASE+3 + JMS I QOCHAR + JMS I QOTAB + TAD (XBPC2P /FLDA% #BASE+3,2+ + JMS I QOUTSYM + JMS I QCRLF + JMP I DUMSUB +XBPC2P, TEXT '#BASE+3,2+' +OR, JMS I QCODE + ORTABL-6;0 + JMP I (RELGEN +XOR, JMS I QCODE + EQVTBL-6;0 + JMP I (RELGEN +DOTP2, TEXT '.+2' +ZXR, TEXT '#XR' + PAGE + / ASSIGNED GOTO AND ASSIGN + +AGOTO, JMS GTSTUF /LOOK AT THE ASSIGNED VAR + JMS I QGENCOD /GENERATE A JAC + AGTCOD-1 + JMP I QNEXT +ASSIGN, JMS I QGARG /GET THE ASSIGN VAR + JMP GTTYPE + CLL CMA RTL /MUST BE I OR R + TAD TYPE1 + SMA CLA + JMP GTTYPE /GOTO TYPE ERROR + JMS I QGENCOD /GENERATE THE ASSIGN CODE + ASNCOD-1 + JMS I (JAGEN + JMS I QGENCOD /NOW STORE IT + ASTOR-1 + JMP I QNEXT + / OPTIMIZER SUBROUTINES +CHEKXR, 0 /KILL XR EXPRS + CIA /ASSOCIATED WITH THIS VAR + DCA KILVAR /SINCE IT HAS + /JUST BEEN CHANGED + TAD (-7 /LOOK AT XR 1 THRU 7 + DCA TEMP /COUNT + TAD (XRBUFR+20 /POINTER + DCA TEMP2 +KILLUP, TAD I TEMP2 /GET NEXT XR + /EXPR. INDICATOR + SNA CLA + JMP EOKL /NOTHING HERE + TAD TEMP2 /GET POINTER + DCA X13 /INTO AN XR + TAD I X13 /GET ADDR OF DIB + DCA DIMPTR /SAVE IT + CDF 10 /FIELD OF SYMBOL TABLE + TAD I DIMPTR /GET NUMBER OF + /DIMENSIONS + CMA /COMPLIMENTED + DCA NARGS /SAVE IT + CDF /BACK TO FIELD OF XRBUFR +CHKKIL, ISZ NARGS /CHECK 1 LESS + /THAN THE NUMBER + SKP /OF DIMENSIONS + JMP EOKL + TAD I X13 /LOOK AT NEXT + /ELEMENT OF EXPR + TAD KILVAR /IS IT THE VAR + /JUST CHANGED ? + SNA CLA + DCA I TEMP2 /YES, KILL THIS EXPRESSION + JMP CHKKIL /LOOP +EOKL, TAD TEMP2 /DO NEXT XR + TAD Q20 + DCA TEMP2 /BUMP POINTER BY 16 + ISZ TEMP + JMP KILLUP + JMP I CHEKXR /RETURN +KILVAR, +XRTABL, 0 /CLEAR OR RESET + /XR TABLE FLAGS + DCA TYPE /0=CLEAR 1=RESET + TAD (-7 /DO XR1 THRU 7 + DCA TEMP /COUNT + TAD (XRBUFR+20 /POINTER + DCA TEMP2 +XRTLUP, TAD I TEMP2 /GET INDICATOR + SNA CLA + JMP .+3 /DON'T CHANGE IF ZERO + TAD TYPE /OTHERWISE SET TO + DCA I TEMP2 /'USED BY + /PREVIOUS STMT' + TAD TEMP2 /GET TO NEXT ONE + TAD Q20 + DCA TEMP2 /BUMPING BY 16 + ISZ TEMP + JMP XRTLUP /LOOP + JMP I XRTABL /DONE +LOADA, 0 /GENERATE AN FLDA + TAD I LOADA /IF NECESSARY + DCA LODARG /GET ARG POINTER + ISZ LOADA /BUMP RETURN + TAD I LODARG /DOES AC MATCH ? + TAD WHATAC + SZA CLA + JMP DOLOAD /NO, MUST LOAD + TAD LODARG /GET ADDRESS + IAC /OF BASE + DCA ARG /IN CASE SS'D + TAD I ARG /DOES BASE MATCH? + TAD WHATBS + SNA CLA + JMP I LOADA /OK, DON'T LOAD +DOLOAD, JMS I QOPCOD /GENERATE FLDA + FLDA + JMS I QOADDR /ADDRESS +LODARG, 0 + JMP I LOADA + PAGE + / INTER PASS EQUATES + BLNKCN=21 + ALIST=23 + INTLST=60 + FPLIST=56 + DPLIST=57 + CMPLST=61 + HOLIST=55 + SNLIST=62 + ONEI=63 + THREE=70 + SIX=75 + TRUE=102 + / START PASS 2 (INTER PASS COMMUNICATION) + IFNZRO OVERLY < + FIELD 0 + NOPUNCH + *OVRLAY> + IFZERO OVERLY < + FIELD 0 + ENPUNCH + *OVRLAY> +START2, JMP I Q7605 /RETURN BUT DON'T SAVE CORE + TAD I X10 /PICK UP NEXT FROM PASS 1 + DCA X17 + TAD X17 /SAVE POINTER TO + /EXTERNAL LITERALS + DCA EXTLIT + TAD I X10 /PASS ONE STACK LEVEL + DCA X11 + TAD I X10 /TEMP FILE START + DCA INBLOK + TAD I X10 /AND SIZE + CMA + DCA INRCNT + TAD I X10 /START OF PASS2O.SV + DCA PASS2O + TAD I X10 /START OF OUTPUT FILE + DCA FILBLK /SAVE IT FOR CHAINING TO RALF + TAD FILBLK + DCA OBLOCK + TAD I X10 + DCA OSIZE /ALSO MAX SIZE + TAD I X10 /PICK UP PROG NAME + DCA PROGNM + TAD I X10 + DCA ARGLST /AND ARG LIST ADDR + TAD I X10 /AND + /FUNCTION/SUBROUTINE/MAIN SWITCH + DCA FUNCTN + TAD I X10 /GET DP HARDWARE SWITCH + DCA DPUSED + TAD I X10 /CHECK FOR CROSSED VERSIONS + TAD VERS + SZA CLA + JMP VERROR /VERSION ERROR + STA STL /V3C +DCLOOP, TAD X11 /V3C THIS ADD CLEARS THE LINK + DCA X11 /V3C + TAD X11 + TAD (-STACK1 + SNL CLA + JMP PSN /GO DO STMT NUMBERS + TAD I X11 /GET DO LOOP ENDING STMT NUMBER + IAC + DCA X10 + CDF 10 + TAD (0416 /DN DO END MISSING + JMS NPRNT /GO PRINT THE MESSAGE + /AND THE NUMBER + CDF + CLL CMA RTL + JMP DCLOOP /V3C BACK UP 2 +PSN, TAD (SNLIST /PROCESS STMT NUMBERS + CDF 10 +SNCLUP, DCA ENTRY /SAVE NEW ENTRY ADDR + TAD I ENTRY /GET ADDR OF NEXT ENTRY + SNA + JMP SNDONE /NO MORE STMT NUMBERS + IAC + DCA TEMP /ADDR OF TYPE WORD + TAD I TEMP /WAS STMT NUMBER DEFINED? + SPA CLA + JMP SNDEFN /YES + TAD TEMP + DCA X10 + TAD (2523 /PRINT US MESSAGE + JMS NPRNT +SNDEFN, TAD (0110 /SET TYPE WORD + DCA I TEMP + TAD I ENTRY /PROCEED + JMP SNCLUP +SNDONE, CDF +FIXELP, JMS I (TYPRTN + NEGSLV /FIX UP NEGATIVE EQUIVALENCE OFFSETS + CLL CML RTL /CHECK FOR BLOCK DATA + TAD FUNCTN /(FUNCTN=-2) + SNA CLA + JMP BDSTUF /IT IS + JMS I (TYPRTN /DO IMPLICIT TYPING + IMPLCT + JMS I (TYPRTN /REMOVE SUB ARGS FROM LIST + SUBARG + JMS I (TYPRTN /EXTERNALS + EXTRNL + JMP I (PROLG1 /MORE PROLOG +BDSTUF, TAD I (BDSWIT /SET UP SWITCH + DCA I (PROLG2 + TAD (END2 /ALTER END CODE + CDF 10 + DCA I (XEND + CDF 0 + DCA NODBUG /NO ISN'S + JMP I (HOLDUN /DO SOME STUFF +SUBARG, 0 /REMOVE ARGS FROM ST + TAD I TYPE + AND Q20 /CHECK ARG BIT + SNA CLA + JMP I SUBARG + JMS UNHOOK + JMP TFUDGE + +UNHOOK, 0 + TAD I ENTRY + DCA I OENTRY + TAD BUCKET + DCA I ENTRY + JMP I UNHOOK + +VERROR, TAD (2605 /PRINT VE (VERSION ERROR) + JMS I QTTYP2C + JMS I QTTCRLF + JMP I Q7605 + PAGE + / GENERATE ARGUMENT STORAGE + +PROLG1, JMS I (INS2 / %JA #ST + JA;XST + JMS I (INS /#XR, %ORG .+10 + XXR;ORG;DP8 + JMS I QOPCDE / %TEXT #NAMEXX# + TEXTX + TAD PLUS + JMS I QOCHAR + CDF 10 + TAD PROGNM + JMS I QOUTNAM + JMS I (FILL /FILL WITH BLANKS + TAD PLUS + JMS I QOCHAR + ISZ PROGNM + JMS I QCRLF + JMS I (INS /#RET, %SETX #XR + XRET;SETX;XXR + JMS I (INS2 / %SETB #BASE + SETB;XBASE + JMS I (INS2 / %JA .+3 + JA +XDP3, DP3 + JMS I (INS /#BASE, %ORG .+6 + XBASE;ORG;DP6 + TAD ARGLST /ANY ARGS ? + SNA + JMP NOARGS /NO, SKIP THIS STUFF + DCA X10 /SAVE POINTER TO ARG LIST + CDF 10 /HOW MANY ? + TAD I ARGLST + CIA + DCA NARGS /THIS MANY + DCA TEMP2 /ARRAY ARG COUNTER +ARGLP1, JMS PLSUB1 /OUTPUT DEFS FOR ARRAY + /ARGS FIRST + SNA CLA /SINCE THEY MUST BE + /INDIRECTABLY + JMP NOARAY /REFERENCABLE + ISZ TEMP2 +NOARAY, ISZ NARGS + JMP ARGLP1 /PROCESS ENTIRE ARG LIST + CDF 10 + TAD I ARGLST /GO THRU ARGS AGAIN + CIA CLL + DCA NARGS + TAD ARGLST + DCA X10 + TAD TEMP2 /HOW MANY ARRAY ARGS ? + TAD QM6 + SNA + JMP NISA /NO INDIRECT LOCS LEFT + /FOR SCALARS + DCA TEMP2 + SZL CLA + JMP TOOMNY /TOO MANY ARRAY ARGS (>6) +ARGLP2, JMS PLSUB1 /NOW OUTPUT AS MANY INDIRECT + SZA CLA /SCALAR ARGS AS POSSIBLE + JMP NOSCLR /TO REDUCE THE PROLOG + ISZ TEMP2 /ROOM FOR ANY MORE + SKP + JMP NISA2 /NO, THE REST MUST MOVE VALUES +NOSCLR, ISZ NARGS /LOOP SOME MORE + JMP ARGLP2 + JMS I (PLSUB2 /OUTPUT SOME TRACEBACK STUFF + JMP I (MORE /GENERATE SCALAR, + /LITERAL AND TEMP STORAGE +NISA2, JMS I (PLSUB2 + JMP NDLP3 /OUTPUT TRACEBACK + /STUFF,THEN REST +NISA, JMS I (PLSUB2 /GET PAST THE TRACEBACK STUFF +ARGLP3, TAD XM3 /GENERATE ORG .+6 FOR D OR C + DCA XNOP + JMS PLSUB1 /OUTPUT REMAINING + /SCALAR ARG SPACE + SZA CLA + JMP NDLP3 + CDF 10 + TAD I TEMP /TURN OFF SUBARG BIT + AND (7757 /(THATS THE + /SECOND TIME I FIXED THIS) + + DCA I TEMP +NDLP3, ISZ NARGS + JMP ARGLP3 + CDF + JMP I (MORE /GENERATE SCALAR, + /LITERAL AND TEMP STORAGE + +NOARGS, JMS I (PLSUB2 /NO ARGS, OUTPUT TRACEBACK STUFF + JMP I (MORE /GENERATE SCALAR, + /LITERAL AND TEMP STORAGE +PLSUB1, 0 + CDF + TAD I PLSUB1 /GET THE SKIP + DCA PLSKIP + ISZ PLSUB1 + CDF 10 + TAD I X10 /GET THE NEXT ARG + IAC + DCA TEMP /TYP WORD ADDR + CLL CML RTR /2000=DIM BIT + AND I TEMP +PLSKIP, 0 /ARRAYS OR SCALARS ? + JMP I PLSUB1 + ISZ PLSUB1 + CLA CMA + TAD TEMP /DEFINE THIS VAR + JMS I QOUTNAM + TAD COMMA + JMS I QOCHAR + CDF 10 + TAD I TEMP /LOOK AT THE TYPE + CDF + JMS I QSKPIRL /SKIP IF NOT C OR D +XNOP, NOP /THIS IS CHANGED LATER (MAYBE) + TAD XDP3 /.+3 OR .+6 + DCA .+3 + JMS I (INS2 /ORG FOR THE VALUE + ORG;0 + JMP I PLSUB1 +TOOMNY, TAD P0F1 /TOO MANY ARRAY ARGS + JMP I P0F2 +XM3, CLL CML RTL + PAGE + / SCALARS, LITERALS & TEMPS + +HOLLIT, +MORE, JMS I (TYPRTN /OUTPUT SCALARS + SCALAR + TAD (TEMPS /OUTPUT FIRST FIVE TEMPS + JMS I (OUTVAR + TAD (LITRL2 + JMS I QOUTSYM + TAD COMMA /OUTPUT %LITRL, + JMS I QOCHAR + JMS I (DOLIST + INTLST +O141, 0141;-3 /OUTPUT INTEGER LITERALS + JMS I (DOLIST + FPLIST + 0142;-3 /OUTPUT FP LITERALS + JMS I (DOLIST + DPLIST + 0144;-6 /DOUBLE LITERALS + JMS I (DOLIST + CMPLST + 0143;-6 /COMPLEX LITERALS + JMS I (TYPRTN /OUTPUT DIMENSION FACTORS + DFLIT + JMS I (ADFLIT /OUTPUT ARG DIM FACTOR LITERALS + TAD (HOLIST /OUTPUT HOLLERITH LITERALS + DCA ENTRY +HOLLUP, CDF 10 + TAD I ENTRY + SNA + JMP HOLDUN + DCA ENTRY /SAVE NEW ENTYR + TAD ENTRY + DCA X10 + TAD O141 /SET TYPE INFO + DCA I X10 + TAD LITNUM + DCA I X10 /SAVE LIT DISP + CLL CMA RTL /SET UP COUNTER + DCA HOLLIT /BY THREES +HOLOOP, CDF 10 /OUTPUT LITERAL AS OCTALS + TAD I X10 + CDF + SNA + JMP HOFILL /FILL OUT REST + DCA ARG + TAD ARG + AND (77 /IS THIS LAST WORD? + SZA CLA + JMP .+4 /NO + TAD ARG /YES, STICK IN + TAD Q40 /BLANK + JMP HOFILL+1 /AND OUTPUT IT + TAD ARG /OUTPUT CHAR PAIR + JMS ONUM + ISZ HOLLIT + JMP HOLOOP + JMP HOLOOP-2 +HOFILL, TAD (4040 /FILL WITH BLANKS + JMS ONUM + ISZ HOLLIT + JMP HOFILL + JMP HOLLUP /DO NEXT HOLLERITH LITERAL +HOLDUN, CDF + JMS I (TYPRTN /DO ARRAYS + ARRAYS + JMS I (TYPRTN /REMOVE COMMON VARS FROM S.T. + COMVAR + JMS I QOTAB + TAD (XLBLE /#LBL=. + JMS I QOUTSYM + JMS I QCRLF + CDF 10 /LOOK AT THE BLANK COMMON LIST + TAD I (ONEI+2 /MAKE TRUE=INTEGER ONE + DCA I (TRUE+2 + TAD I (BLNKCN+1 + CDF + SNA + JMP NOBC /NO BLANK COMMON + DCA TYPE /POINTER TO VARIABLE LIST + JMS I QOPCOD + COMMON + JMS I QCRLF + CDF 10 +BCLOOP, TAD TYPE /PROCESS THIS HUNK OF + /BLANK COMMON + DCA X10 + TAD I X10 + SNA + JMP NXTBC /EMPTY HUNK + CIA /SIZE OF HUNK + DCA TEMP + TAD I X10 /OUTPUT HUNK + JMS I (OUTVAR + CDF 10 + ISZ TEMP + JMP .-4 +NXTBC, TAD I TYPE /ADDR OF NEXT HUNK + SNA + JMP NOBC /THAT WAS THE LAST HUNK + DCA TYPE + JMP BCLOOP /DO NEXT HUNK +NOBC, CDF + JMS I (TYPRTN /DO NAMED COMMONS + COMNAM + JMS I (TYPRTN /NOW EQUIVALENCES + EQUIVS + JMS INS2 + ORG;XLBL /%ORG #LBL + JMP I (PROLG2 /COMPLETE PROLOG + PAGE + / ARGUMENT PICKUP GENERATOR + +PROLG2, TAD FUNCTN /SECOND PART OF PROLOG + SZA CLA + JMP DORETN /NOT A MAIN PROG + JMS I (INS /#ST, BASE #BASE + XST;BASE;XBASE + JMS I (INS2 / SETB #BASE + SETB;XBASE + JMS I (INS2 / SETX #XR + SETX;XXR +BDSWIT, JMP I (FINIST /GO GET OVERLAY +DORETN, JMS I (INS /#RTN, BASE #BASE + XRTN;BASE;XBASE + TAD ARGLST /ANY ARGS ? + SNA + JMP JAGOBK /NO + DCA X10 /POINTER TO THE LIST + CDF 10 + TAD I ARGLST /NUMBER OF ARGS + CIA + DCA NARGS + DCA TEMP2 /ZERO ARG COUNTER + CDF + TAD NARGS /WILL WE RESTORE ANY ? + TAD (6 + SMA CLA + JMP JAGOBK /NO + JMS I (INS2 / FLDA #ARGS + FLDA;XARGS + JMS I (INS2 / FSTA #BASE + FSTA;XBASE +RSLOOP, CDF 10 + TAD I X10 /GET NEXT ARG + IAC + DCA TEMP /ADDR OF TYPE WORD + ISZ TEMP2 /INCR COUNT + TAD I TEMP /IS IT A VALUE TRANSMISSION ? + AND Q20 + CDF + SZA CLA + JMP NOREST /NO, DON'T RESTORE IT + JMS I QOPCDE / %LDX XXXX,1 + LDX + TAD TEMP2 + JMS I QONUMBR + TAD (C1 + JMS I QOUTSYM + JMS I QCRLF + JMS I QGENCOD /STARTD + SD-1 + JMS I (INS2 /GET POINTER TO ARG + FLDAI;XBASC1 + JMS I (INS2 /AND SAVE IN #BASE+3 + FSTA;XBASP3 + JMS STFORE /INTO CORRECT MODE + JMS I QOPCDE /FLDA VAR + FLDA + CMA + TAD TEMP + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMS I (INS2 / FSTA% #BASE+3 + FSTAI;XBASP3 +NOREST, ISZ NARGS + JMP RSLOOP + JMS I QGENCOD /MAKE SURE WE'RE IN F MODE +QSFM1, SF-1 +JAGOBK, TAD FUNCTN /WHAT WAS THIS ? + SPA CLA + JMP NOFVAL /NOT A FUNCTION + CDF 10 /GET TYPE + TAD I PROGNM + AND Q17 + TAD (FVAL-1 /PLUS TABLE ADDRESS + DCA GVSKEL /GIVES POINTER TO + /SKELETON ADDRESS + TAD I GVSKEL /GET SKELETON ADDRESS + DCA GVSKEL + JMS I QGENCOD /PICK UP FUNCTION VALUE +GVSKEL, 0 +NOFVAL, JMS I (INS2 / JA #GOBAK + JA;XGOBAK + JMS I (INS /#ST, %STARTD + XST;STARTD;0 + JMS I QOTAB + TAD (210 / %FLDA' 10 + JMS I QONUMBR + JMS I QCRLF + JMS I (INS2 / %FSTA #GOBAK,0 + FSTA;XGOBC0 + JMP I (MORPLG + +STFORE, 0 /START F OR E + CDF 10 + TAD I TEMP /GET TYPE + CDF + JMS I QSKPIRL /SKIP ON I R OR L + TAD (SE-SF /SE + TAD QSFM1 /SF + DCA .+2 + JMS I QGENCOD + 0 + JMP I STFORE /DON'T FORGET TO + /RETURN DUMMY +XARGS, TEXT '#ARGS' + PAGE + / ENTRY AND EXIT CODE + +MORPLG, JMS I QOTAB + TAD Q200 / FLDA' 0 + JMS I QONUMBR + JMS I QCRLF + JMS I (INS2 / %SETX #XR + SETX;XXR + JMS I (INS2 / %SETB #BASE + SETB;XBASE + TAD ARGLST /ANY ARGS ? + SNA + JMP I (ENDPLG /NO, JUST STARTF + DCA ARG /SAVE POINTER TO THEM + JMS I (INS2 / %LDX 0,1 + LDX;ZC1 + JMS I (INS2 / %FSTA #BASE + FSTA;XBASE + JMS I (INS2 / %FSTA #ARGS + FSTA;XARGS + CDF 10 + TAD I ARGLST /NUMBER OF ARGS + CIA + DCA NARGS +GALOOP, CDF + JMS I (INS2 / %FLDA I #BASE,1+ + FLDAI;XBAC1P + DCA TYPE /CLEAR THE SD SWITCH + CDF 10 + ISZ ARG /GET TO NEXT ARG + TAD I ARG /LOOK AT ITS TYPE WORD + IAC + DCA TEMP + CLL CML RTR + AND I TEMP /WAS IT DIMENSIONED ? + SNA CLA + JMP I (TSTABT /NO, SEE IF ITS VALUE + CMA + TAD TEMP /GET ADDR OF DIM INFO + JMS I QGETSS + IAC /ADDR OF SIZE + DCA TEMP2 + TAD I TEMP2 + ISZ TEMP2 + ISZ TEMP2 + SNA CLA + JMP OUFSTA+1 /IT HAS A VARIABLE DIMENSION + TAD I TEMP2 /GET MAGIC NUMBER LIT DISP + DCA TEMP2 + CDF + JMS I QOPCDE / %FSUB #LIT+XXXX + FSUB + TAD QLITRL + JMS I QOUTSYM + TAD TEMP2 + JMS I QONUMBR + JMS I QCRLF + CDF 10 +OUFSTA, DCA I ARG /IT ISN'T VARIABLY DIMENSIONED + CDF + JMS I QOPCDE / %FSTA ARGN + FSTA + CDF 10 + CMA + TAD TEMP + JMS I QOUTNAM + JMS I QCRLF + ISZ NARGS + SKP + JMP I (ENDPLG /END OF PROLOG + TAD TYPE /DID WE LEAVE D MODE + SNA CLA + JMP GALOOP /NO + JMS I QGENCOD /YES, OUTPUT AN %SD + SD-1 + JMP GALOOP +FINIST, CDF 10 + TAD FUNCTN /WAS THIS A FUNCTION ? + SPA SNA CLA + JMP .+4 /NO, SKIP THIS + TAD I PROGNM /YES, TURN OFF EXT BIT + AND (6777 /ALLOWING STORING IN FUN NAME + DCA I PROGNM + TAD (2200 /CHECK /N /Q + AND I (7644 + CDF + SNA CLA +NODBUG, DCA I (DEBUG /IF NOT SET, PUT ISN'S + CDF 10 /INTO CODE + TAD I (7644 /IS /Q SET ? + CDF + AND (0200 + SZA CLA + ISZ I (OPTMYZ /MAKE A CLA IAC FROM A CLA +GFNAME, CDF 10 + TAD I FNAME /MOVE FILE NAME + CDF + DCA I NAMEF /INTO PAGE + ISZ FNAME + ISZ NAMEF + ISZ NFCNT + JMP GFNAME + JMP I (RDOVLY /GO WHERE ? + /CALIFORNIA OF COURSE!!!! +FNAME, 7601 +NAMEF, F1LNAM +NFCNT, -4 + +ONUM, 0 + ISZ LITNUM /BUMP LITERAL COUNTER + DCA ARG + JMS I QOTAB + TAD ARG + JMS I QONUMBR + JMS I QCRLF + JMP I ONUM + PAGE + / ENTRY AND EXIT CODE + +TSTABT, TAD I TEMP /VALUE TRANSMISSION ? + AND Q20 + SZA CLA + JMP I (OUFSTA /NO + CDF + JMS I (INS2 / %FSTA #BASE+3 + FSTA;XBASP3 + JMS I (STFORE /ENTER CORRECT MODE + JMS I (INS2 / %FLDA% #BASE+3 + FLDAI;XBASP3 + ISZ TYPE /SET SWITCH + JMP I (OUFSTA-1 +ENDPLG, JMS I QGENCOD /%SF + SF-1 + TAD ARGLST /ANY VARIABLY + /DIMENSIONED ARRAYS ? + SNA + JMP I (FINIST /NO ARGS AT ALL + DCA X10 + CDF 10 + TAD I ARGLST /NUMBER OF ARGS + CIA + DCA NSARGS +VDIMLP, CDF 10 + TAD I X10 /GET NEXT ARG + SNA + JMP NDVDIM /NOT A VARIABLY + /DIMENSIONED ARRAY + DCA VDTEMP + TAD VDTEMP /GET ADDR OF DIMENSION INFO + JMS I QGETSS + DCA VDTMP2 + TAD I VDTMP2 /NUMBER OF DIMENSIONS + CIA + DCA NARGS + ISZ VDTMP2 /MOVE TO MAGIC NUMBER LITERAL + ISZ VDTMP2 + ISZ VDTMP2 + TAD I VDTMP2 /GET IT + CDF + DCA MNL /SAVE MAGIC NUMBER LITERAL + TAD (FLDA /JUST LOAD FIRST DIM + DCA MNOPC + TAD NARGS /GET ADDRESS + CIA /OF THE LAST + TAD VDTMP2 /DIMENSION + DCA VDTMP2 /FOR THE SIZE GETTER + JMP CMPMN3 /SKIP MULTIPLY FIRST TIME +CMPMN1, TAD (FMUL /NEXT TIME USE A MULTIPLY + DCA MNOPC + JMS I QOPCOD /NEXT SUBSCRIPT (ALWAYS (1.0) + FADD + JMS I QOADDR /NOW ADDRESS + (ONEI +CMPMN3, ISZ NARGS /ANY MORE SS ? + JMP CMPMN2 /YES + ISZ VDTEMP /GET TO TYPE + CDF 10 + TAD I VDTEMP + CDF + JMS I QSKPIRL /SKIP ON I R L + TAD Q6M3 /YES + TAD (THREE + JMS LDAMUL /3.02 + JMS I (INS2 /ALN 0 + ALN;D0 + JMS I QOPCDE + FSTA + TAD QLITRL /SAVE IN THE MAGIC + /NUMBER LITERAL + JMS I QOUTSYM + CLA CMA + TAD MNL + JMS I QONUMBR + JMS I QCRLF + JMS I (INS2 /FNEG + FNEG;0 + JMS I (INS2 /ENTER D MODE + STARTD;0 + JMS I QOPCDE + FADDM /NOW MODIFY THE POINTER + CMA + TAD VDTEMP + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMS I (INS2 /RETURN TO F MODE + STARTF;0 +NDVDIM, ISZ NSARGS /ANY MORE ARGS TO CHECK? + JMP VDIMLP /YES + CDF + JMP I (FINIST +CMPMN2, CLA CMA /BACK UP THE POINTER + TAD VDTMP2 /BY ONE + DCA VDTMP2 + CDF 10 + TAD I VDTMP2 /GET IT + CDF + JMS LDAMUL /3.02 + JMP CMPMN1 /LOOP +VDTEMP, 0 +VDTMP2, 0 +NSARGS, 0 +MNL, 0 +DP12, TEXT '.+14' +LDAMUL, 0 /3.02 + DCA MNADR + JMS I QOPCOD +MNOPC, 0 + JMS I QOADDR + MNADR + JMP I LDAMUL +MNADR, 0 + PAGE +/ RANDOM PROLOG STUFF + +ARRAYS, 0 /OUTPUT ARRAYS + TAD I TYPE + AND (6220 /IS IT AN ARRAY + SNA + JMP I ARRAYS + AND (4220 /NOT COMMON, EQUIV OR ARG + SZA CLA + JMP I ARRAYS + JMS I (UNHOOK /REMOVE FROM BUCKET + TAD ENTRY /OUTPUT VARIABLE + JMS I (OUTVAR + JMP TFUDGE-1 +FILL, 0 /FILL SUB NAME WITH BLANKS + CLL CML RTL + TAD PROGNM /PROGNM+2 + CIA /-PROGNM-2 + TAD I XNAMP /1,2,3 + TAD QM4 /-3,-2,-1 + DCA TEMP + JMP .+5 + TAD (240 /TWO BLANKS FOR EACH WORD + JMS I QOCHAR + TAD (240 + JMS I QOCHAR + ISZ TEMP /MORE ? + JMP .-5 /YES + JMP I FILL +XNAMP, NAMPTR +NPRNT, 0 + JMS I QTTYP2C + JMS I QTTYP2C + TAD I X10 /NOW NUMBER + JMS I QTTYP2C + TAD I X10 + JMS I QTTYP2C + TAD I X10 + JMS I QTTYP2C + JMS I QTTCRLF + JMP I NPRNT + /ROUTINE TO FIX UP NEGATIVE EQUIVALENCE OFFSETS + +NEGSLV, 0 + TAD I TYPE + AND Q200 + SNA CLA /IS VARIABLE A SLAVE? + JMP I NEGSLV /NO + TAD TYPE + DCA X10 + TAD I X10 /GET POINTER TO EQUIV BLOCK + DCA X10 + CLA IAC + TAD I X10 /GET POINTER TO MASTER + DCA OLDM /TYPE WORD + TAD I X10 /OFFSET FROM MASTER + CMA STL + TAD I X10 /SUBTRACT FROM SLAVE OFFSET + DCA SFUDGE /SAVE IN CASE WE NEED IT + TAD I OLDM /IF MASTER IS IN COMMON FORGET THE NEXT TEST: + SZL SPA CLA /IF MASTER OFFSET < SLAVE OFFSET THEN + JMP I NEGSLV /SLAVE WILL ORIGIN BEFORE MASTER - + TAD I TYPE /THEREFORE THE SLAVE MUST BECOME THE MASTER + AND (7577 /UNSLAVE THE SLAVE + DCA I TYPE + ISZ TYPE + TAD I TYPE + DCA TYPE1 /TYPE1 POINTS TO EQUIV BLOCK + CLA IAC + TAD TYPE1 + DCA X10 /USE AUTO-XR TO CLEAR OFFSETS + TAD ENTRY + DCA NEWM + TAD I OLDM /GET OLD MASTER'S TYPE WD + TAD Q200 + DCA I OLDM /MAKE IT A SLAVE + ISZ OLDM + TAD I TYPE1 /GET POINTER TO SLAVE DIMENSION BLOCK + DCA I TYPE /PUT IT IN SYMTAB AS BEFITTING A NEW MASTER + TAD I OLDM /GET OLD MASTERS DIM PTR + DCA I TYPE1 /PUT IT IN EQUIV BLOCK AS BEFITTING A NEW SLAVE + TAD TYPE1 /NOW ASSOCIATE THE EQUIV BLOCK + DCA I OLDM /WITH THE NEW SLAVE + DCA I X10 /AND MAKE BOTH OFFSETS 0 + DCA I X10 /("FIXSLV" WILL ADJUST IT - NOTE THE "MASTER" + CDF 0 /WD OF THE BLOCK STILL POINTS TO THE OLD MASTER) + JMS I (TYPRTN /** RECURSIVE CALL ** - ACTUALLY WE DON'T CARE + FIXSLV /SINCE WE AREN'T RETURNING ANYWAY + JMP I (FIXELP /TRY AGAIN FROM SCRATCH + /ROUTINE TO ADJUST ALL SLAVES OF THE OLD MASTER +/TO BE SLAVES OF THE NEW MASTER + +FIXSLV, 0 /THROUGHOUT + TAD I TYPE + AND Q200 + SNA CLA /IS IT A SLAVE? + JMP I FIXSLV /NO + ISZ TYPE + CLA IAC + TAD I TYPE + DCA TYPE /TYPE NOW POINTS TO THE EQUIV BLOCK + CLA IAC + TAD I TYPE /GET PTR TO THIS SLAVES MASTER (+1) + CMA + TAD OLDM /COMPARE MASTERS + SZA CLA + JMP I FIXSLV /NOT UNDER SAME MASTER - LEAVE + TAD NEWM + DCA I TYPE /"MEET THE NEW BOSS..... + ISZ TYPE / SAME AS THE OLD BOSS...." + TAD I TYPE / (THE WHO) + + TAD SFUDGE /ADD IN THE DIFFERENCE BETWEEN OLD AND NEW + IAC /MASTERS TO THE MASTER OFFSET + DCA I TYPE + JMP I FIXSLV /THE SLAVE IS NOW -- A SLAVE! + +OLDM, 0 +NEWM, 0 +SFUDGE, 0 + PAGE + / ENTRY AND EXIT CODE + +PLSUB2, 0 /DUMB SUBR FOR PROLOG + CDF + JMS INS2 / %ORG #BASE+30 + ORG;XBAP30 + JMS INS2 / %FNOP + FNOP;0 + JMS INS2 / %JA #RET + JA;XRET + JMS INS2 / FNOP + FNOP;0 + JMS INS /#GOBAK,ORG .+2 + XGOBAK;DBLZRO;0 /**TO INSURE IT'S 0 + TAD DPUSED /WAS DOUBLE PRECISSION USED ? + SNA CLA + JMP NDPUSD /NO, NO NEED FOR TEMP + JMS INS + XDPTMP;ORG;DP12 /#DPT, ORG .+12 + JMS INS2 + DPCHK;0 +NDPUSD, TAD FUNCTN /FUNCTION OR SUBR ? + SNA + JMP I PLSUB2 /ITS #MAIN, NO #VAL OR #ARGS + SPA CLA + JMP .+5 /ITS A SUBROUTINE, NO #VAL + JMS INS /#VAL, %ORG .+6 + XVAL;ORG;DP6 + JMS INS /#ARGS, %ORG .+3 + XARGS;ORG;DP3 + JMP I PLSUB2 +INS2, 0 / %OPCOD ADDR + TAD INS2 /COMMONIZE RETURNS + DCA INS + JMP INS3 +INS, 0 /TAG, %OPCOD ADDR + TAD I INS /GET TAG FIELD + ISZ INS + JMS I QOUTSYM /OUTPUT IT + TAD COMMA + JMS I QOCHAR +INS3, JMS I QOTAB + TAD I INS /GET OPCODE + ISZ INS + JMS I QOUTSYM + TAD I INS /GET ADDR + SNA CLA + JMP .+4 /NO ADDRESS + JMS I QOTAB + TAD I INS + JMS I QOUTSYM + ISZ INS + JMS I QCRLF + JMP I INS +SECT, TEXT 'SECT' +XRET, TEXT '#RET' +XXR, TEXT '#XR' +XGOBAK, TEXT '#GOBAK' +XST, TEXT '#ST' +XGOBC0, TEXT '#GOBAK,0' +XBAP30, TEXT '#BASE+30' +FNOP, TEXT 'FNOP' +SETX, TEXT 'SETX' +SETB, TEXT 'SETB' +TEXTX, TEXT 'TEXT' +XBASC1, TEXT '#BASE,1' +DP3, TEXT '.+3' +DP6, TEXT '.+6' +ZC1, TEXT '0,1' +FLDAI, TEXT 'FLDA%' +FSTAI, TEXT 'FSTA%' +XLBLE, TEXT '#LBL=.' +C1, TEXT ',1' +XLBL, TEXT '#LBL' /STACK-5 CAN'T BE 0 +DBLZRO, TEXT '0;0' + PAGE + / SYMBOL TABLE PROCESSING ROUTINES + +IMPLCT, 0 /DO IMPLICIT TYPING + TAD I TYPE + AND O100 /WAS IT EXPLICITLY TYPED + SZA CLA + JMP I IMPLCT /YES + TAD BUCKET /IS IT INTEGER ? + TAD M317 + CLL + TAD M006 + SNL CLA + ISZ I TYPE /TYPE IT REAL + ISZ I TYPE /TYP IT INTEGER + JMP I IMPLCT +O100, +DFLIT, 100 /GENERATE FACTORS FOR CALLS + CLL CML RTR /DIMENSIONED ? + AND I TYPE + SNA CLA + JMP I DFLIT /NO + TAD I TYPE + DCA TEMP /SET PROPER WDS/ENTRY FOR VMC + TAD ENTRY /GET ADDR OF MAGIC NUMBER + JMS I QGETSS + TAD (2 + DCA TYPE + TAD I ENTRY /SAVE LINK + DCA DFTEMP + TAD BUCKET /FIX NAME + DCA I ENTRY + TAD I TYPE /GET MAGIC NUMBER + DCA TEMP2 + ISZ TYPE + CDF + JMS I (ONUM /OUTPUT A ZERO WORD + JMS I QOPCDE + JA + TAD ENTRY /OUTPUT VAR MINUS CONST + JMS I (VMC + JMS I QCRLF /END LITERAL + CDF 10 + TAD LITNUM /SAVE NUMBER IN DIM INFO + DCA I TYPE + ISZ LITNUM /THEN BY 2 MORE + ISZ LITNUM + TAD DFTEMP /RESTORE ENTRY + DCA I ENTRY + JMP I DFLIT +M006, +DFTEMP, +EXTRNL, 6 /DO EXTERNALS + TAD I TYPE + AND O1000 /IS IT EXT ? + SNA CLA + JMP I EXTRNL + JMS I (UNHOOK /REMOVE THIS SYMBOL + TAD PROGNM /IS IT THE PROG NAME ? + CIA + TAD ENTRY + SZA CLA + JMP .+5 /NO, OUTPUT EXTERN + TAD FUNCTN /IS IT A MAIN PROG ? + SNA CLA + JMP TFUDGE-1 /YES, NO SECT + TAD (SECT-EXTERN /NOT MAIN, OUTPUT SECT + TAD XTRN + DCA M317 + CDF + JMS I QOPCDE +M317, -317 + TAD ENTRY /NOW VAR NAME + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMP TFUDGE-1 +O1000, +EQUIVS, 1000 /OUTPUT EQUIVALENCES + TAD I TYPE + AND Q200 /IS THIS A SLAVE ? + SNA CLA + JMP I EQUIVS /NO + JMS I (UNHOOK /UNHOOK THE ENTRY + TAD I TYPE /SAVE THE TYPE WORD + DCA TYPE1 + ISZ TYPE /POINT TO EQUIVALENCE BLOCK + TAD I TYPE + DCA X10 + CDF + JMS I QOPCDE /OUTPUT ORG + ORG + CDF 10 + TAD I X10 /MASTER NAME + DCA X11 /SAVE IT + TAD X11 + JMS I QOUTNAM /OUTPUT IT + TAD PLUS /+ + JMS I QOCHAR + CDF 10 + TAD I X11 /MASTER SS + JMS SUBRX + TAD Q255 /MINUS + JMS I QOCHAR + CDF 10 + TAD TYPE1 /SLAVE SS + JMS SUBRX + JMS I QCRLF /EOL + CDF 10 + TAD ENTRY /NOW OUTPUT SLAVE + JMS I (OUTVAR + JMP TFUDGE-1 +XTRN, +SUBRX, EXTERN + JMS I QSKPIRL /SIZE OF THING + TAD Q3 + TAD Q3 /TIMES 3 OR 6 + DCA MQ + TAD I X10 + CDF + JMS I QMUL12 /MAKE THE PRODUCT + JMS I QNUMBRO /OUT WITH IT + JMP I SUBRX +DPCHK, TEXT 'DPCHK' +FADDM, TEXT 'FADDM' + PAGE + / SYMBOL TABLE PROCESSING ROUTINES + +BASE, TEXT 'BASE' +OUTVAR, 0 /ALLOCATE STORAGE FOR A VARIABLE + DCA VARADR + RDF /GET FIELD OF VAR + TAD X6201 + DCA OVFLD1 + TAD OVFLD1 + DCA OVFLD2 + TAD VARADR /OUTPUT NAME, + JMS I QOUTNAM + TAD COMMA + JMS I QOCHAR + JMS I QOPCDE /OUTPUT ORG + ORG + ISZ VARADR /POINT TO TYPE WROD +OVFLD1, 0 + TAD I VARADR /GET TYPE +X6201, CDF + JMS I QSKPIRL + TAD Q3 /PER ENTRY + TAD Q3 /INTEGER, REAL, AND + /LOGICAL 3WORDS + DCA MQ + DCA AC +OVFLD2, 0 + CLL CML RTR /CHECK DIM BIT + AND I VARADR + SNA CLA + JMP PLSDOT /NOT DIMENSIONED + TAD I VARADR /LOOK AT TYPE + ISZ VARADR /MOVE TO EQ DIM POINTER + AND Q200 /EQUIVALENCED ? + SNA CLA + JMP .+3 /NO + TAD I VARADR /YES, SKIP EQUIV INFO + DCA VARADR + TAD I VARADR /ADDRESS OF DIM INFO + IAC + DCA VARADR /ADDRESS OF SIZE + TAD I VARADR /GET TOTAL SIZE + CDF + JMS I QMUL12 +PLSDOT, CDF + TAD Q256 + JMS I QOCHAR + TAD PLUS + JMS I QOCHAR + JMS I QNUMBRO + JMS I QCRLF + JMP I OUTVAR +SCALAR, 0 /OUTPUT SCALARS + TAD I TYPE /IS IT A SCALAR ? + AND (7630 /COM, DIM, EXT, ASF, + /EQV, ARG, COMMONNAME + SZA CLA + JMP I SCALAR /NO + JMS I (UNHOOK /DELETE THIS FROM THE LIST + TAD ENTRY /OUTPUT THIS VARIABLE + JMS OUTVAR + JMP TFUDGE-1 +VARADR, +DOLIST, 0 /PROCESS A LITERAL LIST + TAD I DOLIST /GET LIST START + DCA ENTRY + ISZ DOLIST + TAD I DOLIST + DCA TYPE /GET TYPE BITS + ISZ DOLIST + TAD I DOLIST + ISZ DOLIST + DCA LSIZE /GET LITERAL SIZE + CDF 10 +DLLOOP, TAD I ENTRY /GET NEXT ENTRY + SNA + JMP DLRETN /NO MORE + DCA ENTRY + TAD ENTRY + DCA X10 /ADDRESS OF TYPE WORD + TAD TYPE /PUT IN TYPE + DCA I X10 + TAD X10 /SAVE THIS ADDR + DCA X11 + TAD LSIZE /SIZE OF LITERAL + DCA TEMP +LITLUP, CDF + JMS I QOTAB + CDF 10 + TAD I X10 + CDF + JMS I QONUMBR + JMS I QCRLF + ISZ TEMP + JMP LITLUP + CDF 10 + TAD LITNUM /SAVE LITERAL NUMBER + DCA I X11 + TAD LSIZE /INCREMENT LITERAL NUMBER + CIA + TAD LITNUM + DCA LITNUM + JMP DLLOOP +DLRETN, CDF + JMP I DOLIST +TEMPS, 243;2000;TMPSIZ;2415;2000 +TMPSIZ, 1;TMPBLK+1 +LSIZE, +COMVAR, 0 /REMOVE COMMON VARS FROM ST + TAD I TYPE + AND (4400 /ALSO ASF NAMES + SNA CLA + JMP I COMVAR + JMS I (UNHOOK + JMP TFUDGE-1 +LITRL2, TEXT '#LIT' +COMMON, TEXT 'COMMON' + PAGE + / SYMBOL TABLE PROCESSING ROUTINES + +TYPRTN, 0 /PROCESS ENTIRE SYMBOL TABLE + TAD I TYPRTN /GET ROUTINE ADDRESS + DCA ROUTNE + ISZ TYPRTN + TAD O301 /START WITH 'A' + DCA BUCKET + TAD M32 /BUCKET COUNT + DCA BCNT +TYPLP2, TAD BUCKET /GET START OF NEXT LIST + TAD ALM301 +TYPLUP, DCA OENTRY /SAVE OLD ENTRY ADDRESS + CDF 10 +TFUDGE, TAD I OENTRY /GET ADDR OF NEXT ENTRY + SNA + JMP EOL /0 MEANS END OF LIST + DCA ENTRY + IAC + TAD ENTRY /ADDR OF TYPE WORD + DCA TYPE + JMS I ROUTNE /CALL ROUTINE + TAD I OENTRY /CONTINUE DOWN THE LIST + JMP TYPLUP +EOL, ISZ BUCKET /DO NEXT LETTER + ISZ BCNT + JMP TYPLP2 + CDF + JMP I TYPRTN /END OF PASS + BCNT=ARG1 +COMNAM, 0 /OUTPUT A COMMON BLOCK + TAD I TYPE /IS THIS A COMMON BLOCK NAME + TAD M111 + SZA CLA + JMP I COMNAM /NO + CDF + JMS I QOPCDE + COMMON + CDF 10 + JMS I (UNHOOK /REMOVE THE COMMON + /BLOCK FROM S.T. + TAD ENTRY + JMS I QOUTNAM /OUTPUT NAME + JMS I QCRLF + ISZ TYPE /GET TO COMMON STUFF POINTER +CNLOOP, CDF 10 + TAD I TYPE /GET ADDR OF NEXT HUNK + /OF COMMON + SNA + JMP TFUDGE /END OF IT + DCA TYPE + TAD TYPE /GET A WORKING POINTER + DCA X10 + TAD I X10 /GET COUNT + SNA + JMP CNLOOP /NONE IN THIS HUNK + CIA + DCA TEMP2 + TAD I X10 /GET VARIABLE ADDRESS + JMS I (OUTVAR /OUTPUT IT + CDF 10 + ISZ TEMP2 + JMP .-4 /DO NEXT ONE FROM THIS HUNK + JMP CNLOOP /DO NEXT HUNK +O301, 301 +M32, -32 +ALM301, ALIST-301 +M111, -111 +ROUTNE, +ADFLIT, 0 /OUTPUT ARG DF LITS + TAD ARGLST /ANY ARGS + SNA + JMP I ADFLIT + DCA X10 + CDF 10 + TAD I ARGLST /NUMBER OF ARGS + CIA + DCA NARGS +ADFLUP, CDF 10 + TAD I X10 /GET ARG ADDR + IAC + DCA TEMP /TYPE WORD ADDR + TAD I TEMP /GET TYPE INFO + DCA TEMP2 + CLL CML RTR + AND I TEMP /DIMENSIONED ? + SNA CLA + JMP NDADFL /NO + ISZ TEMP /ADDR OF DIM INFO + CLL CML RTL + TAD I TEMP /ADDR OF MAGIC NUMBER + DCA TEMP + TAD I TEMP /MAGIC NUMBER + DCA MQ /PREPARE TO MULTIPLY + ISZ TEMP /ADDR OF LITERAL GOES HERE + TAD LITNUM /STICK IN THE ADDRESS + IAC + DCA I TEMP + CDF + JMS I (ONUM /OUTPUT A ZERO + TAD TEMP2 /LOOK AT TYPE + JMS I QSKPIRL /SKIP ON I R L + TAD (3 /DOUBLE OR COMPLEX + TAD (3 + JMS I QMUL12 + TAD AC /OUTPUT 2 WORD LITERAL + JMS I (ONUM + TAD MQ + JMS I (ONUM +NDADFL, ISZ NARGS + JMP ADFLUP + JMP I ADFLIT +RDOVLY, JMS I (7607 /READ IN OVERLAY + NPOVLY + OVRLAY +PASS2O, 0 + JMP I (INERR + TAD I (VOVER /CHECK VERSION OF OVERLAY + TAD VERS + SZA CLA + JMP I (VERROR /ERROR, MIXED VERSIONS + JMP I (EOSTMT /START PASS2 PROPER + PAGE + FIELD 1 + *5000 + 0 /THIS IS THE START OF + /THE ERROR MESSAGE LIST + /WHICH WORKS BACKWARDS + /OS/8 F4 COMPILER CODE SKELETONS + + MAC=-6 + NEGSGN=-5 + FLDAA2=-4 + FLDAA1=-3 + ENTERE=-2 + ENTERF=-1 +CGTCOD, ATX;DD1;STARTD;0;FLDA;DP2C1;STARTF;0 +AGTCOD, JAC;0;0 +ASNCOD, ENTERF;FLDA;DP3C0;JA;DP4;0 +ERCODE, EXTERN;XUE;TRAP3;XUE;0 +A0FN, EXTERN;XFIX;JSA;XFIX;0 +A0SD, ALN;D0 +SD, STARTD;0;0 +SE, STARTE;0;0 +SF, STARTF;0;0 +MPTR0, ENTERF;FLDAA1;FSTA;XBASE;0 +MPTR3, ENTERF;FLDAA2;FSTA;XBASP3;0 +JADP2, JA;DOT;0 +DOFIN0, ENTERF;FLDAA1;FADD;-2 +ASTOR, FSTA;-1;0 +DOFIN1, ENTERF;FLDAA1;FADD;-2;MAC+A0FN;FSTA;-1;0 +LDASTD, FLDAA1;STARTD;0;0 + /CHALK UP ONE FOR PAL8 +ATX1, ATX;DD1;0 +LXM1C2, LDX;M1C2;STARTD;0;0 +FVAL, FVI-1;FVI-1;FVC-1;FVD-1;FVI-1 +FVI, FLDA;XVAL;0 +FVC, STARTE;0;FLDA;XVAL;MAC+PCAC;0 +FVD, STARTE;0;FLDA;XVAL;0 +RTNCOD, RTNX+MAC;JA;XRTN;0 +PAZCOD, ENTERF;EXTERN;XPAUSE;JSR;XPAUSE;0 +STPCOD, RTNX+MAC;EXTERN;XEXIT;JSR;XEXIT;0 +GIRL1, ENTERF;FLDAA1;ENTERE;0 +GIRL2, ENTERF;FLDAA2;ENTERE;0 +SEGCAC, +GCAC, ENTERE;EXTERN;CAC;FLDA;CAC;0 +PCAC, EXTERN;CAC;FSTA;CAC;0 +GC1C2, ENTERE;FLDAA1;EXTERN;CAC;FSTA;CAC;FLDAA2;0 +GC1, ENTERE;FLDAA1;0 +GC2, ENTERE;FLDAA2;0 +JSACEQ, EXTERN;CEQ;JSA;CEQ;NEGSGN;0 +JSACNG, EXTERN;CNEG;JSA;CNEG;0 +JSACAD, EXTERN;CADD;JSA;CADD;0 +JSACSB, EXTERN;CSUB;JSA;CSUB;0 +JSACML, EXTERN;CMUL;JSA;CMUL;0 +JSACDV, EXTERN;CDIV;JSA;CDIV;0 + / ADD, SUBTRACT, MULTIPLY, AND DIVIDE SKELETONS +ADDTBL, AS-1;AS+2;AS+4 + AX-1;AX+2;AX+5 + AS-1;AD-1;AS+4 + ASC-1;ASC+2;ASC+3 + ASD-1;ASD+7;ASD+10 + ACS-1;ACS+4;ACS+6 + ADS-1;ADS+3;ADS+7 + 0 + FNEG;0 +AS, FADD;-1;0 + ENTERF;FLDAA1 + FADD;-2;0 + JSACNG+MAC +AX, GC1+MAC;JSACAD+MAC;0 + GC1C2+MAC;JSACAD+MAC;0 + GC2+MAC;JSACAD+MAC;0 +AD, ENTERE;FLDAA1;FADD;-2;0 + JSACNG+MAC +ASC, GIRL1+MAC;JSACAD+MAC;0 + GIRL1+MAC + ENTERE;PCAC+MAC;GC2+MAC;JSACAD+MAC;0 + FNEG;0 +ASD, FSTA;XDPTMP;ENTERF;FLDAA1;ENTERE;FADD;XDPTMP;0 + GIRL1+MAC + ENTERE;FADD;-2;0 + JSACNG+MAC +ACS, ENTERE;PCAC+MAC;GC1+MAC;JSACAD+MAC;0 + GC1+MAC;PCAC+MAC + GIRL2+MAC;JSACAD+MAC;0 + FNEG;0 +ADS, ENTERE;FADD;-1;0 + GIRL2+MAC;FADD;-1;0 + FSTA;XDPTMP;GIRL2+MAC;FADD;XDPTMP;0 +SUBTBL, AS-3;SS-1;SS+1 + AX-2;SX-1;SX+2 + AS-3;SDBL-1;SS+1 + ASC-2;SSX-1;SSX + ASD-3;SSD-1;SSD + ACS-2;SCS-1;SCS+1 + ADS-3;SDS-1;SDS5-1 + 0 +SS, ENTERF;FLDAA1 + FSUB;-2;0 +SX, GC1C2+MAC;JSACSB+MAC;0 + GC2+MAC;JSACSB+MAC;0 +SDBL, ENTERE;FLDAA1;FSUB;-2;0 +SSX, GIRL1+MAC + ENTERE;PCAC+MAC;GC2+MAC;JSACSB+MAC;0 +SSD, GIRL1+MAC + ENTERE;FSUB;-2;0 +SCS, GC1+MAC;PCAC+MAC + GIRL2+MAC;JSACSB+MAC;0 +SDS, GIRL2+MAC;FNEG;0;FADD;-1;0 +SDS5, FSTA;XDPTMP;GIRL2+MAC;FNEG;0;FADD;XDPTMP;0 +MULTBL, M1-1;M1+3-1;M1+5-1 + M4-1;M4+3-1;M4+6-1 + M1-1;M7-1;M7+2-1 + M8-1;M8+3-1;M8+4-1 + M11-1;M11+6-1;M11+7-1 + M14-1;M14+5-1;M14+7-1 + M18+1-1;M18-1;M18+5-1 + 0 +M1, FMUL;-1;0 + ENTERF;FLDAA1 + FMUL;-2;0 +M4, GC1+MAC;JSACML+MAC;0 + GC1C2+MAC;JSACML+MAC;0 + GC2+MAC;JSACML+MAC;0 +M7, ENTERE;FLDAA1;FMUL;-2;0 +M8, GIRL1+MAC;JSACML+MAC;0 + GIRL1+MAC + ENTERE;PCAC+MAC;GC2+MAC;JSACML+MAC;0 +M11, FSTA;XDPTMP;GIRL1+MAC;FMUL;XDPTMP;0 + GIRL1+MAC + ENTERE;FMUL;-2;0 +M14, ENTERE;PCAC+MAC;GC1+MAC;JSACML+MAC;0 + GC1+MAC;PCAC+MAC + GIRL2+MAC;JSACML+MAC;0 +M18, GIRL2+MAC + ENTERE;FMUL;-1;0 + FSTA;XDPTMP;GIRL2+MAC;FMUL;XDPTMP;0 +DIVTBL, 1;D2-1;D2+2-1 + 1;D5-1;D5+3-1 + 1;D7-1;D7+2-1 + 1;D9-1;D10-1 + 1;D12-1;D13-1 + 1;D14-1;D15-1 + 1;D16-1;D17-1 + 0 +D2, ENTERF;FLDAA1 + FDIV;-2;0 +D5, GC1C2+MAC;JSACDV+MAC;0 + GC2+MAC;JSACDV+MAC;0 +D7, ENTERE;FLDAA1;FDIV;-2;0 +D9, GIRL1+MAC +D10, ENTERE;PCAC+MAC;GC2+MAC;JSACDV+MAC;0 +D12, GIRL1+MAC +D13, ENTERE;FDIV;-2;0 +D14, GC1+MAC;PCAC+MAC +D15, GIRL2+MAC;JSACDV+MAC;0 +D16, GIRL2+MAC;FSTA;XDPTMP;FLDAA1;FDIV;XDPTMP;0 +D17, FSTA;XDPP6;GIRL2+MAC;FSTA;XDPTMP;FLDA;XDPP6;FDIV;XDPTMP;0 + / RELATIONALS AND LOGICALS SKELETON TABLES +EQTABL, EQ1-1;EQ2-1;EQ3-1 + EQ4-1;EQ5-1;EQ6-1 + EQ1-1;EQ7-1;EQ3-1 + EQ8-1;EQ9-1;EQ10-1 + EQ11-1;EQ12-1;EQ13-1 + EQ14-1;EQ15-1;EQ16-1 + EQ17-1;EQ18-1;EQ19-1 + EQ1-1;EQ2-1;EQ3-1 +EQ1, FSUB;-1;0 +EQ2, ENTERF;FLDAA1 +EQ3, FSUB;-2;0 +EQ4, GC1+MAC;JSACEQ+MAC;0 +EQ5, GC1C2+MAC;JSACEQ+MAC;0 +EQ6, GC2+MAC;JSACEQ+MAC;0 +EQ7, ENTERE;MAC+EQ2+1;0 +EQ8, GIRL1+MAC;JSACEQ+MAC;0 +EQ9, GIRL1+MAC +EQ10, ENTERE;PCAC+MAC;GC2+MAC;JSACEQ+MAC;0 +EQ11, MAC+ASD-2;0 +EQ12, GIRL1+MAC +EQ13, MAC+SSD+1;0 +EQ15, GIRL2+MAC +EQ14, ENTERE;PCAC+MAC;GC1+MAC;JSACEQ+MAC;0 +EQ16, GIRL2+MAC;JSACEQ+MAC;0 +EQ18, GIRL2+MAC +EQ17, MAC+ADS-2;0 +EQ19, MAC+SDS5;0 + LETABL, LE1-1;LE2-1;LE3-1 + 0;0;0 + LE1-1;LE4-1;LE3-1 + 0;0;0 + LE11-1;LE12-1;LE13-1 + 0;0;0 + LE17-1;LE18-1;LE19-1 + 0 +LE1, FSUB;-1;NEGSGN;0 +LE2, ENTERF;FLDAA1 +LE3, FSUB;-2;0 +LE4, ENTERE;MAC+LE2+1;0 +LE11, MAC+ASD-2;0 +LE12, GIRL1+MAC +LE13, MAC+SSD+1;0 +LE18, GIRL2+MAC +LE17, MAC+ADS-2;0 +LE19, MAC+SDS5;0 + ANDTBL, 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + M1-1;M1+3-1;M1+5-1 +ORTABL, 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + AS-1;AS+2;AS+4 + EQVTBL, 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + EQ1-1;EQ2-1;EQ3-1 + /CONVERSION-FOR-STORE-OPERATOR SKELETONS +STRTBL, SIIM-1;SIRM-1;SICM-1;SIDM-1;SIIM-1 + SIIA-1;SIRA-1;SICA-1;SIDA-1;SIIA-1 + SIIM-1;SIIM-1;SRCM-1;SRDM-1;SIIM-1 + SIIA-1;SIIA-1;SRCA-1;SRDA-1;SIIA-1 + SCIM-1;SCIM-1;SCCM-1;SCDM-1;SCIM-1 + SCIA-1;SCIA-1;SCCA-1;SCDA-1;SCIA-1 + SDIM-1;SDIM-1;SDCM-1;SDDM-1;SDIM-1 + SDIA-1;SDIA-1;SDCA-1;SDDA-1;SDIA-1 + SLIM-1;SLIM-1;SLCM-1;SLDM-1;SIIM-1 + SLIA-1;SLIA-1;SLCA-1;SLDA-1;SIIA-1 +SIIM, ENTERF;FLDAA2 +SIIA, 0 +SIRM, ENTERF;FLDAA2 +SIRA, A0FN+MAC;0 +SICM, GC2+MAC;PCAC+MAC +SICA, ENTERF;GCAC+1+MAC;A0FN+MAC;0 +SRCM, GC2+MAC;PCAC+MAC +SRCA, ENTERF;GCAC+1+MAC;0 + SCCM=GC2 +SCIM, ENTERF;FLDAA2 +SCIA, ENTERE;0 + SCCA=GCAC +SLIM, ENTERF;FLDAA2 +SLIA, JSA;LTRNE;0 +SLCM, GC2+MAC;ENTERF;SLIA+MAC;0 +SLCA, ENTERF;GCAC+1+MAC;SLIA+MAC;0 +SIDM, ENTERE;FLDAA2 +SIDA, ENTERF;SIRA+MAC;0 +SRDM, ENTERE;FLDAA2 +SRDA, ENTERF;0 +SCDM, ENTERE;FLDAA2 +SCDA, FSTA;TEMPN;ENTERF;FLDA;TEMPN;ENTERE;0 +SDIM, ENTERF;FLDAA2 +SDIA, ENTERE;0 +SDCM, ENTERE;FLDAA2;PCAC+MAC +SDCA, ENTERF;GCAC+1+MAC;ENTERE;0 +SDDM, ENTERE;FLDAA2 +SDDA, 0 +SLDM, ENTERE;FLDAA2 +SLDA, JSA;LTRNE;0 + / UNARY MINUS AND .NOT. SKELETONS +NEGTBL, NIM-1;NIM-1;NCM-1;NDM-1;0 + NIA-1;NIA-1;NCA-1;NIA-1;0 +NIM, ENTERF;FLDAA1 +NIA, FNEG;0;0 +NCM, GC1+MAC;PCAC+MAC;JSACNG+MAC;0 + NCA=JSACNG +NDM, ENTERE;NIM+1+MAC;0 +NOTTBL, 0;0;0;0;NOTM-1 + 0;0;0;0;NOTA-1 +NOTM, ENTERF;FLDAA1 +NOTA, 0 + / ARITHMETIC IF SKELETONS +AIFTBL, GI-1;GI-1;GC-1;GD-1;GI-1 /V3C + GI+1;GI+1;GC+1;GD+1;GI+1 /V3C +GI, ENTERF;FLDAA1;0 +GC, GC1+MAC;0 +GD, ENTERE;FLDAA1;0 + /OPERATOR DISPATCH TABLE + +XPUSH, PUSH + ADD + SUB + MUL + DIV + EXP + NOT + NEG + GE + GT + LE + LT + DNA + OR + EQ + NE + XOR + EQV + PAUZE + DPUSH + BINRD1 + FMTRD1 + WCLOSE /** + DARD1 + BINWR1 + FMTWR1 + WCLOSE + DAWR1 + DEFFIL + ASFDEF + ARGS + EOSTMT + ERROR + RETURN + REWIND + STORE +XEND, END + DEFLBL + DOFINI + ARTHIF +XLOGIF, LIFBGN + DOBEGN + ENDFIL + STOP + ASSIGN + BAKSPC + FORMAT +XGOTO, GOTO + CGOTO + AGOTO + IOLMNT + DATELM + DREPTC + DATAST + ENDELM + PURGE +XLAST, DOSTOR + / EXPONENTIATION TABLE (NOT A STANDARD SKELETON TABLE) +EXPTBL, 1;1111;2;1122;3;1103;4;1104;0;0 /I**D=D + 2;1111;2;1122;3;1103;4;1104;0;0 /R**D=D + 3;0311;3;0322;3;0303;0;0;0;0 + 4;0411;4;0422;0;0;4;0404;0;0 + 0;0;0;0;0;0;0;0;0 + / TYPE MIXING TABLE +TYPMIX, 1;6;2;6;3;17;4;22;0;0 + 2;6;2;6;3;17;4;22;0;0 + 3;25;3;25;3;11;0;0;0;0 + 4;30;4;30;0;0;4;14;0;0 + 0;0;0;0;0;0;0;0;5;33 +RTNX, ENTERF;EXTERN;LTRNE;0 + $ +