1               /3  OS/8 FORTRAN  (PASS TWO)
   2               /
   3               / VERSION 4A  PT 16-MAY-77
   4               /
   5               /       OS/8 FORTRAN COMPILER - PASS 2
   6               /
   7               /               BY: HANK MAURER
   8               /               UPDATED BY: R. LARY + M. HURLEY
   9               /
  10               /
  11               /COPYRIGHT  (C)  1974,1975 BY DIGITAL EQUIPMENT CORPORATION
  12               /
  13               /
  14               /
  15               /
  16               /
  17               /
  18               /
  19               /
  20               /
  21               /
  22               /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
  23               /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
  24               /CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
  25               /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
  26               /
  27               /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
  28               /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
  29               /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
  30               /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
  31               /
  32               /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
  33               /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
  34               /DIGITAL.
  35               /
  36               /
  37               /
  38               VERSON=4
  39               /SEE F4.PA FOR LIST OF MAINTENANCE RELEASE CHANGES -S.R.
  40               /ALSO, ADDED SAFETY CDF 0 TO BUMP ROUTINE TO FIX BUG
  41               /MASSAGED LINK IN THAT AREA TO GET ROOM
  42               /ALSO,
  43               /       FIXED BUG RE DN ERROR PRINTING WRONG LINE NUMBER
  44               /
  45               /
  46               /CHANGES FOR OS/8 V3D AND OS/78 BY P.T.
  47               /.PATCH LEVEL FOR PASS2 IS IN LOCATION 327
  48               
  49                       IFNDEF  OVERLY  <OVERLY=0>
  50                       IFNZRO  OVERLY  <NOPUNCH>
  51                       *2                      /V3C
  52 000002  0001  TEM,    1                       /V3C
  53 000003  0001  LINENO, 1                       /LINE NUMBER
  54 000004  7774  VERS,   -VERSON                 /VERSION NUMBER
  55 000005  5001  ERRPTR, 5001                    /POINTER TO THE ERROR LIST
  56 000006  0000  FILDEV, 0                       /THIS IS THE FILE DESCRIPTOR
  57 000007  0000  FILBLK, 0                       /FOR RALF
  58 000010  4577  X10,    COMREG-1                /INTER PASS COM REGION
  59 000011  0000  X11,    0
  60 000012  0000  X12,    0
  61 000013  0000  X13,    0
  62 000014  0000  X14,    0
  63 000015  0000  X15,    0
  64 000016  0000  X16,    0
  65 000017  0000  X17,    0                       /AUTO INDEX REGISTERS
  66 000020  0000  ENTRY,  0                       /THINGS USED BY SYMBOL
  67                                               /TABLE FIDDLER
  68 000021  0000  OENTRY, 0
  69 000022  0000  BUCKET, 0
  70 000023  0000  TYPE,   0
  71 000024  0000  TEMP,   0                       /GENERAL TEMPS
  72 000025  0000  TEMP2,  0
  73 000026  0000  ARG1,   0                       /ARGS AND TYPES
  74 000027  0000  BASE1,  0
  75 000030  0000  TYPE1,  0
  76 000031  0000  ARG2,   0
  77 000032  0000  BASE2,  0
  78 000033  0000  TYPE2,  0
  79 000034  0001  TMPCNT, 1                       /TEMP COUNT
  80 000035  0000  TMPMAX, 0                       /MAX TEMP COUNT
  81 000036  0000  LITNUM, 0                       /LITERAL DISPLACEMENT
  82                       TMPBLK=2
  83                       OUBUF=4400
  84                       COMREG=4600
  85                       STACK1=4700
  86                       OVRLAY=5000
  87                       NPOVLY=700
  88                       XRBUFR=6600
  89                       STACK=7000              /STACK-5 CAN'T BE 0
  90                       INBUF=7200
  91                       NPPAS3=1600
  92 000037  0000  ARG,    0                       /TEMP FOR CODE
  93 000040  0000  AC,     0                       /AC FOR MULTIPLY ROUTINE
  94 000041  0000  XR,     0                       /XR CHAR FOR OADDR
  95 000042  0000  MQ,     0                       /MQ FOR MULTIPLY ROUTINE
  96 000043  0000  XRNUM,  0                       /TEMP USED IN XR STUFF
  97 000044  0000  WHATAC, 0                       /POINTER TO VAR
  98 000045  0000  WHATBS, 0                       /JUST STORED
  99 000046  0000  FREEXR, 0                       /NUMBER OF FREE
 100                                               /INDEX REG
 101 000047  0000  DIMPTR, 0                       /POINTER TO DIM INFO
 102                                               /AFTER GETSS
 103 000050  0000  NARGS,  0                       /ARG COUNT FOR SS VAR
 104                                               /COMPILE
 105 000051  0001  GLABEL, 1                       /GENERATED LABEL COUNTER
 106 000052  7000  STKLVL, STACK                   /STACK LEVEL (CHANGED
 107                                               /BY DO)
 108 000053  0254  COMMA,  254                     /,
 109 000054  0253  PLUS,   253                     /+
 110 000055  0000  IFLABL, 0                       /HOLDS LABEL FOR LOG IF
 111 000056  7000  DOTEMP, 7000                    /DO LOOP TEMP COUNTER
 112 000057  0000  BINARY, 0                       /BINARY IO=1, FORMATTED=0
 113 000060  0000  INPUT,  0                       /INPUT=1 OUTPUT=0 FOR IO STMTS
 114 000061  0000  PROGNM, 0                       /POINTER TO PROG/FUNC NAME
 115 000062  0000  FUNCTN, 0                       /0=MAIN, 1=FUNC, -2=SUBR
 116 000063  0000  ARGLST, 0                       /POINTER TO ARG LIST
 117 000064  0000  DATASW, 0                       /=1 IF THIS IS A DATA STMT
 118 000065  0000  GCTEMP, 0                       /TEMP USED BY GENCAL
 119 000066  0000  EXTLIT, 0                       /EXTERNAL LITERALS LIST
 120 000067  0000  ELCNT,  0                       /AND COUNT
 121 000070  0000  IOLOOP, 0                       /IO LOOP SWITCH
 122 000071  0000  ARGIO,  0                       /ARG IO SWITCH
 123 000072  0617  F1LNAM, 0617;2224;2216;2415     /FILE NAME FORTRN.TM
     000073  2224  
     000074  2216  
     000075  2415  
 124 000076  7607  DEVH,   7607                    /DEVICE HANDLER ADDRESS
 125 000077  0000  ACSWIT, 0                       /IS NON ZERO IF CALLING AN ARG
 126 000100  0000  IOSTMT, 0                       /SET 1 IF IN IO STMT
 127                                               /(FOR IMPLIED LOOPS)
 128 000101  0001  FMODE,  1                       /1 IF IN F OR D MODE (0 IF E)
 129 000102  0000  ASFSWT, 0                       /1 IF ASF PROLOG, -1 IF
 130                                               /ASF END, 0 OTHER
 131 000103  0000  JSRLBL, 0                       /LABEL NUMBER FOR CALLS TO ARGS
 132 000104  0000  DPUSED, 0                       /=1 IF DP HARDWARE USED
 133 000105  7774  QM4,    -4
 134 000106  0260  Q260,   260
 135 000107  0730  QTTYOU, TTYOUT
 136 000110  4310  QERMSG, ERMSG
 137 000111  0402  QNEXT,  NEXT
 138 000112  0400  QNEXTM, NEXT-2
 139 000113  0656  QUCODE, UCODE
 140 000114  1300  QCODE,  CODE
 141 000115  0600  QINWOR, INWORD
 142 000116  0275  QONUMB, ONUMBR
 143 000117  1025  QSAVEA, SAVEAC
 144               Q6M3,
 145 000120  0005  Q5,     5
 146 000121  1400  QGENCO, GENCOD
 147 000122  7772  QM6,    -6
 148 000123  2254  QOPCOD, OPCOD
 149 000124  3540  QOPCDE, OPCODE
 150 000125  1600  QOADDR, OADDR
 151 000126  0017  Q17,    17
 152 000127  0345  QTTYMS, TTYMSG
 153 000130  6461  QXRTBL, XRTABL
 154 000131  6420  QCHKXR, CHEKXR
 155 000132  5437  QGENSF, GENSTF
 156 000133  3553  QGENSE, GENSTE
 157 000134  0214  QOSNUM, OSNUM
 158 000135  0200  QCRLF,  CRLF
 159 000136  3140  QOTAB,  OTAB
 160 000137  0225  QOUTSY, OUTSYM
 161 000140  0704  QGARG,  GARG
 162 000141  0020  Q20,    20
 163 000142  0040  Q40,    40
 164 000143  0234  QOUTNA, OUTNAM
 165 000144  2364  QLITRL, LITRL
 166 000145  0200  Q200,   200
 167 000146  0255  Q255,   255
 168 000147  0003  Q3,     3
 169 000150  3527  QOLABE, OLABEL
 170 000151  0630  QGETSS, GETSS
 171 000152  0256  Q256,   256
 172 000153  1020  QSAVAC, SAVACT
 173 000154  2102  QSKPIR, SKPIRL
 174 000155  3200  QGENCA, GENCAL
 175 000156  6502  QLOADA, LOADA
 176 000157  2112  QMUL12, MUL12
 177 000160  1200  QGARGS, GARGS
 178 000161  5466  QOINS,  OINS
 179 000162  0472  QOCHAR, OCHAR
 180 000163  0645  QNUMBR, NUMBRO
 181 000164  6600  QXRBUF, XRBUFR
 182 000165  0315  QTTYP2, TTYP2C
 183 000166  0337  QTTCRL, TTCRLF
 184 000167  7715  QM63,   -63
 185 000170  7605  Q7605,  7605
 186 000171  0000  RELCD,  0
 187 000172  3363  QLABEL, NLABEL  
 188 000173  5274  P0F1,   5274            /101-2605
 189 000174  5146  P0F2,   VERROR
 190               / OUTPUT UTILTIY ROUTINES
 191                       PAGE
 192               OCNT,
 193 000200  0000  CRLF,   0                       /OUTPUT CR LF
 194 000201  1377          TAD     (215
 195 000202  4562          JMS I   QOCHAR
 196 000203  1376          TAD     (212
 197 000204  4562          JMS I   QOCHAR
 198 000205  1375          TAD     (200
 199 000206  6034          KRS
 200 000207  1374          TAD     (-203
 201 000210  7650          SNA CLA
 202 000211  6031          KSF             /CHECK FOR ^C
 203 000212  5600          JMP I   CRLF
 204 000213  5773          JMP I   (7605
 205               NCHAR,
 206 000214  0000  OSNUM,  0                       /PRINT STMT NUMBER
 207 000215  7001          IAC                     /SKIP POINTER WORD
 208 000216  3327          DCA     NAMPTR
 209 000217  1372          TAD     (6211           /ALWAYS IN FIELD 1
 210 000220  3247          DCA     NAMCDF
 211 000221  1214          TAD     OSNUM           /SAVE ENTRY POINT
 212 000222  3234          DCA     OUTNAM
 213 000223  1371          TAD     (243            /GET FIRST CHAR (ALWAYS #)
 214 000224  5244          JMP     L6201           /GO PRINT NAME
 215               TTCHAR,
 216 000225  0000  OUTSYM, 0                       /PRINT OPCODE
 217 000226  3327          DCA     NAMPTR          /SAVE POINTER TO STUFF
 218 000227  1244          TAD     L6201           /ALWAYS FIELD 0
 219 000230  3247          DCA     NAMCDF
 220 000231  1225          TAD     OUTSYM          /SAVE ENTRY
 221 000232  3234          DCA     OUTNAM
 222 000233  5247          JMP     NAMCDF          /PRINT REST
 223               ONUMT,
 224 000234  0000  OUTNAM, 0                       /OUTPUT NAME
 225 000235  3327          DCA     NAMPTR          /SAVE ADDRESS OF NAME
 226 000236  6214          RDF                     /GET FIELD OF NAME
 227 000237  1244          TAD     L6201
 228 000240  3247          DCA     NAMCDF          /SAVE AS CDF
 229 000241  1727          TAD I   NAMPTR          /GET FIRST CHAR (ALREADY ASCII)
 230 000242  2327          ISZ     NAMPTR          /SKIP OVER TYPE AND DIM PTR
 231 000243  2327          ISZ     NAMPTR
 232 000244  6201  L6201,  CDF
 233 000245  4562          JMS I   QOCHAR          /OUTPUT CHAR
 234 000246  2327          ISZ     NAMPTR
 235 000247  0000  NAMCDF, 0
 236 000250  1727          TAD I   NAMPTR          /GET NEXT TWO CHARS
 237 000251  6201          CDF
 238 000252  7450          SNA                     /IS NAME DONE ?
 239 000253  5634          JMP I   OUTNAM          /YES
 240 000254  3214          DCA     NCHAR           /SAVE TWO CHARS
 241 000255  1214          TAD     NCHAR
 242 000256  7012          RTR                     /GET UPPER CHAR
 243 000257  7012          RTR
 244 000260  7012          RTR
 245 000261  1370          TAD     (240
 246 000262  0367          AND     (77
 247 000263  1370          TAD     (240
 248 000264  4562          JMS I   QOCHAR          /OUTPUT IT
 249 000265  1214          TAD     NCHAR           /NOW DO LOWER
 250 000266  0367          AND     (77
 251 000267  7450          SNA
 252 000270  5634          JMP I   OUTNAM          /NAME DONE
 253 000271  1370          TAD     (240
 254 000272  0367          AND     (77
 255 000273  1370          TAD     (240
 256 000274  5245          JMP     L6201+1         /GO AND OUTPUT IT
 257 000275  0000  ONUMBR, 0                       /OUTPUT OCTAL NUMBER
 258 000276  3234          DCA     ONUMT           /SAVE TEMPORARILY
 259 000277  1105          TAD     QM4             /4 DIGITS
 260 000300  3200          DCA     OCNT
 261 000301  1234  OLOOP,  TAD     ONUMT
 262 000302  7106          CLL RTL
 263 000303  7004          RAL
 264 000304  3234          DCA     ONUMT
 265 000305  1234          TAD     ONUMT
 266 000306  7004          RAL
 267 000307  0366          AND     (7
 268 000310  1106          TAD     Q260
 269 000311  4562          JMS I   QOCHAR
 270 000312  2200          ISZ     OCNT
 271 000313  5301          JMP     OLOOP
 272 000314  5675          JMP I   ONUMBR
 273 000315  0000  TTYP2C, 0                       /PRINT 2 CHARS ON THE TTY
 274 000316  3225          DCA     TTCHAR
 275 000317  1225          TAD     TTCHAR
 276 000320  7012          RTR
 277 000321  7012          RTR
 278 000322  7012          RTR
 279 000323  4327          JMS     CONVRT
 280 000324  1225          TAD     TTCHAR
 281 000325  4327          JMS     CONVRT
 282 000326  5715          JMP I   TTYP2C
 283               NAMPTR,
 284 000327  6401  CONVRT, 6401                    /CONVERT TO ASCII
 285 000330  0367          AND     (77
 286 000331  7440          SZA
 287 000332  1370          TAD     (240
 288 000333  0367          AND     (77
 289 000334  1370          TAD     (240
 290 000335  4507          JMS I   QTTYOUT
 291 000336  5727          JMP I   CONVRT
 292 000337  0000  TTCRLF, 0
 293 000340  1377          TAD     (215
 294 000341  4507          JMS I   QTTYOUT
 295 000342  1376          TAD     (212
 296 000343  4507          JMS I   QTTYOUT
 297 000344  5737          JMP I   TTCRLF
 298 000345  0000  TTYMSG, 0                       /PRINT 2 CHAR ERROR MESSAGE
 299 000346  6201          CDF
 300 000347  1745          TAD I   TTYMSG
 301 000350  2345          ISZ     TTYMSG          /PRINT ERROR MESSAGE
 302 000351  4510          JMS I   QERMSG
 303 000352  5511  FATAL,  JMP I   QNEXT           /FATAL ERROR MESSAGE
 304 000353  1752          TAD I   FATAL
 305 000354  4510          JMS I   QERMSG
 306 000355  5570          JMP I   Q7605           /RETURN TO PS8
 307 000356  5653  DP2C1,  TEXT    '.+2,1'
     000357  6254  
     000360  6100  
 308 000361  4513  NEG,    JMS I   QUCODE          /NEGATE CODE
 309 000362  6452          NEGTBL-1
 310 000363  5511          JMP I   QNEXT
 311 000366  0007          PAGE
     000367  0077  
     000370  0240  
     000371  0243  
     000372  6211  
     000373  7605  
     000374  7575  
     000375  0200  
     000376  0212  
     000377  0215  
 312               / OPCODE JUMP TABLE
 313               
 314 000400  1025          TAD     TEMP2
 315 000401  7410          SKP                     /CODE ALREADY READ
 316 000402  4515  NEXT,   JMS I   QINWORD         /GET NEXT INPUT WORD
 317 000403  1377          TAD     (XPUSH          /INDEX INTO JUMP TABLE
 318 000404  3025          DCA     TEMP2
 319 000405  6211          CDF 10
 320 000406  1425          TAD I   TEMP2
 321 000407  6201          CDF 0
 322 000410  3025          DCA     TEMP2   /GET JUMP ADDRESS
 323 000411  5425          JMP I   TEMP2   /GO THERE
 324               /OPTIMIZING RELATIONAL CODE FOR OS/8 F4
 325               /COMPLIMENTS OF R.L.
 326               
 327 000412  7126  LE,     STL RTL         /2
 328 000413  1105  LT,     TAD     QM4     /GENERATE -4 FOR LT, -2 FOR LE
 329 000414  5217          JMP     GE+1    /GO TO COMMON RELATIONAL CODE
 330 000415  7126  GT,     STL RTL
 331 000416  7001  GE,     IAC             /GENERATE 1 FOR GE, 3 FOR GT
 332 000417  3171          DCA     RELCD   /ALL THIS FUNNY STUFF IS BECAUSE SOME
 333 000420  4514          JMS I   QCODE   /OF THE RELATIONAL SKELETONS OPTIMIZE BY
 334 000421  6067          LETABL-6;5      /PERFORMING THE RELATIONAL ON THE NEGATIVE
     000422  0005  
 335 000423  1171          TAD     RELCD   /OF THE FAC - WHEN THIS HAPPENS SPECIAL
 336 000424  7510          SPA             /CODE IN THE SKELETON DOES AN "ISZ RELCD",
 337 000425  7041          CIA             /CHANGING ABS(RELCD) TO ITS OPPOSITE RELATIONAL
 338 000426  5240          JMP     RELGEN  /E.G. GE(1) TO LE(2), LE(-2) TO GE(-1)
 339               
 340 000427  7201  EQ,     CLA IAC         /SINCE EQ AND NE ARE SIGN-INDEPENDENT,
 341 000430  3171  NE,     DCA     RELCD   /WE DON'T NEED THAT KLUDGE BUT FOR COMPATIBILITY
 342 000431  4514          JMS I   QCODE   /WITH RTPS THE OS/8 FORTRAN SYSTEM FUNCTION
 343 000432  5757          EQTABL-6;5      /"#CEQ" WORKS THE WRONG WAY - IT PRODUCES
     000433  0005  
 344 000434  7201          CLA IAC         /A 1.0 IF THE COMPLEX AC WAS (0.,0.)
 345 000435  0171          AND     RELCD   /AND A 0.0 OTHERWISE - SO WE HAVE TO REVERSE
 346 000436  7640          SZA CLA         /THE SENSE OF COMPLEX .EQ. AND .NE. RELATIONS.
 347 000437  1120  RELGM1, TAD     Q5
 348 000440  3171  RELGEN, DCA     RELCD   /STORE "FINAL" RELCD
 349 000441  4515          JMS I   QINWORD /GENTLY PROBE AHEAD IN THE INPUT
 350 000442  3025          DCA     TEMP2
 351 000443  1025          TAD     TEMP2
 352 000444  1376          TAD     (XPUSH-XLOGIF
 353 000445  7650          SNA CLA         /IF THIS WAS THE TOP RELATION OF A LOGICAL IF,
 354 000446  5257          JMP     LIFOPT  /WE'RE IN A POSITION TO OPTIMIZE
 355 000447  1171          TAD     RELCD   /OTHERWISE OUTPUT A CALL TO THE
 356 000450  7104          CLL RAL         /ROUTINE CORRESPONDING TO THE RELATIONAL
 357 000451  1375          TAD     (LTRNE
 358 000452  3255          DCA     .+3
 359 000453  7201          CLA IAC
 360 000454  4774          JMS I   (OJSR   /GENERATE A JSA #XX
 361 000455  0000          0
 362 000456  5512          JMP I   QNEXTM2 /PROCESS THE WHATCHIMACALLIT
 363               
 364 000457  1030  LIFOPT, TAD     TYPE1   /SEE IF WE SHOULD GENERATE A "STARTF" FIRST
 365 000460  0126          AND     Q17     /ONLY WORRY ABOUT D.P.
 366 000461  1105          TAD     QM4     /SINCE THE ROUTINE #CEQ DOES A STARTF
 367 000462  3101          DCA     FMODE   /FMODE=0 ONLY IF ARGS WERE D.P.
 368 000463  4532          JMS I   QGENSF  /GENERATE STARTF IF NECESSARY
 369 000464  5665          JMP I   .+1
 370 000465  2277          LIFBGN+1        /GO TO LOGICAL IF PROCESSOR
 371               
 372 000466  4514  EQV,    JMS I   QCODE   /.EQV. LOGICAL OPERATOR
 373 000467  6223          EQVTBL-6;0
     000470  0000  
 374 000471  5237          JMP     RELGM1
 375               / PASS TWO OUTPUT ROUTINE
 376 000472  0000  OCHAR,  0                       /OUTPUT A CHAR TO THE
 377                                               /RALF INPUT FILE
 378 000473  0373          AND     (377
 379 000474  3333          DCA     OUTEMP          /SAVE CHAR
 380 000475  2276          ISZ     OUJUMP          /BUMP THREE WAY SWITCH
 381 000476  5276  OUJUMP, JMP     .
 382 000477  5330          JMP     CHAR1
 383 000500  5325          JMP     CHAR2
 384 000501  1333          TAD     OUTEMP          /HIGH FOUR BITS GO INTO
 385 000502  7106          CLL RTL                 /THE HIGH ORDER BITS OF THE
 386 000503  7006          RTL                     /FIRST WORD OF THE TWO WORD PAIR
 387 000504  0372          AND     (7400           /SEE NOTE * BELOW
 388 000505  1757          TAD I   OUPOLD          /COMBINE WITH OTHER BITS
 389 000506  3757          DCA I   OUPOLD
 390 000507  1333          TAD     OUTEMP          /THE OTHER FOUR BITS OF THIS CHAR
 391 000510  7112          CLL RTR                 /GO INTO THE HIGH ORDER FOUR
 392 000511  7012          RTR                     /BITS OF THE SECOND
 393                                               /WORD OF THE PAIR
 394 000512  7010          RAR
 395 000513  0372          AND     (7400
 396 000514  1760          TAD I   OUPTR
 397 000515  3760          DCA I   OUPTR
 398 000516  1361          TAD     OUJMP           /RESET 3 WAY BRANCH
 399 000517  3276          DCA     OUJUMP
 400 000520  2360          ISZ     OUPTR           /BUMP BUFFER POINTER
 401 000521  2362          ISZ     OUWDCT          /AND DOUBLE WORD COUNTER
 402 000522  5672          JMP I   OCHAR           /BUFFER NOT FULL
 403 000523  4333          JMS     OUDUMP          /DUMP IT
 404 000524  5672          JMP I   OCHAR
 405 000525  1360  CHAR2,  TAD     OUPTR           /SAVE FIRST WORD POINTER
 406 000526  3357          DCA     OUPOLD
 407 000527  2360          ISZ     OUPTR           /GO TO SECOND WORD
 408 000530  1333  CHAR1,  TAD     OUTEMP          /STORE CHAR 1 OR 2
 409 000531  3760          DCA I   OUPTR
 410 000532  5672          JMP I   OCHAR
 411               OUTEMP,
 412 000533  0000  OUDUMP, 0                       /BUMP THE DUFFER
 413 000534  1363          TAD     OSIZE           /ANY ROOM LEFT ?
 414 000535  7450          SNA
 415 000536  5355          JMP     OUERR
 416 000537  7001          IAC
 417 000540  3363          DCA     OSIZE           /YES, ITS OK
 418 000541  4476          JMS I   DEVH            /WRITE
 419 000542  4200          4200                    /CONTROL WORD
 420 000543  4400          OUBUF                   /BUFFER POINTER
 421 000544  0000  OBLOCK, 0                       /BLOCK NUMBER
 422 000545  5355          JMP     OUERR           /ERROR
 423 000546  2344          ISZ     OBLOCK          /INCREMENT BLOCK NUMBER
 424 000547  2771          ISZ     FILSIZ          /AND FILE SIZE
 425 000550  1343          TAD     OBLOCK-1        /SET BUFFER POINTER
 426 000551  3360          DCA     OUPTR
 427 000552  1370          TAD     (-200           /SET DOUBLE WORD COUNT
 428 000553  3362          DCA     OUWDCT
 429 000554  5733          JMP I   OUDUMP
 430 000555  4767  OUERR,  JMS I   (FATAL          /FATAL OUTPUT ERROR
 431 000556  1706          1706
 432               / *  THE PONY EXPRESS STARTED IN 1860 AND ONLY RAN
 433               /       FOR 19 MONTHS WHILE LOSING $200,000.
 434 000557  0000  OUPOLD, 0
 435 000560  4400  OUPTR,  OUBUF
 436 000561  5276  OUJMP,  JMP     OUJUMP
 437 000562  7600  OUWDCT, -200
 438 000563  0000  OSIZE,  0
 439 000564  6100  DD1,    TEXT    '1'
 440 000567  0352          PAGE
     000570  7600  
     000571  4302  
     000572  7400  
     000573  0377  
     000574  5266  
     000575  0753  
     000576  7730  
     000577  6540  
 441               / READ FROM FORTRN.TM
 442               
 443 000600  0000  INWORD, 0                       /READ A WORD FROM INPUT FILE
 444 000601  2225          ISZ     INBCNT          /ANYTHING LEFT IN BUFFER ?
 445 000602  5220          JMP     NOREAD          /YES
 446 000603  2227          ISZ     INRCNT          /ANYTHING LEFT IN FILE?
 447 000604  7410          SKP
 448 000605  5777          JMP I   (END            /NO, END OF PROG
 449 000606  4476          JMS I   DEVH            /READ NEXT BLOCK
 450 000607  0200  X200,   0200
 451 000610  7200          INBUF
 452 000611  0000  INBLOK, 0
 453 000612  5223          JMP     INERR           /INPUT ERROR
 454 000613  2211          ISZ     INBLOK          /BUMP BLOCK NUMBER
 455 000614  1376          TAD     (-400           /RESET COUNTER
 456 000615  3225          DCA     INBCNT
 457 000616  1210          TAD     INBLOK-1        /RESET POINTER
 458 000617  3226          DCA     INBPTR
 459 000620  1626  NOREAD, TAD I   INBPTR          /GET WORD FROM BUFFER
 460 000621  2226          ISZ     INBPTR          /BUMP BUFFER POINTER
 461 000622  5600          JMP I   INWORD
 462 000623  4775  INERR,  JMS I   (FATAL          /FATAL INPUT ERROR
 463 000624  1105          1105
 464 000625  7777  INBCNT, -1                      /FORCE READ FIRST TIME
 465 000626  0000  INBPTR, 0
 466 000627  0000  INRCNT, 0
 467               / CODE UTILITIES
 468 000630  0000  GETSS,  0                       /GET POINTER TO DIM INFO
 469 000631  6211          CDF     10
 470 000632  7001          IAC
 471 000633  3047          DCA     DIMPTR          /ADDR OF TYPE WORD
 472 000634  1447          TAD I   DIMPTR
 473 000635  2047          ISZ     DIMPTR          /MOVE TO DIM/EQUIV POINTER
 474 000636  0207          AND     X200            /EQUIV INFO ?
 475 000637  7650          SNA CLA
 476 000640  5243          JMP     .+3             /NONE
 477 000641  1447          TAD I   DIMPTR          /SKIP EQUIV INFO
 478 000642  3047          DCA     DIMPTR
 479 000643  1447          TAD I   DIMPTR          /ADDRESS OF DIM INFO
 480 000644  5630          JMP I   GETSS
 481 000645  0000  NUMBRO, 0                       /OUTPUT 15 BIT OCTAL NUMBER
 482 000646  1040          TAD     AC              /IS HIGH DIGIT 0 ?
 483 000647  7450          SNA
 484 000650  5253          JMP     .+3             /YES, PRINT 4 DIGITS ONLY
 485 000651  1106          TAD     Q260            /MAKE IT ASCII
 486 000652  4562          JMS I   QOCHAR          /PUT IT
 487 000653  1042          TAD     MQ              /NOW LOW FOUR DIGITS
 488 000654  4516          JMS I   QONUMBR
 489 000655  5645          JMP I   NUMBRO
 490 000656  0000  UCODE,  0                       /GEN CODE FOR UNARY OPERATORS
 491 000657  4517          JMS I   QSAVEAC         /SAVE AC IF NEEDED
 492 000660  4304          JMS     GARG
 493 000661  5774          JMP     OTERR           /OPERATOR/TYPE ERROR
 494 000662  1026          TAD     ARG1            /IS ARG IN AC ?
 495 000663  7650          SNA CLA
 496 000664  1120          TAD     Q5              /YES, USE SECOND HALF OF TABLE
 497 000665  1030          TAD     TYPE1
 498 000666  1656          TAD I   UCODE           /PLUS TABLE ADDRESS
 499 000667  3276          DCA     USKEL
 500 000670  6211          CDF     10
 501 000671  1676          TAD I   USKEL           /ADDR OF SKELETON
 502 000672  7450          SNA
 503 000673  5774          JMP     OTERR           /0 MEANS BAD
 504                                               /OPERATOR/TYPE COMBO
 505 000674  3276          DCA     USKEL           /SAVE SKELETON ADDR
 506 000675  4521          JMS I   QGENCOD         /GO DO THE CODE
 507 000676  0000  USKEL,  0
 508 000677  3416          DCA I   X16             /RESULT IN AC
 509 000700  2016          ISZ     X16             /BUMP STACK POINTER
 510 000701  2016          ISZ     X16             /TYPE IS ALREADY THERE
 511 000702  2256          ISZ     UCODE           /FIX RET ADDR
 512 000703  5656          JMP I   UCODE
 513 000704  0000  GARG,   0                       /GET ONE ARG
 514 000705  7146          CLL CMA RTL             /BACK UP ONE ENTRY
 515 000706  1016          TAD     X16
 516 000707  3016          DCA     X16
 517 000710  1016          TAD     X16             /USABLE POINTER
 518 000711  3015          DCA     X15
 519 000712  1415          TAD I   X15             /GET OPERAND
 520 000713  3026          DCA     ARG1
 521 000714  1415          TAD I   X15
 522 000715  3030          DCA     TYPE1
 523 000716  1415          TAD I   X15
 524 000717  3027          DCA     BASE1
 525 000720  1030          TAD     TYPE1           /CHECK TYPE
 526 000721  1122          TAD     QM6
 527 000722  7700          SMA CLA
 528 000723  5704          JMP I   GARG            /TAKE ERROR EXIT
 529 000724  2031          ISZ     ARG2            /MAKE SURE ARG2 ISN'T ZERO
 530 000725  4773          JMS I   (MPTRA1         /MOVE THE POINTER IF
 531                                               /THERE IS ONE
 532 000726  2304          ISZ     GARG
 533 000727  5704          JMP I   GARG
 534               
 535 000730  0000  TTYOUT, 0                       /OUTPUT TO THE TTY
 536 000731  6046          TLS
 537 000732  6041          TSF
 538 000733  5332          JMP     .-1
 539 000734  7200          CLA
 540 000735  6031          KSF
 541 000736  5730          JMP I   TTYOUT          /NO KEYBOARD FLAG
 542 000737  6036          KRB
 543 000740  0372          AND     (177            /ACCEPT PARITY ASCII
 544 000741  1371          TAD     (-3             /^C ?
 545 000742  7450          SNA
 546 000743  5570          JMP I   Q7605           /YES, BACK TO PS8
 547 000744  1370          TAD     (3-17           /^O ?
 548 000745  7640          SZA CLA
 549 000746  5730          JMP I   TTYOUT          /NO, RETURN
 550 000747  3331          DCA     TTYOUT+1        /KILL OUTPUT STUFF
 551 000750  3332          DCA     TTYOUT+2
 552 000751  3333          DCA     TTYOUT+3
 553 000752  5730          JMP I   TTYOUT          /RETURN
 554 000753  4316  LTRNE, TEXT    '#NE'
     000754  0500  
 555 000755  4307          TEXT    '#GE'
     000756  0500  
 556 000757  4314          TEXT    '#LE'
     000760  0500  
 557 000761  4307          TEXT    '#GT'
     000762  2400  
 558 000763  4314          TEXT    '#LT'
     000764  2400  
 559 000765  4305          TEXT    '#EQ'
     000766  2100  
 560 000770  7764          PAGE
     000771  7775  
     000772  0177  
     000773  1255  
     000774  1360  
     000775  0352  
     000776  7400  
     000777  4200  
 561               / SOME TEXT
 562               
 563 001000  5362  P2,     TEXT    '+2'
     001001  0000  
 564 001002  4326  XVAL,   TEXT    '#VAL'
     001003  0114  
     001004  0000  
 565 001005  5653  DP4,    TEXT    '.+4'
     001006  6400  
 566 001007  0601  FADD,   TEXT    'FADD'
     001010  0404  
     001011  0000  
 567 001012  0614  FLDA,   TEXT    'FLDA'
     001013  0401  
     001014  0000  
 568 001015  0623  FSUB,   TEXT    'FSUB'
     001016  2502  
     001017  0000  
 569               / SAVE AC ROUTINES
 570 001020  0000  SAVACT, 0                       /SAVE TOP OF STACK IF
 571                                               /NECESSARY
 572 001021  1220          TAD     SAVACT          /SAVE RETURN ADDR
 573 001022  3225          DCA     SAVEAC
 574 001023  7144          CLL CMA RAL
 575 001024  5227          JMP     SAVEAC+2        /BACK UP ONLY ONE ENTRY
 576 001025  0000  SAVEAC, 0                       /STORE AC IF NEEDED
 577 001026  1377          TAD     (-5             /LOOK AT STACK TWO DOWN
 578 001027  1016          TAD     X16
 579 001030  3262          DCA     SATEMP
 580 001031  1662          TAD I   SATEMP          /IF 0, RESULT WAS LEFT IN AC
 581 001032  7640          SZA CLA
 582 001033  5625          JMP I   SAVEAC          /NO, NO STORE NEEDED
 583 001034  1034          TAD     TMPCNT          /STORE TEMP NUMBER
 584 001035  3662          DCA I   SATEMP
 585 001036  2262          ISZ     SATEMP          /MOVE TO TYPE WORD
 586 001037  1662          TAD I   SATEMP          /GET TYPE
 587 001040  4242          JMS     SAVE            /GO DO ACTUAL STORE
 588 001041  5625          JMP I   SAVEAC
 589 001042  0000  SAVE,   0                       /SAVE AC
 590 001043  3262          DCA     ACSTOR          /THIS IS THE TYPE
 591 001044  1262          TAD     ACSTOR          /IS IT COMPLEX OR DOUBLE?
 592 001045  1105          TAD     QM4
 593 001046  7450          SNA
 594 001047  5255          JMP     NOC             /ITS DOUBLE
 595 001050  7001          IAC
 596 001051  7640          SZA CLA
 597 001052  5260          JMP     NOCORD          /NO
 598 001053  4521          JMS I   QGENCOD         /STARTE; FLDA #CAC
 599 001054  5171          SEGCAC-1
 600 001055  4262  NOC,    JMS     ACSTOR          /%FSTA #TMP+XXXX
 601 001056  4271          JMS     TMPBMP          /THIS USE TWO TEMPS
 602 001057  5642          JMP I   SAVE
 603 001060  4262  NOCORD, JMS     ACSTOR          /%FSTA #TMP+XXXX
 604 001061  5642          JMP I   SAVE
 605               SATEMP,
 606 001062  0000  ACSTOR, 0                       /GENERATES FSTA TEMP+XXXX
 607 001063  4523          JMS I   QOPCOD          /OUTPUT %FSTA %TEMP+XXXX
 608 001064  1567          FSTA
 609 001065  4525          JMS I   QOADDR
 610 001066  0034          TMPCNT                  /TMPCNT CONTAINS THE
 611                                               /ARG NUMBER
 612 001067  4271          JMS     TMPBMP          /BUMP TEMPORARY NUMBER
 613 001070  5662          JMP I   ACSTOR
 614               
 615 001071  0000  TMPBMP, 0               /ROUTINE TO BUMP TEMPORARIES
 616 001072  1034          TAD     TMPCNT          /BIGGER THAN MAX?
 617 001073  7141          CIA CLL
 618 001074  1035          TAD     TMPMAX
 619 001075  7630          SZL CLA
 620 001076  5301          JMP     .+3             /GO BUMP TEMP CNT
 621 001077  1034          TAD     TMPCNT          /NEW TEMP MAX
 622 001100  3035          DCA     TMPMAX
 623 001101  2034          ISZ     TMPCNT          /INCR TEMP COUNT
 624 001102  5671          JMP I   TMPBMP
 625               / PUSH ARG ONTO STACK
 626 001103  4225  PUSH,   JMS     SAVEAC          /GO SAVE AC IF NEEDED
 627 001104  4515          JMS I   QINWORD         /GET ADDR OF NEW VAR
 628 001105  3024          DCA     TEMP            /SAVE IT
 629 001106  1024          TAD     TEMP            /PUSH IT
 630 001107  3416          DCA I   X16
 631 001110  2024          ISZ     TEMP            /GO TO TYPE
 632 001111  6211          CDF     10
 633 001112  1424          TAD I   TEMP            /GET TYPE
 634 001113  6201          CDF
 635 001114  0126          AND     Q17             /PUSH TYPE
 636 001115  3416          DCA I   X16             /ONTO STACK
 637 001116  3416  CKPDL,  DCA I   X16             /ZERO BASE WORD
 638 001117  1016          TAD     X16             /IS STACK FULL ?
 639 001120  7141          CIA CLL
 640 001121  1376          TAD     (STACK+177
 641 001122  7630          SZL CLA
 642 001123  5511          JMP I   QNEXT           /NO, OK
 643 001124  1052          TAD     STKLVL          /RESET STACK LEVEL
 644 001125  3016          DCA     X16
 645 001126  4527          JMS I   QTTYMSG         /PRINT MESSAGE
 646 001127  2004          2004
 647 001130  4515  DPUSH,  JMS I   QINWORD         /GET THE VAR NAME PTR
 648 001131  3416          DCA I   X16             /PUSH IT
 649 001132  4515          JMS I   QINWORD         /NOW GET THE DISPLACEMENT
 650 001133  5315          JMP     CKPDL-1         /GO CHECK FOR OVERFLOW
 651 001134  2324  STARTF, TEXT    'STARTF'
     001135  0122  
     001136  2406  
     001137  0000  
 652               / ARITHMETIC IF
 653 001140  4513  ARTHIF, JMS I   QUCODE          /GET ARG INTO AC
 654 001141  6515          AIFTBL-1
 655 001142  4532          JMS I   QGENSF          /DO ALL TRANSFERS IN FMODE
 656 001143  1375          TAD     (JLT            /FIRST OPCODE
 657 001144  3355          DCA     AJUMP
 658 001145  4515  AIFLUP, JMS I   QINWORD         /GET NEXT INPUT
 659 001146  3025          DCA     TEMP2           /SAVE IT IN CASE ITS NOT LABEL
 660 001147  1025          TAD     TEMP2
 661 001150  7100          CLL
 662 001151  1374          TAD     (XPUSH-XLAST    /IS IT A LABEL ?
 663 001152  7620          SNL CLA
 664 001153  5512          JMP I   QNEXTM2         /NO, PROCEED
 665 001154  4524          JMS I   QOPCDE
 666 001155  0000  AJUMP,  0                       /OUTPUT CORRECT JUMP
 667 001156  1025          TAD     TEMP2
 668 001157  6211          CDF     10
 669 001160  4534          JMS I   QOSNUM          /NOW THE LABEL
 670 001161  4535          JMS I   QCRLF
 671 001162  2355          ISZ     AJUMP           /MOVE TO NEXT OPCODE
 672 001163  2355          ISZ     AJUMP
 673 001164  5345          JMP     AIFLUP
 674 001165  5600  DOT,    TEXT    '.'
 675 001166  5653  DP8,    TEXT    '.+10'
     001167  6160  
     001170  0000  
 676 001174  7710          PAGE
     001175  3653  
     001176  7177  
     001177  7773  
 677               / PICK UP TOP TWO ARGS
 678               
 679 001200  0000  GARGS,  0                       /GET TOP 2  ARGS FROM STACK
 680 001201  1016          TAD     X16
 681 001202  1122          TAD     QM6             /BACK TWO OPERANDS
 682 001203  3015          DCA     X15
 683 001204  1015          TAD     X15
 684 001205  3016          DCA     X16             /AND OFFICIALLY POP THE STACK
 685 001206  1415          TAD I   X15             /GET FIRST ARG
 686 001207  3026          DCA     ARG1
 687 001210  1415          TAD I   X15             /AND TYPE
 688 001211  3030          DCA     TYPE1
 689 001212  1415          TAD I   X15
 690 001213  3027          DCA     BASE1           /AND FIRST BASE (IN
 691                                               /CASE OF SS)
 692 001214  1415          TAD I   X15             /NOW SECOND ARG
 693 001215  3031          DCA     ARG2
 694 001216  1415          TAD I   X15
 695 001217  3033          DCA     TYPE2
 696 001220  1415          TAD I   X15
 697 001221  3032          DCA     BASE2
 698 001222  1030          TAD     TYPE1           /TYPES MUST BE LT 6
 699 001223  1122          TAD     QM6
 700 001224  7700          SMA CLA
 701 001225  5600          JMP I   GARGS           /RETURN BAD
 702 001226  1033          TAD     TYPE2
 703 001227  1122          TAD     QM6
 704 001230  7710          SPA CLA
 705 001231  2200          ISZ     GARGS           /FIX RETURN
 706 001232  4255          JMS     MPTRA1          /GET ARG1 POINTER IF NEEDED
 707 001233  1031          TAD     ARG2            /IS ARG2 A POINTER
 708 001234  1377          TAD     (-61
 709 001235  7640          SZA CLA
 710 001236  5600          JMP I   GARGS           /NO, RETURN
 711 001237  1026          TAD     ARG1            /IS ARG1 IN THE AC ?
 712 001240  7640          SZA CLA
 713 001241  5246          JMP     .+5             /NO
 714 001242  1034          TAD     TMPCNT          /YES, STORE THE AC
 715 001243  3026          DCA     ARG1
 716 001244  1030          TAD     TYPE1           /GET TYPE
 717 001245  4776          JMS I   (SAVE
 718 001246  1032          TAD     BASE2           /MOVE POINTER FROM TEMP
 719                                               /TO BASE+3
 720 001247  3031          DCA     ARG2
 721 001250  4521          JMS I   QGENCOD
 722 001251  5053          MPTR3-1
 723 001252  1375          TAD     (62             /ARG IS NOW POINTED TO
 724                                               /BY BASE+3
 725 001253  3031          DCA     ARG2
 726 001254  5600          JMP I   GARGS
 727 001255  0000  MPTRA1, 0                       /MOVE ARG1 POINTER TO BASE
 728 001256  1026          TAD     ARG1
 729 001257  1377          TAD     (-61
 730 001260  7640          SZA CLA
 731 001261  5655          JMP I   MPTRA1
 732 001262  1031          TAD     ARG2
 733 001263  7640          SZA CLA
 734 001264  5271          JMP     .+5
 735 001265  1034          TAD     TMPCNT
 736 001266  3031          DCA     ARG2
 737 001267  1033          TAD     TYPE2           /GET THE TYPE
 738 001270  4776          JMS I   (SAVE
 739 001271  1027          TAD     BASE1
 740 001272  3026          DCA     ARG1
 741 001273  4521          JMS I   QGENCOD
 742 001274  5046          MPTR0-1
 743 001275  1374          TAD     (61
 744 001276  3026          DCA     ARG1            /SET ARG1 TO IND0
 745 001277  5655          JMP I   MPTRA1
 746               / BINARY OPERATORS
 747 001300  0000  CODE,   0                       /GENERATE CODE FOR
 748                                               /BINARY OPERATORS
 749 001301  4200          JMS     GARGS           /GET OPERANDS
 750 001302  5360          JMP     OTERR           /BAD TYPE OPERATOR COMBO
 751 001303  1030          TAD     TYPE1           /INDEX INTO TYPE CHECK TABLE
 752 001304  7106          CLL RTL
 753 001305  1030          TAD     TYPE1
 754 001306  1033          TAD     TYPE2
 755 001307  7104          CLL RAL
 756 001310  1373          TAD     (TYPMIX-14      /POINTER TO CORRECT ENTRY
 757 001311  3342          DCA     SKEL
 758 001312  6211          CDF     10
 759 001313  1742          TAD I   SKEL            /RESULTING TYPE
 760 001314  7450          SNA
 761 001315  5355          JMP     TYPERR          /THIS MIX IS ILLEGAL
 762 001316  3030          DCA     TYPE1           /SAVE RESULT TYPE
 763 001317  2342          ISZ     SKEL            /GET INDEX INTO
 764                                               /SKELETON TABLE
 765 001320  1742          TAD I   SKEL
 766 001321  6201          CDF
 767 001322  1700          TAD I   CODE            /PLUS BASE GIVES ADDR
 768                                               /OF M,AC CASE
 769 001323  3342          DCA     SKEL
 770 001324  6211          CDF     10
 771 001325  1742          TAD I   SKEL            /IS THIS TYPE OPER
 772                                               /COMBO LEGAL ?
 773 001326  7650          SNA CLA
 774 001327  5360          JMP     OTERR           /NO
 775 001330  2300          ISZ     CODE            /POINTS TO RESULTING TYPE
 776 001331  1031          TAD     ARG2
 777 001332  7640          SZA CLA
 778 001333  2342          ISZ     SKEL            /SECOND ARG IS IN MEMORY
 779 001334  1026          TAD     ARG1
 780 001335  7650          SNA CLA                 /SKIP ON M,M CASE
 781 001336  2342          ISZ     SKEL            /MOVE TO AC,M CASE
 782 001337  1742          TAD I   SKEL            /PICK UP POINTER TO SKELETON
 783 001340  3342          DCA     SKEL
 784 001341  4521          JMS I   QGENCOD         /GO DO THE CODE
 785 001342  0000  SKEL,   0
 786 001343  3416          DCA I   X16             /RESULT IS IN THE AC
 787 001344  1700          TAD I   CODE
 788 001345  7450          SNA                     /IS TYPE SAME AS ARGS ?
 789 001346  1030          TAD     TYPE1           /YES
 790 001347  3416          DCA I   X16             /STORE IT
 791 001350  3416          DCA I   X16             /ZERO BASE WORD
 792 001351  1700          TAD I   CODE            /IS TYPE SAME AS ARGS ?
 793 001352  7440          SZA
 794 001353  3101          DCA     FMODE           /NO, WE'RE NOW IN FMODE
 795 001354  5700          JMP I   CODE
 796 001355  4772  TYPERR, JMS     BUMP            /PUT FALSE VALUE ONTO STACK
 797 001356  4527          JMS I   QTTYMSG         /OUTPUT ERROR
 798 001357  1524          1524
 799 001360  4772  OTERR,  JMS     BUMP            /PUT FALSE VALUE ONTO STACK
 800 001361  4527          JMS I   QTTYMSG
 801 001362  1724          1724
 802 001363  4304  XDPP6,  TEXT    '#DPT+6'
     001364  2024  
     001365  5366  
     001366  0000  
 803 001367  4306  XFIX,   TEXT    '#FIX'
     001370  1130  
     001371  0000  
 804 001372  2134          PAGE
     001373  6676  
     001374  0061  
     001375  0062  
     001376  1042  
     001377  7717  
 805               / CODE GENERATOR (FROM SKELETONS)
 806               
 807 001400  0000  GENCOD, 0                       /CODE GENERATOR ROUTINE
 808 001401  6201          CDF
 809 001402  1014          TAD     X14
 810 001403  3305          DCA     TEMP14          /FIX COMPLEX FUNCTION BUG
 811 001404  1600          TAD I   GENCOD          /GET SKELETON ADDRESS
 812 001405  2200          ISZ     GENCOD
 813 001406  3014  MPOPUP, DCA     X14             /HERE ON MACRO END
 814 001407  3304          DCA     MRETN
 815 001410  6211  CODLUP, CDF     10              /STUFF IS IN FIELD 1
 816 001411  1414          TAD I   X14             /GET OPCODE
 817 001412  6201          CDF
 818 001413  7450          SNA
 819 001414  5264          JMP     ENDM            /IS IT END OF A MACRO ?
 820 001415  7510          SPA
 821 001416  5250          JMP     MACRO           /ITS A MACRO REFERENCE
 822 001417  3221          DCA     .+2             /SAVE OPCODE
 823 001420  4523          JMS I   QOPCOD          /OUTPUT IT
 824 001421  0000          0
 825 001422  6211          CDF     10
 826 001423  1414          TAD I   X14             /ADDRESS ?
 827 001424  6201          CDF
 828 001425  7450          SNA
 829 001426  5235          JMP     NOADDR          /NO OPERAND FOR THIS INSTR
 830 001427  7510          SPA
 831 001430  5237          JMP     DOADDR          /ADDRESS IS AN OPERAND
 832 001431  3024          DCA     TEMP
 833 001432  4536          JMS I   QOTAB           /ADDRESS IS A SPECIFIC
 834 001433  1024          TAD     TEMP
 835 001434  4537          JMS I   QOUTSYM
 836 001435  4535  NOADDR, JMS I   QCRLF
 837 001436  5210          JMP     CODLUP          /DO NEXT LINE
 838 001437  7001  DOADDR, IAC                     /IS IT ARG1 ?
 839 001440  7640          SZA CLA
 840 001441  5245          JMP     ITSA2           /NO, ITS ARG2
 841 001442  4525          JMS I   QOADDR          /OUTPUT ARG1 ADDRESS FIELD
 842 001443  0026          ARG1
 843 001444  5210          JMP     CODLUP
 844 001445  4525  ITSA2,  JMS I   QOADDR          /OUTPUT ARG2 ADDRESS
 845 001446  0031          ARG2                    /FIELD
 846 001447  5210          JMP     CODLUP
 847 001450  1120  MACRO,  TAD     Q5      /CODES BETWEEN -1 AND -5 ARE SPECIAL
 848 001451  7510          SPA
 849 001452  5256          JMP     .+4     /NOT ONE OF THEM
 850 001453  1377          TAD     (JMP MJTBL
 851 001454  3255          DCA     .+1
 852 001455  7402          HLT             /GO TO PROPER ROUTINE
 853 001456  3024          DCA     MSTART          /SAVE START OF MACRO
 854 001457  1014          TAD     X14             /SAVE RETURN ADDRESS
 855 001460  3304          DCA     MRETN
 856 001461  1024          TAD     MSTART          /GO DO MACRO
 857 001462  3014          DCA     X14
 858 001463  5210          JMP     CODLUP
 859 001464  1304  ENDM,  TAD     MRETN           /WAS THIS A MACRO ?
 860 001465  7440          SZA
 861 001466  5206          JMP     MPOPUP          /YES - GET OUT OF IT
 862 001467  1305          TAD     TEMP14
 863 001470  3014          DCA     X14             /RESTORE X14 FOR FUNCAL
 864 001471  5600          JMP I   GENCOD  /AND EXIT
 865               
 866 001472  4776  LOADA1, JMS I   (LOADA          /GENERATE LOAD
 867 001473  0026          ARG1                    /IF NECESSARY
 868 001474  5210          JMP     CODLUP
 869 001475  4776  LOADA2, JMS I   (LOADA          /GENERATE LOAD
 870 001476  0031          ARG2                    /IF NECESSARY
 871 001477  5210          JMP     CODLUP
 872 001500  4533  DOSTE,  JMS I   QGENSE          /STARTE IF IN F MODE
 873 001501  5210          JMP     CODLUP
 874 001502  2171  SGNNEG, ISZ     RELCD   /CHANGE SIGN OF RELATIONAL OPERATOR
 875 001503  5210          JMP     CODLUP
 876                       MSTART=TEMP
 877 001504  0000  MRETN,  0                       /MACRO RETURN ADDRESS
 878 001505  0000  TEMP14, 0
 879               
 880 001506  5302  MJTBL,  JMP     SGNNEG  /-5 - NEGATE RELATIONAL SIGN
 881 001507  5275          JMP     LOADA2  /-4 - LOAD ARG 2
 882 001510  5272          JMP     LOADA1  /-3 - LOAD ARG 1
 883 001511  5300          JMP     DOSTE   /-2 - START E MODE
 884 001512  4532          JMS I   QGENSF  /-1 - START F MODE
 885 001513  5210          JMP     CODLUP
 886               
 887 001514  2305  XSET,   TEXT    'SETX'
     001515  2430  
     001516  0000  
 888 001517  6054  ZEROC1, TEXT    '0,1'
     001520  6100  
 889               / GOTO'S AND ASSIGN
 890 001521  4346  CGOTO,  JMS     GTSTUF          /LOOK AT INDEX
 891 001522  4521          JMS I   QGENCOD         /OUTPUT COMPUTED GOTO CODE
 892 001523  5000          CGTCOD-1
 893 001524  4515          JMS I   QINWORD         /GET COUNT
 894 001525  7041          CIA
 895 001526  3025          DCA     TEMP2
 896 001527  4336  CGTLUP, JMS     JAGEN
 897 001530  2025          ISZ     TEMP2
 898 001531  5327          JMP     CGTLUP
 899 001532  5511          JMP I   QNEXT
 900 001533  4532  GOTO,   JMS I   QGENSF          /ALL TRANSFERS IN F MODE
 901 001534  4336          JMS     JAGEN
 902 001535  5511          JMP I   QNEXT
 903               
 904 001536  0000  JAGEN,  0
 905 001537  4524          JMS I   QOPCDE          /OUTPUT JA'S
 906 001540  3657          JA
 907 001541  4515          JMS I   QINWORD         /GET THE LABEL
 908 001542  6211          CDF     10
 909 001543  4534          JMS I   QOSNUM          /OUTPUT IT AS THE ADDRESS
 910 001544  4535          JMS I   QCRLF
 911 001545  5736          JMP I   JAGEN
 912               
 913 001546  0000  GTSTUF, 0
 914 001547  4540          JMS I   QGARG           /GET THE ARG
 915 001550  5363          JMP     GTTYPE
 916 001551  7146          CLL CMA RTL             /CHECK THE TYPE
 917 001552  1030          TAD     TYPE1
 918 001553  7700          SMA CLA
 919 001554  5363          JMP     GTTYPE          /NOT INTEGER OR REAL
 920 001555  1026          TAD     ARG1            /IS IT IN THE AC ?
 921 001556  7650          SNA CLA
 922 001557  5746          JMP I   GTSTUF          /YES ALREADY
 923 001560  4521          JMS I   QGENCOD
 924 001561  6527          GI-1                    /LOAD THE INDEX
 925 001562  5746          JMP I   GTSTUF
 926 001563  4527  GTTYPE, JMS I   QTTYMSG         /GOTO TYPE ERROR
 927 001564  0726          0726
 928 001565  1201  JAC,    TEXT    'JAC'
     001566  0300  
 929 001567  0623  FSTA,   TEXT    'FSTA'
     001570  2401  
     001571  0000  
 930 001572  0616  FNEG,   TEXT    'FNEG'
     001573  0507  
     001574  0000  
 931 001576  6502          PAGE
     001577  5306  
 932               / ADDRESS FIELD OUTPUT
 933 001600  0000  OADDR,  0                       /OUTPUT ADDRESS FIELD
 934 001601  1600          TAD I   OADDR           /GET ADDRESS OF PARAMETERS
 935 001602  3037          DCA     ARG
 936 001603  2200          ISZ     OADDR
 937 001604  1437          TAD I   ARG             /GET VALUE OF ARG
 938 001605  7100          CLL
 939 001606  1377          TAD     (-52            /IS IT A TEMP REFNCE
 940 001607  7420          SNL
 941 001610  5776          JMP     TMPREF          /YES, 1-51
 942 001611  1375          TAD     (52-61          /IS IT AN ARRAY REFERENCE ?
 943 001612  7430          SZL
 944 001613  5274          JMP     SSREF           /YES, 52-60 IS XR1-XR7
 945 001614  7450          SNA
 946 001615  5325          JMP     IND0            /INDIRECT THROUGH 0
 947 001616  1374          TAD     (61-7000        /CHECK FOR DO TEMP
 948 001617  7430          SZL
 949 001620  5773          JMP     DOTMP
 950 001621  1372          TAD     (7000-62
 951 001622  7450          SNA
 952 001623  5324          JMP     IND3            /INDIRECT THROUGH 3
 953 001624  1371          TAD     (63
 954 001625  3024          DCA     TEMP
 955 001626  6211          CDF     10
 956 001627  1424          TAD I   TEMP            /IS THIS AN ARG ?
 957 001630  0141          AND     Q20
 958 001631  6201          CDF
 959 001632  7640          SZA CLA
 960 001633  5337          JMP     INDARG          /YES, REF IT INDIRECTLY
 961 001634  4536          JMS I   QOTAB
 962 001635  6211          CDF     10
 963 001636  1424          TAD I   TEMP            /LOOK AT TYPE WORD
 964 001637  0370          AND     (50             /IS IT LIT OR STMT NO.?
 965 001640  7450          SNA
 966 001641  5246          JMP     OUTA            /NO, JUST OUTPUT ADDRESS
 967 001642  0142          AND     Q40
 968 001643  7650          SNA CLA
 969 001644  5332          JMP     OUTSN           /OUTPUT STMT NUMBER
 970 001645  5260          JMP     OUTLIT          /OUTPUT LITERAL
 971 001646  1061  OUTA,   TAD     PROGNM          /IS THIS THE FUNCTION NAME ?
 972 001647  7041          CIA
 973 001650  1024          TAD     TEMP
 974 001651  7650          SNA CLA
 975 001652  5271          JMP     FUNNAM          /YES, REFERENCE #VAL INSTEAD
 976 001653  7240  OUTA2,  CLA CMA                 /SIMPLE LOCAL VARIABLE REFNCE
 977 001654  1024          TAD     TEMP            /ADDRESS OF VAR
 978 001655  4543          JMS I   QOUTNAM         /INTO ADDR FIELD
 979 001656  4535          JMS I   QCRLF
 980 001657  5600          JMP I   OADDR           /END OF ADDRESS
 981 001660  2024  OUTLIT, ISZ     TEMP            /MOVE TO LITERAL NUMBER
 982 001661  1424          TAD I   TEMP
 983 001662  3024          DCA     TEMP            /DISPLACEMENT FROM %LITRL
 984 001663  6201          CDF
 985 001664  1144          TAD     QLITRL          /OUTPUT #LIT+
 986 001665  4537          JMS I   QOUTSYM
 987 001666  1024          TAD     TEMP            /DISPLACEMENT
 988 001667  4516          JMS I   QONUMBR
 989 001670  5322          JMP     OADRET-1
 990 001671  1367  FUNNAM, TAD     (XVAL           /#VAL
 991 001672  4537          JMS I   QOUTSYM
 992 001673  5322          JMP     OADRET-1
 993 001674  1366  SSREF,  TAD     (270            /MAKE IT AN ASCII DIGIT
 994 001675  3041          DCA     XR
 995 001676  2037          ISZ     ARG             /POINT TO THE BASE WORD
 996 001677  1437          TAD I   ARG             /GET THE ADDR OF THE BASE
 997 001700  3037          DCA     ARG
 998 001701  6211          CDF     10
 999 001702  1037          TAD     ARG
1000 001703  7001          IAC                     /GO TO TYPE OF BASE VAR
1001 001704  3025          DCA     TEMP2
1002 001705  1425          TAD I   TEMP2           /IS IT AN ARG TO THE SUBR ?
1003 001706  0141          AND     Q20
1004 001707  7650          SNA CLA
1005 001710  5765          JMP     NOTARG          /NO, NO INDIRECT STUFF
1006 001711  6201          CDF
1007 001712  4342          JMS     SIT
1008 001713  1037          TAD     ARG             /VAR NAME
1009 001714  6211          CDF     10
1010 001715  4543          JMS I   QOUTNAM
1011 001716  1053          TAD     COMMA
1012 001717  4562          JMS I   QOCHAR
1013 001720  1041          TAD     XR              /XR NUMBER
1014 001721  4562          JMS I   QOCHAR
1015 001722  4535          JMS I   QCRLF
1016 001723  5600  OADRET, JMP I   OADDR
1017 001724  1364  IND3,   TAD     (XBASP3-XBASE   /INDIRECT THRU #BASE+3
1018 001725  1363  IND0,   TAD     (XBASE          /INDIRECT THRU #BASE
1019 001726  3024          DCA     TEMP
1020 001727  4342          JMS     SIT
1021 001730  1024          TAD     TEMP
1022 001731  5272          JMP     FUNNAM+1
1023 001732  7240  OUTSN,  CLA CMA                 /OUTPUT STMT NUMBER
1024 001733  1024          TAD     TEMP
1025 001734  4534          JMS I   QOSNUM          /OUTPUT THE NUMBER
1026 001735  1362          TAD     (P2             /+2 (HACK FOR FORMAT)
1027 001736  5272          JMP     FUNNAM+1
1028 001737  4342  INDARG, JMS     SIT             /INDIRECT INDICATOR
1029 001740  6211          CDF     10
1030 001741  5253          JMP     OUTA2           /OUTPUT ARG NAME
1031 001742  0000  SIT,    0
1032 001743  1361          TAD     (245            /% (INDIRECT)
1033 001744  4562          JMS I   QOCHAR
1034 001745  4536          JMS I   QOTAB
1035 001746  5742          JMP I   SIT
1036 001747  4303  CEQ,    TEXT    '#CEQ'
     001750  0521  
     001751  0000  
1037 001752  4302  XBAC1P, TEXT    '#BASE,1+'
     001753  0123  
     001754  0554  
     001755  6153  
     001756  0000  
1038 001757  4325  XUE,    TEXT    '#UE'
     001760  0500  
1039 001761  0245          PAGE
     001762  1000  
     001763  3600  
     001764  0003  
     001765  2000  
     001766  0270  
     001767  1002  
     001770  0050  
     001771  0063  
     001772  6716  
     001773  2030  
     001774  1061  
     001775  7771  
     001776  2035  
     001777  7726  
1040               / ADDRESS FIELD OUTPUT
1041               
1042 002000  1425  NOTARG, TAD I   TEMP2           /GET TYPE WORD
1043 002001  3024          DCA     TEMP            /SAVE IT
1044 002002  1024          TAD     TEMP
1045 002003  2025          ISZ     TEMP2
1046 002004  0145          AND     Q200            /EQUIVALENCED ?
1047 002005  7650          SNA CLA
1048 002006  5211          JMP     .+3
1049 002007  1425          TAD I   TEMP2           /SKIP EQUIV INFO BLOCK
1050 002010  3025          DCA     TEMP2
1051 002011  7126          CLL CML RTL
1052 002012  1425          TAD I   TEMP2           /ADDRESS OF MAGIC NUMBER
1053 002013  3025          DCA     TEMP2
1054 002014  1425          TAD I   TEMP2           /MAGIC NUMBER ITSELF
1055 002015  3025          DCA     TEMP2
1056 002016  6201          CDF
1057 002017  4536          JMS I   QOTAB           /TAB
1058 002020  1037          TAD     ARG             /OUTPUT VARIABLE MINUS CONST
1059 002021  4264          JMS     VMC
1060 002022  1053          TAD     COMMA
1061 002023  4562          JMS I   QOCHAR
1062 002024  1041          TAD     XR              /N
1063 002025  4562          JMS I   QOCHAR
1064 002026  4535          JMS I   QCRLF           /END OF LINE
1065 002027  5777          JMP     OADRET
1066 002030  3024  DOTMP,  DCA     TEMP            /ADDRESS RELATIVE TO %DOTMP
1067 002031  4536          JMS I   QOTAB
1068 002032  1376          TAD     (DOTMPN         /OUTPUT #DOTMP
1069 002033  4537          JMS I   QOUTSYM
1070 002034  5254          JMP     PLUSN           /GO OUTPUT +XXXX
1071 002035  7200  TMPREF, CLA
1072 002036  1437          TAD I   ARG     /BUMP TEMPS BACK CORRECTLY (?)
1073 002037  3034          DCA     TMPCNT
1074 002040  4536          JMS I   QOTAB           /TAB
1075 002041  7240          CLA CMA
1076 002042  1437          TAD I   ARG             /GET NUMBER
1077 002043  3024          DCA     TEMP            /INTO TEMP
1078                       IFNZRO TMPBLK-2 <XXXXXX>
1079 002044  7344          CLL STA RAL             /V3C -2 (-TMPBLK)
1080                                               /V3C LINK SET
1081 002045  1024          TAD     TEMP            /V3C (SAVES A LITERAL)
1082 002046  7420          SNL                     /V3C
1083 002047  3024          DCA     TEMP            /YES, SAVE ALTERED DISPLACEMENT
1084 002050  7620          SNL CLA                 /V3C
1085 002051  1375          TAD     (TEMPN2-TEMPN   /USE %TEMPX
1086 002052  1374          TAD     (TEMPN          /USE %TEMP
1087 002053  4537          JMS I   QOUTSYM
1088 002054  1054  PLUSN,  TAD     PLUS            /PLUS CONSTANT
1089 002055  4562          JMS I   QOCHAR
1090 002056  1024          TAD     TEMP            /DISPLACEMENT TIMES THREE
1091 002057  7104          CLL RAL
1092 002060  1024          TAD     TEMP
1093 002061  4516          JMS I   QONUMBR         /OUT IT
1094 002062  4535          JMS I   QCRLF
1095 002063  5777          JMP     OADRET
1096               / UTILITIES
1097 002064  0000  VMC,    0                       /OUTPUT VARIABLE MINUS CONST
1098 002065  6211          CDF     10
1099 002066  4543          JMS I   QOUTNAM         /PUT VAR NAME
1100 002067  1146          TAD     Q255            /-
1101 002070  4562          JMS I   QOCHAR
1102 002071  1024          TAD     TEMP            /THIS CONTAINS THE TYPE
1103 002072  4302          JMS     SKPIRL          /SKIP ON I,R OR L
1104 002073  1147          TAD     Q3              /USE SIX WORDS PER ENTRY
1105 002074  1147          TAD     Q3              /REAL, INTEGER, OR
1106                                               /LOGICAL 3 WORDS
1107 002075  3042          DCA     MQ
1108 002076  1025          TAD     TEMP2
1109 002077  4312          JMS     MUL12           /DO MULTIPLY
1110 002100  4563          JMS I   QNUMBRO         /OUTPUT 15 BIT NUMBER
1111 002101  5664          JMP I   VMC
1112               SC,
1113 002102  0000  SKPIRL, 0                       /SKIP ON TYPE I R OR L
1114 002103  0126          AND     Q17             /ISOLATE TYPE CODE
1115 002104  1105          TAD     QM4             /IS IT DOUBLE ?
1116 002105  7440          SZA
1117 002106  7001          IAC                     /NO, IS IT COMPLEX ?
1118 002107  7640          SZA CLA
1119 002110  2302          ISZ     SKPIRL          /NEITHER, SKIP
1120 002111  5702          JMP I   SKPIRL          /RETURN
1121 002112  0000  MUL12,  0                       /12 BIT MULTIPLY
1122 002113  3334          DCA     OPRND
1123 002114  1373          TAD     (-15
1124 002115  3302          DCA     SC
1125 002116  5325          JMP     STMUL
1126 002117  1040  M12LUP, TAD     AC
1127 002120  7420          SNL
1128 002121  5324          JMP     .+3
1129 002122  7100          CLL
1130 002123  1334          TAD     OPRND
1131 002124  7010          RAR
1132 002125  3040  STMUL,  DCA     AC
1133 002126  1042          TAD     MQ
1134 002127  7010          RAR
1135 002130  3042          DCA     MQ
1136 002131  2302          ISZ     SC
1137 002132  5317          JMP     M12LUP
1138 002133  5712          JMP I   MUL12
1139               OPRND,
1140 002134  0000  BUMP,   0                       /PUT FALSE ENTRY ONTO STACK
1141 002135  6201          CDF 0                   /V3C IMPORTANT PROTECTION
1142 002136  3416          DCA I   X16
1143 002137  2016          ISZ     X16
1144 002140  2016          ISZ     X16             /THIS PREVENTS UNDER
1145                                               /FLOWING THE STACK
1146 002141  5734          JMP I   BUMP            /AFTER SOME ERRORS
1147 002142  0530  EXTERN, TEXT    'EXTERN'
     002143  2405  
     002144  2216  
     002145  0000  
1148 002146  4303  CADD,   TEXT    '#CAD'
     002147  0104  
     002150  0000  
1149 002151  4303  CNEG,   TEXT    '#CNG'
     002152  1607  
     002153  0000  
1150 002154  4303  CMUL,   TEXT    '#CML'
     002155  1514  
     002156  0000  
1151 002157  1214  JLE,    TEXT    'JLE'
     002160  0500  
1152 002161  1722  ORG,    TEXT    'ORG'
     002162  0700  
1153 002163  2324  STARTE, TEXT    'STARTE'
     002164  0122  
     002165  2405  
     002166  0000  
1154 002167  4304  XDPTMP, TEXT    '#DPT'
     002170  2024  
     002171  0000  
1155 002173  7763          PAGE
     002174  2367  
     002175  0564  
     002176  3565  
     002177  1723  
1156               / RANDOM CODE GENERATORS
1157               
1158 002200  4515  ERROR,  JMS I   QINWORD         /GET ERROR CODE
1159 002201  4510          JMS I   QERMSG          /PRINT IT
1160 002202  5511          JMP I   QNEXT
1161 002203  1064  EOSTMT, TAD     DATASW          /WAS THIS A DATA STMT ?
1162 002204  7650          SNA CLA
1163 002205  5215          JMP     OPTMYZ          /NO
1164 002206  3064          DCA     DATASW          /KILL SWITCH
1165 002207  4524          JMS I   QOPCDE
1166 002210  2161          ORG                     /ORIGIN BACK TO THE PROGRAM
1167 002211  1051          TAD     GLABEL
1168 002212  4550          JMS I   QOLABEL
1169 002213  4535          JMS I   QCRLF
1170 002214  2051          ISZ     GLABEL          /BUMP LABEL GENERATOR
1171 002215  7200  OPTMYZ, CLA                     /CHANGED TO CLA IAC IF /O
1172 002216  4530          JMS I   QXRTBL          /CLEAR TABLE OR RESET FLAGS
1173 002217  2003          ISZ     LINENO          /BUMP LINE NUM
1174 002220  1003          TAD     LINENO          /DISPLAY IN MQ
1175 002221  7421          7421                    /FOR COOLNESS
1176 002222  7200          CLA                     /FOR NON-EAE FOLKS
1177 002223  1052          TAD     STKLVL          /RESET STACK LEVEL
1178 002224  3016          DCA     X16
1179 002225  4242          JMS     IFEND           /LOOK FOR END OF LOGICAL IF
1180 002226  4777          JMS I   (ASFEND         /END OF A.S.F. DEFINITION ?
1181 002227  5511  DEBUG,  JMP I   QNEXT           /OVERLAYED IF NO /N SWITCH
1182 002230  4524          JMS I   QOPCDE          /OUTPUT  LDX NNNN,0
1183 002231  3622          LDX
1184 002232  1003          TAD     LINENO          /THIS IS THE CURRENT ISN
1185 002233  4516          JMS I   QONUMBR
1186 002234  1053          TAD     COMMA
1187 002235  4562          JMS I   QOCHAR
1188 002236  1106          TAD     Q260
1189 002237  4562          JMS I   QOCHAR
1190 002240  4535          JMS I   QCRLF
1191 002241  5511          JMP I   QNEXT
1192 002242  0000  IFEND,  0                       /OUTPUT IF END LABEL IF
1193 002243  1055          TAD     IFLABL          /WAS THIS END OF LOG IF
1194 002244  7450          SNA
1195 002245  5642          JMP I   IFEND           /OUTPUT DEBUG STUFF
1196 002246  4572          JMS I   QLABEL          /OUPTUT THE LABEL
1197 002247  4532          JMS I   QGENSF          /ALL LOGICAL IFS MUST
1198                                               /END IN FMODE
1199 002250  3044          DCA     WHATAC          /CAN'T DEPEND ON
1200                                               /AC HERE
1201 002251  4530          JMS I   QXRTBL          /OR XR'S EITHER
1202 002252  3055          DCA     IFLABL          /KILL THE SWITCH
1203 002253  5642          JMP I   IFEND
1204 002254  0000  OPCOD,  0                       /TAB OPCODE
1205 002255  3044          DCA     WHATAC          /AC HAS JUST BEEN
1206                                               /MODIFIED
1207 002256  4536          JMS I   QOTAB
1208 002257  1654          TAD I   OPCOD
1209 002260  2254          ISZ     OPCOD
1210 002261  4537          JMS I   QOUTSYM
1211 002262  5654          JMP I   OPCOD
1212 002263  4553  DIV,    JMS I   QSAVACT         /IF SECOND OPERAND IN AC, SAVE IT
1213 002264  4514          JMS I   QCODE           /DIVIDE
1214 002265  5650          DIVTBL-6;0
     002266  0000  
1215 002267  7240          CLA CMA                 /WERE BOTH VARS INTEGER?
1216 002270  1030          TAD     TYPE1
1217 002271  7640          SZA CLA
1218 002272  5511          JMP I   QNEXT           /NO
1219 002273  4521          JMS I   QGENCOD
1220 002274  5026          A0FN-1                  /ALN 0;FNORM
1221 002275  5511          JMP I   QNEXT
1222 002276  3171  LIFBGN, DCA     RELCD   /ENTER HERE IF LAST OPCODE NOT A RELATIONAL
1223 002277  4540          JMS I   QGARG   /ENTER HERE FROM RELATIONAL OPTIMIZER
1224 002300  5342          JMP     NOTLOG
1225 002301  1030          TAD     TYPE1           /MUST BE LOGICAL
1226 002302  1376          TAD     (-5
1227 002303  7640          SZA CLA
1228 002304  5342          JMP     NOTLOG
1229 002305  1026          TAD     ARG1            /IS IT IN AC ?
1230 002306  7650          SNA CLA
1231 002307  5312          JMP     .+3
1232 002310  4521          JMS I   QGENCOD
1233 002311  6527          GI-1
1234 002312  4515          JMS I   QINWORD         /IS IT IF(...)GOTO XX ?
1235 002313  3025          DCA     TEMP2
1236 002314  1025          TAD     TEMP2
1237 002315  1375          TAD     (XPUSH-XGOTO
1238 002316  7650          SNA CLA
1239 002317  5333          JMP     IFGOTO          /YES, TREAT AS SPECIAL CASE
1240 002320  1051          TAD     GLABEL          /SET IF LABEL
1241 002321  3055          DCA     IFLABL
1242 002322  1171          TAD     RELCD
1243 002323  7041          CIA
1244 002324  1120          TAD     Q5      /GENERATE THE OPPOSITE JUMP
1245 002325  4344          JMS     RELJMP  /AROUND THE TARGET OF THE IF
1246 002326  1051          TAD     GLABEL
1247 002327  4550          JMS I   QOLABEL
1248 002330  2051          ISZ     GLABEL          /INCREMENT LABEL GENERATOR
1249 002331  4535          JMS I   QCRLF
1250 002332  5512          JMP I   QNEXTM2
1251 002333  1171  IFGOTO, TAD     RELCD
1252 002334  4344          JMS     RELJMP  /GENERATE TRUE RELATIONAL JUMP IF "IF()GOTO"
1253 002335  4515          JMS I   QINWORD         /GET THE LABEL
1254 002336  6211          CDF     10
1255 002337  4534          JMS I   QOSNUM
1256 002340  4535          JMS I   QCRLF
1257 002341  5511          JMP I   QNEXT
1258 002342  4527  NOTLOG, JMS I   QTTYMSG
1259 002343  1411          1411
1260               
1261 002344  0000  RELJMP, 0
1262 002345  7104          CLL RAL
1263 002346  1374          TAD     (JNE
1264 002347  3351          DCA     .+2
1265 002350  4524          JMS I   QOPCDE
1266 002351  0000          0
1267 002352  5744          JMP I   RELJMP
1268               
1269 002353  0615  FMUL,   TEXT    'FMUL'
     002354  2514  
     002355  0000  
1270 002356  0604  FDIV,   TEXT    'FDIV'
     002357  1126  
     002360  0000  
1271 002361  4303  CAC,    TEXT    '#CAC'
     002362  0103  
     002363  0000  
1272 002364  4314  LITRL,  TEXT    '#LIT+'
     002365  1124  
     002366  5300  
1273 002367  4324  TEMPN,  TEXT    '#TMP'
     002370  1520  
     002371  0000  
1274 002374  3643          PAGE
     002375  7721  
     002376  7773  
     002377  5723  
1275               / DO LOOP COMPILER
1276               
1277 002400  4553  DOBEGN, JMS I   QSAVACT         /FOR EXPR IN LOOP PARAMS
1278 002401  1016          TAD     X16             /SET NEW STACK LEVEL
1279 002402  3052          DCA     STKLVL
1280 002403  4560          JMS I   QGARGS          /GET LIMIT AND STEP
1281 002404  5242          JMP     DPERR           /ERROR IN DO PARMS
1282 002405  4324          JMS     DOPARM          /DO PARAMETER STUF FOR LIMIT
1283 002406  0026          ARG1
1284 002407  4324          JMS     DOPARM
1285 002410  0031          ARG2                    /AND THEN FOR STEP
1286 002411  1026          TAD     ARG1            /REPLACE ALTERRED STACK
1287                                               /ENTRIES
1288 002412  3416          DCA I   X16
1289 002413  2016          ISZ     X16             /REST OF ARG1 OK
1290 002414  1051          TAD     GLABEL          /SAVE LOOP LABEL
1291 002415  3416          DCA I   X16
1292 002416  1031          TAD     ARG2
1293 002417  3416          DCA I   X16
1294 002420  2016          ISZ     X16
1295 002421  2016          ISZ     X16
1296 002422  4535          JMS I   QCRLF           /CRLF BEFORE LABL
1297 002423  1051          TAD     GLABEL
1298 002424  4572          JMS I   QLABEL          /OUPTUT LOOP LABEL
1299 002425  2051          ISZ     GLABEL          /INCR LABEL GENERATOR
1300 002426  3044          DCA     WHATAC          /FORGET AC AND
1301 002427  4530          JMS I   QXRTBL          /XR'S AT DO BEGIN
1302 002430  5511          JMP I   QNEXT
1303 002431  4560  DOSTOR, JMS I   QGARGS          /LOOK AT INDEX AND
1304 002432  5242          JMP     DPERR           /INITIAL VALUE
1305 002433  7146          CLL CMA RTL             /MUST BE INTEGER OR
1306 002434  1030          TAD     TYPE1           /REAL (L=1  AC=-3)
1307 002435  7630          SZL CLA                 /SKIP IF >2
1308 002436  7146          CLL CMA RTL             /L=1 AC=-3
1309 002437  1033          TAD     TYPE2
1310 002440  7630          SZL CLA                 /L=0 IS BAD
1311 002441  5777          JMP I   (STORE+2        /DO STORE IF OK
1312 002442  4527  DPERR,  JMS I   QTTYMSG         /ERROR IN LIMITS
1313 002443  0420          0420                    /DP
1314 002444  4530  DOFINI, JMS I   QXRTBL          /DON'T OPTIMIZE XR USAGE
1315                                               /IN SUCCESSIVE IMPLIED DO LOOPS
1316 002445  1100          TAD     IOSTMT          /INSIDE IO STMT ?
1317 002446  7650          SNA CLA
1318 002447  4776          JMS     IFEND           /IF NOT, END IF FIRST
1319 002450  4515          JMS I   QINWORD         /GET THE INDEX
1320 002451  3026          DCA     ARG1
1321 002452  1026          TAD     ARG1            /GET THE TYPE WORD ADR
1322 002453  7001          IAC
1323 002454  3030          DCA     TYPE1
1324 002455  6211          CDF     10
1325 002456  1430          TAD I   TYPE1
1326 002457  6201          CDF
1327 002460  0126          AND     Q17
1328 002461  3030          DCA     TYPE1           /TYPE OF INDEX VAR
1329 002462  1122          TAD     QM6
1330 002463  1052          TAD     STKLVL          /BACK UP THE STACK
1331 002464  3016          DCA     X16
1332 002465  1016          TAD     X16             /RESET THE STACK LEVEL
1333 002466  3052          DCA     STKLVL
1334 002467  1416          TAD I   X16             /GET THE FINAL VALUE
1335 002470  3324          DCA     DOARG
1336 002471  2016          ISZ     X16
1337 002472  1416          TAD I   X16             /GET THE LOOP LABEL
1338 002473  3360          DCA     DARG
1339 002474  1416          TAD I   X16             /GET THE STEP
1340 002475  3031          DCA     ARG2
1341 002476  1416          TAD I   X16             /WHICH DO FIN CODE ?
1342 002477  7124          CLL CML RAL
1343 002500  1030          TAD     TYPE1
1344 002501  1122          TAD     QM6
1345 002502  7650          SNA CLA
1346 002503  1375          TAD     (DOFIN1-DOFIN0  /INDEX=I, STEP=R
1347 002504  1374          TAD     (DOFIN0-1       /ALL OTHER CASES
1348 002505  3307          DCA     .+2
1349 002506  4521          JMS I   QGENCOD         /DO FINISH CODE
1350 002507  0000          0
1351 002510  4523          JMS I   QOPCOD          /SUBTRACT UPPER LIMIT
1352 002511  1015          FSUB
1353 002512  4525          JMS I   QOADDR
1354 002513  2524          DOARG
1355 002514  4524          JMS I   QOPCDE          /NOW THE JLT %%LOOP
1356 002515  2157          JLE
1357 002516  1360          TAD     DARG            /OUTPUT LABEL
1358 002517  4550          JMS I   QOLABEL
1359 002520  4535          JMS I   QCRLF
1360 002521  1052          TAD     STKLVL          /FIX X16 INCASE MULTIPLE DO ENDER
1361 002522  3016          DCA     X16
1362 002523  5511          JMP I   QNEXT
1363               DOARG,
1364 002524  0000  DOPARM, 0                       /SUBR FOR DO PARAMETERS
1365 002525  1724          TAD I   DOPARM
1366 002526  2324          ISZ     DOPARM          /GET THE PARM POINTER
1367 002527  3360          DCA     DARG
1368 002530  7126          CLL CML RTL             /GET ADDR OF TYPE WORD
1369 002531  1360          TAD     DARG
1370 002532  3023          DCA     TYPE
1371 002533  7146          CLL CMA RTL             /CHECK TYPE
1372 002534  1423          TAD I   TYPE
1373 002535  7700          SMA CLA
1374 002536  5242          JMP     DPERR           /NOT I OR R
1375 002537  1760          TAD I   DARG
1376 002540  7450          SNA
1377 002541  5361          JMP     STRTMP          /ARG ALREADY IN AC
1378 002542  1167          TAD     QM63            /IS IT ARRAY REF?
1379 002543  7710          SPA CLA
1380 002544  5355          JMP     SVLIMT          /YES, SAVE LIMIT
1381 002545  1760          TAD I   DARG            /REGET SYM ADDR
1382 002546  3010          DCA     X10             /ADR OF TYPE WORD
1383 002547  6211          CDF     10
1384 002550  1410          TAD I   X10             /MAYBE ITS A LIT?
1385 002551  6201          CDF
1386 002552  0142          AND     Q40
1387 002553  7640          SZA CLA
1388 002554  5724          JMP I   DOPARM          /YES, ITS LITERAL
1389                                               /WE'RE ALWAYS IN F MODE HERE
1390                                               /SINCE THE LAST THING
1391                                               /WAS A DO STORE
1392 002555  4523  SVLIMT, JMS I   QOPCOD          /OTHERWISE LOAD IT
1393 002556  1012          FLDA
1394 002557  4525          JMS I   QOADDR
1395 002560  0000  DARG,   0
1396 002561  1056  STRTMP, TAD     DOTEMP          /SET ARG TO NEXT DO TEMP
1397 002562  3760          DCA I   DARG
1398 002563  4523          JMS I   QOPCOD          /GENERATE STORE
1399 002564  1567          FSTA
1400 002565  2056          ISZ     DOTEMP          /BUMP DO TEMP
1401 002566  1360          TAD     DARG
1402 002567  3371          DCA     .+2
1403 002570  4525          JMS I   QOADDR          /DO TEMP ADDRESS FIELD
1404 002571  0000          0
1405 002572  5724          JMP I   DOPARM
1406 002574  5063          PAGE
     002575  0007  
     002576  2242  
     002577  5505  
1407               / SUBSCRIPT REFERENCE COMPILER
1408               
1409 002600  4515  ARGS,   JMS I   QINWORD         /COMPILE ARGUMENT LIST
1410 002601  7040          CMA
1411 002602  3050          DCA     NARGS           /NUMBER OF ARGS
1412 002603  1050          TAD     NARGS           /GET ADDRESS OF SUBSCRIPTED VAR
1413 002604  7104          CLL RAL
1414 002605  1050          TAD     NARGS           /ENTRY ON THE STACK
1415 002606  1016          TAD     X16
1416 002607  3015          DCA     X15
1417 002610  1015          TAD     X15             /SAVE POINTER TO START
1418                                               /OF THIS ENTRY
1419 002611  3014          DCA     X14             /FOR POSSIBLE FUTURE USE
1420 002612  2050          ISZ     NARGS           /NOW ITS THE 2'S COMPLEMENT
1421 002613  7000          NOP
1422 002614  1415          TAD I   X15             /FETCH SS VARIABLE
1423 002615  3027          DCA     BASE1
1424 002616  1415          TAD I   X15             /ITS TYPE
1425 002617  3030          DCA     TYPE1
1426 002620  1027          TAD     BASE1           /STORE BASE WORD
1427 002621  3415          DCA I   X15
1428 002622  1027          TAD     BASE1           /GET ADDR OF TYPE WORD
1429 002623  7001          IAC
1430 002624  3024          DCA     TEMP
1431 002625  6211          CDF     10              /GET TYPE WORD
1432 002626  7132          CLL CML RTR             /TEST DIM BIT
1433 002627  0424          AND I   TEMP
1434 002630  7650          SNA CLA
1435 002631  5777          JMP     TRYCAL          /SOME KIND OF CALL
1436 002632  1027          TAD     BASE1           /NOW GET ADDRESS OF DIM INFO
1437 002633  4551          JMS I   QGETSS
1438 002634  3026          DCA     ARG1            /RETURNS WITH FIELD SET
1439 002635  1426          TAD I   ARG1            /CORRECT NUMBER OF DIMENSIONS?
1440 002636  1050          TAD     NARGS
1441 002637  6201          CDF
1442 002640  7640          SZA CLA
1443 002641  5776          JMP     DIMERR          /NO
1444 002642  2026          ISZ     ARG1            /SKIP TOTAL SIZE
1445 002643  2026          ISZ     ARG1            /SKIP MAGIC NUMBER
1446 002644  2026          ISZ     ARG1            /AND ASSOCIATED LITERAL
1447 002645  3043          DCA     XRNUM           /START WITH XR 1
1448 002646  1375          TAD     (-10            /SEVEN XRS
1449 002647  3774          DCA     XRCNT           /COUNT FOR SEARCH
1450 002650  3046          DCA     FREEXR          /ZERO FREE XR INDICATOR
1451 002651  6201  XRCHEK, CDF
1452 002652  2774          ISZ     XRCNT           /ANY MORE XR EXPRS TO TEST ?
1453 002653  7410          SKP                     /YES, GO CHECK THEM
1454 002654  5773          JMP     COMPSS          /NO, MUST COMPILE
1455                                               /XR ERPRESSION
1456 002655  2043          ISZ     XRNUM           /BUMP XR NUMBER
1457 002656  1043          TAD     XRNUM
1458 002657  7106          CLL RTL                 /TIMES 16
1459 002660  7106          CLL RTL
1460 002661  1372          TAD     (XRBUFR-1       /PLUS BASE (-1)
1461 002662  3013          DCA     X13
1462 002663  1413          TAD I   X13             /LOOK AT THE
1463 002664  7510          SPA                     /INDICATOR
1464 002665  5270          JMP     .+3             /-1=USED BY THIS STMT
1465 002666  7640          SZA CLA                 /IF ZERO GO TO
1466                                               /MTXR (EVENTUALLY)
1467 002667  1046          TAD     FREEXR          /ANY FREE BEFORE THIS ONE ?
1468 002670  7640          SZA CLA
1469 002671  5275          JMP     NOTMT           /YES, ALREADY FOUND ONE
1470 002672  1043          TAD     XRNUM           /THIS WILL BE
1471 002673  3046          DCA     FREEXR          /THE XR WE USE
1472 002674  5251          JMP     XRCHEK          /GO LOOK AT NEXT
1473 002675  1013  NOTMT,  TAD     X13             /SAVE FLAG ADDRESS
1474 002676  3365          DCA     XRFLAG          /IN CASE WE NEED IT LATER
1475 002677  1413          TAD I   X13             /POINTER TO THE DIM INFO
1476 002700  3025          DCA     TEMP2
1477 002701  6211          CDF     10
1478 002702  1425          TAD I   TEMP2           /SAME NUMBER OF DIMS ?
1479 002703  1050          TAD     NARGS
1480 002704  7640          SZA CLA
1481 002705  5251          JMP     XRCHEK          /NO, THIS XR WONT DO
1482 002706  1050          TAD     NARGS           /SET COUNTER
1483 002707  3364          DCA     DCNT
1484 002710  1026          TAD     ARG1            /POINTER TO DIM FACTORS
1485 002711  3012          DCA     X12
1486 002712  2025          ISZ     TEMP2           /SKIP THREE WORDS
1487 002713  2025          ISZ     TEMP2
1488 002714  2025          ISZ     TEMP2
1489 002715  2364  DCHEK,  ISZ     DCNT            /ANY MORE ?
1490 002716  7410          SKP
1491 002717  5327          JMP     SSCHEK          /DIMS OK, CHECK SS
1492 002720  2025          ISZ     TEMP2           /GET TO NEXT DIM
1493 002721  1425          TAD I   TEMP2           /ARE THEY EQUAL ?
1494 002722  7041          CIA
1495 002723  1412          TAD I   X12
1496 002724  7640          SZA CLA
1497 002725  5251          JMP     XRCHEK          /NO, GO TRY NEXT ONE
1498 002726  5315          JMP     DCHEK
1499 002727  1050  SSCHEK, TAD     NARGS           /COUNT AGAIN
1500 002730  6201          CDF
1501 002731  3364          DCA     DCNT
1502 002732  7144          CLL CMA RAL             /-2
1503 002733  1016          TAD     X16             /ADDR OF START OF TOP
1504                                               /SS ON STACK
1505 002734  5337          JMP     .+3
1506 002735  7146  SSC2,   CLL CMA RTL             /-3
1507 002736  1366          TAD     XTMP            /BACK UP TO NEXT LOWER SS
1508 002737  3366          DCA     XTMP            /LINK IS ALWAYS ZERO HERE
1509 002740  1766          TAD I   XTMP            /GET NEXT SS (WORKING
1510                                               /RIGHT TO LEFT)
1511 002741  1371          TAD     (-61            /IS IT A VAR OR LITERAL?
1512 002742  7620          SNL CLA
1513 002743  5251          JMP     XRCHEK          /WE'RE JUST
1514                                               /LOOKING FOR AN EMPTY
1515 002744  1766          TAD I   XTMP            /RE GET SS POINTER
1516 002745  7041          CIA
1517 002746  1413          TAD I   X13             /ARE THEY THE SAME ?
1518 002747  7640          SZA CLA
1519 002750  5251          JMP     XRCHEK          /NO
1520 002751  2364          ISZ     DCNT
1521 002752  5335          JMP     SSC2            /KEEP CHECKING
1522 002753  1043          TAD     XRNUM           /THEY MATCH, STICK IN
1523                                               /THE XR NUMBER
1524 002754  1370          TAD     (51
1525 002755  3414          DCA I   X14
1526 002756  7126          CLL CML RTL
1527 002757  1014          TAD     X14             /PURGE SS FROM STACK
1528 002760  3016          DCA     X16
1529 002761  7240          CLA CMA                 /SET FLAG TO
1530                                               /'USED BY THIS STMT'
1531 002762  3765          DCA I   XRFLAG
1532 002763  5511          JMP I   QNEXT
1533 002764  0000  DCNT,   0
1534 002765  0000  XRFLAG, 0
1535 002766  0000  XTMP,   0
1536 002770  0051          PAGE
     002771  7717  
     002772  6577  
     002773  3000  
     002774  3074  
     002775  7770  
     002776  3072  
     002777  3075  
1537               / SUBSCRIPT REFERENCE COMPILER
1538               
1539 003000  1046  COMPSS, TAD     FREEXR          /GET XR EXPR AREA
1540 003001  7106          CLL RTL                 /BY MULTIPLYING
1541                                               /THE NUMBER
1542 003002  7106          CLL RTL                 /BY 16
1543 003003  1377          TAD     (XRBUFR         /AND ADDING THE
1544                                               /BASE ADDRESS
1545 003004  3337          DCA     XREPTR          /THIS IS IT
1546 003005  7240          CLA CMA                 /SET USED BY THIS
1547                                               /STMT FLAG
1548 003006  3737          DCA I   XREPTR
1549 003007  2337          ISZ     XREPTR
1550 003010  7146          CLL CMA RTL             /STORE THE DIB POINTER
1551 003011  1026          TAD     ARG1
1552 003012  3737          DCA I   XREPTR
1553 003013  1050          TAD     NARGS           /GET ADDR OF POINTER TO LAST
1554 003014  7040          CMA                     /DIMENSION FACTOR
1555 003015  1026          TAD     ARG1
1556 003016  3026          DCA     ARG1            /SINCE WE USE THEM IN
1557                                               /REVERSE ORDER
1558 003017  4517          JMS I   QSAVEAC         /STORE AC IF NEEDED
1559                               /FOLLOWING INSTRUCTION REMOVED FOR OPTOMIZATION
1560               /       JMS I   QGENSF          /ALL SUBSCRIPTS AR I OR R
1561 003020  1376          TAD     (FLDA           /LOAD FIRST SS
1562 003021  7410          SKP
1563 003022  1375  CSSLUP, TAD     (FADD           /ADD ALL SUBSEQUENT ONES
1564 003023  3250          DCA     OPC
1565 003024  7146          CLL CMA RTL             /BACK UP STACK BY ONE ENTRY
1566 003025  1016          TAD     X16
1567 003026  3016          DCA     X16
1568 003027  1016          TAD     X16             /GET A WORKING POINTER
1569 003030  3015          DCA     X15
1570 003031  1415          TAD I   X15             /GET THE NEXT SUBSCRIPT
1571 003032  3031          DCA     ARG2
1572 003033  7144          CLL CMA RAL             /MUST BE INTEGER
1573 003034  1415          TAD I   X15
1574 003035  7700          SMA CLA
1575 003036  5272          JMP     DIMERR
1576 003037  1415          TAD I   X15
1577 003040  3032          DCA     BASE2
1578 003041  1031          TAD     ARG2            /STORE THE SS INTO THE
1579                                               /XR EXPR
1580 003042  2337          ISZ     XREPTR          /INCREMENT FIRST
1581 003043  3737          DCA I   XREPTR
1582 003044  1031          TAD     ARG2            /IS ARG2 THE AC (ONLY
1583                                               /POSSIBLE IF
1584 003045  7650          SNA CLA                 /ITS THE RIGHTMOST
1585                                               /SUBSCRIPT)
1586 003046  5253          JMP     NLODSS          /YES, DON'T LOAD IT
1587 003047  4523          JMS I   QOPCOD          /OUTPUT LOAD OR ADD
1588 003050  0000  OPC,    0                       /THIS LOCATION TELLS
1589                                               /THE STORY
1590 003051  4525          JMS I   QOADDR          /FOLLOWED BY THE OPERAND
1591 003052  0031          ARG2                    /POINTED TO BY ARG2
1592 003053  2050  NLODSS, ISZ     NARGS           /ANY MORE SUBSCRIPTS ?
1593 003054  5310          JMP     MORESS          /YES, GO COMPILE THEM
1594 003055  1046          TAD     FREEXR          /ANY FREE INDEX REG?
1595 003056  7640          SZA CLA
1596 003057  5325          JMP     ASGNXR          /YES, GO USE IT
1597 003060  1374          TAD     (61             /ITS A SPECIAL POINTER ENTRY
1598 003061  3414          DCA I   X14
1599 003062  2014          ISZ     X14
1600 003063  1034          TAD     TMPCNT          /SAVE TEMP NUMBER
1601 003064  3414          DCA I   X14             /BEFORE WE BLOW X14
1602 003065  4773          JMS I   (GENPTR         /GENERATE POINTER TO THE ARG
1603 003066  4521          JMS I   QGENCOD         /BACK TO FMODE
1604 003067  5043          SF-1
1605 003070  4772          JMS I   (ACSTOR         /GENERATE STORE AC
1606 003071  5511          JMP I   QNEXT
1607 003072  4527  DIMERR, JMS I   QTTYMSG         /SS NOT OF CORRECT NUMBER
1608 003073  2323          2323
1609 003074  0000  XRCNT,  0
1610 003075  1102  TRYCAL, TAD     ASFSWT          /ASF DEFINITION
1611 003076  7740          SMA SZA CLA
1612 003077  5771          JMP     DEFASF          /YES, GO OUTPUT PROLOG
1613 003100  1424          TAD I   TEMP            /IS IT A FUNCTION OR AN ARG?
1614 003101  6201          CDF
1615 003102  0370          AND     (1420
1616 003103  7450          SNA
1617 003104  5272          JMP     DIMERR          /NO, SOME KIND OF ERROR
1618 003105  0141          AND     Q20
1619 003106  3077          DCA     ACSWIT          /SAVE THE AC SWITCH
1620 003107  5767          JMP     FUNCAL          /STANDARD FUNCTION CALL
1621 003110  4532  MORESS, JMS I   QGENSF  /MUST USE SINGLE PRECISION FOR MULTIPLY
1622 003111  4523          JMS I   QOPCOD          /MULTIPLY BY DIM FACTOR
1623 003112  2353          FMUL
1624 003113  6211          CDF     10
1625 003114  1426          TAD I   ARG1            /PICK UP FACTOR ADDRESS
1626 003115  6201          CDF
1627 003116  3031          DCA     ARG2
1628 003117  7240          CLA CMA
1629 003120  1026          TAD     ARG1            /MOVE BACK ONE
1630 003121  3026          DCA     ARG1
1631 003122  4525          JMS I   QOADDR          /OUTPUT MULTIPLY ADDRESS
1632 003123  0031          ARG2
1633 003124  5222          JMP     CSSLUP          /LOOP ON NEXT SS
1634 003125  4524  ASGNXR, JMS I   QOPCDE          /OUTPUT ATX N
1635 003126  3616          ATX
1636 003127  1046          TAD     FREEXR          /GET NUMBER OF FREE XR
1637 003130  1106          TAD     Q260
1638 003131  4562          JMS I   QOCHAR
1639 003132  4535          JMS I   QCRLF
1640 003133  1046          TAD     FREEXR
1641 003134  1366          TAD     (51             /COMPUTE PROPER NUMBER
1642 003135  3414          DCA I   X14             /PUT IT INTO TOP OF STACK
1643 003136  5511          JMP I   QNEXT
1644 003137  0000  XREPTR, 0
1645               / RANDOM TEXT
1646 003140  0000  OTAB,   0
1647 003141  1365          TAD     (211
1648 003142  4562          JMS I   QOCHAR
1649 003143  5740          JMP I   OTAB
1650 003144  0603  FCLA,   TEXT    'FCLA'
     003145  1401  
     003146  0000  
1651 003147  2324  STARTD, TEXT    'STARTD'
     003150  0122  
     003151  2404  
     003152  0000  
1652 003153  4324  TEMPN2, TEXT    '#TMPX'
     003154  1520  
     003155  3000  
1653 003156  4303  CSUB,   TEXT    '#CSB'
     003157  2302  
     003160  0000  
1654 003161  4303  CDIV,   TEXT    '#CDV'
     003162  0426  
     003163  0000  
1655 003165  0211          PAGE
     003166  0051  
     003167  3400  
     003170  1420  
     003171  5600  
     003172  1062  
     003173  3670  
     003174  0061  
     003175  1007  
     003176  1012  
     003177  6600  
1656               / GENERAL CALL GENERATOR
1657               
1658 003200  0000  GENCAL, 0               /GENERATE A CALL; ALL ARGS ON STACK
1659                                       /X15 POINTS TO START OF STACK INFO
1660                                       /NARGS IS NEG NUMBER OF ARGS
1661                                       /FUNCTION NAME IS FIRST ON STACK
1662 003201  1600          TAD I   GENCAL          /GET FUN NAME SWITCH
1663 003202  3266          DCA     FNSWIT
1664 003203  1015          TAD     X15             /NEW STACK VALUE
1665 003204  3016          DCA     X16
1666 003205  1015          TAD     X15             /WORKING POINTER
1667 003206  3031          DCA     ARG2
1668 003207  1050          TAD     NARGS           /WORKING COUNTER
1669 003210  7450          SNA
1670 003211  5257          JMP     OUTJSR          /NO ARGS, PUT JSR
1671 003212  3033          DCA     TYPE2
1672 003213  2031  CHKPTR, ISZ     ARG2            /MOVE TO NUMBER
1673 003214  1031          TAD     ARG2
1674 003215  7001          IAC                     /ADDR OF TYPE WORD
1675 003216  3032          DCA     BASE2
1676 003217  1432          TAD I   BASE2           /GET TYPE
1677 003220  3030          DCA     TYPE1           /TYPE OF ARG FOR GENPTR
1678 003221  2032          ISZ     BASE2           /POINT TO BASE WORD
1679 003222  1432          TAD I   BASE2
1680 003223  3027          DCA     BASE1           /FOR GENPTR
1681 003224  1431          TAD I   ARG2            /GET ARG NUMBER
1682 003225  7100          CLL
1683 003226  1377          TAD     (-52            /IS IT INDEXED ?
1684 003227  7420          SNL
1685 003230  5252          JMP     NOTINX          /NO, ITS A TEMP
1686 003231  1376          TAD     (52-61          /IS IT INDIRECT ?
1687 003232  7430          SZL
1688 003233  5775          JMP     INXR            /NO, ITS IN AN XR
1689 003234  7450          SNA
1690 003235  5343          JMP     INTMP           /POINTER IN A TEMP
1691 003236  1374          TAD     (62             /GET TO TYPE WORD
1692 003237  3065          DCA     GCTEMP
1693 003240  6211          CDF     10
1694 003241  1465          TAD I   GCTEMP          /IS IT AN ARG
1695 003242  6201          CDF
1696 003243  0373          AND     (1020           /ARG OR EXTERNAL ?
1697 003244  7450          SNA
1698 003245  5253          JMP     NOTINX+1        /NEITHER
1699 003246  0141          AND     Q20
1700 003247  7640          SZA CLA
1701 003250  5772          JMP     ARGARG          /ARG SQUARED
1702 003251  5771          JMP     EXTARG          /EXTERNAL ARG
1703 003252  7200  NOTINX, CLA
1704 003253  2031          ISZ     ARG2            /BUMP POINTER
1705 003254  2031          ISZ     ARG2
1706 003255  2033          ISZ     TYPE2           /INCR COUNT
1707 003256  5213          JMP     CHKPTR
1708 003257  1103  OUTJSR, TAD     JSRLBL          /DOES IT GET A LABEL ?
1709 003260  7450          SNA
1710 003261  5264          JMP     .+3             /NO
1711 003262  4572          JMS I   QLABEL          /OUPTUT THE LABEL+COMMA
1712 003263  3103          DCA     JSRLBL          /KILL SWITCH
1713 003264  1016          TAD     X16             /ADDR OF POINTER TO FUN NAME
1714 003265  3024          DCA     TEMP
1715 003266  0000  FNSWIT, 0                       /REAARANGED**
1716 003267  5770          JMP I   (IOFUN          /IO FUNCTION CALL
1717 003270  4524          JMS I   QOPCDE          /OUTPUT THE JSR
1718 003271  3661          JSR
1719 003272  1424          TAD I   TEMP            /NOW THE SUBR NAME
1720 003273  6211          CDF     10
1721 003274  4543          JMS I   QOUTNAM
1722 003275  4535          JMS I   QCRLF
1723 003276  1050          TAD     NARGS           /ANY ARGS ?
1724 003277  7650          SNA CLA
1725 003300  5600          JMP I   GENCAL          /NO, END OF CALL
1726 003301  4524          JMS I   QOPCDE          /JUMP AROUND THE ARGS
1727 003302  3657          JA
1728 003303  1152          TAD     Q256
1729 003304  4562          JMS I   QOCHAR          /.
1730 003305  1054          TAD     PLUS
1731 003306  4562          JMS I   QOCHAR          /+
1732 003307  7344          CLL CLA CMA RAL         /-2
1733 003310  1050          TAD     NARGS           /-N-2
1734 003311  7144          CLL CMA RAL             /2*N+2
1735 003312  4516          JMS I   QONUMBR
1736 003313  4535  IOONLY, JMS I   QCRLF
1737 003314  1016          TAD     X16             /WORKING POINTER
1738 003315  3015          DCA     X15
1739 003316  1415  PTRLST, TAD I   X15             /GET NEXT ARG
1740 003317  7440          SZA
1741 003320  5331          JMP     SARG            /SIMPLE ARG
1742 003321  7126          CLL CML RTL
1743 003322  1015          TAD     X15             /ADDR OF GENERATED
1744                                               /LABEL NUMBER
1745 003323  3024          DCA     TEMP
1746 003324  1424          TAD I   TEMP            /OUTPUT #GXXXX (THE
1747                                               /GENERATED LABEL)
1748 003325  4572          JMS I   QLABEL          /OUPTUT THE LABEL
1749 003326  4521          JMS I   QGENCOD
1750 003327  5060          JADP2-1                 /GENERATE A DUMMY JA
1751 003330  5336          JMP     BARGLP
1752 003331  3031  SARG,   DCA     ARG2            /STORE THE ARG NUMBER
1753 003332  4523          JMS I   QOPCOD          /OUTPUT JA ARG
1754 003333  3657          JA
1755 003334  4525          JMS I   QOADDR          /NOW ADDRESS FIELD
1756 003335  0031          ARG2
1757 003336  2015  BARGLP, ISZ     X15             /BUMP POINTER
1758 003337  2015          ISZ     X15
1759 003340  2050          ISZ     NARGS           /BUMP COUNT
1760 003341  5316          JMP     PTRLST
1761 003342  5600          JMP I   GENCAL
1762 003343  1432  INTMP,  TAD I   BASE2           /GET TEMP NUMBER
1763 003344  3026          DCA     ARG1            /THAT PTR IS STORED IN
1764 003345  4521          JMS I   QGENCOD         /PICK UP POINTER
1765 003346  5102          LDASTD-1
1766 003347  4524  STRPTR, JMS I   QOPCDE          /NOW STORE THE POINTER
1767 003350  1567          FSTA
1768 003351  1051          TAD     GLABEL          /OUTPUT THE LABEL
1769 003352  4550          JMS I   QOLABEL
1770 003353  4535          JMS I   QCRLF
1771 003354  1051          TAD     GLABEL          /SAVE THE LABEL NUMBER
1772 003355  3432          DCA I   BASE2
1773 003356  3431          DCA I   ARG2            /ZERO ARG NUMBER
1774 003357  2051          ISZ     GLABEL          /INCREMENT LABEL NUMBER
1775 003360  4521          JMS I   QGENCOD         /BACK TO F MODE
1776 003361  5043          SF-1
1777 003362  5252          JMP     NOTINX          /CONTINUE LOOP
1778 003363  0000  NLABEL, 0
1779 003364  4550          JMS I   QOLABEL
1780 003365  1053          TAD     COMMA
1781 003366  4562          JMS I   QOCHAR
1782 003367  5763          JMP I   NLABEL
1783 003370  5757          PAGE
     003371  3514  
     003372  3441  
     003373  1020  
     003374  0062  
     003375  3476  
     003376  7771  
     003377  7726  
1784               / GENERATE SUBROUTINE CALL
1785               
1786 003400  4517  FUNCAL, JMS I   QSAVEAC         /SAVE NEXT TO LAST IF NEEDED
1787 003401  4553          JMS I   QSAVACT         /SAVE LAST IF NEEDED
1788 003402  4532          JMS I   QGENSF          /ALL CALLS DONE IN F MODE
1789 003403  3414          DCA I   X14             /RESULT RETURNED IN AC
1790 003404  1077          TAD     ACSWIT          /IS THE SUBR AN ARG ?
1791 003405  7650          SNA CLA
1792 003406  5227          JMP     MAKCAL          /NO, ITS EASIER
1793 003407  4523          JMS I   QOPCOD          /GET THE JSR TO THE SUBR
1794 003410  1012          FLDA
1795 003411  4525          JMS I   QOADDR
1796 003412  0027          BASE1                   /BY GETTING THE VALUE
1797                                               /OF THE ARG
1798 003413  4521          JMS I   QGENCOD         /STARTD
1799 003414  5035          SD-1
1800 003415  4524          JMS I   QOPCDE          /STORE IT AHEAD
1801 003416  1567          FSTA
1802 003417  1051          TAD     GLABEL          /INTO THE JSR
1803 003420  2051          ISZ     GLABEL
1804 003421  3103          DCA     JSRLBL          /SET THE SWITCH
1805 003422  1103          TAD     JSRLBL
1806 003423  4550          JMS I   QOLABEL
1807 003424  4535          JMS I   QCRLF
1808 003425  4521          JMS I   QGENCOD         /STARTF
1809 003426  5043          SF-1
1810 003427  2027  MAKCAL, ISZ     BASE1           /MOVE TO TYPE WORD
1811 003430  6211          CDF     10
1812 003431  1427          TAD I   BASE1           /GET TYPE OF FUNCTION
1813 003432  6201          CDF
1814 003433  4554          JMS I   QSKPIRL         /WHAT MODE WILL WE LEAVE IN?
1815 003434  3101          DCA     FMODE           /PROBABLY E
1816 003435  4555          JMS I   QGENCAL         /GO GENERATE THE CALL
1817 003436  7410          SKP
1818 003437  0000          0                       /THIS IS A FREE LOCATION
1819 003440  5511          JMP I   QNEXT
1820 003441  4524  ARGARG, JMS I   QOPCDE          /%FLDA
1821 003442  1012          FLDA
1822 003443  1431          TAD I   ARG2            /POINTER
1823 003444  6211          CDF     10
1824 003445  4543          JMS I   QOUTNAM
1825 003446  4535          JMS I   QCRLF
1826 003447  4521          JMS I   QGENCOD         /%SD
1827 003450  5035          SD-1
1828 003451  6211          CDF     10
1829 003452  7132          CLL CML RTR             /IS IT AN ARRAY ?
1830 003453  0465          AND I   GCTEMP
1831 003454  6201          CDF
1832 003455  7650          SNA CLA
1833 003456  5777          JMP     STRPTR          /GO STORE THE POINTER
1834 003457  1431          TAD I   ARG2            /GET THE LITERAL NUMBER
1835 003460  4551          JMS I   QGETSS
1836 003461  1147          TAD     Q3
1837 003462  3065          DCA     GCTEMP
1838 003463  1465          TAD I   GCTEMP
1839 003464  3327          DCA     OLABEL          /SAVE IT
1840 003465  6201          CDF
1841 003466  4524          JMS I   QOPCDE          /%FADD LITERAL
1842 003467  1007          FADD
1843 003470  1144          TAD     QLITRL
1844 003471  4537          JMS I   QOUTSYM
1845 003472  1327          TAD     OLABEL          /XXXX
1846 003473  4516          JMS I   QONUMBR
1847 003474  4535          JMS I   QCRLF
1848 003475  5777          JMP     STRPTR          /GO STORE THE POINTER
1849 003476  1376  INXR,   TAD     (270            /MAKE AN ASCII CHAR
1850 003477  3041          DCA     XR
1851 003500  4524          JMS I   QOPCDE          /XTA
1852 003501  3620          XTA
1853 003502  1041          TAD     XR
1854 003503  4562          JMS I   QOCHAR          /N
1855 003504  4535          JMS I   QCRLF
1856 003505  1027          TAD     BASE1           /FIND ADDR OF MAGIC
1857                                               /NUMBER LITERAL
1858 003506  4551          JMS I   QGETSS
1859 003507  6201          CDF
1860 003510  1147          TAD     Q3
1861 003511  3026          DCA     ARG1
1862 003512  4775          JMS I   (GENPTR         /GENERATE THE POINTER
1863 003513  5777          JMP     STRPTR          /GO STORE THE POINTER
1864 003514  1431  EXTARG, TAD I   ARG2            /MAKE AN ENTRY IN THE EXT
1865 003515  6211          CDF     10              /LITERAL LIST
1866 003516  3417          DCA I   X17
1867 003517  1056          TAD     DOTEMP          /USE DO TEMPS FOR THIS
1868 003520  3417          DCA I   X17
1869 003521  6201          CDF
1870 003522  1056          TAD     DOTEMP          /SINCE OADDR CAN HANDLE THEM
1871 003523  3431          DCA I   ARG2
1872 003524  2056          ISZ     DOTEMP          /BUMP COUNT
1873 003525  2067          ISZ     ELCNT           /ALSO EXT LIT COUNT
1874 003526  5774          JMP     NOTINX          /BACK TO PROCESSING ARGS
1875               / UTILITY ROUTINES
1876 003527  0000  OLABEL, 0                       /OUTPUT #GXXXX FOR GEN'D LABELS
1877 003530  3024          DCA     TEMP
1878 003531  1373          TAD     (243
1879 003532  4562          JMS I   QOCHAR
1880 003533  1372          TAD     (307
1881 003534  4562          JMS I   QOCHAR
1882 003535  1024          TAD     TEMP
1883 003536  4516          JMS I   QONUMBR
1884 003537  5727          JMP I   OLABEL
1885 003540  0000  OPCODE, 0                       /TAD OPCODE TAB
1886 003541  3044          DCA     WHATAC          /THIS INSTRUCTION ZAPS AC
1887 003542  4536          JMS I   QOTAB
1888 003543  1740          TAD I   OPCODE
1889 003544  2340          ISZ     OPCODE
1890 003545  4537          JMS I   QOUTSYM
1891 003546  4536          JMS I   QOTAB
1892 003547  5740          JMP I   OPCODE
1893 003550  5561  M1C2,   TEXT    '-1,2'
     003551  5462  
     003552  0000  
1894 003553  0000  GENSTE, 0                       /GENERATE STARTE IF IN
1895                                               /F MODE
1896 003554  1101          TAD     FMODE           /LOOK AT THE SWITCH
1897 003555  7650          SNA CLA
1898 003556  5753          JMP I   GENSTE          /ALREADY IN E MODE
1899 003557  3101          DCA     FMODE           /CLEAR THE SWITCH
1900 003560  4523          JMS I   QOPCOD          /GENERATE THE STARTE
1901 003561  2163          STARTE
1902 003562  4535          JMS I   QCRLF           /CAN'T USE GENCOD FOR THAT
1903 003563  5753          JMP I   GENSTE
1904 003564  6000  D0,     TEXT    '0'
1905 003565  4304  DOTMPN, TEXT    '#DOTMP'
     003566  1724  
     003567  1520  
     003570  0000  
1906 003572  0307          PAGE
     003573  0243  
     003574  3252  
     003575  3670  
     003576  0270  
     003577  3347  
1907               / OPCODES AND OTHER TEXT
1908               
1909 003600  4302  XBASE,  TEXT    '#BASE'
     003601  0123  
     003602  0500  
1910 003603  4302  XBASP3, TEXT    '#BASE+3'
     003604  0123  
     003605  0553  
     003606  6300  
1911 003607  5653  DP3C0,  TEXT    '.+3,0'
     003610  6354  
     003611  6000  
1912 003612  1230  JXN,    TEXT    'JXN'
     003613  1600  
1913 003614  0114  ALN,    TEXT    'ALN'
     003615  1600  
1914 003616  0124  ATX,    TEXT    'ATX'
     003617  3000  
1915 003620  3024  XTA,    TEXT    'XTA'
     003621  0100  
1916 003622  1404  LDX,    TEXT    'LDX'
     003623  3000  
1917 003624  4322  XREW,   TEXT    '#REW'
     003625  0527  
     003626  0000  
1918 003627  4305  XENDF,  TEXT    '#ENDF'
     003630  1604  
     003631  0600  
1919 003632  4302  XBAK,   TEXT    '#BAK'
     003633  0113  
     003634  0000  
1920 003635  4305  XEXIT,  TEXT    '#EXIT'
     003636  3011  
     003637  2400  
1921 003640  4322  XRTN,   TEXT    '#RTN'
     003641  2416  
     003642  0000  
1922 003643  1216  JNE,   TEXT    'JNE'
     003644  0500  
1923 003645  1207          TEXT    'JGE'
     003646  0500  
1924 003647  1214          TEXT    'JLE'
     003650  0500  
1925 003651  1207          TEXT    'JGT'
     003652  2400  
1926 003653  1214  JLT,    TEXT    'JLT'   /MUST BE IN THIS ORDER!!
     003654  2400  
1927 003655  1205          TEXT    'JEQ'
     003656  2100  
1928 003657  1201  JA,     TEXT    'JA'
     003660  0000  
1929               
1930 003661  1223  JSR,    TEXT    'JSR'
     003662  2200  
1931 003663  1223  JSA,    TEXT    'JSA'   /MUST BE IN THIS ORDER!
     003664  0100  
1932 003665  2422  TRAP3,  TEXT    'TRAP3'
     003666  0120  
     003667  6300  
1933               / POINTER GENERATOR
1934 003670  0000  GENPTR, 0                       /GENERATE A POINTER
1935 003671  4523          JMS I   QOPCOD          /MULTIPLY BY 3. OR 6.
1936 003672  2353          FMUL
1937 003673  1030          TAD     TYPE1           /D OR C ?
1938 003674  4554          JMS I   QSKPIRL         /SKIP ON I, R, OR L
1939 003675  1120          TAD     Q6M3
1940 003676  1377          TAD     (THREE
1941 003677  3024          DCA     TEMP            /POINTER TO CORRECT LITERAL
1942 003700  4525          JMS I   QOADDR
1943 003701  0024          TEMP
1944 003702  4521          JMS I   QGENCOD         /ALN 0; STARTD
1945 003703  5033          A0SD-1
1946 003704  4524          JMS I   QOPCDE          /FADD THE BASE LITERAL
1947 003705  1007          FADD
1948 003706  2027          ISZ     BASE1           /GET ADDR OF TYPE WORD
1949 003707  6211          CDF     10
1950 003710  1427          TAD I   BASE1           /GET TYPE WORD
1951 003711  0141          AND     Q20
1952 003712  7650          SNA CLA
1953 003713  5320          JMP     NIARG           /NOT AN ARG
1954 003714  7040          CMA
1955 003715  1027          TAD     BASE1
1956 003716  4543          JMS I   QOUTNAM         /IF AN ARG, THE LITERAL
1957                                               /IS THE ARG
1958 003717  5327          JMP     OSF
1959 003720  6201  NIARG,  CDF
1960 003721  1144          TAD     QLITRL          /OTHERWISE ITS IN THE
1961                                               /LITERAL BLOCK
1962 003722  4537          JMS I   QOUTSYM
1963 003723  6211          CDF     10
1964 003724  1426          TAD I   ARG1            /LITERAL NUMBER
1965 003725  6201          CDF
1966 003726  4516          JMS I   QONUMBR
1967 003727  4535  OSF,    JMS I   QCRLF
1968 003730  5670          JMP I   GENPTR
1969               / MORE RANDOM CODE GENERATORS
1970 003731  4521  STOP,   JMS I   QGENCOD         /CALL EXIT
1971 003732  5153          STPCOD-1
1972 003733  5511          JMP I   QNEXT
1973 003734  4515  FORMAT, JMS I   QINWORD         /NUMBER OF WORDS OF TEXT
1974 003735  7040          CMA
1975 003736  3024          DCA     TEMP
1976 003737  4524          JMS I   QOPCDE          /JA AROUND THE STUFF
1977 003740  3657          JA
1978 003741  1152          TAD     Q256
1979 003742  4562          JMS I   QOCHAR          /.
1980 003743  1054          TAD     PLUS
1981 003744  4562          JMS I   QOCHAR
1982 003745  7144          CLL CMA RAL             /.+2+NWORDS
1983 003746  1024          TAD     TEMP
1984 003747  7040          CMA
1985 003750  5353          JMP     .+3
1986 003751  4536  FMTLUP, JMS I   QOTAB           /TA
1987 003752  4515          JMS I   QINWORD         /GET NEXT WORD
1988 003753  4516          JMS I   QONUMBR         /OUTPUT IT
1989 003754  4535          JMS I   QCRLF
1990 003755  2024          ISZ     TEMP
1991 003756  5351          JMP     FMTLUP
1992 003757  5511          JMP I   QNEXT
1993               
1994 003760  0000  DFRTTM, 0               /ROUTINE TO DELETE "SYS:FORTRN.TM"
1995 003761  7201          CLA IAC
1996 003762  6212          CIF 10
1997 003763  4545          JMS I   Q200
1998 003764  0004          4
1999 003765  5336          FTRNTM
2000 003766  0000          0
2001 003767  7000          NOP
2002 003770  5760          JMP I   DFRTTM
2003               
2004 003771  7556  EQUDOT, TEXT    '=.'
     003772  0000  
2005 003773  4320  XPAUSE, TEXT    '#PAUSE'
     003774  0125  
     003775  2305  
     003776  0000  
2006 003777  0070          PAGE
2007               /REWIND, ENDFILE, BACKSPACE
2008               
2009 004000  1377  REWIND, TAD     (XREW-XENDF
2010 004001  1377  ENDFIL, TAD     (XENDF-XBAK
2011 004002  1376  BAKSPC, TAD     (XBAK
2012 004003  3211          DCA     REBSUB
2013 004004  4513          JMS I   QUCODE
2014 004005  6515          AIFTBL-1        /GET UNIT INTO FAC
2015 004006  4532          JMS I   QGENSF  /FORCE F MODE
2016 004007  7326          CLA STL RTL
2017 004010  4775          JMS I   (OJSR
2018 004011  0000  REBSUB, 0
2019 004012  5511          JMP I   QNEXT
2020               / DATA STATEMENT STUFF
2021 004013  1016  DATAST, TAD     X16             /SAVE STACK
2022 004014  3027          DCA     DSTACK
2023 004015  1064          TAD     DATASW          /MULTIPLE DATA STMT ?
2024 004016  7640          SZA CLA
2025 004017  5227          JMP     FIXDAT-2        /YES, DON'T OUTPUT LABEL
2026 004020  2064          ISZ     DATASW          /SET DATA SWITCH
2027 004021  4536          JMS I   QOTAB           /DEFINE ORIGIN SYMBOL
2028 004022  1051          TAD     GLABEL
2029 004023  4550          JMS I   QOLABEL
2030 004024  1374          TAD     (EQUDOT         /#GXXXX=.
2031 004025  4537          JMS I   QOUTSYM
2032 004026  4535          JMS I   QCRLF
2033 004027  7240          CLA CMA                 /SET VAR TO NONE LEFT
2034 004030  3030          DCA     NUMELM
2035 004031  1164  FIXDAT, TAD     QXRBUFR         /USE XR BUFFER FOR DATA BUFFER
2036 004032  3031          DCA     DATPTR
2037 004033  7040          CMA
2038 004034  3033          DCA     RCOUNT          /SET REPETITION COUNT TO 1
2039 004035  5511          JMP I   QNEXT
2040 004036  4515  DREPTC, JMS I   QINWORD         /GET REPETITION COUNT
2041 004037  7041          CIA
2042 004040  3033          DCA     RCOUNT
2043 004041  5511          JMP I   QNEXT
2044 004042  4515  DATELM, JMS I   QINWORD         /GET SIZE OF ELEMENT
2045 004043  7041          CIA
2046 004044  3024          DCA     TEMP
2047 004045  4515          JMS I   QINWORD         /GET ELEMENT
2048 004046  3431          DCA I   DATPTR
2049 004047  2031          ISZ     DATPTR          /INTO DATA BUFFER
2050 004050  2024          ISZ     TEMP
2051 004051  5245          JMP     .-4
2052 004052  5511          JMP I   QNEXT
2053 004053  1164  ENDELM, TAD     QXRBUFR         /SETUP POINTER
2054 004054  3024          DCA     TEMP
2055 004055  2030  MORELM, ISZ     NUMELM          /ANY MORE FOR THIS VAR?
2056 004056  5343          JMP     SAMVAR          /YES
2057 004057  1027          TAD     DSTACK          /CHECK FOR MISMATCH
2058 004060  7041          CIA
2059 004061  1016          TAD     X16
2060 004062  7650          SNA CLA
2061 004063  5367          JMP     DLERR           /OOOPS
2062 004064  2027          ISZ     DSTACK          /GET TO NEXT VAR
2063 004065  4524          JMS I   QOPCDE          /%ORG VAR
2064 004066  2161          ORG
2065 004067  1427          TAD I   DSTACK          /GET VAR
2066 004070  3025          DCA     TEMP2
2067 004071  1025          TAD     TEMP2
2068 004072  2027          ISZ     DSTACK          /MOVE TO THE DISPLACEMENT
2069 004073  6211          CDF     10              /OUTPUT VAR
2070 004074  4543          JMS I   QOUTNAM
2071 004075  7040          CMA
2072 004076  3030          DCA     NUMELM          /ASSUME UNDIMENSIONED
2073 004077  6211          CDF     10
2074 004100  2025          ISZ     TEMP2           /MOVE TO TYPE WORD
2075 004101  1425          TAD I   TEMP2           /GET TYPE
2076 004102  4554          JMS I   QSKPIRL         /SKIP ON I R L
2077 004103  7146          CLL CMA RTL             /YES
2078 004104  1377          TAD     (-3
2079 004105  3026          DCA     ELMSIZ          /NUMBER OF WORDS PER ELEMENT
2080 004106  7132          CLL CML RTR
2081 004107  0425          AND I   TEMP2
2082 004110  6201          CDF
2083 004111  7650          SNA CLA
2084 004112  5330          JMP     GOTSIZ          /NOT DIMENSIONED
2085 004113  7201          CLA IAC                 /IF DISP = 7777 , WHOLE ARRAY
2086 004114  1427          TAD I   DSTACK          /LOOK AT DISPLACEMENT
2087 004115  7640          SZA CLA
2088 004116  5331          JMP     GOTSIZ+1        /ONLY ONE ELEMENT OF THE ARRAY
2089 004117  7040          CMA
2090 004120  1025          TAD     TEMP2           /GET TOTAL SIZE
2091 004121  4551          JMS I   QGETSS
2092 004122  7001          IAC
2093 004123  3025          DCA     TEMP2
2094 004124  1425          TAD I   TEMP2
2095 004125  7041          CIA                     /THIS IS THE NUMBER OF ELEMENTS
2096 004126  3030          DCA     NUMELM
2097 004127  6201          CDF
2098 004130  3427  GOTSIZ, DCA I   DSTACK          /ZERO DISPLACEMENT
2099 004131  1054          TAD     PLUS            /OUTPUT +XXXX
2100 004132  4562          JMS I   QOCHAR
2101 004133  1026          TAD     ELMSIZ          /MULTIPLY DISP BY 3 OR 6
2102 004134  7041          CIA
2103 004135  3042          DCA     MQ
2104 004136  1427          TAD I   DSTACK          /GET DISP
2105 004137  4557          JMS I   QMUL12
2106 004140  4563          JMS I   QNUMBRO         /OUTPUT THE ORG ALTERATION
2107 004141  4535          JMS I   QCRLF
2108 004142  2027          ISZ     DSTACK          /MOVE TO NEXT ENTRY
2109 004143  1026  SAMVAR, TAD     ELMSIZ          /GET SET TO PICK UP AN ELEMENT
2110 004144  3050          DCA     NARGS
2111 004145  4536          JMS I   QOTAB
2112 004146  5351          JMP     .+3             /SKIP ; FIRST TIME
2113 004147  1373  ELMLUP, TAD     (273            /SEMICOLON
2114 004150  4562          JMS I   QOCHAR
2115 004151  1424          TAD I   TEMP            /GET A WORD FROM THE BUFFER
2116 004152  2024          ISZ     TEMP
2117 004153  4516          JMS I   QONUMBR
2118 004154  2050          ISZ     NARGS           /ONE DATA LIST ELEMENT MUST FILL
2119 004155  5347          JMP     ELMLUP          /ONE VARIABLE LIST ELEMENT
2120 004156  4535          JMS I   QCRLF           /I.E. ONE ARRAY ELEMENT
2121 004157  1031          TAD     DATPTR          /IS THIS DATA ELEMENT EXHAUSTED?
2122 004160  7141          CIA CLL
2123 004161  1024          TAD     TEMP
2124 004162  7620          SNL CLA
2125 004163  5255          JMP     MORELM          /MORE LEFT
2126 004164  2033          ISZ     RCOUNT          /REPEAT ?
2127 004165  5253          JMP     ENDELM          /YES
2128 004166  5231          JMP     FIXDAT          /NO, BACK FOR MORE DATA
2129 004167  4527  DLERR,  JMS I   QTTYMSG         /DATA LIST ERROR
2130 004170  0414          0414
2131                       ELMSIZ=ARG1
2132                       NUMELM=TYPE1
2133                       DSTACK=BASE1
2134                       DATPTR=ARG2
2135                       RCOUNT=TYPE2
2136 004173  0273          PAGE
     004174  3771  
     004175  5266  
     004176  3632  
     004177  7775  
2137               / END STATEMENT PROCESSING
2138               
2139 004200  1062  END,    TAD     FUNCTN          /WHAT WAS IT ?
2140 004201  7640          SZA CLA
2141 004202  5205          JMP     .+3             /SUBR, RETURN
2142 004203  1377          TAD     (STPCOD-1       /MAIN PROG, CALL EXIT
2143 004204  3206          DCA     .+2
2144 004205  4521          JMS I   QGENCOD
2145 004206  5141          RTNCOD-1
2146 004207  1056          TAD     DOTEMP          /ANY DO TEMPS ?
2147 004210  1343          TAD     M7000
2148 004211  7550          SPA SNA
2149 004212  5215          JMP     .+3             /NO
2150 004213  4343          JMS     OTMPS           /OUTPUT THEM
2151 004214  3565  XDOTMP, DOTMPN
2152 004215  7200          CLA
2153 004216  1035          TAD     TMPMAX          /ANY EXTRA TEMPS ?
2154 004217  1376          TAD     (-TMPBLK
2155 004220  7550          SPA SNA
2156 004221  5225          JMP     .+4
2157 004222  7001          IAC                     /OUTPUT THEM + 1
2158 004223  4343          JMS     OTMPS
2159 004224  3153          TEMPN2
2160 004225  7200          CLA
2161 004226  1067          TAD     ELCNT           /ANY EXTERNAL LITERALS?
2162 004227  7450          SNA
2163 004230  5267          JMP     END2            /NO
2164 004231  7041          CIA
2165 004232  3067          DCA     ELCNT
2166 004233  1066          TAD     EXTLIT          /PICK UP THE POINTER
2167 004234  3017          DCA     X17
2168 004235  6211  ELLOOP, CDF     10
2169 004236  1417          TAD I   X17             /GET SYMBOL NAME
2170 004237  3024          DCA     TEMP
2171 004240  1417          TAD I   X17             /AND DO TEMP NUMBER
2172 004241  6201          CDF
2173 004242  1375          TAD     (-7000          /MINUS BASE
2174 004243  3025          DCA     TEMP2
2175 004244  4524          JMS I   QOPCDE          /ORIGIN
2176 004245  2161          ORG
2177 004246  1214          TAD     XDOTMP          /OUTPUT #DOTMP
2178 004247  4537          JMS I   QOUTSYM
2179 004250  1054          TAD     PLUS            /+
2180 004251  4562          JMS I   QOCHAR
2181 004252  1025          TAD     TEMP2           /DISP
2182 004253  7124          CLL CML RAL             /*2+1
2183 004254  1025          TAD     TEMP2           /*3+1
2184 004255  4516          JMS I   QONUMBR
2185 004256  4535          JMS I   QCRLF
2186 004257  4524          JMS I   QOPCDE          /NOW OUTPUT JSR NAME
2187 004260  3661          JSR
2188 004261  1024          TAD     TEMP
2189 004262  6211          CDF     10
2190 004263  4543          JMS I   QOUTNAM
2191 004264  4535          JMS I   QCRLF
2192 004265  2067          ISZ     ELCNT
2193 004266  5235          JMP     ELLOOP
2194 004267  1374  END2,   TAD     (232            /^Z
2195 004270  4562          JMS I   QOCHAR
2196 004271  4773          JMS I   (OUDUMP         /DUMP BUFFER
2197 004272  6212          CIF     10
2198 004273  4772          JMS I   (7700           /GET USR
2199 004274  0010          10
2200 004275  6212          CIF     10
2201 004276  7201          CLA IAC
2202 004277  4545          JMS I   Q200            /CLOSE OUTPUT FILE
2203 004300  0004          4
2204 004301  0072          F1LNAM
2205 004302  0000  FILSIZ, 0
2206 004303  5771          JMP     OUERR           /BADDDDIE
2207 004304  1302          TAD     FILSIZ          /FIX INPUT LIST
2208 004305  7106          CLL RTL
2209 004306  7006          RTL
2210 004307  5770          JMP     FINAL
2211 004310  0000  ERMSG,  0                       /PRINT ERROR MESSAGE ON THE TTY
2212 004311  3024          DCA     TEMP            /SAVE THE CODE
2213 004312  1105          TAD     QM4             /BACK UP THE ERROR
2214 004313  1005          TAD     ERRPTR          /POINTER
2215 004314  3010          DCA     X10
2216 004315  6211          CDF     10
2217 004316  3410          DCA I   X10             /ZERO END OF LIST
2218 004317  1024          TAD     TEMP            /NOW STICK IN THE CODE
2219 004320  3410          DCA I   X10
2220 004321  1010          TAD     X10             /SAVE THE NEW POINTER
2221 004322  3005          DCA     ERRPTR
2222 004323  1003          TAD     LINENO          /NOW THE LINE NUMBER
2223 004324  3410          DCA I   X10
2224 004325  6201          CDF
2225 004326  1024          TAD     TEMP            /PRINT ERROR CODE
2226 004327  4565          JMS I   QTTYP2C
2227 004330  4565          JMS I   QTTYP2C         /NOW SOME SPACES
2228 004331  1107          TAD     QTTYOUT         /FUDGE THE OUTPUT
2229                                               /ROUTINE POINTER
2230 004332  3162          DCA     QOCHAR          /SO THAT ONUMBR GOES TO
2231                                               /THE TTY
2232 004333  1003          TAD     LINENO          /PRINT THE LINE NUMBER
2233 004334  4516          JMS I   QONUMBR
2234 004335  1367          TAD     (OCHAR          /FIXUP OUTPUT POINTER
2235 004336  3162          DCA     QOCHAR
2236 004337  4566          JMS I   QTTCRLF
2237 004340  4521          JMS I   QGENCOD         /TRAP IF ERROR EXECUTED
2238 004341  5021          ERCODE-1
2239 004342  5710          JMP I   ERMSG
2240               M7000,
2241 004343  1000  OTMPS,  -7000                   /OUTPUT TEMP BLOCK
2242 004344  3024          DCA     TEMP            /SAVE SIZE
2243 004345  1743          TAD I   OTMPS
2244 004346  2343          ISZ     OTMPS
2245 004347  4537          JMS I   QOUTSYM         /OUTPUT NAME
2246 004350  1053          TAD     COMMA
2247 004351  4562          JMS I   QOCHAR
2248 004352  4524          JMS I   QOPCDE          /ORG
2249 004353  2161          ORG
2250 004354  1152          TAD     Q256            /.
2251 004355  4562          JMS I   QOCHAR
2252 004356  1054          TAD     PLUS
2253 004357  4562          JMS I   QOCHAR
2254 004360  1024          TAD     TEMP
2255 004361  7104          CLL RAL
2256 004362  1024          TAD     TEMP            /SIZE TIMES THREE
2257 004363  4516          JMS I   QONUMBR
2258 004364  4535          JMS I   QCRLF
2259 004365  5743          JMP I   OTMPS
2260 004367  0472          PAGE
     004370  5135  
     004371  0555  
     004372  7700  
     004373  0533  
     004374  0232  
     004375  1000  
     004376  7776  
     004377  5153  
2261               / CHAIN TO RALF
2262               / PASS2O     VERSION 4A  PT 16-MAY-77
2263               /CHANGES FOR OS/8 V3D AND OS/78 BY P.T.
2264               /FIXED THE Q OPTION
2265               /PATCH LEVEL IS IN LOCATION 26131
2266                       IFZERO  OVERLY <        /ANOTHER SCORE FOR PAL8
2267                       *OVRLAY
2268                       NOPUNCH>
2269                       IFNZRO  OVERLY <        /TO TAKE THE LEAD
2270                       FIELD   2
2271                       ENPUNCH
2272                       *OVRLAY>                /LATE IN THE FINAL QUARTER
2273 005000  1006  GORALF, TAD     FILDEV          /GET SIZE AND DEVICE WORD
2274 005001  3777          DCA I   (7617           /PUT IT AWAY
2275 005002  2377          ISZ     (7617           /BUMP POINTER
2276 005003  1007          TAD     FILBLK          /GET ORIGIN OF FIE
2277 005004  3777          DCA I   (7617           /STORE IT
2278 005005  2377          ISZ     (7617
2279 005006  3777          DCA I   (7617           /ZERO END OF LIST
2280 005007  1620          TAD I   RALFSV
2281 005010  6201          CDF 0
2282 005011  7710          SPA CLA         /WAS /A SPECIFIED?
2283 005012  5776          JMP I   (7605   /YES - GET OUT
2284 005013  7201          CLA IAC
2285 005014  6212  CHNLKP, CIF     10
2286 005015  4545          JMS I   Q200
2287 005016  0002          2                       /LOOKUP RALF.SV
2288 005017  5025          RALFNM
2289 005020  7643  RALFSV, 7643
2290 005021  5776          JMP I   (7605
2291 005022  1375          TAD     (6              /**
2292 005023  3216          DCA     CHNLKP+2
2293 005024  5214          JMP     CHNLKP
2294 005025  2201  RALFNM, 2201;1406;0000;2326     /RALF.SV
     005026  1406  
     005027  0000  
     005030  2326  
2295 005031  2001  PASS3N, 2001;2323;6300;2326     /PASS3.SV
     005032  2323  
     005033  6300  
     005034  2326  
2296               
2297 005035  4514  ADD,    JMS I   QCODE           /GENERATE CODE FOR ADD
2298 005036  5254          ADDTBL-6;0
     005037  0000  
2299 005040  5511          JMP I   QNEXT
2300               / EXP OPERATOR
2301 005041  0000  ETYPE,  0
2302 005042  4553  EXP,    JMS I   QSAVACT         /SAVE AC IF ITS SECOND ARG
2303 005043  4560          JMS I   QGARGS          /GET THE TWO ARGS
2304 005044  5774          JMP I   (OTERR          /TYPE/OPERATOR ERROR
2305 005045  1030          TAD     TYPE1           /GET PLACE IN TABLE
2306 005046  7106          CLL RTL
2307 005047  1030          TAD     TYPE1           /TYPE1 TIMES TEN
2308 005050  1033          TAD     TYPE2           /**
2309 005051  7104          CLL RAL
2310 005052  1373          TAD     (EXPTBL-15      /POINTER TO ENTRY MINUS ONE
2311 005053  3010          DCA     X10
2312 005054  6211          CDF     10
2313 005055  1410          TAD I   X10             /GET RESULTING TYPE
2314 005056  7450          SNA
2315 005057  5774          JMP I   (OTERR          /BAD IF THIS WORD IS ZERO
2316 005060  3241          DCA     ETYPE           /SAVE THE TYPE
2317 005061  1410          TAD I   X10             /GET THE SUBR NAME
2318 005062  6201          CDF
2319 005063  3772          DCA I   (ESUBR+2        /PUT IT INTO ITS PLACE
2320 005064  1030          TAD     TYPE1           /GET INTO CORRECT MODE
2321 005065  4326          JMS     SETMOD
2322 005066  1026          TAD     ARG1            /IS ARG 1 ALREADY IN THE AC
2323 005067  7650          SNA CLA
2324 005070  5275          JMP     .+5             /YES, SKIP THE LOAD
2325 005071  4523          JMS I   QOPCOD          /OTHERWISE LOAD IT
2326 005072  1012          FLDA
2327 005073  4525          JMS I   QOADDR
2328 005074  0026          ARG1
2329 005075  4561          JMS I   QOINS           /FSTA   #BASE
2330 005076  1567          FSTA;XBASE
     005077  3600  
2331 005100  1033          TAD     TYPE2           /SET MODE FOR ARG 2
2332 005101  4326          JMS     SETMOD
2333 005102  4523          JMS I   QOPCOD          /NOW LOAD IT
2334 005103  1012          FLDA
2335 005104  4525          JMS I   QOADDR
2336 005105  0031          ARG2
2337 005106  4561          JMS I   QOINS           /EXTERN FOR THE SUBR
2338 005107  2142          EXTERN;ESUBR
     005110  5764  
2339 005111  4561          JMS I   QOINS           /JSA TO THE SUBR
2340 005112  3663          JSA;ESUBR
     005113  5764  
2341 005114  3416          DCA I   X16             /RESULT IS THE AC
2342 005115  1241          TAD     ETYPE           /WITH THIS AS THE TYPE
2343 005116  3416          DCA I   X16
2344 005117  3416          DCA I   X16
2345 005120  1241          TAD     ETYPE           /SET FMODE CORRECTLY
2346 005121  4554          JMS I   QSKPIRL
2347 005122  7410          SKP
2348 005123  7201          CLA IAC                 /RETURNED IN F MODE
2349 005124  3101          DCA     FMODE
2350 005125  5511          JMP I   QNEXT
2351               SETMOD,                         /SET MODE TO CORRESPOND
2352                                               /TO THE ARG
2353 005126  0004  VOVER,  VERSON                  /VERSION NUMBER FOR OVERLAY
2354 005127  4554          JMS I   QSKPIRL         /SKIP IF WE WANT F MODE
2355 005130  5333          JMP     .+3             /SET TO E MODE
2356 005131  4532          JMS I   QGENSF          /SET TO F MODE
2357 005132  5726          JMP I   SETMOD
2358 005133  4533          JMS I   QGENSE
2359 005134  5726          JMP I   SETMOD
2360 005135  7041  FINAL,  CIA
2361 005136  7001          IAC
2362 005137  3006          DCA     FILDEV          /SAVE RALF INPUT SPEC
2363 005140  7040          CMA
2364 005141  3765          DCA I   X7746           /DON'T SAVE CORE ARROUND CHAIN
2365 005142  4771          JMS I   (DFRTTM /DELETE FORTRN.TM
2366 005143  6211          CDF     10
2367 005144  1570          TAD I   Q7605           /IS THERE A LISTING FILE?
2368 005145  7650          SNA CLA
2369 005146  5200          JMP     GORALF          /NO, JUST CHAIN TO RALF
2370 005147  6212          CIF     10
2371 005150  6201          CDF
2372 005151  7201          CLA IAC
2373 005152  4545          JMS I   Q200            /FIND PASS 3
2374 005153  0002          2
2375 005154  5031          PASS3N
2376 005155  0000  PAS3SV, 0
2377 005156  5570          JMP I   Q7605
2378 005157  1354          TAD     PAS3SV-1        /MOVE BLOCK TO CHAIN COMMAND
2379 005160  7001          IAC                     /SKIP OVER CORE CONTROL BLOCK
2380 005161  3365          DCA     X7746
2381 005162  4476          JMS I   DEVH            /READ IN PASS 3
2382 005163  1600          NPPAS3
2383 005164  0400  SPASS3, 400
2384 005165  7746  X7746,  7746
2385 005166  5570          JMP I   Q7605
2386 005167  5764          JMP I   SPASS3          /GO DO PASS 3
2387 005171  3760          PAGE
     005172  5766  
     005173  6614  
     005174  1360  
     005175  0006  
     005176  7605  
     005177  7617  
2388               / I/O OPEN AND CLOSE
2389               
2390 005200  0000  STRTIO, 0                       /ROUTINE FOR STARTING IO STMT
2391 005201  2100          ISZ     IOSTMT          /SET IOSTMT SWITCH
2392                                               /(INCASE OF IMPLIED LOOPS)
2393 005202  4517          JMS I   QSAVEAC         /SAVE AC
2394 005203  4553          JMS I   QSAVACT         /IF NECESSARY
2395 005204  1600          TAD I   STRTIO          /GET NUMBER OF ARGS
2396 005205  3050          DCA     NARGS           /SAVE IT
2397 005206  2200          ISZ     STRTIO          /MOVE TOHE NME
2398 005207  1050          TAD     NARGS           /BACKUP STACK BY THIS MUCH
2399 005210  1050          TAD     NARGS           /THREE OR SIX
2400 005211  1050          TAD     NARGS
2401 005212  1016          TAD     X16
2402 005213  3015          DCA     X15
2403 005214  1015          TAD     X15
2404 005215  3024          DCA     TEMP            /FUNCTION NAME GOES HERE
2405 005216  4524          JMS I   QOPCDE          /EXTERN FOR SUBR
2406 005217  2142          EXTERN
2407 005220  1600          TAD I   STRTIO          /GET SUBROUTINE NAME
2408 005221  4537          JMS I   QOUTSYM         /OUTPUT IT
2409 005222  4535          JMS I   QCRLF
2410 005223  1600          TAD I   STRTIO          /PUT NAME
2411 005224  3424          DCA I   TEMP            /ONTO STACK
2412 005225  4532          JMS I   QGENSF          /ALL CALLS IN F MODE
2413 005226  4555          JMS I   QGENCAL         /GENERATE THE CALL
2414 005227  7000          NOP
2415 005230  5511          JMP I   QNEXT           /NOTHING FOR R CLOSE
2416 005231  7001  FMTRD1, IAC                     /START FORMATTED READ
2417 005232  3060          DCA     INPUT           /SET INPUT = 1
2418 005233  3057          DCA     BINARY          /AND BINARY = 0
2419 005234  4200          JMS     STRTIO          /GO MAKE THE CALL
2420 005235  7776          -2;XREADO
     005236  5312  
2421 005237  3060  FMTWR1, DCA     INPUT           /SET SWITCHES
2422 005240  3057          DCA     BINARY
2423 005241  4200          JMS     STRTIO
2424 005242  7776          -2;XWRITO
     005243  5316  
2425 005244  7201  BINRD1, CLA IAC
2426 005245  3057          DCA     BINARY
2427 005246  7201          CLA IAC
2428 005247  3060          DCA     INPUT
2429 005250  4200          JMS     STRTIO
2430 005251  7777          -1;XRUO
     005252  5322  
2431 005253  3060  BINWR1, DCA     INPUT
2432 005254  7201          CLA IAC
2433 005255  3057          DCA     BINARY
2434 005256  4200          JMS     STRTIO
2435 005257  7777          -1;XWUO
     005260  5325  
2436 005261  7326  WCLOSE, CLA STL RTL             /TRAP3 HERE TOO**
2437 005262  4266          JMS     OJSR            /OUTPUT TRAP3 #WUC
2438 005263  5306          XWUC
2439 005264  3100          DCA     IOSTMT          /KILL IO SWITCH
2440 005265  5511          JMP I   QNEXT
2441 005266  0000  OJSR,   0                       /OUTPUT EXTERN THEN JSR OR TRAP3
2442 005267  7104          CLL RAL         /AC ON ENTRY IS 0 (JSR), 1 (JSA) OR 2 (TRAP3).
2443 005270  1377          TAD     (JSR
2444 005271  3300          DCA     OJSROP
2445 005272  4524          JMS I   QOPCDE          /FIRST EXTERN
2446 005273  2142          EXTERN
2447 005274  1666          TAD I   OJSR
2448 005275  4537          JMS I   QOUTSYM
2449 005276  4535          JMS I   QCRLF
2450 005277  4524          JMS I   QOPCDE          /THEN JSR
2451 005300  0000  OJSROP, 0
2452 005301  1666          TAD I   OJSR
2453 005302  2266          ISZ     OJSR
2454 005303  4537          JMS I   QOUTSYM
2455 005304  4535          JMS I   QCRLF
2456 005305  5666          JMP I   OJSR
2457               
2458 005306  4322  XWUC,   TEXT    '#RENDO'        /**
     005307  0516  
     005310  0417  
     005311  0000  
2459 005312  4322  XREADO, TEXT    '#READO'
     005313  0501  
     005314  0417  
     005315  0000  
2460 005316  4327  XWRITO, TEXT    '#WRITO'
     005317  2211  
     005320  2417  
     005321  0000  
2461 005322  4322  XRUO,   TEXT    '#RUO'
     005323  2517  
     005324  0000  
2462 005325  4327  XWUO,   TEXT    '#WUO'
     005326  2517  
     005327  0000  
2463 005330  4322  RDRTNE, TEXT    /#RSVO/
     005331  2326  
     005332  1700  
2464 005333  4322  RDDRTN, TEXT    /#RFDV/
     005334  0604  
     005335  2600  
2465 005336  0617  FTRNTM, 0617;2224;2216;2415     /FORTRN.TM
     005337  2224  
     005340  2216  
     005341  2415  
2466 005342  4514  DNA,   JMS I   QCODE           /AND CODE
2467 005343  6143          ANDTBL-6;0
     005344  0000  
2468 005345  5511          JMP I   QNEXT
2469 005346  4540  PURGE,  JMS I   QGARG           /LOOK AT THE TOP OF STACK
2470 005347  5776          JMP I   (IOTYPE         /BAD TYPE
2471 005350  1026          TAD     ARG1            /IT MUST BE A SCALAR REFNCE
2472 005351  7100          CLL
2473 005352  1167          TAD     QM63
2474 005353  7620          SNL CLA
2475 005354  5776          JMP I   (IOTYPE         /BAD TYPE
2476 005355  5511          JMP I   QNEXT
2477 005356  4513  PAUZE,  JMS I   QUCODE          /GET ARG INTO FAC
2478 005357  6515          AIFTBL-1
2479 005360  4521          JMS I   QGENCOD         /OUTPUT JSR
2480 005361  5145          PAZCOD-1
2481 005362  5511          JMP I   QNEXT
2482 005376  6147          PAGE
     005377  3661  
2483               /DIRECT ACCESS I/O
2484               
2485 005400  7201  DARD1,  CLA IAC                 /SET SWITCHES
2486 005401  3060          DCA     INPUT
2487 005402  7201          CLA IAC
2488 005403  3057          DCA     BINARY          /SAME AS UNFORMATTED
2489 005404  4777          JMS I   (STRTIO         /GENERATE CALL
2490 005405  7776          -2;XRDAO
     005406  5426  
2491 005407  3060  DAWR1,  DCA     INPUT           /SAME AS UNFORMATTED WRITE OPEN
2492 005410  7201          CLA IAC
2493 005411  3057          DCA     BINARY
2494 005412  4777          JMS I   (STRTIO         /CALL
2495 005413  7776          -2;XWDAO
     005414  5431  
2496 005415  1220  DEFFIL, TAD     XDFARG          /FAKE A CALL
2497 005416  3777          DCA I   (STRTIO         /TO SKIP THE ISZ IOSTMT
2498 005417  5776          JMP I   (STRTIO+2
2499 005420  5421  XDFARG, .+1
2500 005421  7774          -4;XDEF
     005422  5423  
2501 005423  4304  XDEF,   TEXT    '#DEF'
     005424  0506  
     005425  0000  
2502 005426  4322  XRDAO,  TEXT    '#RDAO'
     005427  0401  
     005430  1700  
2503 005431  4327  XWDAO,  TEXT    '#WDAO'
     005432  0401  
     005433  1700  
2504               / RANDOM UNFITTING STUFF
2505 005434  4521  RETURN, JMS I   QGENCOD         /JA #RTN
2506 005435  5141          RTNCOD-1
2507 005436  5511          JMP I   QNEXT
2508 005437  0000  GENSTF, 0                       /GENERATE STARTF IF IN E MODE
2509 005440  1101          TAD     FMODE           /LOOK AT THE SWITCH
2510 005441  7640          SZA CLA
2511 005442  5637          JMP I   GENSTF          /ALREADY THERE
2512 005443  2101          ISZ     FMODE           /SET SWITCH
2513 005444  4523          JMS I   QOPCOD          /OUTPUT STARTF
2514 005445  1134          STARTF
2515 005446  4535          JMS I   QCRLF
2516 005447  5637          JMP I   GENSTF          /RETURN
2517 005450  4513  NOT,    JMS I   QUCODE          /.NOT.
2518 005451  6500          NOTTBL-1
2519 005452  5775          JMP I   (RELGM1
2520 005453  4514  SUB,    JMS I   QCODE           /SUBTRACT
2521 005454  5417          SUBTBL-6;0
     005455  0000  
2522 005456  5511          JMP I   QNEXT
2523 005457  4514  MUL,    JMS I   QCODE           /MULTIPLY
2524 005460  5523          MULTBL-6;0
     005461  0000  
2525 005462  5511          JMP I   QNEXT
2526 005463  7201  ASFDEF, CLA IAC                 /SET SWITCH FOR ASF PROLOG
2527 005464  3102          DCA     ASFSWT
2528 005465  5511          JMP I   QNEXT
2529 005466  0000  OINS,   0                       /OUTPUT TAB OPCODE TAB
2530                                               /ADDRESS CRLF
2531 005467  3044          DCA     WHATAC          /ZAPS AC
2532 005470  4536          JMS I   QOTAB
2533 005471  1666          TAD I   OINS            /GET OPCODE
2534 005472  2266          ISZ     OINS
2535 005473  4537          JMS I   QOUTSYM
2536 005474  4536          JMS I   QOTAB
2537 005475  1666          TAD I   OINS            /GET ADDRESS
2538 005476  7440          SZA
2539 005477  4537          JMS I   QOUTSYM
2540 005500  4535          JMS I   QCRLF           /END LINE
2541 005501  2266          ISZ     OINS
2542 005502  5666          JMP I   OINS
2543               / CODE GENERATOR FOR STORE
2544 005503  4560  STORE,  JMS I   QGARGS          /GET ARGS FOR STORE
2545 005504  5774          JMP I   (OTERR
2546 005505  1026          TAD     ARG1            /KILL ANY XR
2547                                               /EXPRS. INVOLVING
2548 005506  4531          JMS I   QCHKXR          /THE VARIABLE BEING STORED
2549 005507  1031          TAD     ARG2            /IS SECOND ARG IN AC ?
2550 005510  7650          SNA CLA
2551 005511  1120          TAD     Q5              /YES, ADD 5 TO TYPE2
2552 005512  1033          TAD     TYPE2
2553 005513  3033          DCA     TYPE2
2554 005514  1030          TAD     TYPE1           /TYPE1 TIMES TEN
2555 005515  7106          CLL RTL
2556 005516  1030          TAD     TYPE1
2557 005517  7104          CLL RAL
2558 005520  1033          TAD     TYPE2           /PLUS TYPE2
2559 005521  1373          TAD     (STRTBL-13      /PLUS TABLE BASE
2560 005522  3327          DCA     SSKEL           /GIVES ENTRY ADDRESS
2561 005523  6211          CDF     10
2562 005524  1727          TAD I   SSKEL           /POINTER TO SKELETON
2563 005525  3327          DCA     SSKEL
2564 005526  4521          JMS I   QGENCOD         /GENERATE CODE
2565 005527  0000  SSKEL,  0
2566 005530  1102          TAD     ASFSWT          /IS THIS END OF ASF ?
2567 005531  7640          SZA CLA
2568 005532  5511          JMP I   QNEXT           /YES, DON'T DO A STORE
2569 005533  1030          TAD     TYPE1           /MODE IS THE SAME
2570 005534  4554          JMS I   QSKPIRL         /AS THE VARIABLE STORED IN
2571 005535  7410          SKP
2572 005536  7201          CLA IAC
2573 005537  3101          DCA     FMODE
2574 005540  4523          JMS I   QOPCOD          /OUTPUT STORE
2575 005541  1567          FSTA
2576 005542  4525          JMS I   QOADDR          /ADDRESS FIELD
2577 005543  0026          ARG1
2578 005544  1026          TAD     ARG1            /REMEMBER THE AC
2579 005545  7041          CIA
2580 005546  3044          DCA     WHATAC          /(REMEMBER THE
2581 005547  1027          TAD     BASE1           /ALAMO ?)
2582 005550  7041          CIA                     /(WOULD YOU
2583 005551  3045          DCA     WHATBS          /BELIEVE THE MAINE ???)
2584 005552  2026          ISZ     ARG1            /GO TO TYPE WORD
2585 005553  6211          CDF     10
2586 005554  7100          CLL                     /IF ARG1 IS
2587 005555  1026          TAD     ARG1            /A SS'D REFNCE
2588 005556  1167          TAD     QM63            /DON'T
2589 005557  7630          SZL CLA                 /BOTHER CHECKING
2590 005560  1426          TAD I   ARG1            /LOOK AT SOME BITS
2591 005561  6201          CDF
2592 005562  0372          AND     (3400           /DIM,EXT, OR ASF ?
2593 005563  7650          SNA CLA
2594 005564  5511          JMP I   QNEXT
2595 005565  4527          JMS I   QTTYMSG         /ATTEMPT TO STORE IN
2596 005566  1720          1720                    /EXTERNAL OR ASF
2597 005567  0614  FLDAP,  TEXT    'FLDA%'
     005570  0401  
     005571  4500  
2598 005572  3400          PAGE
     005573  6246  
     005574  1360  
     005575  0437  
     005576  5202  
     005577  5200  
2599               /ARITHEMTIC STATEMENT FUNCTIONS (BLAH!)
2600               
2601 005600  6201  DEFASF, CDF                     /A.S.F. PROLOG
2602 005601  1101          TAD     FMODE           /SAVE CPU MODE
2603 005602  3355          DCA     ASFMOD          /SINCE WE JUMP ARROUND
2604 005603  1014          TAD     X14             /SET STACK POINTER
2605 005604  1377          TAD     (3              /SO THAT ASF NAME STAYS
2606 005605  3016          DCA     X16
2607 005606  7240          CLA CMA                 /SET ASF SWITCH
2608 005607  3102          DCA     ASFSWT
2609 005610  1035          TAD     TMPMAX          /USE UNIQUE TEMPS
2610 005611  7001          IAC
2611 005612  3034          DCA     TMPCNT          /FOR ALL ASF'S
2612 005613  4530          JMS I   QXRTBL          /AND FORGET XR'S
2613 005614  4524          JMS I   QOPCDE          /JA AROUND
2614 005615  3657          JA
2615 005616  1051          TAD     GLABEL          /SAVE ARROUND LABEL
2616 005617  3356          DCA     ASFSKP
2617 005620  2051          ISZ     GLABEL          /BUMP LABEL GENERATOR
2618 005621  1356          TAD     ASFSKP          /PUT LABEL AS ADDRESS OF JA
2619 005622  4550          JMS I   QOLABEL
2620 005623  4535          JMS I   QCRLF
2621 005624  1051          TAD     GLABEL          /FUNCTIONS XR'S O HERE
2622 005625  4572          JMS I   QLABEL          /OUPTUT THE LABEL
2623 005626  4561          JMS I   QOINS           /#GXXXX,  ORG   .+10
2624 005627  2161          ORG;DP8
     005630  1166  
2625 005631  1027          TAD     BASE1           /NOW OUTPUT FUNCTION NAME
2626 005632  6211          CDF     10
2627 005633  4543          JMS I   QOUTNAM
2628 005634  1053          TAD     COMMA           /AS TAG
2629 005635  4562          JMS I   QOCHAR          /OF START OF FUNCTION
2630 005636  4524          JMS I   QOPCDE          /SETX
2631 005637  1514          XSET
2632 005640  1051          TAD     GLABEL          /TO THE GENERATED LABEL
2633 005641  2051          ISZ     GLABEL
2634 005642  4550          JMS I   QOLABEL
2635 005643  4535          JMS I   QCRLF
2636 005644  4561          JMS I   QOINS           /LDX  0,1
2637 005645  3622          LDX;ZEROC1
     005646  1517  
2638 005647  4521          JMS I   QGENCOD         /STARTD
2639 005650  5035          SD-1                    /JUST LIKE A SUBROUTINE
2640                                               /ISN'T IT ?
2641 005651  4561          JMS I   QOINS           /FLDA  #BASE
2642 005652  1012          FLDA;XBASE              /GET RETURN JUMP
     005653  3600  
2643 005654  4524          JMS I   QOPCDE          /STORE IT AHEAD
2644 005655  1567          FSTA
2645 005656  1051          TAD     GLABEL          /USING GENERATED LABEL
2646 005657  4550          JMS I   QOLABEL
2647 005660  4535          JMS I   QCRLF
2648 005661  4561  ASFARG, JMS I   QOINS           /FLDA% #BASE,1+
2649 005662  5567          FLDAP;XBAC1P            /GET ARG POINTER
     005663  1752  
2650 005664  4561          JMS I   QOINS           /FSTA   #BASE+3
2651 005665  1567          FSTA;XBASP3             /SAVE IT
     005666  3603  
2652 005667  1415          TAD I   X15             /GET PARAMETER
2653 005670  3031          DCA     ARG2
2654 005671  1415          TAD I   X15
2655 005672  3033          DCA     TYPE2
2656 005673  2015          ISZ     X15
2657 005674  1033          TAD     TYPE2           /IS IT SINGLE OR DOUBLE?
2658 005675  4554          JMS I   QSKPIRL
2659 005676  5320          JMP     ASFASE          /DOUBLE
2660 005677  4521          JMS I   QGENCOD         /STARTF
2661 005700  5043          SF-1
2662 005701  7201          CLA IAC
2663 005702  3101  ARGSV,  DCA     FMODE           /SET FMODE APPROPRIATELY
2664 005703  4561          JMS I   QOINS           /FLDA% #BASE+3
2665 005704  5567          FLDAP;XBASP3            /GET THE VALUE
     005705  3603  
2666 005706  4523          JMS I   QOPCOD
2667 005707  1567          FSTA                    /AND SAVE IT
2668 005710  4525          JMS I   QOADDR
2669 005711  0031          ARG2
2670 005712  2050          ISZ     NARGS           /ANY MORE ARGS ?
2671 005713  7410          SKP
2672 005714  5511          JMP I   QNEXT           /NO, END OF ASF PROLOG
2673 005715  4521          JMS I   QGENCOD         /STARTD
2674 005716  5035          SD-1
2675 005717  5261          JMP     ASFARG          /NEXT ARG
2676 005720  4521  ASFASE, JMS I   QGENCOD         /STARTE
2677 005721  5040          SE-1
2678 005722  5302          JMP     ARGSV
2679 005723  0000  ASFEND, 0                       /HANDLE END OF A.S.F.
2680 005724  1102          TAD     ASFSWT          /IS THIS END OF ASF ?
2681 005725  7650          SNA CLA
2682 005726  5352          JMP     PTCH            /V3C NO
2683 005727  3102          DCA     ASFSWT          /CLEAR SWITCH
2684 005730  4561          JMS I   QOINS           /RESET XR'S
2685 005731  1514          XSET;ZXR
     005732  6364  
2686 005733  1051          TAD     GLABEL          /OUTPUT SPACE FOR RETURN ADDR
2687 005734  2051          ISZ     GLABEL
2688 005735  4572          JMS I   QLABEL          /OUPTUT THE LABEL
2689 005736  4561          JMS I   QOINS           /ORG .+2
2690 005737  2161          ORG;DOTP2
     005740  6362  
2691 005741  1356          TAD     ASFSKP          /OUTPUT SKIP ARROUND LABEL
2692 005742  4572          JMS I   QLABEL          /OUPTUT THE LABEL
2693 005743  4535          JMS I   QCRLF
2694 005744  1355          TAD     ASFMOD          /RESET MODE SWITCH
2695 005745  3101          DCA     FMODE
2696 005746  1035          TAD     TMPMAX          /UNIQUE TEMPS
2697 005747  7001          IAC
2698 005750  3002          DCA     TEM             /V3C MUST BE USED
2699 005751  4530          JMS I   QXRTBL          /AND XR'S LOST
2700 005752  1002  PTCH,   TAD     TEM             /V3C
2701 005753  3034          DCA     TMPCNT          /V3C
2702 005754  5723          JMP I   ASFEND          /RETURN
2703 005755  0000  ASFMOD, 0
2704 005756  0000  ASFSKP, 0
2705 005757  4524  IOFUN,  JMS I   QOPCDE          /CALLED BY TRAP3,NOT JSR**
2706 005760  3665          TRAP3
2707 005761  1424          TAD I   TEMP
2708 005762  4537          JMS I   QOUTSYM         /OUTPUT THE IO FUNCTION NAME
2709 005763  5776          JMP I   (IOONLY         /DO SOME OTHER STUFF
2710 005764  4305  ESUBR,  TEXT    '#EXPXX'        /THIS WILL BE THE CORRECT NAME
     005765  3020  
     005766  3030  
     005767  0000  
2711 005776  3313          PAGE
     005777  0003  
2712               / I/O LIST ELEMENT
2713               
2714 006000  4540  IOLMNT, JMS I   QGARG           /GET THE ARG
2715 006001  5347          JMP     IOTYPE          /TYPE ERROR
2716 006002  3070          DCA     IOLOOP          /CLEAR LOOP SWITCH
2717 006003  7346          CLL STA RTL     /-3
2718 006004  1030          TAD     TYPE1
2719 006005  3030          DCA     TYPE1   /TYPE1 = 0 IF COMPLEX, 1 IF D.P.
2720 006006  1026          TAD     ARG1            /ADDR OF TYPE WD
2721 006007  7101          CLL IAC
2722 006010  3031          DCA     ARG2
2723 006011  1026          TAD     ARG1            /LOOK AT ARG
2724 006012  1167          TAD     QM63
2725 006013  7620          SNL CLA
2726 006014  5263          JMP     NOLOOP          /NOT ARRAY OUTPUT
2727 006015  6211          CDF     10
2728 006016  7132          CLL CML RTR             /IS IT DIMENSIONED ?
2729 006017  0431          AND I   ARG2
2730 006020  6201          CDF
2731 006021  7650          SNA CLA
2732 006022  5263          JMP     NOLOOP          /NO, NO LOOP
2733 006023  2070          ISZ     IOLOOP          /SET SWITCH
2734 006024  1026          TAD     ARG1            /GET TO SS
2735 006025  4551          JMS I   QGETSS
2736 006026  7001          IAC                     /TOTAL SIZE WORD
2737 006027  3027          DCA     BASE1
2738 006030  1431          TAD I   ARG2            /IS THIS ARRAY AN ARG ?
2739 006031  0141          AND     Q20
2740 006032  3071          DCA     ARGIO           /SET SWITCH
2741 006033  1427          TAD I   BASE1           /IS IT VARIABLY DIMENSIONED ?
2742 006034  7450          SNA
2743 006035  5777          JMP I   (VDAIO          /YES, MUST COMPUTE SIZE
2744 006036  3032          DCA     BASE2           /SAVE SIZE
2745 006037  6201          CDF
2746 006040  4524          JMS I   QOPCDE          /PUT SIZE IN XR 1
2747 006041  3622          LDX
2748 006042  1146          TAD     Q255
2749 006043  4562          JMS I   QOCHAR          /-
2750 006044  1032          TAD     BASE2
2751 006045  4516          JMS I   QONUMBR
2752 006046  1053          TAD     COMMA
2753 006047  4562          JMS I   QOCHAR
2754 006050  1376          TAD     (261
2755 006051  4562          JMS I   QOCHAR
2756 006052  4535          JMS I   QCRLF
2757 006053  1071          TAD     ARGIO           /IS IT AN ARG ?
2758 006054  7640          SZA CLA
2759 006055  5775          JMP I   (ARGIOA         /YES
2760 006056  1051  OLLABL, TAD     GLABEL          /OUTPUT LABEL
2761 006057  4550          JMS I   QOLABEL
2762 006060  3774          DCA I   (XRBUFR+20      /KILL XR1 ENTRY
2763 006061  1053          TAD     COMMA
2764 006062  4562          JMS I   QOCHAR
2765 006063  1060  NOLOOP, TAD     INPUT           /INPUT OR OUTPUT ?
2766 006064  7650          SNA CLA
2767 006065  5317          JMP     OUTV            /OUTPUT
2768 006066  4331          JMS     FIXCAL          /SET PTR FOR OJSR**
2769 006067  4773          JMS I   (DUMSUB         /NOW THE STORE
2770 006070  1567          FSTA
2771 006071  1026          TAD     ARG1            /KILL ASSOCIATED
2772 006072  4531          JMS I   QCHKXR          /XR EXPRESSIONS
2773 006073  1030  CDSFLP, TAD     TYPE1           /IS IT C OR D ?
2774 006074  7110          CLL RAR
2775 006075  7640          SZA CLA
2776 006076  5301          JMP     ENDLUP          /NO, NO STARTE
2777 006077  4521          JMS I   QGENCOD
2778 006100  5043          SF-1
2779 006101  1070  ENDLUP, TAD     IOLOOP          /IS THERE A LOOP ?
2780 006102  7650          SNA CLA
2781 006103  5511          JMP I   QNEXT           /NO, DO NEXT LIST ELEMENT
2782 006104  4524          JMS I   QOPCDE          /YES, OUTPUT JXN
2783 006105  3612          JXN
2784 006106  1051          TAD     GLABEL
2785 006107  2051          ISZ     GLABEL          /OUTPUT LABEL
2786 006110  4572          JMS I   QLABEL          /OUPTUT THE LABEL
2787 006111  1376          TAD     (261
2788 006112  4562          JMS I   QOCHAR
2789 006113  1054          TAD     PLUS            /OUTPUT PLUS (FOR
2790                                               /INCREMENT DUMMY)
2791 006114  4562          JMS I   QOCHAR
2792 006115  4535          JMS I   QCRLF
2793 006116  5511          JMP I   QNEXT           /DO NEXT LIST ELEMENT
2794 006117  1030  OUTV,   TAD     TYPE1           /D OR C ?
2795 006120  7110          CLL RAR
2796 006121  7640          SZA CLA
2797 006122  5325          JMP     .+3             /NO, NO STARTF NECCESSARY
2798 006123  4521          JMS I   QGENCOD
2799 006124  5040          SE-1
2800 006125  4773          JMS I   (DUMSUB         /OUTPUT FLDA
2801 006126  1012          FLDA
2802 006127  4331          JMS     FIXCAL
2803 006130  5273          JMP     CDSFLP          /THEN STARTF AND JXN IF ANY
2804 006131  6401  FIXCAL, 6401
2805 006132  1030          TAD     TYPE1   /IF VARIABLE IS COMPLEX,
2806 006133  7041          CIA             /OR IF VARIABLE IS DOUBLE AND
2807 006134  7440          SZA             /I/O IS BINARY,
2808 006135  1057          TAD     BINARY  /GENERATE A JSR #RFDV
2809 006136  7650          SNA CLA         /ELSE GENERATE A TRAP3 #RSVO
2810 006137  5344          JMP     BINDIO
2811 006140  7326          CLA STL RTL             /SET PTR
2812 006141  4772          JMS I   (OJSR           /NOW GO DO IT
2813 006142  5330          RDRTNE                  /HERE'S THE NAME
2814 006143  5731          JMP I   FIXCAL
2815 006144  4772  BINDIO, JMS I   (OJSR
2816 006145  5333          RDDRTN
2817 006146  5731          JMP I   FIXCAL
2818               
2819 006147  4527  IOTYPE, JMS I   QTTYMSG         /IO TYPE ERROR
2820 006150  1124          1124
2821 006151  4535  DEFLBL, JMS I   QCRLF           /CRLF BEFORE LABL
2822 006152  4532          JMS I   QGENSF          /ENTER F MODE BEFORE ALL LABELS
2823 006153  4515          JMS I   QINWORD         /GET THE LABEL
2824 006154  6211          CDF     10
2825 006155  4534          JMS I   QOSNUM          /OUTPUT IT
2826 006156  1053          TAD     COMMA
2827 006157  4562          JMS I   QOCHAR
2828 006160  4530          JMS I   QXRTBL          /KILL XR TABLE
2829 006161  3044          DCA     WHATAC          /AND AC AT LABEL
2830 006162  5511          JMP I   QNEXT
2831 006172  5266          PAGE
     006173  6270  
     006174  6620  
     006175  6234  
     006176  0261  
     006177  6200  
2832               / I/O LIST ELEMENT
2833               
2834 006200  7144  VDAIO,  CLL CMA RAL             /GET ADDR OF NUMBER OF DIMS
2835 006201  1027          TAD     BASE1
2836 006202  3010          DCA     X10
2837 006203  1410          TAD I   X10             /GET DIM COUNT
2838 006204  7041          CIA
2839 006205  3050          DCA     NARGS
2840 006206  2010          ISZ     X10             /SKIP SIZE
2841 006207  2010          ISZ     X10             /AND MAGIC NUMBER
2842 006210  2010          ISZ     X10             /AND LITERAL NUMBER
2843 006211  1377          TAD     (FLDA           /LOAD FIRST DIM
2844 006212  7410          SKP
2845 006213  1376  GSIZLP, TAD     (FMUL           /MULTIPLY THE REST
2846 006214  3222          DCA     OPCIO
2847 006215  6211          CDF     10
2848 006216  1410          TAD I   X10             /GET THE NEXT DIMENSION
2849 006217  3033          DCA     TYPE2
2850 006220  6201          CDF
2851 006221  4523          JMS I   QOPCOD          /OUTPUT OPCODE
2852 006222  0000  OPCIO,  0
2853 006223  4525          JMS I   QOADDR          /NOW THE DIMENSION
2854 006224  0033          TYPE2
2855 006225  2050          ISZ     NARGS
2856 006226  5213          JMP     GSIZLP          /KEEP GOING
2857 006227  4523          JMS I   QOPCOD          /NEGATE THE FAC
2858 006230  1572          FNEG
2859 006231  4535          JMS I   QCRLF
2860 006232  4521          JMS I   QGENCOD         /PUT THE COUNT INTO XR1
2861 006233  5106          ATX1-1
2862 006234  4521  ARGIOA, JMS I   QGENCOD         /PUT -1 INTO XR 2
2863 006235  5111          LXM1C2-1
2864 006236  4524          JMS I   QOPCDE          /LOAD THE ARG POINTER -
2865 006237  1012          FLDA                    /CONST
2866 006240  3775          DCA I   (XRBUFR+40      /KILL XR 2 ENTRY
2867 006241  1026          TAD     ARG1
2868 006242  6211          CDF     10
2869 006243  4543          JMS I   QOUTNAM
2870 006244  4535          JMS I   QCRLF
2871 006245  4524          JMS I   QOPCDE          /NOW ADD THE MAGIC NUMBER
2872 006246  1007          FADD
2873 006247  1144          TAD     QLITRL          /OUTPUT #LIT+XXXX
2874 006250  4537          JMS I   QOUTSYM
2875 006251  6211          CDF     10
2876 006252  2027          ISZ     BASE1
2877 006253  2027          ISZ     BASE1
2878 006254  1427          TAD I   BASE1
2879 006255  6201          CDF
2880 006256  4516          JMS I   QONUMBR
2881 006257  4535          JMS I   QCRLF
2882 006260  4524          JMS I   QOPCDE
2883 006261  1567          FSTA                    /NOW STORE IN #BASE+3
2884 006262  1374          TAD     (XBASP3
2885 006263  4537          JMS I   QOUTSYM
2886 006264  4535          JMS I   QCRLF
2887 006265  4521          JMS I   QGENCOD         /STARTF
2888 006266  5043          SF-1
2889 006267  5773          JMP I   (OLLABL         /NOW THE INSIDE OF THE LOOP
2890 006270  0000  DUMSUB, 0                       /OUTPUT FLDA OR FSTA
2891                                               /WITH SE IF NEEDED
2892 006271  1670          TAD I   DUMSUB          /GET THE OPCODE
2893 006272  3303          DCA     LDASTA
2894 006273  2270          ISZ     DUMSUB
2895 006274  1030          TAD     TYPE1           /MUST WE SE ?
2896 006275  7110          CLL RAR         /TYPE1 IS 0 IF C, 1 IF D
2897 006276  7650          SNA CLA
2898 006277  1147          TAD     Q3              /MULTIPLIER IS 6
2899 006300  1147          TAD     Q3              /OR 3
2900 006301  3042          DCA     MQ
2901 006302  4523          JMS I   QOPCOD          /FLDA OR FSTA
2902 006303  0000  LDASTA, 0
2903 006304  1070          TAD     IOLOOP          /IS IT A LOOP ?
2904 006305  7650          SNA CLA
2905 006306  5332          JMP     EZVAR           /NO
2906 006307  1071          TAD     ARGIO           /IS IT AN ARG  ?
2907 006310  7640          SZA CLA
2908 006311  5335          JMP     IBASP3          /YES, INDIRECT THROUGH #BASE+3
2909 006312  4536          JMS I   QOTAB
2910 006313  1026          TAD     ARG1
2911 006314  6211          CDF     10              /OUTPUT NAME
2912 006315  4543          JMS I   QOUTNAM
2913 006316  1372          TAD     (255            /-
2914 006317  4562          JMS I   QOCHAR
2915 006320  1032          TAD     BASE2           /NEGATIVE OF SIZE
2916 006321  7041          CIA
2917 006322  4557          JMS I   QMUL12          /TIMES 6 OR 3
2918 006323  4563          JMS I   QNUMBRO
2919 006324  1053          TAD     COMMA           /COMMA SEVEN
2920 006325  4562          JMS I   QOCHAR
2921 006326  1371          TAD     (261
2922 006327  4562          JMS I   QOCHAR
2923 006330  4535          JMS I   QCRLF
2924 006331  5670          JMP I   DUMSUB          /RETURN
2925 006332  4525  EZVAR,  JMS I   QOADDR          /ITS A SCALAR
2926 006333  0026          ARG1
2927 006334  5670          JMP I   DUMSUB
2928 006335  1370  IBASP3, TAD     (245            /INDIRECT THROUGH #BASE+3
2929 006336  4562          JMS I   QOCHAR
2930 006337  4536          JMS I   QOTAB
2931 006340  1367          TAD     (XBPC2P         /FLDA%  #BASE+3,2+
2932 006341  4537          JMS I   QOUTSYM
2933 006342  4535          JMS I   QCRLF
2934 006343  5670          JMP I   DUMSUB
2935 006344  4302  XBPC2P, TEXT    '#BASE+3,2+'
     006345  0123  
     006346  0553  
     006347  6354  
     006350  6253  
     006351  0000  
2936 006352  4514  OR,     JMS I   QCODE
2937 006353  6173          ORTABL-6;0
     006354  0000  
2938 006355  5766          JMP I   (RELGEN
2939 006356  4514  XOR,    JMS I   QCODE
2940 006357  6223          EQVTBL-6;0
     006360  0000  
2941 006361  5766          JMP I   (RELGEN
2942 006362  5653  DOTP2,  TEXT    '.+2'
     006363  6200  
2943 006364  4330  ZXR,    TEXT    '#XR'
     006365  2200  
2944 006366  0440          PAGE
     006367  6344  
     006370  0245  
     006371  0261  
     006372  0255  
     006373  6056  
     006374  3603  
     006375  6640  
     006376  2353  
     006377  1012  
2945               / ASSIGNED GOTO AND ASSIGN
2946               
2947 006400  4777  AGOTO,  JMS     GTSTUF          /LOOK AT THE ASSIGNED VAR
2948 006401  4521          JMS I   QGENCOD         /GENERATE A JAC
2949 006402  5010          AGTCOD-1
2950 006403  5511          JMP I   QNEXT
2951 006404  4540  ASSIGN, JMS I   QGARG           /GET THE ASSIGN VAR
2952 006405  5776          JMP     GTTYPE
2953 006406  7146          CLL CMA RTL             /MUST BE I OR R
2954 006407  1030          TAD     TYPE1
2955 006410  7700          SMA CLA
2956 006411  5776          JMP     GTTYPE          /GOTO TYPE ERROR
2957 006412  4521          JMS I   QGENCOD         /GENERATE THE ASSIGN CODE
2958 006413  5013          ASNCOD-1
2959 006414  4775          JMS I   (JAGEN
2960 006415  4521          JMS I   QGENCOD         /NOW STORE IT
2961 006416  5067          ASTOR-1
2962 006417  5511          JMP I   QNEXT
2963               / OPTIMIZER SUBROUTINES
2964 006420  0000  CHEKXR, 0                       /KILL XR EXPRS
2965 006421  7041          CIA                     /ASSOCIATED WITH THIS VAR
2966 006422  3261          DCA     KILVAR          /SINCE IT HAS
2967                                               /JUST BEEN CHANGED
2968 006423  1374          TAD     (-7             /LOOK AT XR 1 THRU 7
2969 006424  3024          DCA     TEMP            /COUNT
2970 006425  1373          TAD     (XRBUFR+20      /POINTER
2971 006426  3025          DCA     TEMP2
2972 006427  1425  KILLUP, TAD I   TEMP2           /GET NEXT XR
2973                                               /EXPR. INDICATOR
2974 006430  7650          SNA CLA
2975 006431  5253          JMP     EOKL            /NOTHING HERE
2976 006432  1025          TAD     TEMP2           /GET POINTER
2977 006433  3013          DCA     X13             /INTO AN XR
2978 006434  1413          TAD I   X13             /GET ADDR OF DIB
2979 006435  3047          DCA     DIMPTR          /SAVE IT
2980 006436  6211          CDF     10              /FIELD OF SYMBOL TABLE
2981 006437  1447          TAD I   DIMPTR          /GET NUMBER OF
2982                                               /DIMENSIONS
2983 006440  7040          CMA                     /COMPLIMENTED
2984 006441  3050          DCA     NARGS           /SAVE IT
2985 006442  6201          CDF                     /BACK TO FIELD OF XRBUFR
2986 006443  2050  CHKKIL, ISZ     NARGS           /CHECK 1 LESS
2987                                               /THAN THE NUMBER
2988 006444  7410          SKP                     /OF DIMENSIONS
2989 006445  5253          JMP     EOKL
2990 006446  1413          TAD I   X13             /LOOK AT NEXT
2991                                               /ELEMENT OF EXPR
2992 006447  1261          TAD     KILVAR          /IS IT THE VAR
2993                                               /JUST CHANGED ?
2994 006450  7650          SNA CLA
2995 006451  3425          DCA I   TEMP2           /YES, KILL THIS EXPRESSION
2996 006452  5243          JMP     CHKKIL          /LOOP
2997 006453  1025  EOKL,   TAD     TEMP2           /DO NEXT XR
2998 006454  1141          TAD     Q20
2999 006455  3025          DCA     TEMP2           /BUMP POINTER BY 16
3000 006456  2024          ISZ     TEMP
3001 006457  5227          JMP     KILLUP
3002 006460  5620          JMP I   CHEKXR          /RETURN
3003               KILVAR,
3004 006461  0000  XRTABL, 0                       /CLEAR OR RESET
3005                                               /XR TABLE FLAGS
3006 006462  3023          DCA     TYPE            /0=CLEAR  1=RESET
3007 006463  1374          TAD     (-7             /DO XR1 THRU 7
3008 006464  3024          DCA     TEMP            /COUNT
3009 006465  1373          TAD     (XRBUFR+20      /POINTER
3010 006466  3025          DCA     TEMP2
3011 006467  1425  XRTLUP, TAD I   TEMP2           /GET INDICATOR
3012 006470  7650          SNA CLA
3013 006471  5274          JMP     .+3             /DON'T CHANGE IF ZERO
3014 006472  1023          TAD     TYPE            /OTHERWISE SET TO
3015 006473  3425          DCA I   TEMP2           /'USED BY
3016                                               /PREVIOUS STMT'
3017 006474  1025          TAD     TEMP2           /GET TO NEXT ONE
3018 006475  1141          TAD     Q20
3019 006476  3025          DCA     TEMP2           /BUMPING BY 16
3020 006477  2024          ISZ     TEMP
3021 006500  5267          JMP     XRTLUP          /LOOP
3022 006501  5661          JMP I   XRTABL          /DONE
3023 006502  0000  LOADA,  0                       /GENERATE AN FLDA
3024 006503  1702          TAD I   LOADA           /IF NECESSARY
3025 006504  3324          DCA     LODARG          /GET ARG POINTER
3026 006505  2302          ISZ     LOADA           /BUMP RETURN
3027 006506  1724          TAD I   LODARG          /DOES AC MATCH ?
3028 006507  1044          TAD     WHATAC
3029 006510  7640          SZA CLA
3030 006511  5321          JMP     DOLOAD          /NO, MUST LOAD
3031 006512  1324          TAD     LODARG          /GET ADDRESS
3032 006513  7001          IAC                     /OF BASE
3033 006514  3037          DCA     ARG             /IN CASE SS'D
3034 006515  1437          TAD I   ARG             /DOES BASE MATCH?
3035 006516  1045          TAD     WHATBS
3036 006517  7650          SNA CLA
3037 006520  5702          JMP I   LOADA           /OK, DON'T LOAD
3038 006521  4523  DOLOAD, JMS I   QOPCOD          /GENERATE FLDA
3039 006522  1012          FLDA
3040 006523  4525          JMS I   QOADDR          /ADDRESS
3041 006524  0000  LODARG, 0
3042 006525  5702          JMP I   LOADA
3043 006573  6620          PAGE
     006574  7771  
     006575  1536  
     006576  1563  
     006577  1546  
3044               / INTER PASS EQUATES
3045                       BLNKCN=21
3046                       ALIST=23
3047                       INTLST=60
3048                       FPLIST=56
3049                       DPLIST=57
3050                       CMPLST=61
3051                       HOLIST=55
3052                       SNLIST=62
3053                       ONEI=63
3054                       THREE=70
3055                       SIX=75
3056                       TRUE=102
3057               / START PASS 2 (INTER PASS COMMUNICATION)
3058                       IFNZRO  OVERLY <
3059                       FIELD   0
3060                       NOPUNCH
3061                       *OVRLAY>
3062                       IFZERO  OVERLY <
3063                       FIELD   0
3064                       ENPUNCH
3065                       *OVRLAY>
3066 005000  5570  START2, JMP I   Q7605           /RETURN BUT DON'T SAVE CORE
3067 005001  1410          TAD I   X10             /PICK UP NEXT FROM PASS 1
3068 005002  3017          DCA     X17
3069 005003  1017          TAD     X17             /SAVE POINTER TO
3070                                               /EXTERNAL LITERALS
3071 005004  3066          DCA     EXTLIT
3072 005005  1410          TAD I   X10             /PASS ONE STACK LEVEL
3073 005006  3011          DCA     X11
3074 005007  1410          TAD I   X10             /TEMP FILE START
3075 005010  3777          DCA     INBLOK
3076 005011  1410          TAD I   X10             /AND SIZE
3077 005012  7040          CMA
3078 005013  3776          DCA     INRCNT
3079 005014  1410          TAD I   X10             /START OF PASS2O.SV
3080 005015  3775          DCA     PASS2O
3081 005016  1410          TAD I   X10             /START OF OUTPUT FILE
3082 005017  3007          DCA     FILBLK          /SAVE IT FOR CHAINING TO RALF
3083 005020  1007          TAD     FILBLK
3084 005021  3774          DCA     OBLOCK
3085 005022  1410          TAD I   X10
3086 005023  3773          DCA     OSIZE           /ALSO MAX SIZE
3087 005024  1410          TAD I   X10             /PICK UP PROG NAME
3088 005025  3061          DCA     PROGNM
3089 005026  1410          TAD I   X10
3090 005027  3063          DCA     ARGLST          /AND ARG LIST ADDR
3091 005030  1410          TAD I   X10             /AND
3092                                               /FUNCTION/SUBROUTINE/MAIN SWITCH
3093 005031  3062          DCA     FUNCTN
3094 005032  1410          TAD I   X10             /GET DP HARDWARE SWITCH
3095 005033  3104          DCA     DPUSED
3096 005034  1410          TAD I   X10             /CHECK FOR CROSSED VERSIONS
3097 005035  1004          TAD     VERS
3098 005036  7640          SZA CLA
3099 005037  5346          JMP     VERROR          /VERSION ERROR
3100 005040  7360          STA STL                 /V3C
3101 005041  1011  DCLOOP, TAD     X11             /V3C THIS ADD CLEARS THE LINK
3102 005042  3011          DCA     X11             /V3C
3103 005043  1011          TAD     X11
3104 005044  1372          TAD     (-STACK1
3105 005045  7620          SNL CLA
3106 005046  5260          JMP     PSN             /GO DO STMT NUMBERS
3107 005047  1411          TAD I   X11             /GET DO LOOP ENDING STMT NUMBER
3108 005050  7001          IAC
3109 005051  3010          DCA     X10
3110 005052  6211          CDF     10
3111 005053  1371          TAD     (0416           /DN  DO END MISSING
3112 005054  4770          JMS     NPRNT           /GO PRINT THE MESSAGE
3113                                               /AND THE NUMBER
3114 005055  6201          CDF
3115 005056  7146          CLL CMA RTL
3116 005057  5241          JMP     DCLOOP          /V3C BACK UP 2
3117 005060  1367  PSN,    TAD     (SNLIST         /PROCESS STMT NUMBERS
3118 005061  6211          CDF     10
3119 005062  3020  SNCLUP, DCA     ENTRY           /SAVE NEW ENTRY ADDR
3120 005063  1420          TAD I   ENTRY           /GET ADDR OF NEXT ENTRY
3121 005064  7450          SNA
3122 005065  5303          JMP     SNDONE          /NO MORE STMT NUMBERS
3123 005066  7001          IAC
3124 005067  3024          DCA     TEMP            /ADDR OF TYPE WORD
3125 005070  1424          TAD I   TEMP            /WAS STMT NUMBER DEFINED?
3126 005071  7710          SPA CLA
3127 005072  5277          JMP     SNDEFN          /YES
3128 005073  1024          TAD     TEMP
3129 005074  3010          DCA     X10
3130 005075  1366          TAD     (2523           /PRINT US MESSAGE
3131 005076  4770          JMS     NPRNT
3132 005077  1365  SNDEFN, TAD     (0110           /SET TYPE WORD
3133 005100  3424          DCA I   TEMP
3134 005101  1420          TAD I   ENTRY           /PROCEED
3135 005102  5262          JMP     SNCLUP
3136 005103  6201  SNDONE, CDF
3137 005104  4764  FIXELP, JMS I   (TYPRTN
3138 005105  6447          NEGSLV          /FIX UP NEGATIVE EQUIVALENCE OFFSETS
3139 005106  7126          CLL CML RTL             /CHECK FOR BLOCK DATA
3140 005107  1062          TAD     FUNCTN          /(FUNCTN=-2)
3141 005110  7650          SNA CLA
3142 005111  5321          JMP     BDSTUF          /IT IS
3143 005112  4764          JMS I   (TYPRTN         /DO IMPLICIT TYPING
3144 005113  7000          IMPLCT
3145 005114  4764          JMS I   (TYPRTN         /REMOVE SUB ARGS FROM LIST
3146 005115  5131          SUBARG
3147 005116  4764          JMS I   (TYPRTN         /EXTERNALS
3148 005117  7056          EXTRNL
3149 005120  5763          JMP I   (PROLG1         /MORE PROLOG
3150 005121  1762  BDSTUF, TAD I   (BDSWIT         /SET UP SWITCH
3151 005122  3761          DCA I   (PROLG2
3152 005123  1360          TAD     (END2           /ALTER END CODE
3153 005124  6211          CDF 10
3154 005125  3757          DCA I   (XEND
3155 005126  6201          CDF 0
3156 005127  3756          DCA     NODBUG          /NO ISN'S
3157 005130  5755          JMP I   (HOLDUN         /DO SOME STUFF
3158 005131  0000  SUBARG, 0                       /REMOVE ARGS FROM ST
3159 005132  1423          TAD I   TYPE
3160 005133  0141          AND     Q20             /CHECK ARG BIT
3161 005134  7650          SNA CLA
3162 005135  5731          JMP I   SUBARG
3163 005136  4340          JMS     UNHOOK
3164 005137  5754          JMP     TFUDGE
3165               
3166 005140  0000  UNHOOK, 0
3167 005141  1420          TAD I   ENTRY
3168 005142  3421          DCA I   OENTRY
3169 005143  1022          TAD     BUCKET
3170 005144  3420          DCA I   ENTRY
3171 005145  5740          JMP I   UNHOOK
3172               
3173 005146  1353  VERROR, TAD     (2605           /PRINT VE (VERSION ERROR)
3174 005147  4565          JMS I   QTTYP2C
3175 005150  4566          JMS I   QTTCRLF
3176 005151  5570          JMP I   Q7605
3177 005153  2605          PAGE
     005154  7414  
     005155  5501  
     005156  6133  
     005157  6604  
     005160  4267  
     005161  5600  
     005162  5615  
     005163  5200  
     005164  7400  
     005165  0110  
     005166  2523  
     005167  0062  
     005170  6434  
     005171  0416  
     005172  3100  
     005173  0563  
     005174  0544  
     005175  7555  
     005176  0627  
     005177  0611  
3178               / GENERATE ARGUMENT STORAGE
3179               
3180 005200  4777  PROLG1, JMS I   (INS2           /       %JA     #ST
3181 005201  3657          JA;XST
     005202  6715  
3182 005203  4776          JMS I   (INS            /#XR,   %ORG    .+10
3183 005204  6707          XXR;ORG;DP8
     005205  2161  
     005206  1166  
3184 005207  4524          JMS I   QOPCDE          /       %TEXT   #NAMEXX#
3185 005210  6742          TEXTX
3186 005211  1054          TAD     PLUS
3187 005212  4562          JMS I   QOCHAR
3188 005213  6211          CDF     10
3189 005214  1061          TAD     PROGNM
3190 005215  4543          JMS I   QOUTNAM
3191 005216  4775          JMS I   (FILL           /FILL WITH BLANKS
3192 005217  1054          TAD     PLUS
3193 005220  4562          JMS I   QOCHAR
3194 005221  2061          ISZ     PROGNM
3195 005222  4535          JMS I   QCRLF
3196 005223  4776          JMS I   (INS            /#RET,  %SETX   #XR
3197 005224  6704          XRET;SETX;XXR
     005225  6734  
     005226  6707  
3198 005227  4777          JMS I   (INS2           /       %SETB   #BASE
3199 005230  6737          SETB;XBASE
     005231  3600  
3200 005232  4777          JMS I   (INS2           /       %JA     .+3
3201 005233  3657          JA
3202 005234  6751  XDP3,   DP3
3203 005235  4776          JMS I   (INS            /#BASE, %ORG    .+6
3204 005236  3600          XBASE;ORG;DP6
     005237  2161  
     005240  6753  
3205 005241  1063          TAD     ARGLST          /ANY ARGS ?
3206 005242  7450          SNA
3207 005243  5327          JMP     NOARGS          /NO, SKIP THIS STUFF
3208 005244  3010          DCA     X10             /SAVE POINTER TO ARG LIST
3209 005245  6211          CDF     10              /HOW MANY ?
3210 005246  1463          TAD I   ARGLST
3211 005247  7041          CIA
3212 005250  3050          DCA     NARGS           /THIS MANY
3213 005251  3025          DCA     TEMP2           /ARRAY ARG COUNTER
3214 005252  4331  ARGLP1, JMS     PLSUB1          /OUTPUT DEFS FOR ARRAY
3215                                               /ARGS FIRST
3216 005253  7650          SNA CLA                 /SINCE THEY MUST BE
3217                                               /INDIRECTABLY
3218 005254  5256          JMP     NOARAY          /REFERENCABLE
3219 005255  2025          ISZ     TEMP2
3220 005256  2050  NOARAY, ISZ     NARGS
3221 005257  5252          JMP     ARGLP1          /PROCESS ENTIRE ARG LIST
3222 005260  6211          CDF     10
3223 005261  1463          TAD I   ARGLST          /GO THRU ARGS AGAIN
3224 005262  7141          CIA CLL
3225 005263  3050          DCA     NARGS
3226 005264  1063          TAD     ARGLST
3227 005265  3010          DCA     X10
3228 005266  1025          TAD     TEMP2           /HOW MANY ARRAY ARGS ?
3229 005267  1122          TAD     QM6
3230 005270  7450          SNA
3231 005271  5311          JMP     NISA            /NO INDIRECT LOCS LEFT
3232                                               /FOR SCALARS
3233 005272  3025          DCA     TEMP2
3234 005273  7630          SZL CLA
3235 005274  5367          JMP     TOOMNY          /TOO MANY ARRAY ARGS (>6)
3236 005275  4331  ARGLP2, JMS     PLSUB1          /NOW OUTPUT AS MANY INDIRECT
3237 005276  7640          SZA CLA                 /SCALAR ARGS AS POSSIBLE
3238 005277  5303          JMP     NOSCLR          /TO REDUCE THE PROLOG
3239 005300  2025          ISZ     TEMP2           /ROOM FOR ANY MORE
3240 005301  7410          SKP
3241 005302  5307          JMP     NISA2           /NO, THE REST MUST MOVE VALUES
3242 005303  2050  NOSCLR, ISZ     NARGS           /LOOP SOME MORE
3243 005304  5275          JMP     ARGLP2
3244 005305  4774          JMS I   (PLSUB2         /OUTPUT SOME TRACEBACK STUFF
3245 005306  5773          JMP I   (MORE           /GENERATE SCALAR,
3246                                               /LITERAL AND TEMP STORAGE
3247 005307  4774  NISA2,  JMS I   (PLSUB2
3248 005310  5323          JMP     NDLP3           /OUTPUT TRACEBACK
3249                                               /STUFF,THEN REST
3250 005311  4774  NISA,   JMS I   (PLSUB2         /GET PAST THE TRACEBACK STUFF
3251 005312  1371  ARGLP3, TAD     XM3             /GENERATE ORG .+6 FOR D OR C
3252 005313  3360          DCA     XNOP
3253 005314  4331          JMS     PLSUB1          /OUTPUT REMAINING
3254                                               /SCALAR ARG SPACE
3255 005315  7640          SZA CLA
3256 005316  5323          JMP     NDLP3
3257 005317  6211          CDF     10
3258 005320  1424          TAD I   TEMP            /TURN OFF SUBARG BIT
3259 005321  0372          AND     (7757           /(THATS THE
3260                                               /SECOND TIME I FIXED THIS)
3261               
3262 005322  3424          DCA I   TEMP
3263 005323  2050  NDLP3,  ISZ     NARGS
3264 005324  5312          JMP     ARGLP3
3265 005325  6201          CDF
3266 005326  5773          JMP I   (MORE           /GENERATE SCALAR,
3267                                               /LITERAL AND TEMP STORAGE
3268               
3269 005327  4774  NOARGS, JMS I   (PLSUB2         /NO ARGS, OUTPUT TRACEBACK STUFF
3270 005330  5773          JMP I   (MORE           /GENERATE SCALAR,
3271                                               /LITERAL AND TEMP STORAGE
3272 005331  0000  PLSUB1, 0       
3273 005332  6201          CDF
3274 005333  1731          TAD I   PLSUB1          /GET THE SKIP
3275 005334  3344          DCA     PLSKIP
3276 005335  2331          ISZ     PLSUB1
3277 005336  6211          CDF     10
3278 005337  1410          TAD I   X10             /GET THE NEXT ARG
3279 005340  7001          IAC
3280 005341  3024          DCA     TEMP            /TYP WORD ADDR
3281 005342  7132          CLL CML RTR             /2000=DIM BIT
3282 005343  0424          AND I   TEMP
3283 005344  0000  PLSKIP, 0                       /ARRAYS OR SCALARS ?
3284 005345  5731          JMP I   PLSUB1
3285 005346  2331          ISZ     PLSUB1
3286 005347  7240          CLA CMA
3287 005350  1024          TAD     TEMP            /DEFINE THIS VAR
3288 005351  4543          JMS I   QOUTNAM
3289 005352  1053          TAD     COMMA
3290 005353  4562          JMS I   QOCHAR
3291 005354  6211          CDF     10
3292 005355  1424          TAD I   TEMP            /LOOK AT THE TYPE
3293 005356  6201          CDF
3294 005357  4554          JMS I   QSKPIRL         /SKIP IF NOT C OR D
3295 005360  7000  XNOP,   NOP                     /THIS IS CHANGED LATER (MAYBE)
3296 005361  1234          TAD     XDP3            /.+3 OR .+6
3297 005362  3365          DCA     .+3
3298 005363  4777          JMS I   (INS2           /ORG FOR THE VALUE
3299 005364  2161          ORG;0
     005365  0000  
3300 005366  5731          JMP I   PLSUB1
3301 005367  1173  TOOMNY, TAD     P0F1            /TOO MANY ARRAY ARGS
3302 005370  5574          JMP I   P0F2
3303 005371  7126  XM3,    CLL CML RTL
3304 005372  7757          PAGE
     005373  5400  
     005374  6600  
     005375  6414  
     005376  6656  
     005377  6652  
3305               / SCALARS, LITERALS & TEMPS
3306               
3307               HOLLIT,
3308 005400  4777  MORE,   JMS I   (TYPRTN         /OUTPUT SCALARS
3309 005401  7263          SCALAR
3310 005402  1376          TAD     (TEMPS          /OUTPUT FIRST FIVE TEMPS
3311 005403  4775          JMS I   (OUTVAR
3312 005404  1374          TAD     (LITRL2
3313 005405  4537          JMS I   QOUTSYM
3314 005406  1053          TAD     COMMA           /OUTPUT %LITRL,
3315 005407  4562          JMS I   QOCHAR
3316 005410  4773          JMS I   (DOLIST
3317 005411  0060          INTLST
3318 005412  0141  O141,   0141;-3                 /OUTPUT INTEGER LITERALS
     005413  7775  
3319 005414  4773          JMS I   (DOLIST
3320 005415  0056          FPLIST
3321 005416  0142          0142;-3                 /OUTPUT FP LITERALS
     005417  7775  
3322 005420  4773          JMS I   (DOLIST
3323 005421  0057          DPLIST
3324 005422  0144          0144;-6                 /DOUBLE LITERALS
     005423  7772  
3325 005424  4773          JMS I   (DOLIST
3326 005425  0061          CMPLST
3327 005426  0143          0143;-6                 /COMPLEX LITERALS
     005427  7772  
3328 005430  4777          JMS I   (TYPRTN         /OUTPUT DIMENSION FACTORS
3329 005431  7015          DFLIT
3330 005432  4772          JMS I   (ADFLIT         /OUTPUT ARG DIM FACTOR LITERALS
3331 005433  1371          TAD     (HOLIST         /OUTPUT HOLLERITH LITERALS
3332 005434  3020          DCA     ENTRY
3333 005435  6211  HOLLUP, CDF     10
3334 005436  1420          TAD I   ENTRY
3335 005437  7450          SNA
3336 005440  5301          JMP     HOLDUN
3337 005441  3020          DCA     ENTRY           /SAVE NEW ENTYR
3338 005442  1020          TAD     ENTRY
3339 005443  3010          DCA     X10
3340 005444  1212          TAD     O141            /SET TYPE INFO
3341 005445  3410          DCA I   X10
3342 005446  1036          TAD     LITNUM
3343 005447  3410          DCA I   X10             /SAVE LIT DISP
3344 005450  7146          CLL CMA RTL             /SET UP COUNTER
3345 005451  3200          DCA     HOLLIT          /BY THREES
3346 005452  6211  HOLOOP, CDF     10              /OUTPUT LITERAL AS OCTALS
3347 005453  1410          TAD I   X10
3348 005454  6201          CDF
3349 005455  7450          SNA
3350 005456  5274          JMP     HOFILL          /FILL OUT REST
3351 005457  3037          DCA     ARG
3352 005460  1037          TAD     ARG
3353 005461  0370          AND     (77             /IS THIS LAST WORD?
3354 005462  7640          SZA CLA
3355 005463  5267          JMP     .+4             /NO
3356 005464  1037          TAD     ARG             /YES, STICK IN
3357 005465  1142          TAD     Q40             /BLANK
3358 005466  5275          JMP     HOFILL+1        /AND OUTPUT IT
3359 005467  1037          TAD     ARG             /OUTPUT CHAR PAIR
3360 005470  4767          JMS     ONUM
3361 005471  2200          ISZ     HOLLIT
3362 005472  5252          JMP     HOLOOP
3363 005473  5250          JMP     HOLOOP-2
3364 005474  1366  HOFILL, TAD     (4040           /FILL WITH BLANKS
3365 005475  4767          JMS     ONUM
3366 005476  2200          ISZ     HOLLIT
3367 005477  5274          JMP     HOFILL
3368 005500  5235          JMP     HOLLUP          /DO NEXT HOLLERITH LITERAL
3369 005501  6201  HOLDUN, CDF
3370 005502  4777          JMS I   (TYPRTN         /DO ARRAYS
3371 005503  6400          ARRAYS
3372 005504  4777          JMS I   (TYPRTN         /REMOVE COMMON VARS FROM S.T.
3373 005505  7355          COMVAR
3374 005506  4536          JMS I   QOTAB
3375 005507  1365          TAD     (XLBLE          /#LBL=.
3376 005510  4537          JMS I   QOUTSYM
3377 005511  4535          JMS I   QCRLF
3378 005512  6211          CDF     10              /LOOK AT THE BLANK COMMON LIST
3379 005513  1764          TAD I   (ONEI+2         /MAKE TRUE=INTEGER ONE
3380 005514  3763          DCA I   (TRUE+2
3381 005515  1762          TAD I   (BLNKCN+1
3382 005516  6201          CDF
3383 005517  7450          SNA
3384 005520  5347          JMP     NOBC            /NO BLANK COMMON
3385 005521  3023          DCA     TYPE            /POINTER TO VARIABLE LIST
3386 005522  4523          JMS I   QOPCOD
3387 005523  7367          COMMON
3388 005524  4535          JMS I   QCRLF
3389 005525  6211          CDF     10
3390 005526  1023  BCLOOP, TAD     TYPE            /PROCESS THIS HUNK OF
3391                                               /BLANK COMMON
3392 005527  3010          DCA     X10
3393 005530  1410          TAD I   X10
3394 005531  7450          SNA
3395 005532  5342          JMP     NXTBC           /EMPTY HUNK
3396 005533  7041          CIA                     /SIZE OF HUNK
3397 005534  3024          DCA     TEMP
3398 005535  1410          TAD I   X10             /OUTPUT HUNK
3399 005536  4775          JMS I   (OUTVAR
3400 005537  6211          CDF     10
3401 005540  2024          ISZ     TEMP
3402 005541  5335          JMP     .-4
3403 005542  1423  NXTBC,  TAD I   TYPE            /ADDR OF NEXT HUNK
3404 005543  7450          SNA
3405 005544  5347          JMP     NOBC            /THAT WAS THE LAST HUNK
3406 005545  3023          DCA     TYPE
3407 005546  5326          JMP     BCLOOP          /DO NEXT HUNK
3408 005547  6201  NOBC,   CDF
3409 005550  4777          JMS I   (TYPRTN         /DO NAMED COMMONS
3410 005551  7433          COMNAM
3411 005552  4777          JMS I   (TYPRTN         /NOW EQUIVALENCES
3412 005553  7107          EQUIVS
3413 005554  4761          JMS     INS2
3414 005555  2161          ORG;XLBL                /%ORG #LBL
     005556  6773  
3415 005557  5760          JMP I   (PROLG2         /COMPLETE PROLOG
3416 005560  5600          PAGE
     005561  6652  
     005562  0022  
     005563  0104  
     005564  0065  
     005565  6765  
     005566  4040  
     005567  6156  
     005570  0077  
     005571  0055  
     005572  7477  
     005573  7274  
     005574  7364  
     005575  7203  
     005576  7346  
     005577  7400  
3417               / ARGUMENT PICKUP GENERATOR
3418               
3419 005600  1062  PROLG2, TAD     FUNCTN          /SECOND PART OF PROLOG
3420 005601  7640          SZA CLA
3421 005602  5216          JMP     DORETN          /NOT A MAIN PROG
3422 005603  4777          JMS I   (INS            /#ST,   BASE    #BASE
3423 005604  6715          XST;BASE;XBASE
     005605  7200  
     005606  3600  
3424 005607  4776          JMS I   (INS2           /       SETB    #BASE
3425 005610  6737          SETB;XBASE
     005611  3600  
3426 005612  4776          JMS I   (INS2           /       SETX    #XR
3427 005613  6734          SETX;XXR
     005614  6707  
3428 005615  5775  BDSWIT, JMP I   (FINIST         /GO GET OVERLAY
3429 005616  4777  DORETN, JMS I   (INS            /#RTN,  BASE    #BASE
3430 005617  3640          XRTN;BASE;XBASE
     005620  7200  
     005621  3600  
3431 005622  1063          TAD     ARGLST          /ANY ARGS ?
3432 005623  7450          SNA
3433 005624  5316          JMP     JAGOBK          /NO
3434 005625  3010          DCA     X10             /POINTER TO THE LIST
3435 005626  6211          CDF     10
3436 005627  1463          TAD I   ARGLST          /NUMBER OF ARGS
3437 005630  7041          CIA
3438 005631  3050          DCA     NARGS
3439 005632  3025          DCA     TEMP2           /ZERO ARG COUNTER
3440 005633  6201          CDF
3441 005634  1050          TAD     NARGS           /WILL WE RESTORE ANY ?
3442 005635  1374          TAD     (6
3443 005636  7700          SMA CLA
3444 005637  5316          JMP     JAGOBK          /NO
3445 005640  4776          JMS I   (INS2           /       FLDA    #ARGS
3446 005641  1012          FLDA;XARGS
     005642  5764  
3447 005643  4776          JMS I   (INS2           /       FSTA    #BASE
3448 005644  1567          FSTA;XBASE
     005645  3600  
3449 005646  6211  RSLOOP, CDF     10
3450 005647  1410          TAD I   X10             /GET NEXT ARG
3451 005650  7001          IAC
3452 005651  3024          DCA     TEMP            /ADDR OF TYPE WORD
3453 005652  2025          ISZ     TEMP2           /INCR COUNT
3454 005653  1424          TAD I   TEMP            /IS IT A VALUE TRANSMISSION ?
3455 005654  0141          AND     Q20
3456 005655  6201          CDF
3457 005656  7640          SZA CLA
3458 005657  5312          JMP     NOREST          /NO, DON'T RESTORE IT
3459 005660  4524          JMS I   QOPCDE          /       %LDX    XXXX,1
3460 005661  3622          LDX
3461 005662  1025          TAD     TEMP2
3462 005663  4516          JMS I   QONUMBR
3463 005664  1373          TAD     (C1
3464 005665  4537          JMS I   QOUTSYM
3465 005666  4535          JMS I   QCRLF
3466 005667  4521          JMS I   QGENCOD         /STARTD
3467 005670  5035          SD-1
3468 005671  4776          JMS I   (INS2           /GET POINTER TO ARG
3469 005672  6757          FLDAI;XBASC1
     005673  6745  
3470 005674  4776          JMS I   (INS2           /AND SAVE IN #BASE+3
3471 005675  1567          FSTA;XBASP3
     005676  3603  
3472 005677  4351          JMS     STFORE          /INTO CORRECT MODE
3473 005700  4524          JMS I   QOPCDE          /FLDA VAR
3474 005701  1012          FLDA
3475 005702  7040          CMA
3476 005703  1024          TAD     TEMP
3477 005704  6211          CDF     10
3478 005705  4543          JMS I   QOUTNAM
3479 005706  4535          JMS I   QCRLF
3480 005707  4776          JMS I   (INS2           /       FSTA%   #BASE+3
3481 005710  6762          FSTAI;XBASP3
     005711  3603  
3482 005712  2050  NOREST, ISZ     NARGS
3483 005713  5246          JMP     RSLOOP
3484 005714  4521          JMS I   QGENCOD         /MAKE SURE WE'RE IN F MODE
3485 005715  5043  QSFM1,  SF-1
3486 005716  1062  JAGOBK, TAD     FUNCTN          /WHAT WAS THIS ?
3487 005717  7710          SPA CLA
3488 005720  5332          JMP     NOFVAL          /NOT A FUNCTION
3489 005721  6211          CDF     10              /GET TYPE
3490 005722  1461          TAD I   PROGNM
3491 005723  0126          AND     Q17
3492 005724  1372          TAD     (FVAL-1         /PLUS TABLE ADDRESS
3493 005725  3331          DCA     GVSKEL          /GIVES POINTER TO
3494                                               /SKELETON ADDRESS
3495 005726  1731          TAD I   GVSKEL          /GET SKELETON ADDRESS
3496 005727  3331          DCA     GVSKEL
3497 005730  4521          JMS I   QGENCOD         /PICK UP FUNCTION VALUE
3498 005731  0000  GVSKEL, 0
3499 005732  4776  NOFVAL, JMS I   (INS2           /       JA      #GOBAK
3500 005733  3657          JA;XGOBAK
     005734  6711  
3501 005735  4777          JMS I   (INS            /#ST,   %STARTD
3502 005736  6715          XST;STARTD;0
     005737  3147  
     005740  0000  
3503 005741  4536          JMS I   QOTAB
3504 005742  1371          TAD     (210            /       %FLDA'  10
3505 005743  4516          JMS I   QONUMBR
3506 005744  4535          JMS I   QCRLF
3507 005745  4776          JMS I   (INS2           /       %FSTA   #GOBAK,0
3508 005746  1567          FSTA;XGOBC0
     005747  6717  
3509 005750  5770          JMP I   (MORPLG
3510               
3511 005751  0000  STFORE, 0                       /START F OR E
3512 005752  6211          CDF     10
3513 005753  1424          TAD I   TEMP            /GET TYPE
3514 005754  6201          CDF
3515 005755  4554          JMS I   QSKPIRL         /SKIP ON I R OR L
3516 005756  1367          TAD     (SE-SF          /SE
3517 005757  1315          TAD     QSFM1           /SF
3518 005760  3362          DCA     .+2
3519 005761  4521          JMS I   QGENCOD
3520 005762  0000          0
3521 005763  5751          JMP I   STFORE          /DON'T FORGET TO
3522                                               /RETURN DUMMY
3523 005764  4301  XARGS,  TEXT    '#ARGS'
     005765  2207  
     005766  2300  
3524 005767  7775          PAGE
     005770  6000  
     005771  0210  
     005772  5116  
     005773  6771  
     005774  0006  
     005775  6120  
     005776  6652  
     005777  6656  
3525               / ENTRY AND EXIT CODE
3526               
3527 006000  4536  MORPLG, JMS I   QOTAB
3528 006001  1145          TAD     Q200            /       FLDA'   0
3529 006002  4516          JMS I   QONUMBR
3530 006003  4535          JMS I   QCRLF
3531 006004  4777          JMS I   (INS2           /       %SETX   #XR
3532 006005  6734          SETX;XXR
     006006  6707  
3533 006007  4777          JMS I   (INS2           /       %SETB   #BASE
3534 006010  6737          SETB;XBASE
     006011  3600  
3535 006012  1063          TAD     ARGLST          /ANY ARGS ?
3536 006013  7450          SNA
3537 006014  5776          JMP I   (ENDPLG         /NO, JUST STARTF
3538 006015  3037          DCA     ARG             /SAVE POINTER TO THEM
3539 006016  4777          JMS I   (INS2           /       %LDX    0,1
3540 006017  3622          LDX;ZC1
     006020  6755  
3541 006021  4777          JMS I   (INS2           /       %FSTA   #BASE
3542 006022  1567          FSTA;XBASE
     006023  3600  
3543 006024  4777          JMS I   (INS2           /       %FSTA   #ARGS
3544 006025  1567          FSTA;XARGS
     006026  5764  
3545 006027  6211          CDF     10
3546 006030  1463          TAD I   ARGLST          /NUMBER OF ARGS
3547 006031  7041          CIA
3548 006032  3050          DCA     NARGS
3549 006033  6201  GALOOP, CDF
3550 006034  4777          JMS I   (INS2           /       %FLDA I #BASE,1+
3551 006035  6757          FLDAI;XBAC1P
     006036  1752  
3552 006037  3023          DCA     TYPE            /CLEAR THE SD SWITCH
3553 006040  6211          CDF     10
3554 006041  2037          ISZ     ARG             /GET TO NEXT ARG
3555 006042  1437          TAD I   ARG             /LOOK AT ITS TYPE WORD
3556 006043  7001          IAC
3557 006044  3024          DCA     TEMP
3558 006045  7132          CLL CML RTR
3559 006046  0424          AND I   TEMP            /WAS IT DIMENSIONED ?
3560 006047  7650          SNA CLA
3561 006050  5775          JMP I   (TSTABT         /NO, SEE IF ITS VALUE
3562 006051  7040          CMA
3563 006052  1024          TAD     TEMP            /GET ADDR OF DIM INFO
3564 006053  4551          JMS I   QGETSS
3565 006054  7001          IAC                     /ADDR OF SIZE
3566 006055  3025          DCA     TEMP2
3567 006056  1425          TAD I   TEMP2
3568 006057  2025          ISZ     TEMP2
3569 006060  2025          ISZ     TEMP2
3570 006061  7650          SNA CLA
3571 006062  5277          JMP     OUFSTA+1        /IT HAS A VARIABLE DIMENSION
3572 006063  1425          TAD I   TEMP2           /GET MAGIC NUMBER LIT DISP
3573 006064  3025          DCA     TEMP2
3574 006065  6201          CDF
3575 006066  4524          JMS I   QOPCDE          /       %FSUB   #LIT+XXXX
3576 006067  1015          FSUB
3577 006070  1144          TAD     QLITRL
3578 006071  4537          JMS I   QOUTSYM
3579 006072  1025          TAD     TEMP2
3580 006073  4516          JMS I   QONUMBR
3581 006074  4535          JMS I   QCRLF
3582 006075  6211          CDF     10
3583 006076  3437  OUFSTA, DCA I   ARG             /IT ISN'T VARIABLY DIMENSIONED
3584 006077  6201          CDF
3585 006100  4524          JMS I   QOPCDE          /       %FSTA   ARGN
3586 006101  1567          FSTA
3587 006102  6211          CDF     10
3588 006103  7040          CMA
3589 006104  1024          TAD     TEMP
3590 006105  4543          JMS I   QOUTNAM
3591 006106  4535          JMS I   QCRLF
3592 006107  2050          ISZ     NARGS
3593 006110  7410          SKP
3594 006111  5776          JMP I   (ENDPLG         /END OF PROLOG
3595 006112  1023          TAD     TYPE            /DID WE LEAVE D MODE
3596 006113  7650          SNA CLA
3597 006114  5233          JMP     GALOOP          /NO
3598 006115  4521          JMS I   QGENCOD         /YES, OUTPUT AN %SD
3599 006116  5035          SD-1
3600 006117  5233          JMP     GALOOP
3601 006120  6211  FINIST, CDF     10
3602 006121  1062          TAD     FUNCTN          /WAS THIS A FUNCTION ?
3603 006122  7750          SPA SNA CLA
3604 006123  5327          JMP     .+4             /NO, SKIP THIS
3605 006124  1461          TAD I   PROGNM          /YES, TURN OFF EXT BIT
3606 006125  0374          AND     (6777           /ALLOWING STORING IN FUN NAME
3607 006126  3461          DCA I   PROGNM
3608 006127  1373          TAD     (2200           /CHECK /N /Q
3609 006130  0772          AND I   (7644
3610 006131  6201          CDF
3611 006132  7650          SNA CLA
3612 006133  3771  NODBUG, DCA I   (DEBUG          /IF NOT SET, PUT ISN'S
3613 006134  6211          CDF     10              /INTO CODE
3614 006135  1772          TAD I   (7644           /IS /Q SET ?
3615 006136  6201          CDF
3616 006137  0370          AND     (0200
3617 006140  7640          SZA CLA
3618 006141  2767          ISZ I   (OPTMYZ         /MAKE A CLA IAC FROM A CLA
3619 006142  6211  GFNAME, CDF     10
3620 006143  1753          TAD I   FNAME           /MOVE FILE NAME
3621 006144  6201          CDF
3622 006145  3754          DCA I   NAMEF           /INTO PAGE
3623 006146  2353          ISZ     FNAME
3624 006147  2354          ISZ     NAMEF
3625 006150  2355          ISZ     NFCNT
3626 006151  5342          JMP     GFNAME
3627 006152  5766          JMP I   (RDOVLY         /GO WHERE ?
3628                                               /CALIFORNIA OF COURSE!!!!
3629 006153  7601  FNAME,  7601
3630 006154  0072  NAMEF,  F1LNAM
3631 006155  7774  NFCNT,  -4
3632               
3633 006156  0000  ONUM,   0
3634 006157  2036          ISZ     LITNUM          /BUMP LITERAL COUNTER
3635 006160  3037          DCA     ARG
3636 006161  4536          JMS I   QOTAB
3637 006162  1037          TAD     ARG
3638 006163  4516          JMS I   QONUMBR
3639 006164  4535          JMS I   QCRLF
3640 006165  5756          JMP I   ONUM
3641 006166  7552          PAGE
     006167  2215  
     006170  0200  
     006171  2227  
     006172  7644  
     006173  2200  
     006174  6777  
     006175  6200  
     006176  6216  
     006177  6652  
3642               / ENTRY AND EXIT CODE
3643               
3644 006200  1424  TSTABT, TAD I   TEMP            /VALUE TRANSMISSION ?
3645 006201  0141          AND     Q20
3646 006202  7640          SZA CLA
3647 006203  5777          JMP I   (OUFSTA         /NO
3648 006204  6201          CDF
3649 006205  4776          JMS I   (INS2           /       %FSTA   #BASE+3
3650 006206  1567          FSTA;XBASP3
     006207  3603  
3651 006210  4775          JMS I   (STFORE         /ENTER CORRECT MODE
3652 006211  4776          JMS I   (INS2           /       %FLDA%  #BASE+3
3653 006212  6757          FLDAI;XBASP3
     006213  3603  
3654 006214  2023          ISZ     TYPE            /SET SWITCH
3655 006215  5774          JMP I   (OUFSTA-1
3656 006216  4521  ENDPLG, JMS I   QGENCOD         /%SF
3657 006217  5043          SF-1
3658 006220  1063          TAD     ARGLST          /ANY VARIABLY
3659                                               /DIMENSIONED ARRAYS ?
3660 006221  7450          SNA
3661 006222  5773          JMP I   (FINIST         /NO ARGS AT ALL
3662 006223  3010          DCA     X10
3663 006224  6211          CDF     10
3664 006225  1463          TAD I   ARGLST          /NUMBER OF ARGS
3665 006226  7041          CIA
3666 006227  3351          DCA     NSARGS
3667 006230  6211  VDIMLP, CDF     10
3668 006231  1410          TAD I   X10             /GET NEXT ARG
3669 006232  7450          SNA
3670 006233  5333          JMP     NDVDIM          /NOT A VARIABLY
3671                                               /DIMENSIONED ARRAY
3672 006234  3347          DCA     VDTEMP
3673 006235  1347          TAD     VDTEMP          /GET ADDR OF DIMENSION INFO
3674 006236  4551          JMS I   QGETSS
3675 006237  3350          DCA     VDTMP2
3676 006240  1750          TAD I   VDTMP2          /NUMBER OF DIMENSIONS
3677 006241  7041          CIA
3678 006242  3050          DCA     NARGS
3679 006243  2350          ISZ     VDTMP2          /MOVE TO MAGIC NUMBER LITERAL
3680 006244  2350          ISZ     VDTMP2
3681 006245  2350          ISZ     VDTMP2
3682 006246  1750          TAD I   VDTMP2          /GET IT
3683 006247  6201          CDF
3684 006250  3352          DCA     MNL             /SAVE MAGIC NUMBER LITERAL
3685 006251  1372          TAD     (FLDA           /JUST LOAD FIRST DIM
3686 006252  3361          DCA     MNOPC
3687 006253  1050          TAD     NARGS           /GET ADDRESS
3688 006254  7041          CIA                     /OF THE LAST
3689 006255  1350          TAD     VDTMP2          /DIMENSION
3690 006256  3350          DCA     VDTMP2          /FOR THE SIZE GETTER
3691 006257  5266          JMP     CMPMN3          /SKIP MULTIPLY FIRST TIME
3692 006260  1371  CMPMN1, TAD     (FMUL           /NEXT TIME USE A MULTIPLY
3693 006261  3361          DCA     MNOPC
3694 006262  4523          JMS I   QOPCOD          /NEXT SUBSCRIPT (ALWAYS (1.0)
3695 006263  1007          FADD
3696 006264  4525          JMS I   QOADDR          /NOW ADDRESS
3697 006265  6370          (ONEI
3698 006266  2050  CMPMN3, ISZ     NARGS           /ANY MORE SS ?
3699 006267  5337          JMP     CMPMN2          /YES
3700 006270  2347          ISZ     VDTEMP          /GET TO TYPE
3701 006271  6211          CDF     10
3702 006272  1747          TAD I   VDTEMP
3703 006273  6201          CDF
3704 006274  4554          JMS I   QSKPIRL         /SKIP ON I R L
3705 006275  1120          TAD     Q6M3            /YES
3706 006276  1367          TAD     (THREE
3707 006277  4356          JMS     LDAMUL          /3.02
3708 006300  4776          JMS I   (INS2           /ALN 0
3709 006301  3614          ALN;D0
     006302  3564  
3710 006303  4524          JMS I   QOPCDE
3711 006304  1567          FSTA
3712 006305  1144          TAD     QLITRL          /SAVE IN THE MAGIC
3713                                               /NUMBER LITERAL
3714 006306  4537          JMS I   QOUTSYM
3715 006307  7240          CLA CMA
3716 006310  1352          TAD     MNL
3717 006311  4516          JMS I   QONUMBR
3718 006312  4535          JMS I   QCRLF
3719 006313  4776          JMS I   (INS2           /FNEG
3720 006314  1572          FNEG;0
     006315  0000  
3721 006316  4776          JMS I   (INS2           /ENTER D MODE
3722 006317  3147          STARTD;0
     006320  0000  
3723 006321  4524          JMS I   QOPCDE
3724 006322  7166          FADDM                   /NOW MODIFY THE POINTER
3725 006323  7040          CMA
3726 006324  1347          TAD     VDTEMP
3727 006325  6211          CDF     10
3728 006326  4543          JMS I   QOUTNAM
3729 006327  4535          JMS I   QCRLF
3730 006330  4776          JMS I   (INS2           /RETURN TO F MODE
3731 006331  1134          STARTF;0
     006332  0000  
3732 006333  2351  NDVDIM, ISZ     NSARGS          /ANY MORE ARGS TO CHECK?
3733 006334  5230          JMP     VDIMLP          /YES
3734 006335  6201          CDF
3735 006336  5773          JMP I   (FINIST
3736 006337  7240  CMPMN2, CLA CMA                 /BACK UP THE POINTER
3737 006340  1350          TAD     VDTMP2          /BY ONE
3738 006341  3350          DCA     VDTMP2
3739 006342  6211          CDF     10
3740 006343  1750          TAD I   VDTMP2          /GET IT
3741 006344  6201          CDF
3742 006345  4356          JMS     LDAMUL          /3.02
3743 006346  5260          JMP     CMPMN1          /LOOP
3744 006347  0000  VDTEMP, 0
3745 006350  0000  VDTMP2, 0
3746 006351  0000  NSARGS, 0
3747 006352  0000  MNL,    0
3748 006353  5653  DP12,   TEXT    '.+14'
     006354  6164  
     006355  0000  
3749 006356  0000  LDAMUL, 0                       /3.02
3750 006357  3365          DCA     MNADR
3751 006360  4523          JMS I   QOPCOD
3752 006361  0000  MNOPC,  0
3753 006362  4525          JMS I   QOADDR
3754 006363  6365          MNADR
3755 006364  5756          JMP I   LDAMUL
3756 006365  0000  MNADR,  0
3757 006367  0070          PAGE
     006370  0063  
     006371  2353  
     006372  1012  
     006373  6120  
     006374  6075  
     006375  5751  
     006376  6652  
     006377  6076  
3758               / RANDOM PROLOG STUFF
3759               
3760 006400  0000  ARRAYS, 0                       /OUTPUT ARRAYS
3761 006401  1423          TAD I   TYPE
3762 006402  0377          AND     (6220           /IS IT AN ARRAY
3763 006403  7450          SNA
3764 006404  5600          JMP I   ARRAYS
3765 006405  0376          AND     (4220           /NOT COMMON, EQUIV OR ARG
3766 006406  7640          SZA CLA
3767 006407  5600          JMP I   ARRAYS
3768 006410  4775          JMS I   (UNHOOK         /REMOVE FROM BUCKET
3769 006411  1020          TAD     ENTRY           /OUTPUT VARIABLE
3770 006412  4774          JMS I   (OUTVAR
3771 006413  5773          JMP     TFUDGE-1
3772 006414  0000  FILL,   0                       /FILL SUB NAME WITH BLANKS
3773 006415  7126          CLL CML RTL
3774 006416  1061          TAD     PROGNM          /PROGNM+2
3775 006417  7041          CIA                     /-PROGNM-2
3776 006420  1633          TAD I   XNAMP           /1,2,3
3777 006421  1105          TAD     QM4             /-3,-2,-1
3778 006422  3024          DCA     TEMP
3779 006423  5230          JMP     .+5
3780 006424  1372          TAD     (240            /TWO BLANKS FOR EACH WORD
3781 006425  4562          JMS I   QOCHAR
3782 006426  1372          TAD     (240
3783 006427  4562          JMS I   QOCHAR
3784 006430  2024          ISZ     TEMP            /MORE ?
3785 006431  5224          JMP     .-5             /YES
3786 006432  5614          JMP I   FILL
3787 006433  0327  XNAMP,  NAMPTR
3788 006434  0000  NPRNT,  0
3789 006435  4565          JMS I   QTTYP2C
3790 006436  4565          JMS I   QTTYP2C
3791 006437  1410          TAD I   X10             /NOW NUMBER
3792 006440  4565          JMS I   QTTYP2C
3793 006441  1410          TAD I   X10
3794 006442  4565          JMS I   QTTYP2C
3795 006443  1410          TAD I   X10
3796 006444  4565          JMS I   QTTYP2C
3797 006445  4566          JMS I   QTTCRLF
3798 006446  5634          JMP I   NPRNT
3799               /ROUTINE TO FIX UP NEGATIVE EQUIVALENCE OFFSETS
3800               
3801 006447  0000  NEGSLV, 0
3802 006450  1423          TAD I   TYPE
3803 006451  0145          AND     Q200
3804 006452  7650          SNA CLA         /IS VARIABLE A SLAVE?
3805 006453  5647          JMP I   NEGSLV  /NO
3806 006454  1023          TAD     TYPE
3807 006455  3010          DCA     X10
3808 006456  1410          TAD I   X10     /GET POINTER TO EQUIV BLOCK
3809 006457  3010          DCA     X10
3810 006460  7201          CLA IAC
3811 006461  1410          TAD I   X10     /GET POINTER TO MASTER
3812 006462  3354          DCA     OLDM    /TYPE WORD
3813 006463  1410          TAD I   X10     /OFFSET FROM MASTER
3814 006464  7160          CMA STL
3815 006465  1410          TAD I   X10     /SUBTRACT FROM SLAVE OFFSET
3816 006466  3356          DCA     SFUDGE  /SAVE IN CASE WE NEED IT
3817 006467  1754          TAD I   OLDM    /IF MASTER IS IN COMMON FORGET THE NEXT TEST:
3818 006470  7730          SZL SPA CLA     /IF MASTER OFFSET < SLAVE OFFSET THEN
3819 006471  5647          JMP I   NEGSLV  /SLAVE WILL ORIGIN BEFORE MASTER -
3820 006472  1423          TAD I   TYPE    /THEREFORE THE SLAVE MUST BECOME THE MASTER
3821 006473  0371          AND     (7577   /UNSLAVE THE SLAVE
3822 006474  3423          DCA I   TYPE
3823 006475  2023          ISZ     TYPE
3824 006476  1423          TAD I   TYPE
3825 006477  3030          DCA     TYPE1   /TYPE1 POINTS TO EQUIV BLOCK
3826 006500  7201          CLA IAC
3827 006501  1030          TAD     TYPE1
3828 006502  3010          DCA     X10     /USE AUTO-XR TO CLEAR OFFSETS
3829 006503  1020          TAD     ENTRY
3830 006504  3355          DCA     NEWM
3831 006505  1754          TAD I   OLDM    /GET OLD MASTER'S TYPE WD
3832 006506  1145          TAD     Q200
3833 006507  3754          DCA I   OLDM    /MAKE IT A SLAVE
3834 006510  2354          ISZ     OLDM
3835 006511  1430          TAD I   TYPE1   /GET POINTER TO SLAVE DIMENSION BLOCK
3836 006512  3423          DCA I   TYPE    /PUT IT IN SYMTAB AS BEFITTING A NEW MASTER
3837 006513  1754          TAD I   OLDM    /GET OLD MASTERS DIM PTR
3838 006514  3430          DCA I   TYPE1   /PUT IT IN EQUIV BLOCK AS BEFITTING A NEW SLAVE
3839 006515  1030          TAD     TYPE1   /NOW ASSOCIATE THE EQUIV BLOCK
3840 006516  3754          DCA I   OLDM    /WITH THE NEW SLAVE
3841 006517  3410          DCA I   X10     /AND MAKE BOTH OFFSETS 0
3842 006520  3410          DCA I   X10     /("FIXSLV" WILL ADJUST IT - NOTE THE "MASTER"
3843 006521  6201          CDF 0           /WD OF THE BLOCK STILL POINTS TO THE OLD MASTER)
3844 006522  4770          JMS I   (TYPRTN /** RECURSIVE CALL ** - ACTUALLY WE DON'T CARE
3845 006523  6525          FIXSLV          /SINCE WE AREN'T RETURNING ANYWAY
3846 006524  5767          JMP I   (FIXELP /TRY AGAIN FROM SCRATCH
3847               /ROUTINE TO ADJUST ALL SLAVES OF THE OLD MASTER
3848               /TO BE SLAVES OF THE NEW MASTER
3849               
3850 006525  0000  FIXSLV, 0               /THROUGHOUT
3851 006526  1423          TAD I   TYPE
3852 006527  0145          AND     Q200
3853 006530  7650          SNA CLA         /IS IT A SLAVE?
3854 006531  5725          JMP I   FIXSLV  /NO
3855 006532  2023          ISZ     TYPE
3856 006533  7201          CLA IAC
3857 006534  1423          TAD I   TYPE
3858 006535  3023          DCA     TYPE    /TYPE NOW POINTS TO THE EQUIV BLOCK
3859 006536  7201          CLA IAC
3860 006537  1423          TAD I   TYPE    /GET PTR TO THIS SLAVES MASTER (+1)
3861 006540  7040          CMA
3862 006541  1354          TAD     OLDM    /COMPARE MASTERS
3863 006542  7640          SZA CLA
3864 006543  5725          JMP I   FIXSLV  /NOT UNDER SAME MASTER - LEAVE
3865 006544  1355          TAD     NEWM
3866 006545  3423          DCA I   TYPE    /"MEET THE NEW BOSS.....
3867 006546  2023          ISZ     TYPE    / SAME AS THE OLD BOSS...."
3868 006547  1423          TAD I   TYPE    /               (THE WHO)
3869               
3870 006550  1356          TAD     SFUDGE  /ADD IN THE DIFFERENCE BETWEEN OLD AND NEW
3871 006551  7001          IAC             /MASTERS TO THE MASTER OFFSET
3872 006552  3423          DCA I   TYPE
3873 006553  5725          JMP I   FIXSLV  /THE SLAVE IS NOW --  A SLAVE!
3874               
3875 006554  0000  OLDM,   0
3876 006555  0000  NEWM,   0
3877 006556  0000  SFUDGE, 0
3878 006567  5104          PAGE
     006570  7400  
     006571  7577  
     006572  0240  
     006573  7413  
     006574  7203  
     006575  5140  
     006576  4220  
     006577  6220  
3879               / ENTRY AND EXIT CODE
3880               
3881 006600  0000  PLSUB2, 0                       /DUMB SUBR FOR PROLOG
3882 006601  6201          CDF
3883 006602  4252          JMS     INS2            /       %ORG    #BASE+30
3884 006603  2161          ORG;XBAP30
     006604  6724  
3885 006605  4252          JMS     INS2            /       %FNOP
3886 006606  6731          FNOP;0
     006607  0000  
3887 006610  4252          JMS     INS2            /       %JA     #RET
3888 006611  3657          JA;XRET
     006612  6704  
3889 006613  4252          JMS     INS2            /       FNOP
3890 006614  6731          FNOP;0
     006615  0000  
3891 006616  4256          JMS     INS             /#GOBAK,ORG     .+2
3892 006617  6711          XGOBAK;DBLZRO;0         /**TO INSURE IT'S 0
     006620  6776  
     006621  0000  
3893 006622  1104          TAD     DPUSED          /WAS DOUBLE PRECISSION USED ?
3894 006623  7650          SNA CLA
3895 006624  5234          JMP     NDPUSD          /NO, NO NEED FOR TEMP
3896 006625  4256          JMS     INS
3897 006626  2167          XDPTMP;ORG;DP12         /#DPT,  ORG     .+12
     006627  2161  
     006630  6353  
3898 006631  4252          JMS     INS2
3899 006632  7163          DPCHK;0
     006633  0000  
3900 006634  1062  NDPUSD, TAD     FUNCTN          /FUNCTION OR SUBR ?
3901 006635  7450          SNA
3902 006636  5600          JMP I   PLSUB2          /ITS #MAIN, NO #VAL OR #ARGS
3903 006637  7710          SPA CLA
3904 006640  5245          JMP     .+5             /ITS A SUBROUTINE, NO #VAL
3905 006641  4256          JMS     INS             /#VAL,  %ORG    .+6
3906 006642  1002          XVAL;ORG;DP6
     006643  2161  
     006644  6753  
3907 006645  4256          JMS     INS             /#ARGS, %ORG    .+3
3908 006646  5764          XARGS;ORG;DP3
     006647  2161  
     006650  6751  
3909 006651  5600          JMP I   PLSUB2
3910 006652  0000  INS2,   0                       /       %OPCOD  ADDR
3911 006653  1252          TAD     INS2            /COMMONIZE RETURNS
3912 006654  3256          DCA     INS
3913 006655  5264          JMP     INS3
3914 006656  0000  INS,    0                       /TAG,   %OPCOD  ADDR
3915 006657  1656          TAD I   INS             /GET TAG FIELD
3916 006660  2256          ISZ     INS
3917 006661  4537          JMS I   QOUTSYM         /OUTPUT IT
3918 006662  1053          TAD     COMMA
3919 006663  4562          JMS I   QOCHAR
3920 006664  4536  INS3,   JMS I   QOTAB
3921 006665  1656          TAD I   INS             /GET OPCODE
3922 006666  2256          ISZ     INS
3923 006667  4537          JMS I   QOUTSYM
3924 006670  1656          TAD I   INS             /GET ADDR
3925 006671  7650          SNA CLA
3926 006672  5276          JMP     .+4             /NO ADDRESS
3927 006673  4536          JMS I   QOTAB
3928 006674  1656          TAD I   INS
3929 006675  4537          JMS I   QOUTSYM
3930 006676  2256          ISZ     INS
3931 006677  4535          JMS I   QCRLF
3932 006700  5656          JMP I   INS
3933 006701  2305  SECT,   TEXT    'SECT'
     006702  0324  
     006703  0000  
3934 006704  4322  XRET,   TEXT    '#RET'
     006705  0524  
     006706  0000  
3935 006707  4330  XXR,    TEXT    '#XR'
     006710  2200  
3936 006711  4307  XGOBAK, TEXT    '#GOBAK'
     006712  1702  
     006713  0113  
     006714  0000  
3937 006715  4323  XST,    TEXT    '#ST'
     006716  2400  
3938 006717  4307  XGOBC0, TEXT    '#GOBAK,0'
     006720  1702  
     006721  0113  
     006722  5460  
     006723  0000  
3939 006724  4302  XBAP30, TEXT    '#BASE+30'
     006725  0123  
     006726  0553  
     006727  6360  
     006730  0000  
3940 006731  0616  FNOP,   TEXT    'FNOP'
     006732  1720  
     006733  0000  
3941 006734  2305  SETX,   TEXT    'SETX'
     006735  2430  
     006736  0000  
3942 006737  2305  SETB,   TEXT    'SETB'
     006740  2402  
     006741  0000  
3943 006742  2405  TEXTX,  TEXT    'TEXT'
     006743  3024  
     006744  0000  
3944 006745  4302  XBASC1, TEXT    '#BASE,1'
     006746  0123  
     006747  0554  
     006750  6100  
3945 006751  5653  DP3,    TEXT    '.+3'
     006752  6300  
3946 006753  5653  DP6,    TEXT    '.+6'
     006754  6600  
3947 006755  6054  ZC1,    TEXT    '0,1'
     006756  6100  
3948 006757  0614  FLDAI,  TEXT    'FLDA%'
     006760  0401  
     006761  4500  
3949 006762  0623  FSTAI,  TEXT    'FSTA%'
     006763  2401  
     006764  4500  
3950 006765  4314  XLBLE,  TEXT    '#LBL=.'
     006766  0214  
     006767  7556  
     006770  0000  
3951 006771  5461  C1,     TEXT    ',1'
     006772  0000  
3952 006773  4314  XLBL,   TEXT    '#LBL'          /STACK-5 CAN'T BE 0
     006774  0214  
     006775  0000  
3953 006776  6073  DBLZRO, TEXT    '0;0'
     006777  6000  
3954                       PAGE
3955               / SYMBOL TABLE PROCESSING ROUTINES
3956               
3957 007000  0000  IMPLCT, 0                       /DO IMPLICIT TYPING
3958 007001  1423          TAD I   TYPE
3959 007002  0215          AND     O100            /WAS IT EXPLICITLY TYPED
3960 007003  7640          SZA CLA
3961 007004  5600          JMP I   IMPLCT          /YES
3962 007005  1022          TAD     BUCKET          /IS IT INTEGER ?
3963 007006  1301          TAD     M317
3964 007007  7100          CLL
3965 007010  1256          TAD     M006
3966 007011  7620          SNL CLA
3967 007012  2423          ISZ I   TYPE            /TYPE IT REAL
3968 007013  2423          ISZ I   TYPE            /TYP IT INTEGER
3969 007014  5600          JMP I   IMPLCT
3970               O100,
3971 007015  0100  DFLIT,  100                     /GENERATE FACTORS FOR CALLS
3972 007016  7132          CLL CML RTR             /DIMENSIONED ?
3973 007017  0423          AND I   TYPE
3974 007020  7650          SNA CLA
3975 007021  5615          JMP I   DFLIT           /NO
3976 007022  1423          TAD I   TYPE
3977 007023  3024          DCA     TEMP    /SET PROPER WDS/ENTRY FOR VMC
3978 007024  1020          TAD     ENTRY           /GET ADDR OF MAGIC NUMBER
3979 007025  4551          JMS I   QGETSS
3980 007026  1377          TAD     (2
3981 007027  3023          DCA     TYPE
3982 007030  1420          TAD I   ENTRY           /SAVE LINK
3983 007031  3256          DCA     DFTEMP
3984 007032  1022          TAD     BUCKET          /FIX NAME
3985 007033  3420          DCA I   ENTRY
3986 007034  1423          TAD I   TYPE            /GET MAGIC NUMBER
3987 007035  3025          DCA     TEMP2
3988 007036  2023          ISZ     TYPE
3989 007037  6201          CDF
3990 007040  4776          JMS I   (ONUM           /OUTPUT A ZERO WORD
3991 007041  4524          JMS I   QOPCDE
3992 007042  3657          JA
3993 007043  1020          TAD     ENTRY           /OUTPUT VAR MINUS CONST
3994 007044  4775          JMS I   (VMC
3995 007045  4535          JMS I   QCRLF           /END LITERAL
3996 007046  6211          CDF     10
3997 007047  1036          TAD     LITNUM          /SAVE NUMBER IN DIM INFO
3998 007050  3423          DCA I   TYPE
3999 007051  2036          ISZ     LITNUM          /THEN BY 2 MORE
4000 007052  2036          ISZ     LITNUM
4001 007053  1256          TAD     DFTEMP          /RESTORE ENTRY
4002 007054  3420          DCA I   ENTRY
4003 007055  5615          JMP I   DFLIT
4004               M006,
4005               DFTEMP,
4006 007056  0006  EXTRNL, 6                       /DO EXTERNALS
4007 007057  1423          TAD I   TYPE
4008 007060  0307          AND     O1000           /IS IT EXT ?
4009 007061  7650          SNA CLA
4010 007062  5656          JMP I   EXTRNL
4011 007063  4774          JMS I   (UNHOOK         /REMOVE THIS SYMBOL
4012 007064  1061          TAD     PROGNM          /IS IT THE PROG NAME ?
4013 007065  7041          CIA
4014 007066  1020          TAD     ENTRY
4015 007067  7640          SZA CLA
4016 007070  5275          JMP     .+5             /NO, OUTPUT EXTERN
4017 007071  1062          TAD     FUNCTN          /IS IT A MAIN PROG ?
4018 007072  7650          SNA CLA
4019 007073  5773          JMP     TFUDGE-1        /YES, NO SECT
4020 007074  1372          TAD     (SECT-EXTERN    /NOT MAIN, OUTPUT SECT
4021 007075  1351          TAD     XTRN
4022 007076  3301          DCA     M317
4023 007077  6201          CDF
4024 007100  4524          JMS I   QOPCDE
4025 007101  7461  M317,   -317
4026 007102  1020          TAD     ENTRY           /NOW VAR NAME
4027 007103  6211          CDF     10
4028 007104  4543          JMS I   QOUTNAM
4029 007105  4535          JMS I   QCRLF
4030 007106  5773          JMP     TFUDGE-1
4031               O1000,
4032 007107  1000  EQUIVS, 1000                    /OUTPUT EQUIVALENCES
4033 007110  1423          TAD I   TYPE
4034 007111  0145          AND     Q200            /IS THIS A SLAVE ?
4035 007112  7650          SNA CLA
4036 007113  5707          JMP I   EQUIVS          /NO
4037 007114  4774          JMS I   (UNHOOK         /UNHOOK THE ENTRY
4038 007115  1423          TAD I   TYPE            /SAVE THE TYPE WORD
4039 007116  3030          DCA     TYPE1
4040 007117  2023          ISZ     TYPE            /POINT TO EQUIVALENCE BLOCK
4041 007120  1423          TAD I   TYPE
4042 007121  3010          DCA     X10
4043 007122  6201          CDF
4044 007123  4524          JMS I   QOPCDE          /OUTPUT ORG
4045 007124  2161          ORG
4046 007125  6211          CDF     10
4047 007126  1410          TAD I   X10             /MASTER NAME
4048 007127  3011          DCA     X11             /SAVE IT
4049 007130  1011          TAD     X11
4050 007131  4543          JMS I   QOUTNAM         /OUTPUT IT
4051 007132  1054          TAD     PLUS            /+
4052 007133  4562          JMS I   QOCHAR
4053 007134  6211          CDF     10
4054 007135  1411          TAD I   X11             /MASTER SS
4055 007136  4351          JMS     SUBRX
4056 007137  1146          TAD     Q255            /MINUS
4057 007140  4562          JMS I   QOCHAR
4058 007141  6211          CDF     10
4059 007142  1030          TAD     TYPE1           /SLAVE SS
4060 007143  4351          JMS     SUBRX
4061 007144  4535          JMS I   QCRLF           /EOL
4062 007145  6211          CDF     10
4063 007146  1020          TAD     ENTRY           /NOW OUTPUT SLAVE
4064 007147  4771          JMS I   (OUTVAR
4065 007150  5773          JMP     TFUDGE-1
4066               XTRN,
4067 007151  2142  SUBRX,  EXTERN
4068 007152  4554          JMS I   QSKPIRL         /SIZE OF THING
4069 007153  1147          TAD     Q3
4070 007154  1147          TAD     Q3              /TIMES 3 OR 6
4071 007155  3042          DCA     MQ
4072 007156  1410          TAD I   X10
4073 007157  6201          CDF
4074 007160  4557          JMS I   QMUL12          /MAKE THE PRODUCT
4075 007161  4563          JMS I   QNUMBRO         /OUT WITH IT
4076 007162  5751          JMP I   SUBRX
4077 007163  0420  DPCHK,  TEXT    'DPCHK'
     007164  0310  
     007165  1300  
4078 007166  0601  FADDM,  TEXT    'FADDM'
     007167  0404  
     007170  1500  
4079 007171  7203          PAGE
     007172  4537  
     007173  7413  
     007174  5140  
     007175  2064  
     007176  6156  
     007177  0002  
4080               / SYMBOL TABLE PROCESSING ROUTINES
4081               
4082 007200  0201  BASE,   TEXT    'BASE'
     007201  2305  
     007202  0000  
4083 007203  0000  OUTVAR, 0                       /ALLOCATE STORAGE FOR A VARIABLE
4084 007204  3274          DCA     VARADR
4085 007205  6214          RDF                     /GET FIELD OF VAR
4086 007206  1223          TAD     X6201
4087 007207  3221          DCA     OVFLD1
4088 007210  1221          TAD     OVFLD1
4089 007211  3231          DCA     OVFLD2
4090 007212  1274          TAD     VARADR          /OUTPUT         NAME,
4091 007213  4543          JMS I   QOUTNAM
4092 007214  1053          TAD     COMMA
4093 007215  4562          JMS I   QOCHAR
4094 007216  4524          JMS I   QOPCDE          /OUTPUT ORG
4095 007217  2161          ORG
4096 007220  2274          ISZ     VARADR          /POINT TO TYPE WROD
4097 007221  0000  OVFLD1, 0
4098 007222  1674          TAD I   VARADR          /GET TYPE
4099 007223  6201  X6201,  CDF
4100 007224  4554          JMS I   QSKPIRL
4101 007225  1147          TAD     Q3              /PER ENTRY
4102 007226  1147          TAD     Q3              /INTEGER, REAL, AND
4103                                               /LOGICAL  3WORDS
4104 007227  3042          DCA     MQ
4105 007230  3040          DCA     AC
4106 007231  0000  OVFLD2, 0
4107 007232  7132          CLL CML RTR             /CHECK DIM BIT
4108 007233  0674          AND I   VARADR
4109 007234  7650          SNA CLA
4110 007235  5253          JMP     PLSDOT          /NOT DIMENSIONED
4111 007236  1674          TAD I   VARADR          /LOOK AT TYPE
4112 007237  2274          ISZ     VARADR          /MOVE TO EQ DIM POINTER
4113 007240  0145          AND     Q200            /EQUIVALENCED ?
4114 007241  7650          SNA CLA
4115 007242  5245          JMP     .+3             /NO
4116 007243  1674          TAD I   VARADR          /YES, SKIP EQUIV INFO
4117 007244  3274          DCA     VARADR
4118 007245  1674          TAD I   VARADR          /ADDRESS OF DIM INFO
4119 007246  7001          IAC
4120 007247  3274          DCA     VARADR          /ADDRESS OF SIZE
4121 007250  1674          TAD I   VARADR          /GET TOTAL SIZE
4122 007251  6201          CDF
4123 007252  4557          JMS I   QMUL12
4124 007253  6201  PLSDOT, CDF
4125 007254  1152          TAD     Q256
4126 007255  4562          JMS I   QOCHAR
4127 007256  1054          TAD     PLUS
4128 007257  4562          JMS I   QOCHAR
4129 007260  4563          JMS I   QNUMBRO
4130 007261  4535          JMS I   QCRLF
4131 007262  5603          JMP I   OUTVAR
4132 007263  0000  SCALAR, 0                       /OUTPUT SCALARS
4133 007264  1423          TAD I   TYPE            /IS IT A SCALAR ?
4134 007265  0377          AND     (7630           /COM, DIM, EXT, ASF,
4135                                               /EQV, ARG, COMMONNAME
4136 007266  7640          SZA CLA
4137 007267  5663          JMP I   SCALAR          /NO
4138 007270  4776          JMS I   (UNHOOK         /DELETE THIS FROM THE LIST
4139 007271  1020          TAD     ENTRY           /OUTPUT THIS VARIABLE
4140 007272  4203          JMS     OUTVAR
4141 007273  5775          JMP     TFUDGE-1
4142               VARADR,
4143 007274  0000  DOLIST, 0                       /PROCESS A LITERAL LIST
4144 007275  1674          TAD I   DOLIST          /GET LIST START
4145 007276  3020          DCA     ENTRY
4146 007277  2274          ISZ     DOLIST
4147 007300  1674          TAD I   DOLIST
4148 007301  3023          DCA     TYPE            /GET TYPE BITS
4149 007302  2274          ISZ     DOLIST
4150 007303  1674          TAD I   DOLIST
4151 007304  2274          ISZ     DOLIST
4152 007305  3355          DCA     LSIZE           /GET LITERAL SIZE
4153 007306  6211          CDF     10
4154 007307  1420  DLLOOP, TAD I   ENTRY           /GET NEXT ENTRY
4155 007310  7450          SNA
4156 007311  5344          JMP     DLRETN          /NO MORE
4157 007312  3020          DCA     ENTRY
4158 007313  1020          TAD     ENTRY
4159 007314  3010          DCA     X10             /ADDRESS OF TYPE WORD
4160 007315  1023          TAD     TYPE            /PUT IN TYPE
4161 007316  3410          DCA I   X10
4162 007317  1010          TAD     X10             /SAVE THIS ADDR
4163 007320  3011          DCA     X11
4164 007321  1355          TAD     LSIZE           /SIZE OF LITERAL
4165 007322  3024          DCA     TEMP
4166 007323  6201  LITLUP, CDF
4167 007324  4536          JMS I   QOTAB
4168 007325  6211          CDF     10
4169 007326  1410          TAD I   X10
4170 007327  6201          CDF
4171 007330  4516          JMS I   QONUMBR
4172 007331  4535          JMS I   QCRLF
4173 007332  2024          ISZ     TEMP
4174 007333  5323          JMP     LITLUP
4175 007334  6211          CDF     10
4176 007335  1036          TAD     LITNUM          /SAVE LITERAL NUMBER
4177 007336  3411          DCA I   X11
4178 007337  1355          TAD     LSIZE           /INCREMENT LITERAL NUMBER
4179 007340  7041          CIA
4180 007341  1036          TAD     LITNUM
4181 007342  3036          DCA     LITNUM
4182 007343  5307          JMP     DLLOOP
4183 007344  6201  DLRETN, CDF
4184 007345  5674          JMP I   DOLIST
4185 007346  0243  TEMPS,  243;2000;TMPSIZ;2415;2000
     007347  2000  
     007350  7353  
     007351  2415  
     007352  2000  
4186 007353  0001  TMPSIZ, 1;TMPBLK+1
     007354  0003  
4187               LSIZE,
4188 007355  0000  COMVAR, 0                       /REMOVE COMMON VARS FROM ST
4189 007356  1423          TAD I   TYPE
4190 007357  0374          AND     (4400           /ALSO ASF NAMES
4191 007360  7650          SNA CLA
4192 007361  5755          JMP I   COMVAR
4193 007362  4776          JMS I   (UNHOOK
4194 007363  5775          JMP     TFUDGE-1
4195 007364  4314  LITRL2, TEXT    '#LIT'
     007365  1124  
     007366  0000  
4196 007367  0317  COMMON, TEXT    'COMMON'
     007370  1515  
     007371  1716  
     007372  0000  
4197 007374  4400          PAGE
     007375  7413  
     007376  5140  
     007377  7630  
4198               / SYMBOL TABLE PROCESSING ROUTINES
4199               
4200 007400  0000  TYPRTN, 0                       /PROCESS ENTIRE SYMBOL TABLE
4201 007401  1600          TAD I   TYPRTN          /GET ROUTINE ADDRESS
4202 007402  3277          DCA     ROUTNE
4203 007403  2200          ISZ     TYPRTN
4204 007404  1273          TAD     O301            /START WITH 'A'
4205 007405  3022          DCA     BUCKET
4206 007406  1274          TAD     M32             /BUCKET COUNT
4207 007407  3026          DCA     BCNT
4208 007410  1022  TYPLP2, TAD     BUCKET          /GET START OF NEXT LIST
4209 007411  1275          TAD     ALM301
4210 007412  3021  TYPLUP, DCA     OENTRY          /SAVE OLD ENTRY ADDRESS
4211 007413  6211          CDF     10
4212 007414  1421  TFUDGE, TAD I   OENTRY          /GET ADDR OF NEXT ENTRY
4213 007415  7450          SNA
4214 007416  5226          JMP     EOL             /0 MEANS END OF LIST
4215 007417  3020          DCA     ENTRY
4216 007420  7001          IAC
4217 007421  1020          TAD     ENTRY           /ADDR OF TYPE WORD
4218 007422  3023          DCA     TYPE
4219 007423  4677          JMS I   ROUTNE          /CALL ROUTINE
4220 007424  1421          TAD I   OENTRY          /CONTINUE DOWN THE LIST
4221 007425  5212          JMP     TYPLUP
4222 007426  2022  EOL,    ISZ     BUCKET          /DO NEXT LETTER
4223 007427  2026          ISZ     BCNT
4224 007430  5210          JMP     TYPLP2
4225 007431  6201          CDF
4226 007432  5600          JMP I   TYPRTN          /END OF PASS
4227                       BCNT=ARG1
4228 007433  0000  COMNAM, 0                       /OUTPUT A COMMON BLOCK
4229 007434  1423          TAD I   TYPE            /IS THIS A COMMON BLOCK NAME
4230 007435  1276          TAD     M111
4231 007436  7640          SZA CLA
4232 007437  5633          JMP I   COMNAM          /NO
4233 007440  6201          CDF
4234 007441  4524          JMS I   QOPCDE
4235 007442  7367          COMMON
4236 007443  6211          CDF     10
4237 007444  4777          JMS I   (UNHOOK         /REMOVE THE COMMON
4238                                               /BLOCK FROM S.T.
4239 007445  1020          TAD     ENTRY
4240 007446  4543          JMS I   QOUTNAM         /OUTPUT NAME
4241 007447  4535          JMS I   QCRLF
4242 007450  2023          ISZ     TYPE            /GET TO COMMON STUFF POINTER
4243 007451  6211  CNLOOP, CDF     10
4244 007452  1423          TAD I   TYPE            /GET ADDR OF NEXT HUNK
4245                                               /OF COMMON
4246 007453  7450          SNA
4247 007454  5214          JMP     TFUDGE          /END OF IT
4248 007455  3023          DCA     TYPE
4249 007456  1023          TAD     TYPE            /GET A WORKING POINTER
4250 007457  3010          DCA     X10
4251 007460  1410          TAD I   X10             /GET COUNT
4252 007461  7450          SNA
4253 007462  5251          JMP     CNLOOP          /NONE IN THIS HUNK
4254 007463  7041          CIA
4255 007464  3025          DCA     TEMP2
4256 007465  1410          TAD I   X10             /GET VARIABLE ADDRESS
4257 007466  4776          JMS I   (OUTVAR         /OUTPUT IT
4258 007467  6211          CDF     10
4259 007470  2025          ISZ     TEMP2
4260 007471  5265          JMP     .-4             /DO NEXT ONE FROM THIS HUNK
4261 007472  5251          JMP     CNLOOP          /DO NEXT HUNK
4262 007473  0301  O301,   301
4263 007474  7746  M32,    -32
4264 007475  7522  ALM301, ALIST-301
4265 007476  7667  M111,   -111
4266               ROUTNE,
4267 007477  0000  ADFLIT, 0                       /OUTPUT ARG DF LITS
4268 007500  1063          TAD     ARGLST          /ANY ARGS
4269 007501  7450          SNA
4270 007502  5677          JMP I   ADFLIT
4271 007503  3010          DCA     X10
4272 007504  6211          CDF     10
4273 007505  1463          TAD I   ARGLST          /NUMBER OF ARGS
4274 007506  7041          CIA
4275 007507  3050          DCA     NARGS
4276 007510  6211  ADFLUP, CDF     10
4277 007511  1410          TAD I   X10             /GET ARG ADDR
4278 007512  7001          IAC
4279 007513  3024          DCA     TEMP            /TYPE WORD ADDR
4280 007514  1424          TAD I   TEMP            /GET TYPE INFO
4281 007515  3025          DCA     TEMP2
4282 007516  7132          CLL CML RTR
4283 007517  0424          AND I   TEMP            /DIMENSIONED ?
4284 007520  7650          SNA CLA
4285 007521  5347          JMP     NDADFL          /NO
4286 007522  2024          ISZ     TEMP            /ADDR OF DIM INFO
4287 007523  7126          CLL CML RTL
4288 007524  1424          TAD I   TEMP            /ADDR OF MAGIC NUMBER
4289 007525  3024          DCA     TEMP
4290 007526  1424          TAD I   TEMP            /MAGIC NUMBER
4291 007527  3042          DCA     MQ              /PREPARE TO MULTIPLY
4292 007530  2024          ISZ     TEMP            /ADDR OF LITERAL GOES HERE
4293 007531  1036          TAD     LITNUM          /STICK IN THE ADDRESS
4294 007532  7001          IAC
4295 007533  3424          DCA I   TEMP
4296 007534  6201          CDF
4297 007535  4775          JMS I   (ONUM           /OUTPUT A ZERO
4298 007536  1025          TAD     TEMP2           /LOOK AT TYPE
4299 007537  4554          JMS I   QSKPIRL         /SKIP ON I R L
4300 007540  1374          TAD     (3              /DOUBLE OR COMPLEX
4301 007541  1374          TAD     (3
4302 007542  4557          JMS I   QMUL12
4303 007543  1040          TAD     AC              /OUTPUT 2 WORD LITERAL
4304 007544  4775          JMS I   (ONUM
4305 007545  1042          TAD     MQ
4306 007546  4775          JMS I   (ONUM
4307 007547  2050  NDADFL, ISZ     NARGS
4308 007550  5310          JMP     ADFLUP
4309 007551  5677          JMP I   ADFLIT
4310 007552  4773  RDOVLY, JMS I   (7607           /READ IN OVERLAY
4311 007553  0700          NPOVLY
4312 007554  5000          OVRLAY
4313 007555  0000  PASS2O, 0
4314 007556  5772          JMP I   (INERR
4315 007557  1771          TAD I   (VOVER          /CHECK VERSION OF OVERLAY
4316 007560  1004          TAD     VERS
4317 007561  7640          SZA CLA
4318 007562  5770          JMP I   (VERROR         /ERROR, MIXED VERSIONS
4319 007563  5767          JMP I   (EOSTMT         /START PASS2 PROPER
4320 007567  2203          PAGE
     007570  5146  
     007571  5126  
     007572  0623  
     007573  7607  
     007574  0003  
     007575  6156  
     007576  7203  
     007577  5140  
4321                      FIELD   1
4322                       *5000
4323 015000  0000          0                       /THIS IS THE START OF
4324                                               /THE ERROR MESSAGE LIST
4325                                               /WHICH WORKS BACKWARDS
4326               /OS/8 F4 COMPILER CODE SKELETONS
4327               
4328                       MAC=-6
4329                       NEGSGN=-5
4330                       FLDAA2=-4
4331                       FLDAA1=-3
4332                       ENTERE=-2
4333                       ENTERF=-1
4334 015001  3616  CGTCOD, ATX;DD1;STARTD;0;FLDA;DP2C1;STARTF;0
     015002  0564  
     015003  3147  
     015004  0000  
     015005  1012  
     015006  0356  
     015007  1134  
     015010  0000  
4335 015011  1565  AGTCOD, JAC;0;0
     015012  0000  
     015013  0000  
4336 015014  7777  ASNCOD, ENTERF;FLDA;DP3C0;JA;DP4;0
     015015  1012  
     015016  3607  
     015017  3657  
     015020  1005  
     015021  0000  
4337 015022  2142  ERCODE, EXTERN;XUE;TRAP3;XUE;0
     015023  1757  
     015024  3665  
     015025  1757  
     015026  0000  
4338 015027  2142  A0FN,   EXTERN;XFIX;JSA;XFIX;0
     015030  1367  
     015031  3663  
     015032  1367  
     015033  0000  
4339 015034  3614  A0SD,   ALN;D0
     015035  3564  
4340 015036  3147  SD,     STARTD;0;0
     015037  0000  
     015040  0000  
4341 015041  2163  SE,     STARTE;0;0
     015042  0000  
     015043  0000  
4342 015044  1134  SF,     STARTF;0;0
     015045  0000  
     015046  0000  
4343 015047  7777  MPTR0,  ENTERF;FLDAA1;FSTA;XBASE;0
     015050  7775  
     015051  1567  
     015052  3600  
     015053  0000  
4344 015054  7777  MPTR3,  ENTERF;FLDAA2;FSTA;XBASP3;0
     015055  7774  
     015056  1567  
     015057  3603  
     015060  0000  
4345 015061  3657  JADP2,  JA;DOT;0
     015062  1165  
     015063  0000  
4346 015064  7777  DOFIN0, ENTERF;FLDAA1;FADD;-2
     015065  7775  
     015066  1007  
     015067  7776  
4347 015070  1567  ASTOR,  FSTA;-1;0
     015071  7777  
     015072  0000  
4348 015073  7777  DOFIN1, ENTERF;FLDAA1;FADD;-2;MAC+A0FN;FSTA;-1;0
     015074  7775  
     015075  1007  
     015076  7776  
     015077  5021  
     015100  1567  
     015101  7777  
     015102  0000  
4349 015103  7775  LDASTD, FLDAA1;STARTD;0;0
     015104  3147  
     015105  0000  
     015106  0000  
4350                       /CHALK UP ONE FOR PAL8
4351 015107  3616  ATX1,   ATX;DD1;0
     015110  0564  
     015111  0000  
4352 015112  3622  LXM1C2, LDX;M1C2;STARTD;0;0
     015113  3550  
     015114  3147  
     015115  0000  
     015116  0000  
4353 015117  5123  FVAL,   FVI-1;FVI-1;FVC-1;FVD-1;FVI-1
     015120  5123  
     015121  5126  
     015122  5134  
     015123  5123  
4354 015124  1012  FVI,    FLDA;XVAL;0
     015125  1002  
     015126  0000  
4355 015127  2163  FVC,    STARTE;0;FLDA;XVAL;MAC+PCAC;0
     015130  0000  
     015131  1012  
     015132  1002  
     015133  5172  
     015134  0000  
4356 015135  2163  FVD,    STARTE;0;FLDA;XVAL;0
     015136  0000  
     015137  1012  
     015140  1002  
     015141  0000  
4357 015142  6766  RTNCOD, RTNX+MAC;JA;XRTN;0
     015143  3657  
     015144  3640  
     015145  0000  
4358 015146  7777  PAZCOD, ENTERF;EXTERN;XPAUSE;JSR;XPAUSE;0
     015147  2142  
     015150  3773  
     015151  3661  
     015152  3773  
     015153  0000  
4359 015154  6766  STPCOD, RTNX+MAC;EXTERN;XEXIT;JSR;XEXIT;0
     015155  2142  
     015156  3635  
     015157  3661  
     015160  3635  
     015161  0000  
4360 015162  7777  GIRL1,  ENTERF;FLDAA1;ENTERE;0
     015163  7775  
     015164  7776  
     015165  0000  
4361 015166  7777  GIRL2,  ENTERF;FLDAA2;ENTERE;0
     015167  7774  
     015170  7776  
     015171  0000  
4362               SEGCAC,
4363 015172  7776  GCAC,   ENTERE;EXTERN;CAC;FLDA;CAC;0
     015173  2142  
     015174  2361  
     015175  1012  
     015176  2361  
     015177  0000  
4364 015200  2142  PCAC,   EXTERN;CAC;FSTA;CAC;0
     015201  2361  
     015202  1567  
     015203  2361  
     015204  0000  
4365 015205  7776  GC1C2,  ENTERE;FLDAA1;EXTERN;CAC;FSTA;CAC;FLDAA2;0
     015206  7775  
     015207  2142  
     015210  2361  
     015211  1567  
     015212  2361  
     015213  7774  
     015214  0000  
4366 015215  7776  GC1,    ENTERE;FLDAA1;0
     015216  7775  
     015217  0000  
4367 015220  7776  GC2,    ENTERE;FLDAA2;0
     015221  7774  
     015222  0000  
4368 015223  2142  JSACEQ, EXTERN;CEQ;JSA;CEQ;NEGSGN;0
     015224  1747  
     015225  3663  
     015226  1747  
     015227  7773  
     015230  0000  
4369 015231  2142  JSACNG, EXTERN;CNEG;JSA;CNEG;0
     015232  2151  
     015233  3663  
     015234  2151  
     015235  0000  
4370 015236  2142  JSACAD, EXTERN;CADD;JSA;CADD;0
     015237  2146  
     015240  3663  
     015241  2146  
     015242  0000  
4371 015243  2142  JSACSB, EXTERN;CSUB;JSA;CSUB;0
     015244  3156  
     015245  3663  
     015246  3156  
     015247  0000  
4372 015250  2142  JSACML, EXTERN;CMUL;JSA;CMUL;0
     015251  2154  
     015252  3663  
     015253  2154  
     015254  0000  
4373 015255  2142  JSACDV, EXTERN;CDIV;JSA;CDIV;0
     015256  3161  
     015257  3663  
     015260  3161  
     015261  0000  
4374               / ADD, SUBTRACT, MULTIPLY, AND DIVIDE SKELETONS
4375 015262  5311  ADDTBL, AS-1;AS+2;AS+4
     015263  5314  
     015264  5316  
4376 015265  5322          AX-1;AX+2;AX+5
     015266  5325  
     015267  5330  
4377 015270  5311          AS-1;AD-1;AS+4
     015271  5333  
     015272  5316  
4378 015273  5341          ASC-1;ASC+2;ASC+3
     015274  5344  
     015275  5345  
4379 015276  5354          ASD-1;ASD+7;ASD+10
     015277  5364  
     015300  5365  
4380 015301  5372          ACS-1;ACS+4;ACS+6
     015302  5377  
     015303  5401  
4381 015304  5406          ADS-1;ADS+3;ADS+7
     015305  5412  
     015306  5416  
4382 015307  0000          0
4383 015310  1572          FNEG;0
     015311  0000  
4384 015312  1007  AS,     FADD;-1;0
     015313  7777  
     015314  0000  
4385 015315  7777          ENTERF;FLDAA1
     015316  7775  
4386 015317  1007          FADD;-2;0
     015320  7776  
     015321  0000  
4387 015322  5223          JSACNG+MAC
4388 015323  5207  AX,     GC1+MAC;JSACAD+MAC;0
     015324  5230  
     015325  0000  
4389 015326  5177          GC1C2+MAC;JSACAD+MAC;0
     015327  5230  
     015330  0000  
4390 015331  5212          GC2+MAC;JSACAD+MAC;0
     015332  5230  
     015333  0000  
4391 015334  7776  AD,     ENTERE;FLDAA1;FADD;-2;0
     015335  7775  
     015336  1007  
     015337  7776  
     015340  0000  
4392 015341  5223          JSACNG+MAC
4393 015342  5154  ASC,    GIRL1+MAC;JSACAD+MAC;0
     015343  5230  
     015344  0000  
4394 015345  5154          GIRL1+MAC
4395 015346  7776          ENTERE;PCAC+MAC;GC2+MAC;JSACAD+MAC;0
     015347  5172  
     015350  5212  
     015351  5230  
     015352  0000  
4396 015353  1572          FNEG;0
     015354  0000  
4397 015355  1567  ASD,    FSTA;XDPTMP;ENTERF;FLDAA1;ENTERE;FADD;XDPTMP;0
     015356  2167  
     015357  7777  
     015360  7775  
     015361  7776  
     015362  1007  
     015363  2167  
     015364  0000  
4398 015365  5154          GIRL1+MAC
4399 015366  7776          ENTERE;FADD;-2;0
     015367  1007  
     015370  7776  
     015371  0000  
4400 015372  5223          JSACNG+MAC
4401 015373  7776  ACS,    ENTERE;PCAC+MAC;GC1+MAC;JSACAD+MAC;0
     015374  5172  
     015375  5207  
     015376  5230  
     015377  0000  
4402 015400  5207          GC1+MAC;PCAC+MAC
     015401  5172  
4403 015402  5160          GIRL2+MAC;JSACAD+MAC;0
     015403  5230  
     015404  0000  
4404 015405  1572          FNEG;0
     015406  0000  
4405 015407  7776  ADS,    ENTERE;FADD;-1;0
     015410  1007  
     015411  7777  
     015412  0000  
4406 015413  5160          GIRL2+MAC;FADD;-1;0
     015414  1007  
     015415  7777  
     015416  0000  
4407 015417  1567          FSTA;XDPTMP;GIRL2+MAC;FADD;XDPTMP;0
     015420  2167  
     015421  5160  
     015422  1007  
     015423  2167  
     015424  0000  
4408 015425  5307  SUBTBL, AS-3;SS-1;SS+1
     015426  5452  
     015427  5454  
4409 015430  5321          AX-2;SX-1;SX+2
     015431  5457  
     015432  5462  
4410 015433  5307          AS-3;SDBL-1;SS+1
     015434  5465  
     015435  5454  
4411 015436  5340          ASC-2;SSX-1;SSX
     015437  5472  
     015440  5473  
4412 015441  5352          ASD-3;SSD-1;SSD
     015442  5500  
     015443  5501  
4413 015444  5371          ACS-2;SCS-1;SCS+1
     015445  5505  
     015446  5507  
4414 015447  5404          ADS-3;SDS-1;SDS5-1
     015450  5512  
     015451  5520  
4415 015452  0000          0
4416 015453  7777  SS,     ENTERF;FLDAA1
     015454  7775  
4417 015455  1015          FSUB;-2;0
     015456  7776  
     015457  0000  
4418 015460  5177  SX,     GC1C2+MAC;JSACSB+MAC;0
     015461  5235  
     015462  0000  
4419 015463  5212          GC2+MAC;JSACSB+MAC;0
     015464  5235  
     015465  0000  
4420 015466  7776  SDBL,   ENTERE;FLDAA1;FSUB;-2;0
     015467  7775  
     015470  1015  
     015471  7776  
     015472  0000  
4421 015473  5154  SSX,    GIRL1+MAC
4422 015474  7776          ENTERE;PCAC+MAC;GC2+MAC;JSACSB+MAC;0
     015475  5172  
     015476  5212  
     015477  5235  
     015500  0000  
4423 015501  5154  SSD,    GIRL1+MAC
4424 015502  7776          ENTERE;FSUB;-2;0
     015503  1015  
     015504  7776  
     015505  0000  
4425 015506  5207  SCS,    GC1+MAC;PCAC+MAC
     015507  5172  
4426 015510  5160          GIRL2+MAC;JSACSB+MAC;0
     015511  5235  
     015512  0000  
4427 015513  5160  SDS,    GIRL2+MAC;FNEG;0;FADD;-1;0
     015514  1572  
     015515  0000  
     015516  1007  
     015517  7777  
     015520  0000  
4428 015521  1567  SDS5,   FSTA;XDPTMP;GIRL2+MAC;FNEG;0;FADD;XDPTMP;0
     015522  2167  
     015523  5160  
     015524  1572  
     015525  0000  
     015526  1007  
     015527  2167  
     015530  0000  
4429 015531  5556  MULTBL, M1-1;M1+3-1;M1+5-1
     015532  5561  
     015533  5563  
4430 015534  5566          M4-1;M4+3-1;M4+6-1
     015535  5571  
     015536  5574  
4431 015537  5556          M1-1;M7-1;M7+2-1
     015540  5577  
     015541  5601  
4432 015542  5604          M8-1;M8+3-1;M8+4-1
     015543  5607  
     015544  5610  
4433 015545  5615          M11-1;M11+6-1;M11+7-1
     015546  5623  
     015547  5624  
4434 015550  5630          M14-1;M14+5-1;M14+7-1
     015551  5635  
     015552  5637  
4435 015553  5643          M18+1-1;M18-1;M18+5-1
     015554  5642  
     015555  5647  
4436 015556  0000          0
4437 015557  2353  M1,     FMUL;-1;0
     015560  7777  
     015561  0000  
4438 015562  7777          ENTERF;FLDAA1
     015563  7775  
4439 015564  2353          FMUL;-2;0
     015565  7776  
     015566  0000  
4440 015567  5207  M4,     GC1+MAC;JSACML+MAC;0
     015570  5242  
     015571  0000  
4441 015572  5177          GC1C2+MAC;JSACML+MAC;0
     015573  5242  
     015574  0000  
4442 015575  5212          GC2+MAC;JSACML+MAC;0
     015576  5242  
     015577  0000  
4443 015600  7776  M7,     ENTERE;FLDAA1;FMUL;-2;0
     015601  7775  
     015602  2353  
     015603  7776  
     015604  0000  
4444 015605  5154  M8,     GIRL1+MAC;JSACML+MAC;0
     015606  5242  
     015607  0000  
4445 015610  5154          GIRL1+MAC
4446 015611  7776          ENTERE;PCAC+MAC;GC2+MAC;JSACML+MAC;0
     015612  5172  
     015613  5212  
     015614  5242  
     015615  0000  
4447 015616  1567  M11,    FSTA;XDPTMP;GIRL1+MAC;FMUL;XDPTMP;0
     015617  2167  
     015620  5154  
     015621  2353  
     015622  2167  
     015623  0000  
4448 015624  5154          GIRL1+MAC
4449 015625  7776          ENTERE;FMUL;-2;0
     015626  2353  
     015627  7776  
     015630  0000  
4450 015631  7776  M14,    ENTERE;PCAC+MAC;GC1+MAC;JSACML+MAC;0
     015632  5172  
     015633  5207  
     015634  5242  
     015635  0000  
4451 015636  5207          GC1+MAC;PCAC+MAC
     015637  5172  
4452 015640  5160          GIRL2+MAC;JSACML+MAC;0
     015641  5242  
     015642  0000  
4453 015643  5160  M18,    GIRL2+MAC
4454 015644  7776          ENTERE;FMUL;-1;0
     015645  2353  
     015646  7777  
     015647  0000  
4455 015650  1567          FSTA;XDPTMP;GIRL2+MAC;FMUL;XDPTMP;0
     015651  2167  
     015652  5160  
     015653  2353  
     015654  2167  
     015655  0000  
4456 015656  0001  DIVTBL, 1;D2-1;D2+2-1
     015657  5703  
     015660  5705  
4457 015661  0001          1;D5-1;D5+3-1
     015662  5710  
     015663  5713  
4458 015664  0001          1;D7-1;D7+2-1
     015665  5716  
     015666  5720  
4459 015667  0001          1;D9-1;D10-1
     015670  5723  
     015671  5724  
4460 015672  0001          1;D12-1;D13-1
     015673  5731  
     015674  5732  
4461 015675  0001          1;D14-1;D15-1
     015676  5736  
     015677  5740  
4462 015700  0001          1;D16-1;D17-1
     015701  5743  
     015702  5752  
4463 015703  0000          0
4464 015704  7777  D2,     ENTERF;FLDAA1
     015705  7775  
4465 015706  2356          FDIV;-2;0
     015707  7776  
     015710  0000  
4466 015711  5177  D5,     GC1C2+MAC;JSACDV+MAC;0
     015712  5247  
     015713  0000  
4467 015714  5212          GC2+MAC;JSACDV+MAC;0
     015715  5247  
     015716  0000  
4468 015717  7776  D7,     ENTERE;FLDAA1;FDIV;-2;0
     015720  7775  
     015721  2356  
     015722  7776  
     015723  0000  
4469 015724  5154  D9,     GIRL1+MAC
4470 015725  7776  D10,    ENTERE;PCAC+MAC;GC2+MAC;JSACDV+MAC;0
     015726  5172  
     015727  5212  
     015730  5247  
     015731  0000  
4471 015732  5154  D12,    GIRL1+MAC
4472 015733  7776  D13,    ENTERE;FDIV;-2;0
     015734  2356  
     015735  7776  
     015736  0000  
4473 015737  5207  D14,    GC1+MAC;PCAC+MAC
     015740  5172  
4474 015741  5160  D15,    GIRL2+MAC;JSACDV+MAC;0
     015742  5247  
     015743  0000  
4475 015744  5160  D16,    GIRL2+MAC;FSTA;XDPTMP;FLDAA1;FDIV;XDPTMP;0
     015745  1567  
     015746  2167  
     015747  7775  
     015750  2356  
     015751  2167  
     015752  0000  
4476 015753  1567  D17,    FSTA;XDPP6;GIRL2+MAC;FSTA;XDPTMP;FLDA;XDPP6;FDIV;XDPTMP;0
     015754  1363  
     015755  5160  
     015756  1567  
     015757  2167  
     015760  1012  
     015761  1363  
     015762  2356  
     015763  2167  
     015764  0000  
4477               / RELATIONALS AND LOGICALS SKELETON TABLES
4478 015765  6014  EQTABL, EQ1-1;EQ2-1;EQ3-1
     015766  6017  
     015767  6021  
4479 015770  6024          EQ4-1;EQ5-1;EQ6-1
     015771  6027  
     015772  6032  
4480 015773  6014          EQ1-1;EQ7-1;EQ3-1
     015774  6035  
     015775  6021  
4481 015776  6040          EQ8-1;EQ9-1;EQ10-1
     015777  6043  
     016000  6044  
4482 016001  6051          EQ11-1;EQ12-1;EQ13-1
     016002  6053  
     016003  6054  
4483 016004  6057          EQ14-1;EQ15-1;EQ16-1
     016005  6056  
     016006  6064  
4484 016007  6070          EQ17-1;EQ18-1;EQ19-1
     016010  6067  
     016011  6072  
4485 016012  6014          EQ1-1;EQ2-1;EQ3-1
     016013  6017  
     016014  6021  
4486 016015  1015  EQ1,    FSUB;-1;0
     016016  7777  
     016017  0000  
4487 016020  7777  EQ2,    ENTERF;FLDAA1
     016021  7775  
4488 016022  1015  EQ3,    FSUB;-2;0
     016023  7776  
     016024  0000  
4489 016025  5207  EQ4,    GC1+MAC;JSACEQ+MAC;0
     016026  5215  
     016027  0000  
4490 016030  5177  EQ5,    GC1C2+MAC;JSACEQ+MAC;0
     016031  5215  
     016032  0000  
4491 016033  5212  EQ6,    GC2+MAC;JSACEQ+MAC;0
     016034  5215  
     016035  0000  
4492 016036  7776  EQ7,    ENTERE;MAC+EQ2+1;0
     016037  6013  
     016040  0000  
4493 016041  5154  EQ8,    GIRL1+MAC;JSACEQ+MAC;0
     016042  5215  
     016043  0000  
4494 016044  5154  EQ9,    GIRL1+MAC
4495 016045  7776  EQ10,   ENTERE;PCAC+MAC;GC2+MAC;JSACEQ+MAC;0
     016046  5172  
     016047  5212  
     016050  5215  
     016051  0000  
4496 016052  5345  EQ11,   MAC+ASD-2;0
     016053  0000  
4497 016054  5154  EQ12,   GIRL1+MAC
4498 016055  5474  EQ13,   MAC+SSD+1;0
     016056  0000  
4499 016057  5160  EQ15,   GIRL2+MAC
4500 016060  7776  EQ14,   ENTERE;PCAC+MAC;GC1+MAC;JSACEQ+MAC;0
     016061  5172  
     016062  5207  
     016063  5215  
     016064  0000  
4501 016065  5160  EQ16,   GIRL2+MAC;JSACEQ+MAC;0
     016066  5215  
     016067  0000  
4502 016070  5160  EQ18,   GIRL2+MAC
4503 016071  5377  EQ17,   MAC+ADS-2;0
     016072  0000  
4504 016073  5513  EQ19,   MAC+SDS5;0
     016074  0000  
4505 016075  6122  LETABL,        LE1-1;LE2-1;LE3-1
     016076  6126  
     016077  6130  
4506 016100  0000          0;0;0
     016101  0000  
     016102  0000  
4507 016103  6122          LE1-1;LE4-1;LE3-1
     016104  6133  
     016105  6130  
4508 016106  0000          0;0;0
     016107  0000  
     016110  0000  
4509 016111  6136          LE11-1;LE12-1;LE13-1
     016112  6140  
     016113  6141  
4510 016114  0000          0;0;0
     016115  0000  
     016116  0000  
4511 016117  6144          LE17-1;LE18-1;LE19-1
     016120  6143  
     016121  6146  
4512 016122  0000          0
4513 016123  1015  LE1,    FSUB;-1;NEGSGN;0
     016124  7777  
     016125  7773  
     016126  0000  
4514 016127  7777  LE2,    ENTERF;FLDAA1
     016130  7775  
4515 016131  1015  LE3,    FSUB;-2;0
     016132  7776  
     016133  0000  
4516 016134  7776  LE4,    ENTERE;MAC+LE2+1;0
     016135  6122  
     016136  0000  
4517 016137  5345  LE11,   MAC+ASD-2;0
     016140  0000  
4518 016141  5154  LE12,   GIRL1+MAC
4519 016142  5474  LE13,   MAC+SSD+1;0
     016143  0000  
4520 016144  5160  LE18,   GIRL2+MAC
4521 016145  5377  LE17,   MAC+ADS-2;0
     016146  0000  
4522 016147  5513  LE19,   MAC+SDS5;0
     016150  0000  
4523 016151  0000  ANDTBL,        0;0;0
     016152  0000  
     016153  0000  
4524 016154  0000          0;0;0
     016155  0000  
     016156  0000  
4525 016157  0000          0;0;0
     016160  0000  
     016161  0000  
4526 016162  0000          0;0;0
     016163  0000  
     016164  0000  
4527 016165  0000          0;0;0
     016166  0000  
     016167  0000  
4528 016170  0000          0;0;0
     016171  0000  
     016172  0000  
4529 016173  0000          0;0;0
     016174  0000  
     016175  0000  
4530 016176  5556          M1-1;M1+3-1;M1+5-1
     016177  5561  
     016200  5563  
4531 016201  0000  ORTABL, 0;0;0
     016202  0000  
     016203  0000  
4532 016204  0000          0;0;0
     016205  0000  
     016206  0000  
4533 016207  0000          0;0;0
     016210  0000  
     016211  0000  
4534 016212  0000          0;0;0
     016213  0000  
     016214  0000  
4535 016215  0000          0;0;0
     016216  0000  
     016217  0000  
4536 016220  0000          0;0;0
     016221  0000  
     016222  0000  
4537 016223  0000          0;0;0
     016224  0000  
     016225  0000  
4538 016226  5311          AS-1;AS+2;AS+4
     016227  5314  
     016230  5316  
4539 016231  0000  EQVTBL,        0;0;0
     016232  0000  
     016233  0000  
4540 016234  0000          0;0;0
     016235  0000  
     016236  0000  
4541 016237  0000          0;0;0
     016240  0000  
     016241  0000  
4542 016242  0000          0;0;0
     016243  0000  
     016244  0000  
4543 016245  0000          0;0;0
     016246  0000  
     016247  0000  
4544 016250  0000          0;0;0
     016251  0000  
     016252  0000  
4545 016253  0000          0;0;0
     016254  0000  
     016255  0000  
4546 016256  6014          EQ1-1;EQ2-1;EQ3-1
     016257  6017  
     016260  6021  
4547               /CONVERSION-FOR-STORE-OPERATOR SKELETONS
4548 016261  6342  STRTBL, SIIM-1;SIRM-1;SICM-1;SIDM-1;SIIM-1
     016262  6345  
     016263  6351  
     016264  6405  
     016265  6342  
4549 016266  6344          SIIA-1;SIRA-1;SICA-1;SIDA-1;SIIA-1
     016267  6347  
     016270  6353  
     016271  6407  
     016272  6344  
4550 016273  6342          SIIM-1;SIIM-1;SRCM-1;SRDM-1;SIIM-1
     016274  6342  
     016275  6357  
     016276  6412  
     016277  6342  
4551 016300  6344          SIIA-1;SIIA-1;SRCA-1;SRDA-1;SIIA-1
     016301  6344  
     016302  6361  
     016303  6414  
     016304  6344  
4552 016305  6364          SCIM-1;SCIM-1;SCCM-1;SCDM-1;SCIM-1
     016306  6364  
     016307  5217  
     016310  6416  
     016311  6364  
4553 016312  6366          SCIA-1;SCIA-1;SCCA-1;SCDA-1;SCIA-1
     016313  6366  
     016314  5171  
     016315  6420  
     016316  6366  
4554 016317  6427          SDIM-1;SDIM-1;SDCM-1;SDDM-1;SDIM-1
     016320  6427  
     016321  6433  
     016322  6442  
     016323  6427  
4555 016324  6431          SDIA-1;SDIA-1;SDCA-1;SDDA-1;SDIA-1
     016325  6431  
     016326  6436  
     016327  6444  
     016330  6431  
4556 016331  6370          SLIM-1;SLIM-1;SLCM-1;SLDM-1;SIIM-1
     016332  6370  
     016333  6375  
     016334  6445  
     016335  6342  
4557 016336  6372          SLIA-1;SLIA-1;SLCA-1;SLDA-1;SIIA-1
     016337  6372  
     016340  6401  
     016341  6447  
     016342  6344  
4558 016343  7777  SIIM,   ENTERF;FLDAA2
     016344  7774  
4559 016345  0000  SIIA,   0
4560 016346  7777  SIRM,   ENTERF;FLDAA2
     016347  7774  
4561 016350  5021  SIRA,   A0FN+MAC;0
     016351  0000  
4562 016352  5212  SICM,   GC2+MAC;PCAC+MAC
     016353  5172  
4563 016354  7777  SICA,   ENTERF;GCAC+1+MAC;A0FN+MAC;0
     016355  5165  
     016356  5021  
     016357  0000  
4564 016360  5212  SRCM,   GC2+MAC;PCAC+MAC
     016361  5172  
4565 016362  7777  SRCA,   ENTERF;GCAC+1+MAC;0
     016363  5165  
     016364  0000  
4566                       SCCM=GC2
4567 016365  7777  SCIM,   ENTERF;FLDAA2
     016366  7774  
4568 016367  7776  SCIA,   ENTERE;0
     016370  0000  
4569                       SCCA=GCAC
4570 016371  7777  SLIM,   ENTERF;FLDAA2
     016372  7774  
4571 016373  3663  SLIA,   JSA;LTRNE;0
     016374  0753  
     016375  0000  
4572 016376  5212  SLCM,   GC2+MAC;ENTERF;SLIA+MAC;0
     016377  7777  
     016400  6365  
     016401  0000  
4573 016402  7777  SLCA,   ENTERF;GCAC+1+MAC;SLIA+MAC;0
     016403  5165  
     016404  6365  
     016405  0000  
4574 016406  7776  SIDM,   ENTERE;FLDAA2
     016407  7774  
4575 016410  7777  SIDA,   ENTERF;SIRA+MAC;0
     016411  6342  
     016412  0000  
4576 016413  7776  SRDM,   ENTERE;FLDAA2
     016414  7774  
4577 016415  7777  SRDA,   ENTERF;0
     016416  0000  
4578 016417  7776  SCDM,   ENTERE;FLDAA2
     016420  7774  
4579 016421  1567  SCDA,   FSTA;TEMPN;ENTERF;FLDA;TEMPN;ENTERE;0
     016422  2367  
     016423  7777  
     016424  1012  
     016425  2367  
     016426  7776  
     016427  0000  
4580 016430  7777  SDIM,   ENTERF;FLDAA2
     016431  7774  
4581 016432  7776  SDIA,   ENTERE;0
     016433  0000  
4582 016434  7776  SDCM,   ENTERE;FLDAA2;PCAC+MAC
     016435  7774  
     016436  5172  
4583 016437  7777  SDCA,   ENTERF;GCAC+1+MAC;ENTERE;0
     016440  5165  
     016441  7776  
     016442  0000  
4584 016443  7776  SDDM,   ENTERE;FLDAA2
     016444  7774  
4585 016445  0000  SDDA,   0
4586 016446  7776  SLDM,   ENTERE;FLDAA2
     016447  7774  
4587 016450  3663  SLDA,   JSA;LTRNE;0
     016451  0753  
     016452  0000  
4588               / UNARY MINUS AND .NOT. SKELETONS
4589 016453  6464  NEGTBL, NIM-1;NIM-1;NCM-1;NDM-1;0
     016454  6464  
     016455  6471  
     016456  6475  
     016457  0000  
4590 016460  6466          NIA-1;NIA-1;NCA-1;NIA-1;0
     016461  6466  
     016462  5230  
     016463  6466  
     016464  0000  
4591 016465  7777  NIM,    ENTERF;FLDAA1
     016466  7775  
4592 016467  1572  NIA,    FNEG;0;0
     016470  0000  
     016471  0000  
4593 016472  5207  NCM,    GC1+MAC;PCAC+MAC;JSACNG+MAC;0
     016473  5172  
     016474  5223  
     016475  0000  
4594                       NCA=JSACNG
4595 016476  7776  NDM,    ENTERE;NIM+1+MAC;0
     016477  6460  
     016500  0000  
4596 016501  0000  NOTTBL, 0;0;0;0;NOTM-1
     016502  0000  
     016503  0000  
     016504  0000  
     016505  6512  
4597 016506  0000          0;0;0;0;NOTA-1
     016507  0000  
     016510  0000  
     016511  0000  
     016512  6514  
4598 016513  7777  NOTM,   ENTERF;FLDAA1
     016514  7775  
4599 016515  0000  NOTA,   0
4600               / ARITHMETIC IF SKELETONS
4601 016516  6527  AIFTBL, GI-1;GI-1;GC-1;GD-1;GI-1        /V3C
     016517  6527  
     016520  6532  
     016521  6534  
     016522  6527  
4602 016523  6531          GI+1;GI+1;GC+1;GD+1;GI+1        /V3C
     016524  6531  
     016525  6534  
     016526  6536  
     016527  6531  
4603 016530  7777  GI,     ENTERF;FLDAA1;0
     016531  7775  
     016532  0000  
4604 016533  5207  GC,     GC1+MAC;0
     016534  0000  
4605 016535  7776  GD,     ENTERE;FLDAA1;0
     016536  7775  
     016537  0000  
4606               /OPERATOR DISPATCH TABLE
4607               
4608 016540  1103  XPUSH,  PUSH
4609 016541  5035          ADD
4610 016542  5453          SUB
4611 016543  5457          MUL
4612 016544  2263          DIV
4613 016545  5042          EXP
4614 016546  5450          NOT
4615 016547  0361          NEG
4616 016550  0416          GE
4617 016551  0415          GT
4618 016552  0412          LE
4619 016553  0413          LT
4620 016554  5342          DNA
4621 016555  6352          OR
4622 016556  0427          EQ
4623 016557  0430          NE
4624 016560  6356          XOR
4625 016561  0466          EQV
4626 016562  5356          PAUZE
4627 016563  1130          DPUSH
4628 016564  5244          BINRD1
4629 016565  5231          FMTRD1
4630 016566  5261          WCLOSE          /**
4631 016567  5400          DARD1
4632 016570  5253          BINWR1
4633 016571  5237          FMTWR1
4634 016572  5261          WCLOSE
4635 016573  5407          DAWR1
4636 016574  5415          DEFFIL
4637 016575  5463          ASFDEF
4638 016576  2600          ARGS
4639 016577  2203          EOSTMT
4640 016600  2200          ERROR
4641 016601  5434          RETURN
4642 016602  4000          REWIND
4643 016603  5503          STORE
4644 016604  4200  XEND,   END
4645 016605  6151          DEFLBL
4646 016606  2444          DOFINI
4647 016607  1140          ARTHIF
4648 016610  2276  XLOGIF, LIFBGN
4649 016611  2400          DOBEGN
4650 016612  4001          ENDFIL
4651 016613  3731          STOP
4652 016614  6404          ASSIGN
4653 016615  4002          BAKSPC
4654 016616  3734          FORMAT
4655 016617  1533  XGOTO,  GOTO
4656 016620  1521          CGOTO
4657 016621  6400          AGOTO
4658 016622  6000          IOLMNT
4659 016623  4042          DATELM
4660 016624  4036          DREPTC
4661 016625  4013          DATAST
4662 016626  4053          ENDELM
4663 016627  5346          PURGE
4664 016630  2431  XLAST,  DOSTOR
4665               / EXPONENTIATION TABLE (NOT A STANDARD SKELETON TABLE)
4666 016631  0001  EXPTBL, 1;1111;2;1122;3;1103;4;1104;0;0 /I**D=D
     016632  1111  
     016633  0002  
     016634  1122  
     016635  0003  
     016636  1103  
     016637  0004  
     016640  1104  
     016641  0000  
     016642  0000  
4667 016643  0002          2;1111;2;1122;3;1103;4;1104;0;0 /R**D=D
     016644  1111  
     016645  0002  
     016646  1122  
     016647  0003  
     016650  1103  
     016651  0004  
     016652  1104  
     016653  0000  
     016654  0000  
4668 016655  0003          3;0311;3;0322;3;0303;0;0;0;0
     016656  0311  
     016657  0003  
     016660  0322  
     016661  0003  
     016662  0303  
     016663  0000  
     016664  0000  
     016665  0000  
     016666  0000  
4669 016667  0004          4;0411;4;0422;0;0;4;0404;0;0
     016670  0411  
     016671  0004  
     016672  0422  
     016673  0000  
     016674  0000  
     016675  0004  
     016676  0404  
     016677  0000  
     016700  0000  
4670 016701  0000          0;0;0;0;0;0;0;0;0
     016702  0000  
     016703  0000  
     016704  0000  
     016705  0000  
     016706  0000  
     016707  0000  
     016710  0000  
     016711  0000  
4671               / TYPE MIXING TABLE
4672 016712  0001  TYPMIX, 1;6;2;6;3;17;4;22;0;0
     016713  0006  
     016714  0002  
     016715  0006  
     016716  0003  
     016717  0017  
     016720  0004  
     016721  0022  
     016722  0000  
     016723  0000  
4673 016724  0002          2;6;2;6;3;17;4;22;0;0
     016725  0006  
     016726  0002  
     016727  0006  
     016730  0003  
     016731  0017  
     016732  0004  
     016733  0022  
     016734  0000  
     016735  0000  
4674 016736  0003          3;25;3;25;3;11;0;0;0;0
     016737  0025  
     016740  0003  
     016741  0025  
     016742  0003  
     016743  0011  
     016744  0000  
     016745  0000  
     016746  0000  
     016747  0000  
4675 016750  0004          4;30;4;30;0;0;4;14;0;0
     016751  0030  
     016752  0004  
     016753  0030  
     016754  0000  
     016755  0000  
     016756  0004  
     016757  0014  
     016760  0000  
     016761  0000  
4676 016762  0000          0;0;0;0;0;0;0;0;5;33
     016763  0000  
     016764  0000  
     016765  0000  
     016766  0000  
     016767  0000  
     016770  0000  
     016771  0000  
     016772  0005  
     016773  0033  
4677 016774  7777  RTNX,   ENTERF;EXTERN;LTRNE;0
     016775  2142  
     016776  0753  
     016777  0000  
4678                       $

A0FN    5027
A0SD    5034
AC      0040
ACS     5373
ACSTOR  1062
ACSWIT  0077
AD      5334
ADD     5035
ADDTBL  5262
ADFLIT  7477
ADFLUP  7510
ADS     5407
AGOTO   6400
AGTCOD  5011
AIFLUP  1145
AIFTBL  6516
AJUMP   1155
ALIST   0023
ALM301  7475
ALN     3614
ANDTBL  6151
ARG     0037
ARG1    0026
ARG2    0031
ARGARG  3441
ARGIO   0071
ARGIOA  6234
ARGLP1  5252
ARGLP2  5275
ARGLP3  5312
ARGLST  0063
ARGS    2600
ARGSV   5702
ARRAYS  6400
ARTHIF  1140
AS      5312
ASC     5342
ASD     5355
ASFARG  5661
ASFASE  5720
ASFDEF  5463
ASFEND  5723
ASFMOD  5755
ASFSKP  5756
ASFSWT  0102
ASGNXR  3125
ASNCOD  5014
ASSIGN  6404
ASTOR   5070
ATX     3616
ATX1    5107
AX      5323
BAKSPC  4002
BARGLP  3336
BASE    7200
BASE1   0027
BASE2   0032
BCLOOP  5526
BCNT    0026
BDSTUF  5121
BDSWIT  5615
BINARY  0057
BINDIO  6144
BINRD1  5244
BINWR1  5253
BLNKCN  0021
BUCKET  0022
BUMP    2134
C1      6771
CAC     2361
CADD    2146
CDIV    3161
CDSFLP  6073
CEQ     1747
CGOTO   1521
CGTCOD  5001
CGTLUP  1527
CHAR1   0530
CHAR2   0525
CHEKXR  6420
CHKKIL  6443
CHKPTR  3213
CHNLKP  5014
CKPDL   1116
CMPLST  0061
CMPMN1  6260
CMPMN2  6337
CMPMN3  6266
CMUL    2154
CNEG    2151
CNLOOP  7451
CODE    1300
CODLUP  1410
COMMA   0053
COMMON  7367
COMNAM  7433
COMPSS  3000
COMREG  4600
COMVAR  7355
CONVRT  0327
CRLF    0200
CSSLUP  3022
CSUB    3156
D0      3564
D10     5725
D12     5732
D13     5733
D14     5737
D15     5741
D16     5744
D17     5753
D2      5704
D5      5711
D7      5717
D9      5724
DARD1   5400
DARG    2560
DATAST  4013
DATASW  0064
DATELM  4042
DATPTR  0031
DAWR1   5407
DBLZRO  6776
DCHEK   2715
DCLOOP  5041
DCNT    2764
DD1     0564
DEBUG   2227
DEFASF  5600
DEFFIL  5415
DEFLBL  6151
DEVH    0076
DFLIT   7015
DFRTTM  3760
DFTEMP  7056
DIMERR  3072
DIMPTR  0047
DIV     2263
DIVTBL  5656
DLERR   4167
DLLOOP  7307
DLRETN  7344
DNA     5342
DOADDR  1437
DOARG   2524
DOBEGN  2400
DOFIN0  5064
DOFIN1  5073
DOFINI  2444
DOLIST  7274
DOLOAD  6521
DOPARM  2524
DORETN  5616
DOSTE   1500
DOSTOR  2431
DOT     1165
DOTEMP  0056
DOTMP   2030
DOTMPN  3565
DOTP2   6362
DP12    6353
DP2C1   0356
DP3     6751
DP3C0   3607
DP4     1005
DP6     6753
DP8     1166
DPCHK   7163
DPERR   2442
DPLIST  0057
DPUSED  0104
DPUSH   1130
DREPTC  4036
DSTACK  0027
DUMSUB  6270
ELCNT   0067
ELLOOP  4235
ELMLUP  4147
ELMSIZ  0026
END     4200
END2    4267
ENDELM  4053
ENDFIL  4001
ENDLUP  6101
ENDM    1464
ENDPLG  6216
ENTERE  7776
ENTERF  7777
ENTRY   0020
EOKL    6453
EOL     7426
EOSTMT  2203
EQ      0427
EQ1     6015
EQ10    6045
EQ11    6052
EQ12    6054
EQ13    6055
EQ14    6060
EQ15    6057
EQ16    6065
EQ17    6071
EQ18    6070
EQ19    6073
EQ2     6020
EQ3     6022
EQ4     6025
EQ5     6030
EQ6     6033
EQ7     6036
EQ8     6041
EQ9     6044
EQTABL  5765
EQUDOT  3771
EQUIVS  7107
EQV     0466
EQVTBL  6231
ERCODE  5022
ERMSG   4310
ERROR   2200
ERRPTR  0005
ESUBR   5764
ETYPE   5041
EXP     5042
EXPTBL  6631
EXTARG  3514
EXTERN  2142
EXTLIT  0066
EXTRNL  7056
EZVAR   6332
F1LNAM  0072
FADD    1007
FADDM   7166
FATAL   0352
FCLA    3144 unreferenced
FDIV    2356
FILBLK  0007
FILDEV  0006
FILL    6414
FILSIZ  4302
FINAL   5135
FINIST  6120
FIXCAL  6131
FIXDAT  4031
FIXELP  5104
FIXSLV  6525
FLDA    1012
FLDAA1  7775
FLDAA2  7774
FLDAI   6757
FLDAP   5567
FMODE   0101
FMTLUP  3751
FMTRD1  5231
FMTWR1  5237
FMUL    2353
FNAME   6153
FNEG    1572
FNOP    6731
FNSWIT  3266
FORMAT  3734
FPLIST  0056
FREEXR  0046
FSTA    1567
FSTAI   6762
FSUB    1015
FTRNTM  5336
FUNCAL  3400
FUNCTN  0062
FUNNAM  1671
FVAL    5117
FVC     5127
FVD     5135
FVI     5124
GALOOP  6033
GARG    0704
GARGS   1200
GC      6533
GC1     5215
GC1C2   5205
GC2     5220
GCAC    5172
GCTEMP  0065
GD      6535
GE      0416
GENCAL  3200
GENCOD  1400
GENPTR  3670
GENSTE  3553
GENSTF  5437
GETSS   0630
GFNAME  6142
GI      6530
GIRL1   5162
GIRL2   5166
GLABEL  0051
GORALF  5000
GOTO    1533
GOTSIZ  4130
GSIZLP  6213
GT      0415
GTSTUF  1546
GTTYPE  1563
GVSKEL  5731
HOFILL  5474
HOLDUN  5501
HOLIST  0055
HOLLIT  5400
HOLLUP  5435
HOLOOP  5452
IBASP3  6335
IFEND   2242
IFGOTO  2333
IFLABL  0055
IMPLCT  7000
INBCNT  0625
INBLOK  0611
INBPTR  0626
INBUF   7200
IND0    1725
IND3    1724
INDARG  1737
INERR   0623
INPUT   0060
INRCNT  0627
INS     6656
INS2    6652
INS3    6664
INTLST  0060
INTMP   3343
INWORD  0600
INXR    3476
IOFUN   5757
IOLMNT  6000
IOLOOP  0070
IOONLY  3313
IOSTMT  0100
IOTYPE  6147
ITSA2   1445
JA      3657
JAC     1565
JADP2   5061
JAGEN   1536
JAGOBK  5716
JLE     2157
JLT     3653
JNE     3643
JSA     3663
JSACAD  5236
JSACDV  5255
JSACEQ  5223
JSACML  5250
JSACNG  5231
JSACSB  5243
JSR     3661
JSRLBL  0103
JXN     3612
KILLUP  6427
KILVAR  6461
L6201   0244
LDAMUL  6356
LDASTA  6303
LDASTD  5103
LDX     3622
LE      0412
LE1     6123
LE11    6137
LE12    6141
LE13    6142
LE17    6145
LE18    6144
LE19    6147
LE2     6127
LE3     6131
LE4     6134
LETABL  6075
LIFBGN  2276
LIFOPT  0457
LINENO  0003
LITLUP  7323
LITNUM  0036
LITRL   2364
LITRL2  7364
LOADA   6502
LOADA1  1472
LOADA2  1475
LODARG  6524
LSIZE   7355
LT      0413
LTRNE   0753
LXM1C2  5112
M006    7056
M1      5557
M11     5616
M111    7476
M12LUP  2117
M14     5631
M18     5643
M1C2    3550
M317    7101
M32     7474
M4      5567
M7      5600
M7000   4343
M8      5605
MAC     7772
MACRO   1450
MAKCAL  3427
MJTBL   1506
MNADR   6365
MNL     6352
MNOPC   6361
MORE    5400
MORELM  4055
MORESS  3110
MORPLG  6000
MPOPUP  1406
MPTR0   5047
MPTR3   5054
MPTRA1  1255
MQ      0042
MRETN   1504
MSTART  0024
MUL     5457
MUL12   2112
MULTBL  5531
NAMCDF  0247
NAMEF   6154
NAMPTR  0327
NARGS   0050
NCA     5231
NCHAR   0214
NCM     6472
NDADFL  7547
NDLP3   5323
NDM     6476
NDPUSD  6634
NDVDIM  6333
NE      0430
NEG     0361
NEGSGN  7773
NEGSLV  6447
NEGTBL  6453
NEWM    6555
NEXT    0402
NFCNT   6155
NIA     6467
NIARG   3720
NIM     6465
NISA    5311
NISA2   5307
NLABEL  3363
NLODSS  3053
NOADDR  1435
NOARAY  5256
NOARGS  5327
NOBC    5547
NOC     1055
NOCORD  1060
NODBUG  6133
NOFVAL  5732
NOLOOP  6063
NOREAD  0620
NOREST  5712
NOSCLR  5303
NOT     5450
NOTA    6515
NOTARG  2000
NOTINX  3252
NOTLOG  2342
NOTM    6513
NOTMT   2675
NOTTBL  6501
NPOVLY  0700
NPPAS3  1600
NPRNT   6434
NSARGS  6351
NUMBRO  0645
NUMELM  0030
NXTBC   5542
O100    7015
O1000   7107
O141    5412
O301    7473
OADDR   1600
OADRET  1723
OBLOCK  0544
OCHAR   0472
OCNT    0200
OENTRY  0021
OINS    5466
OJSR    5266
OJSROP  5300
OLABEL  3527
OLDM    6554
OLLABL  6056
OLOOP   0301
ONEI    0063
ONUM    6156
ONUMBR  0275
ONUMT   0234
OPC     3050
OPCIO   6222
OPCOD   2254
OPCODE  3540
OPRND   2134
OPTMYZ  2215
OR      6352
ORG     2161
ORTABL  6201
OSF     3727
OSIZE   0563
OSNUM   0214
OTAB    3140
OTERR   1360
OTMPS   4343
OUBUF   4400
OUDUMP  0533
OUERR   0555
OUFSTA  6076
OUJMP   0561
OUJUMP  0476
OUPOLD  0557
OUPTR   0560
OUTA    1646
OUTA2   1653
OUTEMP  0533
OUTJSR  3257
OUTLIT  1660
OUTNAM  0234
OUTSN   1732
OUTSYM  0225
OUTV    6117
OUTVAR  7203
OUWDCT  0562
OVERLY  0000
OVFLD1  7221
OVFLD2  7231
OVRLAY  5000
P0F1    0173
P0F2    0174
P2      1000
PAS3SV  5155
PASS2O  7555
PASS3N  5031
PAUZE   5356
PAZCOD  5146
PCAC    5200
PLSDOT  7253
PLSKIP  5344
PLSUB1  5331
PLSUB2  6600
PLUS    0054
PLUSN   2054
PROGNM  0061
PROLG1  5200
PROLG2  5600
PSN     5060
PTCH    5752
PTRLST  3316
PURGE   5346
PUSH    1103
Q17     0126
Q20     0141
Q200    0145
Q255    0146
Q256    0152
Q260    0106
Q3      0147
Q40     0142
Q5      0120
Q6M3    0120
Q7605   0170
QCHKXR  0131
QCODE   0114
QCRLF   0135
QERMSG  0110
QGARG   0140
QGARGS  0160
QGENCA  0155
QGENCO  0121
QGENSE  0133
QGENSF  0132
QGETSS  0151
QINWOR  0115
QLABEL  0172
QLITRL  0144
QLOADA  0156 unreferenced
QM4     0105
QM6     0122
QM63    0167
QMUL12  0157
QNEXT   0111
QNEXTM  0112
QNUMBR  0163
QOADDR  0125
QOCHAR  0162
QOINS   0161
QOLABE  0150
QONUMB  0116
QOPCDE  0124
QOPCOD  0123
QOSNUM  0134
QOTAB   0136
QOUTNA  0143
QOUTSY  0137
QSAVAC  0153
QSAVEA  0117
QSFM1   5715
QSKPIR  0154
QTTCRL  0166
QTTYMS  0127
QTTYOU  0107
QTTYP2  0165
QUCODE  0113
QXRBUF  0164
QXRTBL  0130
RALFNM  5025
RALFSV  5020
RCOUNT  0033
RDDRTN  5333
RDOVLY  7552
RDRTNE  5330
REBSUB  4011
RELCD   0171
RELGEN  0440
RELGM1  0437
RELJMP  2344
RETURN  5434
REWIND  4000
ROUTNE  7477
RSLOOP  5646
RTNCOD  5142
RTNX    6774
SAMVAR  4143
SARG    3331
SATEMP  1062
SAVACT  1020
SAVE    1042
SAVEAC  1025
SC      2102
SCALAR  7263
SCCA    5172
SCCM    5220
SCDA    6421
SCDM    6417
SCIA    6367
SCIM    6365
SCS     5506
SD      5036
SDBL    5466
SDCA    6437
SDCM    6434
SDDA    6445
SDDM    6443
SDIA    6432
SDIM    6430
SDS     5513
SDS5    5521
SE      5041
SECT    6701
SEGCAC  5172
SETB    6737
SETMOD  5126
SETX    6734
SF      5044
SFUDGE  6556
SGNNEG  1502
SICA    6354
SICM    6352
SIDA    6410
SIDM    6406
SIIA    6345
SIIM    6343
SIRA    6350
SIRM    6346
SIT     1742
SIX     0075 unreferenced
SKEL    1342
SKPIRL  2102
SLCA    6402
SLCM    6376
SLDA    6450
SLDM    6446
SLIA    6373
SLIM    6371
SNCLUP  5062
SNDEFN  5077
SNDONE  5103
SNLIST  0062
SPASS3  5164
SRCA    6362
SRCM    6360
SRDA    6415
SRDM    6413
SS      5453
SSC2    2735
SSCHEK  2727
SSD     5501
SSKEL   5527
SSREF   1674
SSX     5473
STACK   7000
STACK1  4700
START2  5000 unreferenced
STARTD  3147
STARTE  2163
STARTF  1134
STFORE  5751
STKLVL  0052
STMUL   2125
STOP    3731
STORE   5503
STPCOD  5154
STRPTR  3347
STRTBL  6261
STRTIO  5200
STRTMP  2561
SUB     5453
SUBARG  5131
SUBRX   7151
SUBTBL  5425
SVLIMT  2555
SX      5460
TEM     0002
TEMP    0024
TEMP14  1505
TEMP2   0025
TEMPN   2367
TEMPN2  3153
TEMPS   7346
TEXTX   6742
TFUDGE  7414
THREE   0070
TMPBLK  0002
TMPBMP  1071
TMPCNT  0034
TMPMAX  0035
TMPREF  2035
TMPSIZ  7353
TOOMNY  5367
TRAP3   3665
TRUE    0102
TRYCAL  3075
TSTABT  6200
TTCHAR  0225
TTCRLF  0337
TTYMSG  0345
TTYOUT  0730
TTYP2C  0315
TYPE    0023
TYPE1   0030
TYPE2   0033
TYPERR  1355
TYPLP2  7410
TYPLUP  7412
TYPMIX  6712
TYPRTN  7400
UCODE   0656
UNHOOK  5140
USKEL   0676
VARADR  7274
VDAIO   6200
VDIMLP  6230
VDTEMP  6347
VDTMP2  6350
VERROR  5146
VERS    0004
VERSON  0004
VMC     2064
VOVER   5126
WCLOSE  5261
WHATAC  0044
WHATBS  0045
X10     0010
X11     0011
X12     0012
X13     0013
X14     0014
X15     0015
X16     0016
X17     0017
X200    0607
X6201   7223
X7746   5165
XARGS   5764
XBAC1P  1752
XBAK    3632
XBAP30  6724
XBASC1  6745
XBASE   3600
XBASP3  3603
XBPC2P  6344
XDEF    5423
XDFARG  5420
XDOTMP  4214
XDP3    5234
XDPP6   1363
XDPTMP  2167
XEND    6604
XENDF   3627
XEXIT   3635
XFIX    1367
XGOBAK  6711
XGOBC0  6717
XGOTO   6617
XLAST   6630
XLBL    6773
XLBLE   6765
XLOGIF  6610
XM3     5371
XNAMP   6433
XNOP    5360
XOR     6356
XPAUSE  3773
XPUSH   6540
XR      0041
XRBUFR  6600
XRCHEK  2651
XRCNT   3074
XRDAO   5426
XREADO  5312
XREPTR  3137
XRET    6704
XREW    3624
XRFLAG  2765
XRNUM   0043
XRTABL  6461
XRTLUP  6467
XRTN    3640
XRUO    5322
XSET    1514
XST     6715
XTA     3620
XTMP    2766
XTRN    7151
XUE     1757
XVAL    1002
XWDAO   5431
XWRITO  5316
XWUC    5306
XWUO    5325
XXR     6707
ZC1     6755
ZEROC1  1517
ZXR     6364