A large commit.
[pdp8.git] / sw / os8 / v3d / sources / fortran / all / pass2.pa
diff --git a/sw/os8/v3d/sources/fortran/all/pass2.pa b/sw/os8/v3d/sources/fortran/all/pass2.pa
new file mode 100644 (file)
index 0000000..0a6b273
--- /dev/null
@@ -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
+\f/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  <OVERLY=0>
+       IFNZRO  OVERLY  <NOPUNCH>
+       *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
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\fLTRNE,        TEXT    '#NE'
+       TEXT    '#GE'
+       TEXT    '#LE'
+       TEXT    '#GT'
+       TEXT    '#LT'
+       TEXT    '#EQ'
+       PAGE
+\f/ SOME TEXT
+
+P2,    TEXT    '+2'
+XVAL,  TEXT    '#VAL'
+DP4,   TEXT    '.+4'
+FADD,  TEXT    'FADD'
+FLDA,  TEXT    'FLDA'
+FSUB,  TEXT    'FSUB'
+\f/ 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
+\fSATEMP,
+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
+\f/ 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'
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\fENDM, 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'
+\f/ 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
+\f/ 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
+\f/ 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 <XXXXXX>
+       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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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'
+\fJNE,  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'
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\fDNA,  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
+\f/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'
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f      FIELD   1
+       *5000
+       0                       /THIS IS THE START OF
+                               /THE ERROR MESSAGE LIST
+                               /WHICH WORKS BACKWARDS
+\f/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
+\f/ 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
+\f/ 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
+\fLETABL,       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
+\fANDTBL,       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
+\fEQVTBL,       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
+\f/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
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+       $
+\f