| 1 | /4 OS/8 FORTRAN (PASS ONE) |
| 2 | / |
| 3 | / VERSION 4A PT 16-MAY-77 |
| 4 | / |
| 5 | / OS/8 FORTRAN COMPILER - PASS 1 |
| 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 | \f/CHANGES FOR MAINTENANCE RELEASE (S.R.): |
| 40 | |
| 41 | /1. BUMPED VERSION NUMBER TO 304 |
| 42 | /2. INCLUDED PATCH SEQ #4 (OCT DSN) FOR SF ERROR FIX |
| 43 | /3. INCLUDED PATCH SEQ #6 (TEMP VARS IN ASF) |
| 44 | /4. FIXED PROBLEM IN DATA STATEMENT |
| 45 | /5. STOPPED HALT AFTER OT ERROR BY CONVERTING LOGICAL |
| 46 | / VARS TO INTEGER IN ARITHMETIC IF STATEMENT |
| 47 | /6. FIXED BUG RE /A AND .RA EXTENSION |
| 48 | |
| 49 | /LAST MINUTE CHANGES: |
| 50 | |
| 51 | /7. ALLOWED PARITY INPUT |
| 52 | /8. IGNORE NULLS ON INPUT |
| 53 | /9. FIXED BUG RE IGNORING LAST LINE IF IN ERROR |
| 54 | / OR IN FACT IGNORING ANY LAST LINE IF NO END STATEMENT |
| 55 | /10. ALLOW MULTIPLE INPUT FILES |
| 56 | / |
| 57 | / |
| 58 | /CHANGES FOR OS/8 V3D AND OS/78 BY P.T. |
| 59 | / .PATCH LEVEL NOW CONTAINED IN LOCATION 1130 |
| 60 | \f *7 |
| 61 | LINENO, 1 /2.01/ LINE NUMBER |
| 62 | X10, 0 /AUTO INDEX REGISTERS |
| 63 | X11, 0 |
| 64 | X12, 0 |
| 65 | NEXT, FREE-1 /FREE SPACE POINTER |
| 66 | STACK, STACKS-1 /STACK POINTER |
| 67 | CHRPTR, 0 /INPUT BUFFER POINTER |
| 68 | X16, 0 |
| 69 | X17, 0 |
| 70 | STKLVL, STACKS-1 /STACK BASE LEVEL |
| 71 | BUCKET, 0 /FIRST CHAR OF NAME |
| 72 | WORD1, 0 /SIX WORD LITERAL BUFFER |
| 73 | WORD2, 0 |
| 74 | WORD3, 0 |
| 75 | WORD4, 0 |
| 76 | WORD5, 0 |
| 77 | WORD6, 0 |
| 78 | ACO, 0 /FLOATING AC OVERFLOW WORD |
| 79 | OP1, 0 /SEVEN WORD OPERAND FOR "NUMBER" |
| 80 | OP2, 0 |
| 81 | OP3, 0 |
| 82 | OP4, 0 |
| 83 | OP5, 0 |
| 84 | OP6, 0 |
| 85 | OPO, 0 |
| 86 | CHAR, 0 /ICHAR PUTS CHARACTER HERE |
| 87 | NOCODE, 0 /IS 1 IF CODE GENERATION OFF |
| 88 | NCHARS, 0 /SIZE OF INPUT LINE |
| 89 | NUMELM, 0 /NUMBER OF VARS IN TYPED LIST |
| 90 | TEMP, 0 |
| 91 | TEMP2, 0 |
| 92 | DECPT, 0 /SET 1 IF NUMBER CONTAINED . |
| 93 | ESWIT, 0 /1 FOR E 0 FOR D |
| 94 | NDIGIT, 0 /NUMBER OF DIGITS TO RIGHT OF . |
| 95 | HCHAR, HCOUNT /HOLLERITH GETTER ROUTINE |
| 96 | SNUM, 0 /POINTER TO ST ENTRY FOR STMT NUMBER |
| 97 | IFSWIT, 0 /=1 IF INSIDE LOGICAL IF |
| 98 | EXPON, 0 /HOLDS EXPONENT FOR CONVERSION |
| 99 | TMPFIL, 0617;2224;2216;2415 /PASS1 OUTPUT FILE |
| 100 | 0;0;0;0 /PASS2 OUTPUT FILE |
| 101 | DOEND, 0 /SET 1 IF THIS STMT WAS A IF, |
| 102 | /GOTO, RETURN, PAUSE, OR STOP |
| 103 | THSNUM, 0 /CURRENT STATEMENT NUMBER |
| 104 | DIMNUM, 0 /LINEARIZED SS FOR EQ |
| 105 | DPRDCT, 0 /HOLDS DIMENSION PRODUCT |
| 106 | EQTEMP, 0 /TEMP FOR EQUIVALENCE |
| 107 | MQ, 0 /MQ FOR 12 BIT MULTIPLY |
| 108 | MASTER, 0 /POINTER TO MASTER IN EQUIV GROUP |
| 109 | MNUM, 0 /LINEARIZED SS FOR MASTER |
| 110 | NSLAVE, 0 /NUMBER OF SLAVES IN GROUP |
| 111 | PASS2O, 0 /START OF PASS 2 OVERLAY SECTION |
| 112 | OUFILE, 0 /START OF PASS1 OUTPUT FILE |
| 113 | DSERES, 0 /MAGIC NUMBER |
| 114 | PROGNM, MAIN /POINTER TO PROG NAME |
| 115 | ARGLST, 0 /POINTER TO ARG LIST |
| 116 | FUNCTN, 0 /0=MAIN, 1=FUNCTION, -2=SUBROUTINE |
| 117 | SETBIT, 0 /TEMPS FOR DECLARATION SCANNER |
| 118 | BADBIT, 0 |
| 119 | DOINDX, 0 /POINTER TO DO INDEX FOR DO LOOPS |
| 120 | TLTEMP, 0 /TEMP FOR TYPE ROUTINE |
| 121 | OWTEMP, 0 /TEMP FOR OUTWRD |
| 122 | CNT72, -102 /72 COLUMN COUNTER |
| 123 | DPUSED, 0 /=1 IF DOUBLE HARDWARE USED |
| 124 | VERS, VERSON /VERSION NUMBER |
| 125 | M211, -211 |
| 126 | P211, 211 |
| 127 | P240, 240 |
| 128 | IXLNP5, LINE+5 /** |
| 129 | IXLINE, LINE |
| 130 | IXLINM, LINE-1 |
| 131 | STMJMP, 0 /FOR DEFINE FILE |
| 132 | \f/ OPCODES AND EQUS |
| 133 | MAXHOL=100 /MAXIMUM HOLLERITH LITERAL |
| 134 | COMREG=4600 /INTER-PASS COMMUNICATION REGION |
| 135 | STACKS=4700 /STACK AREA |
| 136 | NAME1=6200 /NAME AND HOLLERITH BUFFER (WAS 6400)** |
| 137 | LINE=6300 /LINE BUFFER (WAS 6500)** |
| 138 | INBUF=6600 /INPUT BUFFER (FIELD 1) |
| 139 | OUBUF=7200 /OUTPUT BUFFER (DITTO) |
| 140 | INDEVH=7200 /INPUT DEVICE HANDLER (WAS 7400)** |
| 141 | PAUSOP=22 |
| 142 | DPUSH=PAUSOP+1 |
| 143 | BINRD1=DPUSH+1 /OPCODE DEFINITIONS |
| 144 | FMTRD1=BINRD1+1 |
| 145 | RCLOSE=FMTRD1+1 |
| 146 | DARD1=RCLOSE+1 |
| 147 | BINWR1=DARD1+1 |
| 148 | FMTWR1=BINWR1+1 |
| 149 | WCLOSE=FMTWR1+1 |
| 150 | DAWR1=WCLOSE+1 |
| 151 | DEFFIL=DAWR1+1 |
| 152 | ASFDEF=DEFFIL+1 |
| 153 | ARGSOP=ASFDEF+1 |
| 154 | EOLCOD=ARGSOP+1 |
| 155 | ERRCOD=EOLCOD+1 |
| 156 | RETOPR=ERRCOD+1 |
| 157 | REWOPR=RETOPR+1 |
| 158 | STOROP=REWOPR+1 |
| 159 | ENDOPR=STOROP+1 |
| 160 | DEFLBL=ENDOPR+1 |
| 161 | DOFINI=DEFLBL+1 |
| 162 | ARTHIF=DOFINI+1 |
| 163 | LIFBGN=ARTHIF+1 |
| 164 | DOBEGN=LIFBGN+1 |
| 165 | ENDFOP=DOBEGN+1 |
| 166 | STOPOP=ENDFOP+1 |
| 167 | ASNOPR=STOPOP+1 |
| 168 | BAKOPR=ASNOPR+1 |
| 169 | FMTOPR=BAKOPR+1 |
| 170 | GO2OPR=FMTOPR+1 |
| 171 | CGO2OP=GO2OPR+1 |
| 172 | AGO2OP=CGO2OP+1 |
| 173 | IOLMNT=AGO2OP+1 |
| 174 | DATELM=IOLMNT+1 |
| 175 | DREPTC=DATELM+1 |
| 176 | DATAST=DREPTC+1 |
| 177 | ENDELM=DATAST+1 |
| 178 | PRGSTK=ENDELM+1 |
| 179 | DOSTOR=PRGSTK+1 |
| 180 | / ASSEMBLE STATEMENT |
| 181 | PAGE |
| 182 | RDLOOP, CIF 10 /FOR OS/8 2 PG HANDLERS** |
| 183 | JMS I [ICHAR /GET CHAR FROM INPUT FILE |
| 184 | JMP ENDLIN /END LINE OR CR |
| 185 | TAD M211 /CHECK FOR TAB** |
| 186 | SNA |
| 187 | TAD (240-211 /CONVERT TO BLANK |
| 188 | TAD P211 /** |
| 189 | DCA I CHRPTR /SAVE CHAR |
| 190 | ISZ CNT72 /PAST COLUMN 72 ? |
| 191 | SKP |
| 192 | JMP SKPLIN /SKIP 73 TO 80 |
| 193 | TAD CHRPTR |
| 194 | CIA CLL |
| 195 | TAD (LINE+670 |
| 196 | SZL CLA /TEST FOR TOO MANY CONTINUATIONS |
| 197 | JMP RDLOOP |
| 198 | JMS I [ERMSG /LINE TOO LONG |
| 199 | 1424 |
| 200 | SKPCOM, TAD X16 /RESTORE CHRPTR |
| 201 | DCA CHRPTR |
| 202 | SKPLIN, CIF 10 /** |
| 203 | JMS I [ICHAR /SKIP REST OF LINE |
| 204 | JMP ENDLIN |
| 205 | CLA |
| 206 | JMP SKPLIN |
| 207 | ENDLIN, TAD CHRPTR /SAVE CHAR POSITION |
| 208 | DCA X16 |
| 209 | TAD CHRPTR |
| 210 | DCA X10 /SAVE POSITION FOR COMMENT CHECK |
| 211 | TAD (-102 /SET COLUMN COUNT |
| 212 | DCA CNT72 |
| 213 | TAD M6 |
| 214 | DCA NCHARS |
| 215 | GET6, CIF 10 /** |
| 216 | JMS I [ICHAR /GET FIRST 6 CHARS |
| 217 | JMP SHORTL /IGNORE SHORT LINES |
| 218 | TAD M211 /IS CHAR A TAB ? ** |
| 219 | SZA CLA |
| 220 | JMP NOTAB /NO |
| 221 | TAD P240 /TREAT FIRST TAB AS SIX BLANKS |
| 222 | DCA I CHRPTR |
| 223 | ISZ NCHARS |
| 224 | JMP .-3 |
| 225 | TAD P240 /FAKE CONTINUATION CHECK |
| 226 | DCA CHAR |
| 227 | JMP CCHECK /GO TO COMMENT CHECK |
| 228 | SHORTL, TAD X16 /RESET CHAR POINTER |
| 229 | DCA CHRPTR /TO IGNORE SHORT LINES |
| 230 | JMP ENDLIN |
| 231 | NOTAB, TAD CHAR |
| 232 | DCA I CHRPTR |
| 233 | ISZ NCHARS |
| 234 | JMP GET6 /LOOP |
| 235 | CCHECK, TAD I X10 /IS IT A COMMENT ? |
| 236 | TAD (-303 |
| 237 | SNA CLA |
| 238 | JMP SKPCOM /COMMENT, SKIP REST |
| 239 | NOCMNT, TAD CHAR /WAS SIXTH CHAR A BLANK ? |
| 240 | TAD MMM240 |
| 241 | SNA CLA |
| 242 | JMP GOTLIN /YES, NO MORE CONTINUATIONS |
| 243 | CCARD, TAD X16 /IGNORE THESE SIX CHARACTERS |
| 244 | DCA CHRPTR |
| 245 | JMP RDLOOP /CONTINUE WITH THIS LINE |
| 246 | GOTLIN, TAD CHRPTR /COMPUTE -NCHARS-1 |
| 247 | CIA |
| 248 | TAD (LINE+4 |
| 249 | DCA NCHARS |
| 250 | TAD [LINE-1 /RESET CHAR POINTER |
| 251 | DCA CHRPTR |
| 252 | JMS I [CKCTLC /CHECK FOR CONTROL C |
| 253 | LINE1, DCA THSNUM /ZERO CURRENT STMT NUMBER |
| 254 | CLL CML RAR /SET LABEL DEFINE BIT |
| 255 | JMS I [STMNUM /GO LOOK FOR LABEL |
| 256 | JMP COMPIL /NONE THERE |
| 257 | TAD SNUM /SAVE STATEMENT NUMBER |
| 258 | DCA THSNUM |
| 259 | TAD (DEFLBL /OUTPUT DEFINITION FOR THIS LABEL |
| 260 | JMS I [OUTWRD |
| 261 | TAD SNUM |
| 262 | JMS I [OUTWRD /FOLLOWED BY THE LABEL ADDRESS |
| 263 | COMPIL, JMS I [SAVECP |
| 264 | ISZ LINENO /2.01/ PUT LINE NUMBER |
| 265 | TAD LINENO /2.01/ INTO MQ |
| 266 | 7421 /2.01/ |
| 267 | CLA IAC |
| 268 | DCA NOCODE /SET NOCODE SWITCH |
| 269 | JMS I [ERMSG /SET UP DEFAULT ERROR MESSAGE |
| 270 | 1513 |
| 271 | JMS I [LEXPR /IS IT ARITHMETIC ? |
| 272 | JMP NOTAR /NO |
| 273 | JMS I [GETC /LOOK FOR = |
| 274 | JMP NOTAR /NOT ARITHMETIC |
| 275 | TAD MMM275 /= |
| 276 | SNA CLA |
| 277 | JMS I [EXPR /SCAN LEFT PART |
| 278 | JMP NOTAR |
| 279 | JMS I [ERMSG /SET MESSAGE TO ILLEGAL OPERATOR |
| 280 | 1720 |
| 281 | ISZ NCHARS /SHOULD BE NOTHING LEFT |
| 282 | JMP NOTAR /IF THERE IS, ITS NOT ARITHMETIC |
| 283 | ITSAR, JMS I [RESTCP /RESTORE TO START OF LINE |
| 284 | DCA NOCODE /ALLON CODE |
| 285 | JMS I [LEXPR /GET LEFT SIDE |
| 286 | M6, -6 /V3C MUST BE HERE |
| 287 | JMS I [GETC /SKIP = |
| 288 | MMM240, -240 /SHOULD NEVER GET HERE |
| 289 | CLA |
| 290 | JMS I [EXPR /GET RIGHT SIDE |
| 291 | MMM275, -275 /SHOULD NEVER GET HERE |
| 292 | TAD (STOROP /OUTPUT STORE |
| 293 | JMS I [OUTWRD |
| 294 | JMP I [NEXTST /DO NEXT LINE |
| 295 | NOTAR, JMS I [RESTCP /RESTART LINE |
| 296 | DCA NOCODE |
| 297 | JMS I [SAVECP /RESAVE CHAR POSITION |
| 298 | TAD (CMDLST-1 |
| 299 | DCA X10 |
| 300 | JMP I (CMDLUP /GO SEARCH FOR KEYWORD |
| 301 | \f/ KEYWORD SEARCH |
| 302 | PAGE |
| 303 | CMDLUP, CDF 10 /TABLE IN FIELD ONE |
| 304 | TAD I X10 /GET NEXT 2 CHARS OF KEYWORD |
| 305 | SZA |
| 306 | JMP CMDLP2 /NOT DONE YET |
| 307 | CLL CMA RAL /REMOVE CHAR POS FROM STACK |
| 308 | TAD STACK |
| 309 | DCA STACK |
| 310 | TAD I X10 /GET ROUTINE ADDRESS |
| 311 | CDF |
| 312 | DCA STMJMP |
| 313 | JMP I STMJMP /JUMP TO THE ROUTINE |
| 314 | CMDLP2, DCA TEMP /SAVE THE TWO CHARS |
| 315 | CDF |
| 316 | JMS I [GET2C /GET TWO CHARS FROM THE INPUT |
| 317 | JMP .+4 /NOT ENOUGH CHARS, CAN'T BE THIS ONE |
| 318 | TAD TEMP /COMPARE |
| 319 | SNA CLA |
| 320 | JMP CMDLUP /MATCHES, KEEP GOING |
| 321 | JMS I [RESTCP /RESTORE CHAR POS |
| 322 | ISZ STACK |
| 323 | ISZ STACK /AND SAVE IT AGAIN |
| 324 | CDF 10 |
| 325 | TAD I X10 /FIND END OF THIS COMMAND |
| 326 | SZA CLA |
| 327 | JMP .-2 |
| 328 | ISZ X10 /SKIP ROUTINE ADDRESS |
| 329 | TAD I X10 /IS THE LIST EXHAUSTED ? |
| 330 | SZA |
| 331 | JMP CMDLP2 /NO, GO AGAIN |
| 332 | BADCMD, JMS I [ERMSG /TREAT AS BAD ARITHMETIC STMT |
| 333 | ERCODE, 0 |
| 334 | \f/ END OF STMT PROC |
| 335 | NEXTLN, |
| 336 | NEXTST, |
| 337 | DOENDR, TAD STKLVL /RESET STACK POINTER |
| 338 | DCA STACK |
| 339 | JMS I [POP /LOOK FOR DO END |
| 340 | CIA |
| 341 | TAD THSNUM /DOES THIS LINE END A DO LOOP ? |
| 342 | SZA CLA |
| 343 | JMP NODOND /NO, REPLACE STACK AND COMPILE STMT |
| 344 | TAD (DOFINI |
| 345 | JMS I [OUTWRD /OUTPUT DO END COMMAND |
| 346 | JMS I [POP /GET INDEX VARIABLE |
| 347 | JMS I [OUTWRD |
| 348 | TAD STACK /RESET STACK BASE LEVEL |
| 349 | DCA STKLVL |
| 350 | TAD DOEND /WAS THIS A LEGAL ENDING STMT ? |
| 351 | SZA CLA |
| 352 | JMS I [ERMSG |
| 353 | 0504 /DO END ERROR |
| 354 | DCA DOEND /KILL SWITCH |
| 355 | JMP DOENDR |
| 356 | NODOND, ISZ STACK /REPLACE STACK ENTRY |
| 357 | DCA DOEND /KILL SWITCH |
| 358 | TAD (EOLCOD /OUTPUT EOL CODE |
| 359 | JMS I [OUTWRD |
| 360 | DCA ERCODE /RESET ERROR CODE |
| 361 | DCA IFSWIT /KILL IF SWITCH |
| 362 | TAD (-6 /MOVE FIRST 6 CHARS |
| 363 | DCA NCHARS |
| 364 | TAD [LINE-1 /INTO START OF BUFFER |
| 365 | DCA CHRPTR |
| 366 | TAD I X16 |
| 367 | DCA I CHRPTR |
| 368 | ISZ NCHARS |
| 369 | JMP .-3 |
| 370 | JMP I (RDLOOP |
| 371 | \f/ GOTO'S |
| 372 | GOTO, ISZ DOEND /DO END ILLEGAL |
| 373 | JMS I [STMNUM /IS IT A SIMPLE GOTO ? |
| 374 | JMP CMPGO2 /NO, SEE IF ITS A COMPUTED ONE |
| 375 | TAD (GO2OPR /OUTPUT GOTO OPERATOR |
| 376 | JMS I [OUTWRD |
| 377 | TAD SNUM /FOLLOWED BY STMT NUMBER |
| 378 | JMS I [OUTWRD |
| 379 | JMP I [NEXTST |
| 380 | CMPGO2, JMS I [GETC /LOOK FOR ( |
| 381 | JMP BADGO2 /BAD GOTO |
| 382 | TAD (-250 |
| 383 | SZA CLA |
| 384 | JMP ASNGO2 /NOT ( , MAYBE ITS AN ASSIGNED GOTO |
| 385 | TAD STACK /SAVE STACK POSITION |
| 386 | DCA X12 |
| 387 | DCA TEMP /ZERO BRANCH COUNTER |
| 388 | GO2LUP, JMS I [STMNUM /GET NEXT STMT NUMBER |
| 389 | JMP BADGO2 /MUST BE THERE |
| 390 | TAD SNUM |
| 391 | JMS I [PUSH /SAVE IT TEMPORARILY |
| 392 | ISZ TEMP /BUMP BRANCH COUNT |
| 393 | JMS I [COMARP /LOOK FOR COMMA OR RIGHT PAREN |
| 394 | JMP BADGO2 /NEITHER |
| 395 | JMP GO2LUP /COMMA, GO GET NEXT LABEL |
| 396 | JMS I [GETC /SKIP NEXT CHAR (ITS A COMMA) |
| 397 | JMP BADGO2 |
| 398 | CLA |
| 399 | TAD TEMP /SAVE COUNT |
| 400 | JMS I [PUSH /ON STACK |
| 401 | JMS I [EXPR /COMPILE INDEX EXPR |
| 402 | JMP I [NEXTST |
| 403 | TAD (CGO2OP /OUTPUT COMPUTED GOTO OPERATOR |
| 404 | JMS I [OUTWRD |
| 405 | JMS I [POP /GET COUNT |
| 406 | CIA |
| 407 | DCA TEMP /SAVE COMPLEMENT |
| 408 | TAD TEMP |
| 409 | CIA |
| 410 | JMS I [OUTWRD /OUTPUT COUNT |
| 411 | TAD X12 /RESTORE STACK POINTER |
| 412 | DCA STACK |
| 413 | TAD I X12 /MOVE STMT NUMBERS TO OUTPUT |
| 414 | JMS I [OUTWRD |
| 415 | ISZ TEMP |
| 416 | JMP .-3 |
| 417 | JMP I [NEXTST |
| 418 | ASNGO2, JMS I [BACK1 /PUT BACK NON ( |
| 419 | JMS I [LEXPR /GET ASSIGN VAR |
| 420 | JMP BADGO2 |
| 421 | TAD (AGO2OP /OUTPUT GOTO OPERATOR |
| 422 | JMS I [OUTWRD |
| 423 | JMP I [NEXTST |
| 424 | BADGO2, JMS I [ERMSG |
| 425 | 0724 |
| 426 | JMP I [NEXTST |
| 427 | \f/ I/O STATEMENTS |
| 428 | PAGE |
| 429 | RDWR, 0 /SUBR FOR IO STATEMENTS |
| 430 | JMS I [CHECKC /LOOK FOR ( |
| 431 | M250, -250 |
| 432 | JMP BADRD |
| 433 | JMS I [EXPR /COMPILE UNIT |
| 434 | JMP I [BADCMD |
| 435 | JMS I [COMARP |
| 436 | JMP DAQUOT /LOOK FOR ' (DIRECT ACCESS I/O) |
| 437 | JMP RDFMT /, |
| 438 | TAD (BINRD1 /FORMATLESS READ/WRITE |
| 439 | IOSTRT, TAD I RDWR /ADD ADJUSTOR |
| 440 | JMS I [OUTWRD /OUTPUT BINARY READ |
| 441 | IOLIST, JMS I [PUSH /MARK STACK |
| 442 | JMS I [GETC /IS IT AN IMPLIED DO ? |
| 443 | JMP ENDIOL /NO, END OF LIST |
| 444 | TAD M250 |
| 445 | SZA CLA |
| 446 | JMP TRYIOE /NO, LOOK FOR IO ELEMENT |
| 447 | JMS I [SAVECP /SAVE CHAR POS AT START OF IDO |
| 448 | DCA IDOPAR /ZERO PAREN COUNTER |
| 449 | FINDND, JMS I [GETNAM /GET A NAME IF THERE IS ONE |
| 450 | XPURGE, PRGSTK /DON'T WORRY ITS A NOP |
| 451 | JMS I [GETC /GET A CHAR |
| 452 | JMP ENDIOL |
| 453 | TAD M251 /IS IT A ) ? |
| 454 | SNA |
| 455 | JMP RPIOL /YES |
| 456 | IAC /IS IT ( ? |
| 457 | SNA |
| 458 | JMP LPIOL /YES |
| 459 | TAD (250-275 /IS IT = ? |
| 460 | SZA CLA |
| 461 | JMP FINDND /NONE OF THESE |
| 462 | TAD IDOPAR /IS PAREN COUNT 0 ? |
| 463 | SZA CLA |
| 464 | JMP FINDND /NO, ITS FROM AN INNER LOOP |
| 465 | JMS I [LOOKUP /THIS ELEMENT IS THE DO INDEX |
| 466 | DCA DOINDX |
| 467 | JMS I (DOSTUF /COMPILE THE LOOP |
| 468 | JMP BADIOL /ERROR IN DO PARMS |
| 469 | JMS I [CHECKC /MUST HAVE ) |
| 470 | -251 |
| 471 | JMP BADIOL |
| 472 | TAD CHRPTR /SAVE CHAR POSITION |
| 473 | DCA TEMP |
| 474 | TAD NCHARS |
| 475 | DCA TEMP2 |
| 476 | JMS I [RESTCP /RESTORE TO START OF IMPLIED LOOP |
| 477 | TAD TEMP2 /NOW SAVE POS AFTER LOOP |
| 478 | JMS I [PUSH |
| 479 | TAD TEMP |
| 480 | JMS I [PUSH |
| 481 | TAD DOINDX /AND DO INDEX |
| 482 | JMP IOLIST |
| 483 | LPIOL, ISZ IDOPAR /( INCREASES COUNT |
| 484 | JMP FINDND |
| 485 | RPIOL, CMA /) DECREASES COUNT |
| 486 | TAD IDOPAR |
| 487 | SMA |
| 488 | JMP FINDND-1 |
| 489 | CLA |
| 490 | BADIOL, |
| 491 | BADRD, JMS I [ERMSG /BAD IO STMT |
| 492 | 2227 |
| 493 | JMP I [NEXTST |
| 494 | TRYIOE, JMS I [BACK1 /PUT BACK NON ( |
| 495 | JMS I [LEXPR /GET IOLIST ELEMENT |
| 496 | JMP BADRD /NOT THERE, ERROR |
| 497 | JMS I [GETC /LOOK FOR A COMMA |
| 498 | JMP .+4 /EOL |
| 499 | TAD (-254 |
| 500 | SZA |
| 501 | JMP NOTIOL /NOT AN ELEMENT |
| 502 | TAD (IOLMNT /OUTPUT OPCODE |
| 503 | JMS I [OUTWRD |
| 504 | JMP IOLIST+1 |
| 505 | NOTIOL, TAD (254-275 /IS IT AN = (END OF IDO) |
| 506 | SZA CLA |
| 507 | JMP BADIOL /NO, BAD |
| 508 | JMS I [POP /GET STUFF FROM THE STACK |
| 509 | SNA |
| 510 | JMP BADIOL /ZERO IS BAD |
| 511 | DCA DOINDX /THIS IS THE INDEX |
| 512 | JMS I [RESTCP /GET THE CHAR POSITION |
| 513 | TAD XPURGE /OUTPUT PURGE OPERATOR |
| 514 | JMS I [OUTWRD /BECAUSE AN EXTRA IS ON THE STK |
| 515 | TAD (DOFINI /END LOOP |
| 516 | JMS I [OUTWRD |
| 517 | TAD DOINDX |
| 518 | JMS I [OUTWRD |
| 519 | JMS I [GETC /END OF LIST ? |
| 520 | JMP ENDIOL |
| 521 | TAD (-254 |
| 522 | SZA CLA |
| 523 | JMP BADIOL /MUST BE A COMMA |
| 524 | JMP IOLIST+1 |
| 525 | IDOPAR, 0 |
| 526 | ENDIOL, JMS I [POP /IS THE MARK THERE ? |
| 527 | SZA CLA |
| 528 | JMP BADRD /NO, ERROR |
| 529 | TAD I RDWR |
| 530 | TAD (RCLOSE /END OF IO OPERATION |
| 531 | JMS I [OUTWRD |
| 532 | JMP I [NEXTST |
| 533 | RDFMT, JMS I [STMNUM /LOOK FOR FMT LINE NUMBER |
| 534 | JMP RTFMT |
| 535 | JMS I [OUTWRD /OUTPUT PUSH COMMAND |
| 536 | TAD SNUM /OUTPUT STMT NUMBER OF FORMAT |
| 537 | JMS I [OUTWRD |
| 538 | RDLIST, TAD (FMTRD1 /START OF FORMATTED READ |
| 539 | TAD I RDWR /ADD ADJUSTOR |
| 540 | JMS I [OUTWRD |
| 541 | JMS I [CHECKC /LOOK FOR ) |
| 542 | M251, -251 |
| 543 | JMP BADRD |
| 544 | JMP IOLIST /GO GET IO LIST |
| 545 | RTFMT, JMS I [LEXPR /GET R.T. FORMAT |
| 546 | JMP BADRD |
| 547 | JMP RDLIST /GET LIST |
| 548 | \f/DIRECT ACCESS I/O |
| 549 | PAGE |
| 550 | DAQUOT, JMS I [BACK1 |
| 551 | JMS I [CHECKC /LOOK FOR ' |
| 552 | -247 |
| 553 | JMP BADRD /SYNTAX IS NO GOOD |
| 554 | JMS I [EXPR /GET RECORD NUMBER EXPR |
| 555 | JMP BADRD |
| 556 | JMS I [CHECKC /LOOK FOR ) |
| 557 | -251 |
| 558 | JMP BADRD |
| 559 | TAD (DARD1 /DIRECT ACCESS OPEN |
| 560 | JMP IOSTRT |
| 561 | FIND, JMP I [NEXTST /COOL ISN'T IT ? |
| 562 | DFINFL, JMS I [EXPR /COMPILE UNIT |
| 563 | JMP BADDEF /BAD DEFINE STMT |
| 564 | DCA STMJMP /PERMIT VARIABLE FOR LOG UNIT |
| 565 | JMS I [CHECKC /( |
| 566 | -250 |
| 567 | JMP BADDEF |
| 568 | JMS I [EXPR /NUMBER OF RECORDS |
| 569 | JMP BADDEF |
| 570 | JMS I [CHECKC /, |
| 571 | -254 |
| 572 | JMP BADDEF |
| 573 | JMS I [EXPR /RECORD SIZE |
| 574 | JMP BADDEF |
| 575 | JMS I [CHECKC /, |
| 576 | -254 |
| 577 | JMP BADDEF |
| 578 | JMS I [CHECKC /U |
| 579 | -325 |
| 580 | JMP BADDEF |
| 581 | JMS I [CHECKC /, |
| 582 | MCOMA, -254 |
| 583 | JMP BADDEF |
| 584 | JMS I [GETNAM /GET INDEX VARIABLE |
| 585 | JMP BADDEF |
| 586 | JMS I [OUTWRD |
| 587 | JMS I [LOOKUP |
| 588 | JMS I [OUTWRD /OUTPUT INDEX VAR |
| 589 | TAD (DEFFIL /OUTPUT DEFINE OPERATOR |
| 590 | JMS I [OUTWRD |
| 591 | JMS I [CHECKC /) |
| 592 | -251 |
| 593 | JMP BADDEF |
| 594 | JMS I [GETC /ANOTHER DEFINE ? |
| 595 | JMP I [NEXTST |
| 596 | TAD MCOMA /, ? |
| 597 | SNA CLA |
| 598 | JMP DFINFL /YES, ANOTHER FILE |
| 599 | BADDEF, JMS I [ERMSG /BAD DEFINE FILE STMT |
| 600 | 0406 |
| 601 | JMP I [NEXTST |
| 602 | RESTCP, 0 /RESTORE CHAR POSITION FROM STACK |
| 603 | JMS I [POP |
| 604 | DCA CHRPTR |
| 605 | JMS I [POP |
| 606 | DCA NCHARS |
| 607 | JMP I RESTCP |
| 608 | INTEGE, JMS I [CHECKC /INTEGER STMT |
| 609 | -322 |
| 610 | JMP I [BADCMD |
| 611 | JMS I [TYPLST |
| 612 | 0101 |
| 613 | 0100 |
| 614 | NOP |
| 615 | JMP I [NEXTST |
| 616 | PAUZE, JMS I [CHECKC /LOOK FOR E |
| 617 | -305 |
| 618 | JMP I [BADCMD |
| 619 | JMS I [GETC /ANY EXPR ? |
| 620 | JMP NOARGP /MAKE IT PAUSE 1 |
| 621 | JMS I [BACK1 /PUT IT BACK |
| 622 | JMS I [EXPR /GET PAUSE NUMBER |
| 623 | XPAUZ, PAUSOP |
| 624 | OPAUZ, TAD XPAUZ /OUTPUT PAUSE OPERATOR |
| 625 | JMS I [OUTWRD |
| 626 | JMP I [NEXTST |
| 627 | NOARGP, JMS I [OUTWRD /PUSH 1.0 |
| 628 | TAD [ONE |
| 629 | JMS I [OUTWRD |
| 630 | JMP OPAUZ /GO PUT OPERATOR |
| 631 | READ, JMS I (RDWR /COMPILE READ STMT |
| 632 | 0 |
| 633 | WRITE, JMS I [CHECKC /LOOK FOR E |
| 634 | -305 |
| 635 | JMP I [BADCMD |
| 636 | JMS I (RDWR /COMPILE WRITE |
| 637 | BINWR1-BINRD1 |
| 638 | CKCTLC, 6401 /CHECK FOR CONTROL C |
| 639 | TAD (7600 |
| 640 | KRS |
| 641 | TAD (-7603 /^C |
| 642 | SNA CLA |
| 643 | KSF |
| 644 | JMP I CKCTLC |
| 645 | JMP I (7600 |
| 646 | |
| 647 | XOCTAL, DCA WORD1 /** |
| 648 | DCA WORD2 |
| 649 | DCA WORD3 /STATEMENT NUM LEFT THERE** |
| 650 | DCA WORD5 |
| 651 | DCA WORD6 |
| 652 | XCTAL1, DCA WORD4 |
| 653 | JMS I [DIGIT /GET NEXT DIGIT |
| 654 | JMP ENDOXT /NO DIGITS LEFT |
| 655 | AND [7 /THROW AWAY SOME BITS |
| 656 | DCA TEMP |
| 657 | JMS I (AL1 /MOVE WORD LEFT THREE |
| 658 | JMS I (AL1 |
| 659 | JMS I (AL1 |
| 660 | TAD WORD4 /ADD DIGIT TO WORD4 |
| 661 | TAD TEMP |
| 662 | JMP XCTAL1 /LOOP |
| 663 | ENDOXT, TAD WORD2 /PUT WORDS INTO THE LEFT PLACE |
| 664 | DCA WORD1 |
| 665 | TAD WORD3 |
| 666 | DCA WORD2 |
| 667 | TAD WORD4 |
| 668 | DCA WORD3 |
| 669 | JMP DATAFP /GO STUFF IT AWAY |
| 670 | \f/ DIMENSION, COMMON, REAL |
| 671 | PAGE |
| 672 | DIMENS, JMS I [IFCHEK |
| 673 | JMS I [CHECKC /CHECK FOR "N" |
| 674 | -316 |
| 675 | JMP I [BADCMD /NO GOOD |
| 676 | JMS I [TYPLST /PROCESS LIST |
| 677 | 0000 /DIMENSION IS THE SIMPLEST CASE |
| 678 | 0000 |
| 679 | NOP /ERROR RETURN |
| 680 | JMP I [NEXTST |
| 681 | REAL, JMS I [IFCHEK /CHECK FOR INSIDE IF |
| 682 | JMS I [TYPLST /PROCESS LIST |
| 683 | 0102 /TYPE-REAL |
| 684 | 0100 |
| 685 | NOP |
| 686 | JMP I [NEXTST |
| 687 | COMPLE, JMS I [CHECKC /CHECK FOR "X" |
| 688 | -330 |
| 689 | JMP I [BADCMD |
| 690 | JMS I [IFCHEK |
| 691 | JMS I [TYPLST /PROCESS COMPLEX LIST |
| 692 | 0103 |
| 693 | 0100 |
| 694 | NOP |
| 695 | CLA IAC /SET DP SWITCH |
| 696 | DCA DPUSED |
| 697 | JMP I [NEXTST |
| 698 | COMMON, JMS I [IFCHEK /BAD INSIDE LOGICAL IF |
| 699 | JMS I [GETC /CHECK FOR SLASH |
| 700 | JMP I [BADCMD |
| 701 | TAD M257 |
| 702 | SZA CLA |
| 703 | JMP BLANKC /MUST BE BLANK COMMON |
| 704 | JMS I [GETNAM /GET NAME OF COMMON |
| 705 | JMP DBLSLS /MIGHT BE // |
| 706 | JMS I [CHECKC /LOOK FOR / |
| 707 | M257, -257 |
| 708 | JMP BADCOM |
| 709 | JMS I [LOOKUP /LOOKUP COMMON NAME |
| 710 | IAC |
| 711 | DCA COMNAM /SAVE ADDR OF TYPE WORD |
| 712 | CDF 10 |
| 713 | TAD I COMNAM /LOOK AT TYPE |
| 714 | SZA |
| 715 | TAD (-111 /MUST BE COMMON OR UNDEF. |
| 716 | SZA CLA |
| 717 | JMP BADCOM |
| 718 | TAD (111 /SET CORRECT BITS |
| 719 | DCA I COMNAM |
| 720 | CDF |
| 721 | DOCOMN, JMS I [TYPLST /HANDLE LIST |
| 722 | 4000 |
| 723 | 5460 |
| 724 | JMP I [NEXTST |
| 725 | TAD X12 |
| 726 | DCA STACK /RESET STACK |
| 727 | CDF 10 |
| 728 | ISZ COMNAM /POINTER TO COMMON INFO |
| 729 | DCA I NEXT /ZERO NEXT PTR WORD |
| 730 | TAD I COMNAM /LOOK FOR END OF LIST |
| 731 | SNA |
| 732 | JMP EOCL /THIS IS IT |
| 733 | DCA COMNAM /PROCEED DOWN LIST |
| 734 | JMP .-4 |
| 735 | EOCL, TAD NEXT /HOOK IN NEXT PART |
| 736 | DCA I COMNAM |
| 737 | TAD NUMELM |
| 738 | DCA I NEXT /NUMBER IN THIS PART |
| 739 | TAD NUMELM |
| 740 | CIA |
| 741 | DCA NUMELM |
| 742 | CDF |
| 743 | TAD I X12 /MOVE VARIABLE PTRS |
| 744 | CDF 10 |
| 745 | DCA I NEXT |
| 746 | ISZ NUMELM |
| 747 | JMP .-5 |
| 748 | CDF |
| 749 | JMS I [GETC /ANOTHER BLOCK ? |
| 750 | JMP I [NEXTST /NO |
| 751 | JMP COMMON+3 /MAYBE |
| 752 | DBLSLS, JMS I [CHECKC /LOOK FOR SECOND SLASH |
| 753 | -257 |
| 754 | JMP BADCOM |
| 755 | SKP |
| 756 | BLANKC, JMS I [BACK1 /PUT BACK NON SLASH |
| 757 | TAD (BLNKCN /USE BLANK COMMON |
| 758 | DCA COMNAM |
| 759 | JMP DOCOMN |
| 760 | BADCOM, JMS I [ERMSG /ERROR IN COMMON STMT |
| 761 | 0317 |
| 762 | JMP I [NEXTST |
| 763 | COMNAM, 0 |
| 764 | \f/ EXTERNAL, FORMAT, BACKSPACE |
| 765 | EXTERN, JMS I [TYPLST /PROCESS LIST |
| 766 | 1000 |
| 767 | 6660 |
| 768 | NOP |
| 769 | JMP I [NEXTST |
| 770 | FORMAT, TAD (FMTOPR /OUTPUT FORMAT OPERATOR |
| 771 | JMS I [OUTWRD |
| 772 | TAD NCHARS /GET NUMBER OF WORDS |
| 773 | CIA |
| 774 | CLL RAR /NWORDS=(NCHARS+1)/2 |
| 775 | FMTLUP, JMS I [OUTWRD /OUTPUT IT |
| 776 | JMS I [GETCWB /GET THE CHARS |
| 777 | JMP I [NEXTST /NO MORE |
| 778 | AND [77 |
| 779 | CLL RTL /SHIFT LEFT 6 |
| 780 | RTL |
| 781 | RTL |
| 782 | DCA TEMP |
| 783 | JMS I [GETCWB /GET OTHER HALF |
| 784 | NOP /IGNORE END OF LINE |
| 785 | AND [77 |
| 786 | TAD TEMP /PUT THEM TOGETHER |
| 787 | JMP FMTLUP /LOOP |
| 788 | /NOTE : THE ENTIRE FORMAT INCLUDING PARENTHESIS () |
| 789 | / IS PASSED TO THE CODE |
| 790 | BACKSP, JMS I [CHECKC /CHECK FOR "E" |
| 791 | -305 |
| 792 | JMP I [BADCMD |
| 793 | JMS I [EXPR /COMPILE UNIT EXPR |
| 794 | JMP I [BADCMD |
| 795 | TAD (BAKOPR /OUTPUT BACKSPACE OPERATOR |
| 796 | JMS I [OUTWRD |
| 797 | JMP I [NEXTST |
| 798 | \f/ OUTPUT ROUTINE |
| 799 | PAGE |
| 800 | OUPTR, OUBUF |
| 801 | OCOUNT, -401 |
| 802 | OUTWRD, 0 /OUTPUT ROUTINE |
| 803 | DCA OWTEMP /SAVE WORD |
| 804 | TAD NOCODE |
| 805 | SZA CLA |
| 806 | JMP I OUTWRD /COOL IT IF NOCODE |
| 807 | ISZ OCOUNT /TEST FOR BUFFER FULL |
| 808 | JMP NOWRIT /STILL SOME ROOM |
| 809 | JMS OUDUMP /DUMP THE BUFFER |
| 810 | TAD OUBLOK-1 /RESET BUFFER PARAMETERS |
| 811 | DCA OUPTR |
| 812 | TAD (-400 |
| 813 | DCA OCOUNT |
| 814 | NOWRIT, TAD OWTEMP /PUT WORD |
| 815 | CDF 10 |
| 816 | DCA I OUPTR /INTO BUFFER |
| 817 | CDF |
| 818 | ISZ OUPTR /MOVE POINTER |
| 819 | JMP I OUTWRD |
| 820 | OULEN, 0 /NUMBER OF BLOCKS LEFT IN HOLE |
| 821 | OUDUMP, 0 /DUMP OUT BUFFER |
| 822 | TAD OULEN /ANY ROOM LEFT ? |
| 823 | SNA |
| 824 | JMP OUERR |
| 825 | IAC |
| 826 | DCA OULEN |
| 827 | JMS I (7607 /CALL SYSTEM HANDLER |
| 828 | 4210 |
| 829 | OUBUF |
| 830 | OUBLOK, 0 |
| 831 | JMP OUERR |
| 832 | ISZ OUBLOK /INCREMENT BLOCK NUMBER |
| 833 | ISZ FILSIZ /ALSO SIZE OF FILE |
| 834 | JMP I OUDUMP |
| 835 | OUERR, JMS I [MESSAG /ERROR IN WRITING OR OPENING FILE |
| 836 | 317 |
| 837 | 306 |
| 838 | \f/ END PASS ONE |
| 839 | XEND, JMS I [CHECKC /LOOK FOR "D" |
| 840 | -304 |
| 841 | JMP I [BADCMD |
| 842 | JMS I [GETC /END MUST BE ALL |
| 843 | JMP ENDX |
| 844 | L7700, SMA CLA /NEVER SKIPS |
| 845 | JMP I [BADCMD |
| 846 | ENDX, CDF 0 |
| 847 | TAD (ENDOPR /OUTPUT END OF FILE |
| 848 | JMS I [OUTWRD |
| 849 | JMS OUDUMP /DUMP BUFFER |
| 850 | CIF 10 |
| 851 | JMS I L7700 /LOCK MONITOR IN |
| 852 | 10 |
| 853 | CIF 10 |
| 854 | CLA IAC |
| 855 | JMS I L200 /CLOSE TEMP FILE |
| 856 | 4 |
| 857 | TMPFIL |
| 858 | FILSIZ, 0 |
| 859 | JMP OUERR |
| 860 | CIF 10 |
| 861 | CLA IAC |
| 862 | JMS I L200 /OPEN PASS 2 OUTPUT FILE |
| 863 | L3, 3 |
| 864 | OBLK, TMPFIL+4 /STARTING BLOCK |
| 865 | 0 /SIZE |
| 866 | JMP OUERR /ERROR |
| 867 | TAD (COMREG-1 /SAVE IMPORTANT STUFF |
| 868 | DCA X10 |
| 869 | TAD NEXT /ADDR OF FREE SPACE |
| 870 | DCA I X10 |
| 871 | TAD STKLVL /STACK LEVEL |
| 872 | DCA I X10 |
| 873 | TAD OUFILE /START OF PASS1 OUTPUT FILE |
| 874 | DCA I X10 |
| 875 | TAD FILSIZ /ALSO THE SIZE |
| 876 | DCA I X10 |
| 877 | TAD PASS2O /START OF PASS2 OVERLAY |
| 878 | DCA I X10 |
| 879 | TAD OBLK /START OF PASS2 OUTPUT FILE |
| 880 | DCA I X10 |
| 881 | TAD OBLK+1 /AND MAX SIZE |
| 882 | DCA I X10 |
| 883 | TAD PROGNM /POINTER TO PROG NAME |
| 884 | DCA I X10 |
| 885 | TAD ARGLST /AND ARG LIST |
| 886 | DCA I X10 |
| 887 | TAD FUNCTN /AND PROG SWITCH |
| 888 | DCA I X10 |
| 889 | TAD DPUSED /STORE THE DP SWITCH |
| 890 | DCA I X10 |
| 891 | TAD VERS /AND THE VERSION NUMBER |
| 892 | DCA I X10 |
| 893 | CIF 10 |
| 894 | JMS I L200 /CHAIN TO PASS TWO |
| 895 | 6 |
| 896 | PASS2B, 0 /FILLED BY ONCE ONLY CODE FOR PASS 1 |
| 897 | RETURN, TAD (RETOPR /OUTPUT RETURN CODE |
| 898 | JMS I [OUTWRD |
| 899 | ISZ DOEND /DO END ILLEGAL HERE |
| 900 | JMP I [NEXTST |
| 901 | COMARP, 0 /LOOK FOR COMMA OR RIGHT PAREN |
| 902 | JMS I [GETC |
| 903 | JMP I COMARP |
| 904 | TAD [-254 /COMMA ? |
| 905 | SNA |
| 906 | JMP .+5 |
| 907 | TAD L3 /RIGHT PAREN ? |
| 908 | SZA CLA |
| 909 | JMP I COMARP |
| 910 | ISZ COMARP |
| 911 | ISZ COMARP /COMMA INCR ONCE |
| 912 | JMP I COMARP |
| 913 | LOGICA, JMS I [CHECKC /LOOK FOR L |
| 914 | -314 |
| 915 | JMP I [BADCMD /NO GOOD |
| 916 | JMS I [TYPLST /PROCESS LIST |
| 917 | 0105 |
| 918 | 0100 |
| 919 | L200, 0200 /NOP |
| 920 | JMP I [NEXTST |
| 921 | \f/ EQUIVALENCE (UGH!) |
| 922 | PAGE |
| 923 | EQUIV, JMS I [IFCHEK /BAD WITH IF |
| 924 | JMS I [CHECKC /LOOK FOR "E" |
| 925 | -305 |
| 926 | JMP I [BADCMD |
| 927 | EQVLUP, JMS I [CHECKC /LOOK FOR ( |
| 928 | -250 |
| 929 | JMP BADEQU |
| 930 | TAD STACK /SAVE STACK POS |
| 931 | DCA X17 |
| 932 | DCA NSLAVE /NUMBER OF SLAVES = 0 |
| 933 | JMS I [GETSS /GET THE MASTER |
| 934 | JMP BADEQU |
| 935 | SVMSTR, CDF 10 /1.03/ CHECK FOR ALREADY EQUIVALENCED |
| 936 | TAD I TEMP2 /1.03/ |
| 937 | CDF /1.03/ |
| 938 | AND (200 /1.03/ (AS A SLAVE) |
| 939 | SZA CLA /1.03/ |
| 940 | JMP DOFUNY /3.01/BACK UP TO ITS MASTER |
| 941 | TAD TEMP2 /SAVE THE MASTER TYPE ADDRESS |
| 942 | DCA MASTER |
| 943 | DCA SFUDGE /3.01/CLEAR OFFSET FUDGE |
| 944 | TAD DIMNUM /SAVE THE MASTER SUBSCRIPT |
| 945 | DCA MNUM |
| 946 | GETSLV, JMS I [COMARP /LOOK FOR , OR ) |
| 947 | JMP BADEQU |
| 948 | JMP DOSLAV /, |
| 949 | TAD NSLAVE /COMPLEMENT THE NUMBER OF SLAVES |
| 950 | SNA |
| 951 | JMP ENDGRP /NO SLAVES |
| 952 | CIA |
| 953 | DCA NSLAVE |
| 954 | TAD X17 /RESTACK THE STORE |
| 955 | DCA STACK |
| 956 | EQLOOP, TAD I X17 /GET NEXT SUBSCRIPT NUMBER |
| 957 | DCA TEMP |
| 958 | TAD I X17 /AND NEXT TYPE WORD ADDRESS |
| 959 | DCA TEMP2 |
| 960 | CDF 10 |
| 961 | TAD I TEMP2 /LOOK AT TYPE WORD |
| 962 | TAD (200 /SET EQUIVALENCE BIT |
| 963 | DCA I TEMP2 |
| 964 | ISZ TEMP2 /MOVE TO EQUIVALENCE/DIMENSION PTR |
| 965 | TAD I TEMP2 /PROPAGATE DIMENSION POINTER |
| 966 | DCA I NEXT /TO EQUIVALENCE INFO BLOCK |
| 967 | TAD NEXT /NOW STORE EQ INFO BLK ADDRESS |
| 968 | DCA I TEMP2 /INTO EQ-DIM POINTER WORD |
| 969 | CLA CMA |
| 970 | TAD MASTER /STORE S.T. ADDR OF MASTER |
| 971 | DCA I NEXT /INTO THE EQUIVALENCE BLOCK |
| 972 | TAD MNUM /OUTPUT NUMBERS |
| 973 | DCA I NEXT |
| 974 | TAD TEMP |
| 975 | DCA I NEXT |
| 976 | CDF |
| 977 | ISZ NSLAVE /ANY MORE SLAVES ? |
| 978 | JMP EQLOOP /YES, EQUIVALENCE NOT YET ATTAINED |
| 979 | ENDGRP, JMS I [GETC /FINI, ALL VARIABLES ARE CREATED |
| 980 | JMP I [NEXTST /EQUIVALENCED |
| 981 | TAD (-254 /IS NEXT CHAR A COMMA ? |
| 982 | SNA CLA |
| 983 | JMP EQVLUP /IF YES, DO NEXT GROUP |
| 984 | BADEQU, JMS I [ERMSG /SYNTAX ERROR IN EQUIVALENCE |
| 985 | 2123 |
| 986 | JMP I [NEXTST |
| 987 | EQUCOM, JMS I [ERMSG /MULTIPLE LEVELS OF EQUIVALENCE OR |
| 988 | 2114 /MORE THAN ONE COMMON VARIABLE |
| 989 | JMP I [NEXTST |
| 990 | DOSLAV, ISZ NSLAVE /ANOTHER SLAVE VARIABLE |
| 991 | JMS I [GETSS /GET THE GOODS |
| 992 | JMP BADEQU |
| 993 | CDF 10 |
| 994 | TAD I TEMP2 /LOOK AT THE TYPE |
| 995 | SMA CLA |
| 996 | JMP SVSLAV /IT ISN'T IN COMMON |
| 997 | TAD I MASTER /LOOK AT THE MASTERS TYPE |
| 998 | SPA CLA |
| 999 | JMP EQUCOM /MASTER IS IN COMMON TOO .. BAD |
| 1000 | CDF |
| 1001 | TAD MNUM /SAVE THE MAGIC NUMBER |
| 1002 | JMS I [PUSH |
| 1003 | TAD MASTER |
| 1004 | JMS I [PUSH /AND THE S.T. ADDRESS |
| 1005 | JMP SVMSTR /NOW GO MAKE THE NEW ONE MASTER |
| 1006 | SVSLAV, TAD I TEMP2 /1.03/ PREVIOUSLY EQUIVALENCED ? |
| 1007 | AND (200 /1.03/ |
| 1008 | SZA CLA /1.03/ |
| 1009 | JMP EQUCOM /1.03/ YES, ERROR |
| 1010 | TAD DIMNUM /SAVE THE NEW SLAVE |
| 1011 | TAD SFUDGE /3.01/ADD OFFSET FUDGE |
| 1012 | CDF |
| 1013 | JMS I [PUSH |
| 1014 | TAD TEMP2 |
| 1015 | JMS I [PUSH |
| 1016 | JMP GETSLV /AND GO GET THE NEXT SLAVE |
| 1017 | |
| 1018 | SFUDGE, 0 |
| 1019 | \f/ROUTINE TO HANDLE TRIVIAL CASES OF EQUIVALENCE CHAINING |
| 1020 | /THIS WHOLE PAGE IS 3.01 |
| 1021 | |
| 1022 | DOFUNY, CLA IAC |
| 1023 | TAD TEMP2 |
| 1024 | DCA MASTER /GET POINTER TO EQUIVALENCE BLOCK |
| 1025 | CDF 10 |
| 1026 | TAD I MASTER |
| 1027 | DCA X12 |
| 1028 | CLA IAC |
| 1029 | TAD I X12 /GET ADDRESS OF "REAL" MASTER'S |
| 1030 | DCA MASTER /TYPE WORD |
| 1031 | TAD I X12 |
| 1032 | TAD DIMNUM |
| 1033 | DCA MNUM /OFFSETS ARE ADDITIVE |
| 1034 | TAD I X12 |
| 1035 | DCA SFUDGE /SAVE OTHER HALF OF OFFSET TO ADD |
| 1036 | CDF /TO SLAVES |
| 1037 | JMP GETSLV / (PRAY) |
| 1038 | PAGE |
| 1039 | \f/ EQUIVALENCE (UGH!) |
| 1040 | O1420, 1420 /1.03/ MUST BE FIRST ON PAGE |
| 1041 | GETSS, 0 /GET THE LINEARIZED SUBSCRIPT |
| 1042 | DCA DIMNUM |
| 1043 | JMS I [GETNAM /GET THE VARIABLE |
| 1044 | JMP I GETSS |
| 1045 | JMS I [LOOKUP |
| 1046 | IAC /ADDRESS OF TYPE WORD |
| 1047 | DCA TEMP2 |
| 1048 | CDF 10 |
| 1049 | TAD I TEMP2 |
| 1050 | CDF |
| 1051 | O200, AND O1420 /1.03/ EXT, STMTFUN, SUBARG ? |
| 1052 | SZA CLA |
| 1053 | JMP I GETSS |
| 1054 | TAD STACK |
| 1055 | DCA X12 /SAVE STACK POSITION |
| 1056 | DCA TEMP /ZERO NUMBER OF DIMENSIONS |
| 1057 | TAD TEMP2 |
| 1058 | IAC |
| 1059 | DCA EQTEMP /ADDRESS OF EQ-DIM POINTER |
| 1060 | JMS I [GETC |
| 1061 | JMP I GETSS |
| 1062 | TAD (-250 /LOOK FOR ( |
| 1063 | SNA CLA |
| 1064 | JMP DIMGET-1 /OK |
| 1065 | JMS I [BACK1 |
| 1066 | JMP RGETSS |
| 1067 | DCA DIMNUM /DATA CALLS GETSS WITH AC = 7777 |
| 1068 | DIMGET, JMS I (SMLNUM /GET A SUBSCRIPT |
| 1069 | CLA CMA |
| 1070 | TAD EXPON /SS-1 |
| 1071 | JMS I [PUSH /SAVE SS |
| 1072 | ISZ TEMP /BUMP COUNT OF SS |
| 1073 | JMS I [COMARP /LOOK FOR , OR ) |
| 1074 | JMP I GETSS |
| 1075 | JMP DIMGET /, |
| 1076 | CLA IAC /) |
| 1077 | DCA DPRDCT /SET DIMENSION PRODUCT TO 1 |
| 1078 | TAD X12 /RESTORE STACK POSITION |
| 1079 | DCA STACK |
| 1080 | TAD TEMP /COMPLEMENT NUMBER OF SS |
| 1081 | CIA |
| 1082 | DCA TEMP |
| 1083 | CDF 10 |
| 1084 | CLL CML RTR /2000 |
| 1085 | AND I TEMP2 /HAS VARIABLE BEEN DIMENSIONED ? |
| 1086 | SNA CLA |
| 1087 | JMP I GETSS /NO, THATS BAD |
| 1088 | TAD I EQTEMP /GET ADDRESS OF DIMENSION BLOCK |
| 1089 | DCA EQTEMP |
| 1090 | TAD I EQTEMP /IS NUMBER OF DIMENSIONS |
| 1091 | TAD TEMP /EQUAL TO NUMBER OF SUBSCRIPTS ? |
| 1092 | SZA CLA |
| 1093 | JMP TRY1SS /1.03/ SEE IF ITS ONE SUBSCRIPT |
| 1094 | CLA CLL IAC /+1 V3C |
| 1095 | TAD I EQTEMP /+ NUMBER OF DIMENSIONS |
| 1096 | TAD EQTEMP /+ ADDRESS OF COUNT WORD |
| 1097 | DCA EQTEMP /GIVES ADDRESS OF NEXT TO LAST DIMENSION |
| 1098 | LINEAR, CDF |
| 1099 | TAD I X12 /GET NEXT SS - 1 |
| 1100 | DCA MQ |
| 1101 | TAD DPRDCT /MULTIPLY BY THE DIMENSION PRODUCT |
| 1102 | JMS MUL12 /WHERE D.P. = 1,D1,D1D2,D1D2D3,... |
| 1103 | TAD DIMNUM /ACCUMULATE THE SUM |
| 1104 | DCA DIMNUM |
| 1105 | CDF 10 |
| 1106 | TAD I EQTEMP /ADDR OF LITERAL |
| 1107 | IAC |
| 1108 | DCA X11 /WORKING POINTER TO VALUE |
| 1109 | TAD I X11 /GET DIMENSION INTO FAC |
| 1110 | DCA WORD1 |
| 1111 | TAD I X11 |
| 1112 | DCA WORD2 |
| 1113 | TAD I X11 |
| 1114 | DCA WORD3 |
| 1115 | CDF |
| 1116 | JMS I [FIXNUM /GO FIX IT |
| 1117 | DCA MQ |
| 1118 | TAD DPRDCT /OF THE D.P. SERIES (ABOVE) |
| 1119 | JMS MUL12 |
| 1120 | DCA DPRDCT |
| 1121 | CLA IAC /V3C BUMP POSITION POINTER |
| 1122 | TAD EQTEMP |
| 1123 | DCA EQTEMP |
| 1124 | ISZ TEMP /ANY MORE SS ? |
| 1125 | JMP LINEAR /YES |
| 1126 | RGETSS, ISZ GETSS |
| 1127 | JMP I GETSS |
| 1128 | TRY1SS, CLA IAC /1.03/ |
| 1129 | TAD TEMP /1.03/ ONLY ONE SS ? |
| 1130 | SZA CLA /1.03/ |
| 1131 | JMP I GETSS /1.03/ MORE, THATS NO GOOD |
| 1132 | CDF /1.03/ |
| 1133 | TAD I X12 /1.03/ GET THE SUBSCRIPT |
| 1134 | DCA DIMNUM /1.03/ AND RETURN IT |
| 1135 | JMP RGETSS /1.03/ |
| 1136 | MUL12, 0 /12 BIT UNSIGNED MULTIPLY |
| 1137 | DCA OP2 /SAVE OPERAND |
| 1138 | TAD (-15 /SET SHIFT COUNT |
| 1139 | DCA SC |
| 1140 | JMP STMUL |
| 1141 | M12LUP, TAD AC |
| 1142 | SNL |
| 1143 | JMP .+3 |
| 1144 | CLL |
| 1145 | TAD OP2 |
| 1146 | RAR |
| 1147 | STMUL, DCA AC |
| 1148 | TAD MQ |
| 1149 | RAR |
| 1150 | DCA MQ |
| 1151 | ISZ SC |
| 1152 | JMP M12LUP |
| 1153 | TAD MQ /RETURN VALUE |
| 1154 | JMP I MUL12 |
| 1155 | AC=OP3 |
| 1156 | SC=OP4 |
| 1157 | \f/ IF STATEMENTS |
| 1158 | PAGE |
| 1159 | IF, JMS I [EXPR /COMPILE CONDITION EXPRESSION |
| 1160 | JMP I [BADCMD |
| 1161 | JMS I [STMNUM /IS IT ARITHMETIC IF ? |
| 1162 | JMP LOGIF |
| 1163 | TAD (ARTHIF /START IF COMMAND |
| 1164 | JMS I [OUTWRD |
| 1165 | CLL CMA RTL |
| 1166 | DCA TEMP |
| 1167 | ISZ DOEND /DO END ILLEGAL HERE |
| 1168 | JMP IFLABL /GET IF LABELS |
| 1169 | IFLOOP, JMS I [CHECKC /LOOK FOR , |
| 1170 | -254 |
| 1171 | JMP I [NEXTST |
| 1172 | JMS I [STMNUM /GET NEXT STMT NUMBER |
| 1173 | JMP BADIF |
| 1174 | IFLABL, TAD SNUM /OUTPUT LABEL |
| 1175 | JMS I [OUTWRD |
| 1176 | ISZ TEMP |
| 1177 | JMP IFLOOP |
| 1178 | JMP I [NEXTST |
| 1179 | LOGIF, JMS IFCHEK /IF()IF()... NOT LEGAL |
| 1180 | ISZ IFSWIT /CLEAR IF SWITCH |
| 1181 | TAD (LIFBGN /START LOGICAL IF |
| 1182 | JMS I [OUTWRD |
| 1183 | JMP I (COMPIL /COMPILE THE STATEMENT |
| 1184 | DOSWT, |
| 1185 | IFCHEK, 0 /CHECK IF SWITCH |
| 1186 | TAD IFSWIT |
| 1187 | SNA CLA |
| 1188 | JMP I IFCHEK |
| 1189 | BADIF, JMS I [ERMSG |
| 1190 | 1111 |
| 1191 | JMP I [NEXTST |
| 1192 | \f/ CALL STMT |
| 1193 | CALL, JMS I [SAVECP /SAVE CHAR POS |
| 1194 | JMS I [GETNAM /GET SUBROUTINE NAME |
| 1195 | JMP BADCAL /NO NAME HERE IS BAD |
| 1196 | JMS I [LOOKUP /GET ADDRESS OF TYPE WORD |
| 1197 | IAC |
| 1198 | DCA TEMP |
| 1199 | CDF 10 |
| 1200 | TAD I TEMP /LOOK AT TYPE |
| 1201 | AND (6640 /ANYTHING BUT EXT OR ARG ? |
| 1202 | SZA CLA |
| 1203 | JMP BADCAL /YES, BAD |
| 1204 | TAD I TEMP /SET EXT BIT |
| 1205 | AND (137 /LEAVE TYPE AND ARG BITS |
| 1206 | TAD (1000 |
| 1207 | DCA I TEMP |
| 1208 | CDF |
| 1209 | JMS I [RESTCP /RESTORE CHAR POS |
| 1210 | CLA IAC /SIGNAL THAT THIS IS A CALL |
| 1211 | JMS I [LEXPR /COMPILE IT |
| 1212 | XSTORE, DOSTOR /DON'T WORRY VIRGINIA, ITS A NOP |
| 1213 | TAD OWTEMP /WHAT WAS THE LAST THING OUT ? |
| 1214 | CLL |
| 1215 | TAD (-63 /IF LESS THAN 63 |
| 1216 | SNL CLA |
| 1217 | JMP I [NEXTST /IT WAS AN ARG COUNT |
| 1218 | TAD [ARGSOP /OTHERWISE IT WAS AN ARG LESS CALL |
| 1219 | JMS I [OUTWRD /SO TELL PASS 2 ABOUT IT |
| 1220 | JMS I [OUTWRD |
| 1221 | JMP I [NEXTST |
| 1222 | BADCAL, JMS I [ERMSG |
| 1223 | 2316 |
| 1224 | JMP I [NEXTST |
| 1225 | \f/ DO DAH, DO DAH |
| 1226 | DO, JMS I [IFCHEK /IF(...)DO IS ILLEGAL |
| 1227 | JMS I [STMNUM /LOOK FOR ENDING STMT NUMBER |
| 1228 | JMP I [BADCMD |
| 1229 | JMS I [GETNAM /LOOKUP INDEX VARIABLE |
| 1230 | JMP I [BADCMD |
| 1231 | JMS I [LOOKUP |
| 1232 | DCA DOINDX |
| 1233 | JMS I [CHECKC /LOOK FOR = |
| 1234 | -275 |
| 1235 | JMP I [BADCMD |
| 1236 | ISZ DOEND /CAN'T END DO LOOP ON A DO |
| 1237 | JMS DOSTUF /GET DO PARAMETERS |
| 1238 | JMP BADDO |
| 1239 | TAD DOINDX /PUSH DO INDEX |
| 1240 | JMS I [PUSH |
| 1241 | TAD SNUM /PUSH ENDING STMT NUMBER |
| 1242 | JMS I [PUSH |
| 1243 | TAD STACK |
| 1244 | DCA STKLVL /SAVE NEW STACK BASE |
| 1245 | JMP I [NEXTST |
| 1246 | |
| 1247 | DOSTUF, 0 /SUBR FOR DO LOOP STUFF |
| 1248 | JMS I [OUTWRD /OUTPUT DO INDEX |
| 1249 | TAD DOINDX |
| 1250 | JMS I [OUTWRD |
| 1251 | JMS I [EXPR /GET EXPR FOR INITIAL VALUE |
| 1252 | JMP I DOSTUF |
| 1253 | TAD XSTORE /YES |
| 1254 | JMS I [OUTWRD |
| 1255 | JMS I [CHECKC /LOOK FOR COMMA |
| 1256 | N254, -254 |
| 1257 | JMP I DOSTUF |
| 1258 | JMS I [EXPR /GET EXPR FOR FINAL VALUE |
| 1259 | JMP I DOSTUF |
| 1260 | JMS I [GETC /LOOK FOR A COMMA |
| 1261 | JMP STEP1 /USE STEP OF 1 |
| 1262 | TAD N254 |
| 1263 | SZA CLA |
| 1264 | JMP STEP1-1 |
| 1265 | JMS I [EXPR /GET EXPR FOR STEP |
| 1266 | JMP I DOSTUF |
| 1267 | DORET, ISZ DOSTUF |
| 1268 | TAD (DOBEGN /DO BEGIN OPERATOR |
| 1269 | JMS I [OUTWRD |
| 1270 | JMP I DOSTUF |
| 1271 | JMS I [BACK1 /PUT BACK NON , (OFFICER BELOW LT.) |
| 1272 | STEP1, JMS I [OUTWRD /OUTPUT A PUSH 1.0 |
| 1273 | TAD (ONE |
| 1274 | JMS I [OUTWRD |
| 1275 | JMP DORET /FINISH DO STUFF |
| 1276 | BADDO, JMS I [ERMSG /BAD DO COMMAND |
| 1277 | 0417 |
| 1278 | JMP I [NEXTST |
| 1279 | BDERR, JMS I [ERMSG /ILLEGAL IN BLOCK DATA |
| 1280 | 0223 |
| 1281 | JMP I [NEXTST |
| 1282 | \f/ TYPE STATEMENT SUBROUTINE |
| 1283 | PAGE |
| 1284 | TYPLST, 0 /HANDLE LIST FOR TYPE DELL |
| 1285 | TAD STACK |
| 1286 | DCA X12 /SAVE STACK POINTER |
| 1287 | DCA NUMELM |
| 1288 | TAD I TYPLST /GET SET BITS |
| 1289 | DCA SETBIT |
| 1290 | ISZ TYPLST |
| 1291 | TAD I TYPLST /AND ILLEGAL BITS |
| 1292 | DCA BADBIT |
| 1293 | ISZ TYPLST |
| 1294 | LSTLUP, JMS I [GETNAM /GET VARIABLE |
| 1295 | JMP BADLST |
| 1296 | JMS I [LOOKUP /S.T. SEARCH |
| 1297 | DCA TLTEMP /SAVE VAR ADDRESS |
| 1298 | TAD TLTEMP /PUT IT ON THE STACK |
| 1299 | ISZ TLTEMP /NOW POINT TO TYPE WORD |
| 1300 | JMS I [PUSH /INCREMENT NUMBER |
| 1301 | ISZ NUMELM /INCREMENT NUMBER |
| 1302 | CDF 10 |
| 1303 | TAD I TLTEMP /COMPARE TYPES |
| 1304 | AND BADBIT /CHECK FOR ILLEGAL BITS |
| 1305 | SZA CLA |
| 1306 | JMP TYPAGN /ATTEMPT TO RE-TYPE |
| 1307 | TAD SETBIT /GET SET BITS |
| 1308 | CMA /GENERATE MASK |
| 1309 | AND I TLTEMP |
| 1310 | TAD SETBIT /DO THE SET |
| 1311 | DCA I TLTEMP /BUT NOT DIMENSION BIT |
| 1312 | CDF |
| 1313 | GETDIM, JMS I [GETC |
| 1314 | JMP EOL |
| 1315 | TAD (-250 /LOOK FOR ( |
| 1316 | SZA |
| 1317 | JMP NOTDIM /NOT DIMENSIONED |
| 1318 | CLA IAC /INITIALIZE MAGIC NUMBER |
| 1319 | DCA DSERES |
| 1320 | CLA IAC |
| 1321 | DCA DPRDCT /AND DIMENSION PRODUCT |
| 1322 | TAD STACK |
| 1323 | DCA X17 /SAVE STACK POINTER |
| 1324 | DCA TEMP2 /DIMENSION COUNT=0 |
| 1325 | JMP I (DIMLUP /GET DIMENSIONS |
| 1326 | PUTDIM, TAD X17 |
| 1327 | DCA STACK /RESTORE STACK |
| 1328 | CDF 10 |
| 1329 | TAD (3400 /DIM, EXT, SF ? |
| 1330 | AND I TLTEMP |
| 1331 | SZA CLA |
| 1332 | JMP DIMAGN /ATTEMPT TP RE-DIMENSION |
| 1333 | CLL CML RTR |
| 1334 | TAD I TLTEMP /SET DIMENSION BIT |
| 1335 | DCA I TLTEMP |
| 1336 | ISZ TLTEMP |
| 1337 | TAD TEMP2 /NUMBER OF DIMS. |
| 1338 | DCA I NEXT |
| 1339 | TAD I TLTEMP /GET EQUIVALENCE POINTER |
| 1340 | SZA |
| 1341 | DCA TLTEMP |
| 1342 | TAD NEXT /STORE POINTER TO |
| 1343 | DCA I TLTEMP /DIMENSION INFORMATION |
| 1344 | TAD DPRDCT /SAVE DIM PRODUCT |
| 1345 | DCA I NEXT |
| 1346 | TAD DSERES /AND MAGIC NUMBER |
| 1347 | DCA I NEXT |
| 1348 | DCA I NEXT /ZERO MAGIC LITERAL POINTER |
| 1349 | TAD TEMP2 |
| 1350 | CIA |
| 1351 | DCA TEMP2 /LEAVE LAST DIM |
| 1352 | CDF |
| 1353 | MOVDIM, TAD I X17 /1.03/ GET THE DIMENSION |
| 1354 | CDF 10 /1.03/ |
| 1355 | DCA I NEXT /1.03/ INTO THE DIMENSION INFO BLOCK |
| 1356 | CDF /1.03/ |
| 1357 | ISZ TEMP2 /1.03/ |
| 1358 | JMP MOVDIM /1.03/ |
| 1359 | NEXTEL, JMS I [GETC /LOOK FOR , |
| 1360 | JMP TLRETN |
| 1361 | TAD (-254 |
| 1362 | SNA CLA |
| 1363 | JMP LSTLUP /OK, GET NEXT MEMBER |
| 1364 | ENDLST, JMS I [BACK1 |
| 1365 | ISZ TYPLST |
| 1366 | JMP I TYPLST |
| 1367 | BADDIM, JMS I [ERMSG /DIMENSION ERROR |
| 1368 | 0204 |
| 1369 | JMP I TYPLST |
| 1370 | BADLST, JMS I [ERMSG /ERROR IN LIST |
| 1371 | 2404 |
| 1372 | JMP I TYPLST |
| 1373 | TYPAGN, JMS I [ERMSG |
| 1374 | 2224 /RE-TYPE |
| 1375 | JMP GETDIM |
| 1376 | DIMAGN, JMS I [ERMSG /ATTEMPT TO RE DIMENSION |
| 1377 | 2204 |
| 1378 | JMP NEXTEL |
| 1379 | NOTDIM, TAD (250-254 /IS IT A COMMA? |
| 1380 | SZA CLA |
| 1381 | JMP ENDLST |
| 1382 | JMP LSTLUP /GET NEXT ELEMENT |
| 1383 | EOL, |
| 1384 | TLRETN, ISZ TYPLST |
| 1385 | JMP I TYPLST /TAKE OK EXIT |
| 1386 | ENDFIL, JMS I [CHECKC /LOOK FOR "E" |
| 1387 | -305 |
| 1388 | JMP I [BADCMD |
| 1389 | JMS I [EXPR /COMPILE UNIT |
| 1390 | JMP I [BADCMD |
| 1391 | TAD (ENDFOP /OUTPUT ENDFILE OPERATOR |
| 1392 | JMS I [OUTWRD |
| 1393 | JMP I [NEXTST |
| 1394 | DOUBLE, JMS I [CHECKC /LOOK FOR N |
| 1395 | -316 |
| 1396 | JMP I [BADCMD |
| 1397 | |
| 1398 | JMS I [IFCHEK /NOT ON AN IF |
| 1399 | JMS I [TYPLST /PROCESS LIST |
| 1400 | 0104 |
| 1401 | 0100 |
| 1402 | NOP |
| 1403 | CLA IAC /SET THE DP SWITCH |
| 1404 | DCA DPUSED |
| 1405 | JMP I [NEXTST |
| 1406 | \f/ SYMBOL TABLE LOOKERUPPER |
| 1407 | PAGE |
| 1408 | LOOKUP, 0 /SYMBOL TABLE LOOKUP FOR VARIABLE ENTRY |
| 1409 | TAD NOCODE /IS THIS IN NOCODE MODE ? |
| 1410 | SZA CLA |
| 1411 | JMP I LOOKUP /YES, DO NOTHING |
| 1412 | TAD BUCKET |
| 1413 | TAD (ALIST-1 /GET START OF CORRECT BUCKET |
| 1414 | CDF 10 |
| 1415 | LOOK, DCA OLDN3 /SAVE ADDR OF PREVIOUS ENTRY |
| 1416 | TAD I OLDN3 /GET ADDR OF NEXT ENTRY |
| 1417 | SNA |
| 1418 | JMP HOOKIN /NO NEXT ENTRY, ATTACH NEW ENTRY |
| 1419 | TAD (2 /SKIP OVER TYPE AND DIM POINTER |
| 1420 | DCA X10 |
| 1421 | TAD (NAME1 |
| 1422 | DCA PNAME /SETUP POINTER TO NAME |
| 1423 | CDF |
| 1424 | CHKNAM, TAD I PNAME /GET WORD NAME |
| 1425 | CIA CLL |
| 1426 | CDF 10 |
| 1427 | TAD I X10 /COMPARE WITH THIS ENTRY |
| 1428 | SZA CLA |
| 1429 | JMP NOTSAM /DIFFERENT |
| 1430 | CDF |
| 1431 | TAD I PNAME |
| 1432 | AND [77 /WAS THIS THE END OF NAME? |
| 1433 | ISZ PNAME |
| 1434 | SZA CLA |
| 1435 | JMP CHKNAM /NO, KEEP COMPARING |
| 1436 | CDF 10 |
| 1437 | RLOOKU, TAD I OLDN3 /GET ADDR OF START OF ENTRY |
| 1438 | CDF /AND RETURN IT IN THE AC |
| 1439 | JMP I LOOKUP /RETURN ADDR OF SYMBOL |
| 1440 | NOTSAM, SZL |
| 1441 | JMP HOOKIN /NEW SYMBOL <CURRENT ONE |
| 1442 | TAD I OLDN3 |
| 1443 | JMP LOOK /CONTINUE SEARCH |
| 1444 | HOOKIN, TAD I OLDN3 /HOOK NEW ENTRY INTO LIST |
| 1445 | DCA I NEXT |
| 1446 | TAD NEXT |
| 1447 | DCA I OLDN3 |
| 1448 | DCA I NEXT /ZERO TYPE WORD |
| 1449 | DCA I NEXT /ZERO EQUIVALENCE/DIMENSION POINTER |
| 1450 | TAD (NAME1 /PREPARE TO STICK IN THE NAME |
| 1451 | DCA PNAME |
| 1452 | CDF |
| 1453 | ENTERN, TAD I PNAME /MOVE NAME INTO S.T. |
| 1454 | CDF 10 |
| 1455 | DCA I NEXT |
| 1456 | CDF |
| 1457 | TAD I PNAME |
| 1458 | ISZ PNAME /END OF NAME? |
| 1459 | AND [77 |
| 1460 | SZA CLA |
| 1461 | JMP ENTERN /NO, KEEP GOING |
| 1462 | CDF 10 |
| 1463 | STCHEK, TAD NEXT /CHECK FOR S.T. OVERFLOW |
| 1464 | CIA CLL |
| 1465 | TAD (4740 /5000 STARTS PASS2 SKELETON TABLES |
| 1466 | SZL CLA |
| 1467 | JMP RLOOKU |
| 1468 | CDF |
| 1469 | JMS I [ERMSG /S.T. FULL |
| 1470 | 2324 |
| 1471 | JMP I (ENDX /TREAT AS END OF INPUT |
| 1472 | OLDN3, 0 /ADDR OF PREVIOUS ENTRY |
| 1473 | N3SIZE, 0 /SIZE OF ENTRY |
| 1474 | LTEMP, |
| 1475 | PNAME, /POINTER TO NAME BUFFER |
| 1476 | LUKUP2, 0 /LOOKUP FOR FIXED LENGTH SYMBOLS |
| 1477 | TAD I LUKUP2 /GET THE BUCKET START |
| 1478 | DCA OLDN3 /SAVE IT AS THE PREVIOUS ENTRY |
| 1479 | ISZ LUKUP2 |
| 1480 | TAD I LUKUP2 /GET THE ENTRY SIZE |
| 1481 | ISZ LUKUP2 |
| 1482 | DCA N3SIZE |
| 1483 | TAD LUKUP2 /SAVE RETURN ADDR |
| 1484 | DCA LOOKUP |
| 1485 | TAD NOCODE /IS CODE GENERATION OFF ? |
| 1486 | SZA CLA |
| 1487 | JMP I LOOKUP /YES, JUST RETURN |
| 1488 | CDF 10 |
| 1489 | LOOK2, TAD I OLDN3 /GET ADDR OF NEXT ENTRY |
| 1490 | SNA |
| 1491 | JMP HOKIN2 /IF 0 ITS END OF LIST |
| 1492 | IAC |
| 1493 | DCA X10 /START OF VALUE INFO |
| 1494 | TAD (WORD1-1 /SETUP POINTER TO PROTOTYPE |
| 1495 | DCA X11 |
| 1496 | TAD N3SIZE /AND TEMP OF ENTRY SIZE |
| 1497 | DCA LTEMP |
| 1498 | CHKVAL, CDF |
| 1499 | TAD I X11 |
| 1500 | CIA CLL /COMPARE THIS WORD OF THE VALUE |
| 1501 | CDF 10 |
| 1502 | TAD I X10 |
| 1503 | SZA CLA |
| 1504 | JMP NOTSM2 /NOT THIS ONE |
| 1505 | ISZ LTEMP /INCR SIZE COUNT |
| 1506 | JMP CHKVAL /MORE STUFF |
| 1507 | JMP RLOOKU /RETURN WITH THE GOODS |
| 1508 | NOTSM2, SZL |
| 1509 | JMP HOKIN2 /NEW SYMBOL < CURRENT ONE |
| 1510 | TAD I OLDN3 /CONTINUE SEARCH |
| 1511 | DCA OLDN3 |
| 1512 | JMP LOOK2 |
| 1513 | HOKIN2, TAD I OLDN3 /HOOK NEW ENTRY INTO LIST |
| 1514 | DCA I NEXT |
| 1515 | TAD NEXT |
| 1516 | DCA I OLDN3 |
| 1517 | TAD (WORD1-1 /PREPARE TO STICK IN THE VALUE |
| 1518 | DCA X11 |
| 1519 | DCA I NEXT /ZERO TYPE WORD |
| 1520 | CDF |
| 1521 | ENTERV, TAD I X11 /MOVE VALUE INTO S.T. |
| 1522 | CDF 10 |
| 1523 | DCA I NEXT |
| 1524 | ISZ N3SIZE /INCR SIZE COUNT |
| 1525 | JMP ENTERV-1 |
| 1526 | JMP STCHEK /STORE TYPE AND CHECK FOR OVERFLOW |
| 1527 | STOP, TAD (STOPOP /OUTPUT STOP OPERATOR |
| 1528 | JMS I [OUTWRD |
| 1529 | ISZ DOEND /DO ILLEGAL ON STOP |
| 1530 | JMP I [NEXTST |
| 1531 | \f/ EXPRESSION ANALYZER |
| 1532 | PAGE |
| 1533 | EXPR, 0 /POLISHIZE EXPRESSION |
| 1534 | TAD EXPR |
| 1535 | JMS I [PUSH /SAVE RETURN ADDR |
| 1536 | JMS I [PUSH /MARK STACK |
| 1537 | UNOPR, JMS I [GETC /LOOK FOR UNARY OPERATOR |
| 1538 | JMP MISARG /THERE HAS TO BE AN OPERAND |
| 1539 | TAD (-253 /UNARY+(NOP) |
| 1540 | SNA |
| 1541 | JMP UNOPR |
| 1542 | TAD (253-255 /UNARY- |
| 1543 | SNA |
| 1544 | JMP UMINUS |
| 1545 | TAD (255-256 /.NOT. |
| 1546 | SZA CLA |
| 1547 | JMP OPRAND |
| 1548 | DCA BUCKET /FOR CKNOT |
| 1549 | JMS I (TRUFAL /.TRUE. OR .FALSE. ? |
| 1550 | JMP CKNOT /NEITHER, IS IT >.NOT. |
| 1551 | JMP .+3 /.TRUE. |
| 1552 | TAD (NOTOPR /FALSE=.NOT.TRUE |
| 1553 | JMS I [PUSH |
| 1554 | JMS I [OUTWRD |
| 1555 | TAD (TRUE |
| 1556 | JMS I [OUTWRD |
| 1557 | JMP I (NOSS |
| 1558 | CKNOT, TAD BUCKET |
| 1559 | TAD (-16 |
| 1560 | SZA CLA |
| 1561 | JMP OPRAND /MIGHT BE LITERAL .XXXXXX |
| 1562 | TAD (NOTOPR /PUSH .NOT. OPERATOR |
| 1563 | JMS I [PUSH |
| 1564 | JMP UNOPR |
| 1565 | UMINUS, TAD (UMOPR /PUSH UNARY MINUS |
| 1566 | JMS I [PUSH |
| 1567 | JMP UNOPR |
| 1568 | OPRAND, JMS I [BACK1 /PUT BACK NON UNARY OPERATOR |
| 1569 | JMS I [GETNAM /LOOK FOR VARIABLE REFERENCE |
| 1570 | JMP NOTVAR /NOPE. |
| 1571 | JMS I [LOOKUP /SYMBOL TABLE SEARCH |
| 1572 | JMP I [OPR8R /GO OUTPUT PUSH-VAR |
| 1573 | NOTVAR, JMS I [NUMBER /LOOK FOR A LITERAL |
| 1574 | JMP NOTNUM /NO KIND OF NUMBER |
| 1575 | JMP HOLCHK /INTEGER |
| 1576 | JMP DPLIT /DOUBLE PRECISION |
| 1577 | FPLIT, JMS I [LUKUP2 /FLOATING, ENTER INTO TABLE |
| 1578 | FPLIST |
| 1579 | -3 |
| 1580 | JMP I [OPR8RL /PUSH VARIABLE, NO SUBSCRIPTS |
| 1581 | DPLIT, JMS I [LUKUP2 /DOUBLE-PREC., ENTER IN TABLE |
| 1582 | DPLIST |
| 1583 | -6 |
| 1584 | JMP I [OPR8RL |
| 1585 | HOLCHK, JMS I [GETC /IS THIS HOLLERITH? |
| 1586 | JMP .+5 |
| 1587 | TAD (-310 |
| 1588 | SNA CLA |
| 1589 | JMP I (HFIELD /YES |
| 1590 | JMS I [BACK1 |
| 1591 | JMS I [LUKUP2 /FIND THE ENTRY |
| 1592 | INTLST |
| 1593 | -3 |
| 1594 | JMP I [OPR8RL |
| 1595 | NOTNUM, JMS I [GETC /LOOK FOR COMPLEX LITERAL |
| 1596 | JMP MISARG /MISSING OPERAND |
| 1597 | TAD (-250 /OPEN PAREN? |
| 1598 | SZA |
| 1599 | JMP QUOTE /GO LOOK FOR A STRING |
| 1600 | JMS I [SAVECP /SAVE CHAR POSITION |
| 1601 | JMS I [NUMBER /GET REAL PART |
| 1602 | JMP I (NCMPLX /NO NUMBER |
| 1603 | SKP /INTEGER-OK |
| 1604 | JMP I (NCMPLX /DOUBLE-NOT LEGAL FOR COMPLEX |
| 1605 | JMS I [CHECKC /LOOK FOR , |
| 1606 | -254 |
| 1607 | JMP I (NCMPLX /NO, CAN'T BE COMPLEX LIT. |
| 1608 | TAD WORD1 /SAVE REAL PART |
| 1609 | DCA TEMP |
| 1610 | TAD WORD2 |
| 1611 | DCA TEMP2 |
| 1612 | TAD WORD3 |
| 1613 | DCA CHAR |
| 1614 | JMS I [NUMBER /GET IMAGINARY PART |
| 1615 | JMP BADCL /NOT THERE, BAD |
| 1616 | SKP /I |
| 1617 | JMP BADCL /D-BAD |
| 1618 | JMS I [CHECKC /LOOK FOR ) |
| 1619 | -251 |
| 1620 | JMP BADCL /NO ) BAD |
| 1621 | TAD WORD1 /PUT IMAGINARY PART |
| 1622 | DCA WORD4 |
| 1623 | TAD WORD2 /INTO SECOND AHLF |
| 1624 | DCA WORD5 |
| 1625 | TAD WORD3 /OF COMPLEX LITERAL |
| 1626 | DCA WORD6 |
| 1627 | TAD TEMP /NOW RESTORE REAL PART |
| 1628 | DCA WORD1 |
| 1629 | TAD TEMP2 |
| 1630 | DCA WORD2 |
| 1631 | TAD CHAR |
| 1632 | DCA WORD3 |
| 1633 | CLL CMA RAL /REMOVE CHAR POS FROM STACK |
| 1634 | TAD STACK /SINCE OTHERWISE IT GOES OUT |
| 1635 | DCA STACK /AS CODE |
| 1636 | JMS I [LUKUP2 /WHICH WE WILL NOW SEARCH |
| 1637 | CMPLST /USE COMPLEX LIST |
| 1638 | -6 |
| 1639 | JMP I [OPR8RL |
| 1640 | BADCL, JMS I [ERMSG /BAD COMPLEX LITERAL |
| 1641 | 0314 |
| 1642 | JMP I [BADEXP |
| 1643 | MISARG, JMS I [ERMSG /MISSING OPERAND |
| 1644 | 1517 |
| 1645 | JMP I [BADEXP |
| 1646 | \f/ EXPRESSION ANALYZER |
| 1647 | PAGE |
| 1648 | HQUOTE, 0 /SUBR FOR QUOTE STRINGS |
| 1649 | JMS I [GETCWB /GET CHAR |
| 1650 | JMP BADH |
| 1651 | TAD [-247 /IS IT ' |
| 1652 | SZA |
| 1653 | JMP NOTQ2 /NO |
| 1654 | JMS I [GETCWB |
| 1655 | JMP LUHOL |
| 1656 | TAD [-247 /LOOK FOR '' |
| 1657 | SNA CLA |
| 1658 | JMP NOTQ2 /REPLACE '' BY ' |
| 1659 | JMS I [BACK1 /ITS END OF STRING |
| 1660 | JMP LUHOL |
| 1661 | NOTQ2, TAD [247 /RESTORE CHAR |
| 1662 | AND [77 |
| 1663 | JMP I HQUOTE |
| 1664 | HFIELD, JMS I [FIXNUM /INTEGERIZE NUMBER |
| 1665 | SNA |
| 1666 | JMP BADH /ZERO IS BAD |
| 1667 | CMA CLL |
| 1668 | DCA TEMP |
| 1669 | TAD (HCOUNT /SET SUBR POINTER |
| 1670 | DOHOL, DCA HCHAR |
| 1671 | TAD (-MAXHOL /SET COUNTER FOR MAX |
| 1672 | DCA HOLCTR |
| 1673 | TAD (NAME1 /SET UP NAME POINTER |
| 1674 | DCA TEMP2 |
| 1675 | PAKHOL, DCA I TEMP2 /PACK HOLLERITH STRING |
| 1676 | JMS I HCHAR |
| 1677 | CLL RTL |
| 1678 | RTL |
| 1679 | RTL |
| 1680 | DCA I TEMP2 |
| 1681 | JMS I HCHAR |
| 1682 | TAD I TEMP2 |
| 1683 | DCA I TEMP2 |
| 1684 | ISZ TEMP2 |
| 1685 | ISZ HOLCTR /CHECK FOR TOO MANY |
| 1686 | JMP PAKHOL |
| 1687 | BADH, JMS I [ERMSG /BAD OR TOO BIG HOLLERITH FIELD |
| 1688 | 1017 |
| 1689 | JMP I [BADEXP |
| 1690 | LUHOL, TAD (33 /LOOK UP THIS LITERAL |
| 1691 | DCA BUCKET |
| 1692 | JMS I [LOOKUP |
| 1693 | JMP I [OPR8RL |
| 1694 | HCOUNT, 0 |
| 1695 | ISZ TEMP /CHECK COUNT |
| 1696 | SKP |
| 1697 | JMP LUHOL /EXPIRED |
| 1698 | JMS I [GETCWB /GET CHAR |
| 1699 | JMP BADH |
| 1700 | AND [77 /6-BIT IZE IT |
| 1701 | JMP I HCOUNT |
| 1702 | HOLCTR, 0 /COUNTER FOR HOLLERITH FIELDS |
| 1703 | NCMPLX, JMS I [RESTCP /NOT COMPLEX LITERAL |
| 1704 | JMS I [EXPR /MUST BE SUB EXPRESSION |
| 1705 | JMP BADEXP |
| 1706 | JMS I [GETC /LOOK FOR ) |
| 1707 | JMP PARMM |
| 1708 | TAD (-251 |
| 1709 | SNA CLA |
| 1710 | JMP I (NOSS /NO SUBSCRIPT LEGAL AFTER SUB EXPR |
| 1711 | PARMM, JMS I [ERMSG /MISSING ) |
| 1712 | 1515 |
| 1713 | BADEXP, JMS I [POP /BAD EXPRESSION, |
| 1714 | SZA CLA |
| 1715 | JMP BADEXP /LOOK FOR STACK MARKER |
| 1716 | JMS I [POP |
| 1717 | DCA TEMP /RETURN ADDR. |
| 1718 | JMP I TEMP |
| 1719 | JMS I [BACK1 /PUT BACK TEMINAL CHAR |
| 1720 | ENDEXP, JMS I [POP /GET NEXT THING FROM STACK |
| 1721 | SNA |
| 1722 | JMP EXPDUN /IF ZERO, FINISH |
| 1723 | IAC /GET ADDR OF OPERATION NUMBER |
| 1724 | DCA TEMP |
| 1725 | TAD I TEMP /GET OPERATOR VALUE |
| 1726 | JMS I [OUTWRD /OUTPUT OPERATOR XXXXXX |
| 1727 | JMP ENDEXP /LOOP |
| 1728 | EXPDUN, JMS I [POP /GET RETURN ADDR |
| 1729 | IAC |
| 1730 | DCA TEMP |
| 1731 | JMP I TEMP |
| 1732 | LETTER, 0 /GET A LETTER |
| 1733 | JMS I [GETC |
| 1734 | JMP I LETTER |
| 1735 | TAD (-301 |
| 1736 | SPA |
| 1737 | JMP NLETR |
| 1738 | TAD (301-333 |
| 1739 | SMA |
| 1740 | JMP NLETR |
| 1741 | TAD (33 |
| 1742 | ISZ LETTER |
| 1743 | JMP I LETTER |
| 1744 | NLETR, JMS I [BACK1 |
| 1745 | JMP I LETTER |
| 1746 | QUOTE, TAD (250-247 /IS IT ' |
| 1747 | SZA |
| 1748 | JMP MISARG /NO, OPERAND IS MISSING |
| 1749 | TAD (HQUOTE /SET SUBR POINTER |
| 1750 | JMP DOHOL |
| 1751 | CHECKC, 0 /CHECK FOR A SINGLE CHAR |
| 1752 | TAD I CHECKC /GET THE CHAR |
| 1753 | DCA CCTEMP |
| 1754 | ISZ CHECKC /SKIP PAST THE CHAR |
| 1755 | JMS I [GETC /GET CHAR FROM INPUT |
| 1756 | JMP I CHECKC /DIDN'T MAKE IT |
| 1757 | TAD CCTEMP /IS THIS IT ? |
| 1758 | SNA CLA |
| 1759 | ISZ CHECKC /YES |
| 1760 | JMP I CHECKC |
| 1761 | CCTEMP, 0 |
| 1762 | \f/ EXPRESSION ANALYZER |
| 1763 | PAGE |
| 1764 | BADFSS, JMS I [ERMSG |
| 1765 | 2323 |
| 1766 | JMP I [BADEXP |
| 1767 | OPR8R, DCA TEMP |
| 1768 | JMS I [OUTWRD /PUSH |
| 1769 | TAD TEMP |
| 1770 | JMS I [OUTWRD /OUTPUT OPERAND PTR |
| 1771 | JMS I [GETC |
| 1772 | JMP I [ENDEXP |
| 1773 | TAD (-250 /IS IT S.S. OR FUNCTION |
| 1774 | SZA |
| 1775 | JMP NOTFSS |
| 1776 | TAD STMJMP |
| 1777 | TAD (-DFINFL |
| 1778 | SNA CLA /FOR D.F.,PERMIT VARPARENS |
| 1779 | JMP NOTFSS |
| 1780 | ISZ TEMP /LOOK AT TYPE |
| 1781 | CDF 10 |
| 1782 | TAD (3420 /DIM, EXT, SF, OR ARG ? |
| 1783 | AND I TEMP |
| 1784 | SZA CLA |
| 1785 | JMP NOTFUN /NOT A FUNCTION REFERENCE |
| 1786 | TAD I TEMP |
| 1787 | TAD (1000 /SET EXT BIT |
| 1788 | DCA I TEMP |
| 1789 | NOTFUN, CDF |
| 1790 | SKP |
| 1791 | JMS I [POP /PUT COUNT INTO AC |
| 1792 | SSFUN, IAC /INCREMENT ARG COUNT |
| 1793 | JMS I [PUSH /SAVE IT ON THE STACK |
| 1794 | JMS I [EXPR /GET ARG (OR S.S.) |
| 1795 | JMP I [BADEXP |
| 1796 | JMS I [COMARP /LOOK FOR , OR ) |
| 1797 | JMP BADFSS /NEITHER |
| 1798 | JMP SSFUN-1 /, GET NEXT ARG (SUBSCRIPT?) |
| 1799 | TAD (ARGSOP /YES, OUTPUT ARGLIST OPER |
| 1800 | JMS I [OUTWRD |
| 1801 | JMS I [POP /AND THE COUNT |
| 1802 | JMS I [OUTWRD |
| 1803 | NOSS, JMS I [GETC /GET NEXT CHAR |
| 1804 | JMP I [ENDEXP |
| 1805 | TAD (-253 /PREPARE IT |
| 1806 | JMP NOTFSS+1 |
| 1807 | OPR8RL, DCA TEMP /SAVE ADDR OF LITERAL |
| 1808 | JMS I [OUTWRD |
| 1809 | TAD TEMP |
| 1810 | JMS I [OUTWRD |
| 1811 | JMP NOSS |
| 1812 | \f/ TYPLST PART TWO |
| 1813 | DIMLUP, JMS I [NUMBER /GET DIMENSION |
| 1814 | JMP VARDIM /MAYBE ITS VAR DIM ? |
| 1815 | JMP .+3 /OK, INTEGER |
| 1816 | JMP BADDIM |
| 1817 | JMP BADDIM /DP AND FP ARE BAD |
| 1818 | JMS I [FIXNUM /FIX IT FOR SOME STUFF |
| 1819 | DCA MQ |
| 1820 | TAD DPRDCT /GET NEW DIMENSION PRODUCT |
| 1821 | JMS I [MUL12 |
| 1822 | DCA DPRDCT |
| 1823 | ISZ TEMP2 /INCREMENT DIM COUNT |
| 1824 | TAD WORD2 /IF WORD2 OR AC NON ZERO |
| 1825 | TAD AC /DIM IS TOO BIG |
| 1826 | SZA CLA /1.03/ |
| 1827 | JMP BADDIM /1.03/ |
| 1828 | JMS I (ANORM /1.03/ RENORMALIZE THE NUMBER |
| 1829 | JMS I [LUKUP2 /1.03/ ENTER IT INTO LITERAL LIST |
| 1830 | INTLST /1.03/ |
| 1831 | -3 /1.03/ |
| 1832 | PSHDIM, JMS I [PUSH /1.03/ AND SAVE ON THE STACK |
| 1833 | JMS I [COMARP /LOOK FOR , OR ) |
| 1834 | JMP BADDIM |
| 1835 | SKP /COMMA MEANS ANOTHER DIM FOLLOWS |
| 1836 | JMP PUTDIM /) MEANS END OF DIMS |
| 1837 | TAD DSERES /FORM NEXT VALUE OF MAGIC NUMBER |
| 1838 | TAD DPRDCT |
| 1839 | DCA DSERES |
| 1840 | JMP DIMLUP /NOW LOOP FOR NEXT DIM |
| 1841 | VDTEMP, 0 |
| 1842 | VARDIM, CDF 10 /IS ARRAY AN ARG ? |
| 1843 | TAD I TLTEMP |
| 1844 | CDF |
| 1845 | AND (20 |
| 1846 | SNA CLA |
| 1847 | JMP BADDIM /NO, BAD DIMENSION |
| 1848 | JMS I [GETNAM /OK, GET DIMENSION |
| 1849 | JMP BADDIM |
| 1850 | JMS I [LOOKUP |
| 1851 | IAC |
| 1852 | DCA VDTEMP /ADDR OF TYPE WORD |
| 1853 | CDF 10 /IS THA VARIABLE AN ARG ? |
| 1854 | TAD I VDTEMP |
| 1855 | AND (20 |
| 1856 | CDF |
| 1857 | SNA CLA |
| 1858 | JMP BADDIM /NO, THATS BAD |
| 1859 | DCA DPRDCT /3.02 ZERO DIM PRODUCT |
| 1860 | ISZ TEMP2 /INCREMENT DIM COUNT |
| 1861 | CMA /1.03/ |
| 1862 | TAD VDTEMP /1.03/ SAVE DIMENSION VARIABLE |
| 1863 | JMP PSHDIM /3.02 SAVE DIM ON STACK |
| 1864 | MESSAG, 0 /PRINT PASS1 IMMEDIATE ERROR |
| 1865 | TAD I MESSAG /GET CHAR ONE |
| 1866 | ISZ MESSAG |
| 1867 | JMS I (TTYOUT |
| 1868 | TAD I MESSAG /GET CHAR TWO |
| 1869 | JMS I (TTYOUT |
| 1870 | TAD (215 /CR |
| 1871 | JMS I (TTYOUT |
| 1872 | TAD (212 /LF |
| 1873 | JMS I (TTYOUT |
| 1874 | JMP I (7605 /EXIT TO MONITOR |
| 1875 | \f/ EXPRESSION ANALYZER REVISITED |
| 1876 | PAGE |
| 1877 | NOTFSS, TAD (250-253 /IS IT + |
| 1878 | SZA |
| 1879 | JMP .+3 |
| 1880 | TAD (ADDOPR /YES |
| 1881 | JMP GOTOPR |
| 1882 | TAD (253-255 /IS IT - |
| 1883 | SZA |
| 1884 | JMP .+3 |
| 1885 | TAD (SUBOPR /YES |
| 1886 | JMP GOTOPR |
| 1887 | TAD (255-252 /IS IT * |
| 1888 | SZA |
| 1889 | JMP NOTMUL /NO |
| 1890 | JMS I [GETC |
| 1891 | JMP NOTEXP |
| 1892 | TAD (-252 /IS IT ** |
| 1893 | SZA CLA |
| 1894 | JMP .+3 |
| 1895 | TAD (EXPOPR /YES |
| 1896 | JMP GOTOPR |
| 1897 | JMS I [BACK1 |
| 1898 | NOTEXP, TAD (MULOPR /IT WAS * |
| 1899 | JMP GOTOPR |
| 1900 | NOTMUL, TAD (252-257 /IS IT / |
| 1901 | SZA |
| 1902 | JMP .+3 |
| 1903 | TAD (DIVOPR /YES |
| 1904 | JMP GOTOPR |
| 1905 | IAC /IS IT . |
| 1906 | SZA CLA |
| 1907 | JMP I (ENDEXP-1 /NO, END OF EXPR |
| 1908 | JMS CKEOPR /LOOK FOR EXTENDED OPERATOR |
| 1909 | JMP BADOPR /NONE THERE |
| 1910 | JMS I [CHECKC /CHECK FOR CLOSING . |
| 1911 | -256 |
| 1912 | JMP BADOPR /NOT THERE |
| 1913 | CDF 10 /3.01/ |
| 1914 | TAD I X10 /GET OPERATOR POINTER |
| 1915 | CDF |
| 1916 | JMP GOTOPR |
| 1917 | CKEOPR, 0 /CHECK FOR EXTENDED OPERATOR |
| 1918 | JMS I [GETNAM /GET NAME |
| 1919 | JMP I CKEOPR /NONE |
| 1920 | TAD (OPRLST-1 /PTR TO LIST |
| 1921 | DCA X10 |
| 1922 | OPRLUP, CDF 10 /3.01/ |
| 1923 | TAD I X10 /COMPARE FIRST CHAR |
| 1924 | CDF 0 |
| 1925 | SNA |
| 1926 | JMP I CKEOPR /END OF LIST |
| 1927 | TAD BUCKET |
| 1928 | SZA CLA |
| 1929 | JMP NOTHIS /NOT THIS ONE |
| 1930 | CDF 10 /3.01/ |
| 1931 | TAD I X10 |
| 1932 | CDF |
| 1933 | TAD I (NAME1 /COMPARE 2ND AND 3RD |
| 1934 | SZA CLA |
| 1935 | JMP NOTHIS+1 /NOT THIS ONE |
| 1936 | ISZ CKEOPR /BUMP RETURN |
| 1937 | JMP I CKEOPR |
| 1938 | NOTHIS, ISZ X10 /BUMP LIST PTR |
| 1939 | ISZ X10 /AGAIN |
| 1940 | JMP OPRLUP /KEEP GOING |
| 1941 | BADOPR, JMS I [ERMSG /NOT LEGAL EXT. OPER. |
| 1942 | 1720 |
| 1943 | JMP I [BADEXP |
| 1944 | GOTOPR, DCA NEWOP /SAVE NEWEST OPER. |
| 1945 | JMS I [POP /GET STACK TOP |
| 1946 | SNA |
| 1947 | JMP PUSH2 /EMPTY |
| 1948 | DCA OLDOP |
| 1949 | TAD I OLDOP /COMPARE PREC. |
| 1950 | CIA |
| 1951 | TAD I NEWOP /NEW-OLD |
| 1952 | SPA SNA CLA |
| 1953 | JMP OUTOLD /OLD>NEW |
| 1954 | TAD OLDOP |
| 1955 | PUSH2, JMS I [PUSH /OLD < NEW |
| 1956 | TAD NEWOP /GO PUSH BOTH |
| 1957 | JMS I [PUSH |
| 1958 | JMP I (UNOPR /GO LOOK FOR NEXT OPERAND |
| 1959 | OUTOLD, ISZ OLDOP /OUTPUT OPERATOR |
| 1960 | TAD I OLDOP |
| 1961 | JMS I [OUTWRD |
| 1962 | JMP GOTOPR+1 /TRY NEXT STACK ELEMENT |
| 1963 | NEWOP=WORD1 |
| 1964 | OLDOP=WORD2 |
| 1965 | \f/ UTILITIES |
| 1966 | GETCWB, 0 /GET A CHARACTER (PRESERVE BLANKS) |
| 1967 | ISZ NCHARS |
| 1968 | JMP .+4 |
| 1969 | CLA CMA |
| 1970 | DCA NCHARS /RESET NCHARS |
| 1971 | JMP I GETCWB |
| 1972 | ISZ GETCWB |
| 1973 | TAD I CHRPTR /GET THE CHAR |
| 1974 | JMP I GETCWB |
| 1975 | SAVECP, 0 /SAVE CHAR POSITION |
| 1976 | TAD NCHARS |
| 1977 | JMS I [PUSH |
| 1978 | TAD CHRPTR |
| 1979 | JMS I [PUSH |
| 1980 | JMP I SAVECP |
| 1981 | FIXNUM, 0 /FIX FAC (I'M MOVING IT AGAIN) |
| 1982 | TAD WORD1 /IS IT FIXED ? |
| 1983 | TAD (-27 |
| 1984 | SNA |
| 1985 | JMP RETFN /YES, EXPONENT IS 23 |
| 1986 | SMA CLA |
| 1987 | JMP I FIXNUM /BAD IF EXP IS >23 |
| 1988 | JMS I (AR1 /RIGHT SHIFT ONE |
| 1989 | JMP FIXNUM+1 /TEST AGAIN |
| 1990 | RETFN, TAD WORD3 /RETURN LOWEST 12 BITS |
| 1991 | JMP I FIXNUM |
| 1992 | \f/ UTILITIES |
| 1993 | PAGE |
| 1994 | GETC, 0 /GET A CHARACTER (IGNORING BLANKS) |
| 1995 | ISZ NCHARS |
| 1996 | JMP .+4 |
| 1997 | CLA CMA |
| 1998 | DCA NCHARS |
| 1999 | JMP I GETC |
| 2000 | TAD I CHRPTR |
| 2001 | TAD (-240 /IS IT A BLANK |
| 2002 | SNA |
| 2003 | JMP GETC+1 /YES IGNORE IT |
| 2004 | TAD (240 /FIX CHAR |
| 2005 | ISZ GETC |
| 2006 | JMP I GETC |
| 2007 | ERMSG, 0 /ERROR MESSAGE HANDLER |
| 2008 | CDF |
| 2009 | TAD NOCODE /IS CODE GENERATION ON ? |
| 2010 | SZA CLA |
| 2011 | JMP NOTOUT /NO |
| 2012 | TAD (ERRCOD /ERROR CODE TO OUTPUT FILE |
| 2013 | JMS I [OUTWRD |
| 2014 | TAD I ERMSG |
| 2015 | ISZ ERMSG |
| 2016 | JMS I [OUTWRD |
| 2017 | JMP I ERMSG /RETURN |
| 2018 | NOTOUT, TAD I ERMSG /SAVE THE ERROR CODE |
| 2019 | ISZ ERMSG |
| 2020 | DCA ERCODE |
| 2021 | JMP I ERMSG |
| 2022 | POP, 0 /PUT TOP OF STACK INTO AC |
| 2023 | TAD STACK |
| 2024 | DCA ERMSG |
| 2025 | CLA CMA |
| 2026 | TAD STACK |
| 2027 | DCA STACK /DECREMENT STACK POINTER |
| 2028 | TAD I ERMSG |
| 2029 | JMP I POP |
| 2030 | TRUFAL, 0 /CHECK FOR LOGICAL LITERALS |
| 2031 | JMS I [GETNAM |
| 2032 | JMP I TRUFAL |
| 2033 | JMS I [CHECKC /LOOK FOR TERMINAL . |
| 2034 | -256 |
| 2035 | JMP I TRUFAL |
| 2036 | TAD BUCKET /LOOK AT FIRST CHAR |
| 2037 | TAD (-24 |
| 2038 | SNA |
| 2039 | JMP .+5 /ITS "T" |
| 2040 | TAD (24-6 |
| 2041 | SZA CLA |
| 2042 | JMP I TRUFAL /ITS NEITHER |
| 2043 | ISZ TRUFAL /ITS "F" |
| 2044 | ISZ TRUFAL |
| 2045 | JMP I TRUFAL |
| 2046 | \f/ LEFT HALF EXPRESSION ANALYZER |
| 2047 | LEXPR, 0 /GET LEFT HAND EXPRESSION |
| 2048 | DCA LETEMP /SAVE CALL SWITCH |
| 2049 | JMS I [GETNAM /LOOK FOR VAR NAME |
| 2050 | JMP MSNGOP /MUST BE THERE |
| 2051 | JMS I [OUTWRD /OUTPUT A ZERO (PUSH) |
| 2052 | JMS I [LOOKUP /SEEK OUT ENTRY FOR THIS VAR |
| 2053 | DCA TEMP |
| 2054 | TAD TEMP |
| 2055 | JMS I [OUTWRD |
| 2056 | JMS I [GETC /LOOK FOR DIMENSIONS |
| 2057 | JMP LEXPOK /NO ( |
| 2058 | TAD (-250 |
| 2059 | SZA CLA |
| 2060 | JMP LEXPOK-1 /NO ( |
| 2061 | ISZ TEMP /LOOK AT TYPE |
| 2062 | CDF 10 |
| 2063 | CLL CML RTR /DIMENSIONED ? |
| 2064 | AND I TEMP |
| 2065 | TAD LETEMP /OR A CALL ? |
| 2066 | TAD NOCODE /OR CODE OFF ? |
| 2067 | SZA CLA |
| 2068 | JMP NOTSF /YES, NOT AN ARITHMETIC S.F. |
| 2069 | TAD I TEMP |
| 2070 | AND (1420 /EXT, SF, OR ARG ? |
| 2071 | SNA CLA /V3C |
| 2072 | TAD [-M6 /SEE IF CALLED FROM SPECIAL PLACE |
| 2073 | TAD LEXPR /V3C COMPARE WITH ENTRY PT |
| 2074 | SZA CLA |
| 2075 | JMP ASFERR /THIS IS BAD IF SO |
| 2076 | TAD I TEMP |
| 2077 | TAD (400 |
| 2078 | DCA I TEMP /SET A.S.F. BIT |
| 2079 | CDF |
| 2080 | TAD (ASFDEF /DEFINE ASF |
| 2081 | JMS I [OUTWRD |
| 2082 | NOTSF, CDF |
| 2083 | SKP |
| 2084 | JMS I [POP /ARG COUNT TO AC |
| 2085 | SSLOOP, IAC /INCREMENT SS COUNT |
| 2086 | JMS I [PUSH /SAVE ON THE STACK |
| 2087 | JMS I [EXPR /COMPILE SUBSCRIPT |
| 2088 | JMP FSSBAD+2 /ERROR WITHIN SS |
| 2089 | JMS I [COMARP /LOOK FOR , OR ) |
| 2090 | JMP FSSBAD /NEITHER (THERE WAS A BUG HERE) |
| 2091 | JMP SSLOOP-1 /, GET NEXT ARG/SS |
| 2092 | TAD (ARGSOP /OUTPUT SS OPERATOR |
| 2093 | JMS I [OUTWRD |
| 2094 | JMS I [POP /THEN COUNT |
| 2095 | JMS I [OUTWRD |
| 2096 | SKP |
| 2097 | JMS I [BACK1 /PUT BACK A CHARACTER |
| 2098 | LEXPOK, ISZ LEXPR |
| 2099 | JMP I LEXPR /RETURN |
| 2100 | MSNGOP, JMS I [ERMSG /MISSING OPERAND |
| 2101 | 1517 |
| 2102 | JMP I LEXPR |
| 2103 | FSSBAD, JMS I [ERMSG /MISSING COMMA OR CLOSE PARENTHESIS |
| 2104 | 2323 |
| 2105 | JMS I [POP /GET ARG COUNT OFF STACK |
| 2106 | CLA |
| 2107 | JMP I LEXPR |
| 2108 | ASFERR, JMS I [ERMSG /BAD ARITHMETIC STMT FUNCTION |
| 2109 | 2306 |
| 2110 | JMP NOTSF /DO THE REST OF THE ASF DEF |
| 2111 | LETEMP, 0 |
| 2112 | \f/UTILITIES |
| 2113 | PAGE |
| 2114 | G2CTMP, |
| 2115 | PUSH, 0 /PUT AC ONTO STACK |
| 2116 | DCA I STACK /STORE |
| 2117 | TAD (STACKS+100 /CHECK FOR STACK OVERFLOW |
| 2118 | CIA CLL |
| 2119 | TAD STACK |
| 2120 | SNL CLA |
| 2121 | JMP I PUSH /OK, RETURN |
| 2122 | DCA NOCODE /SET CODE GENERATION ON |
| 2123 | JMS I [ERMSG |
| 2124 | 2004 |
| 2125 | JMP I [NEXTST |
| 2126 | GET2C, 0 /GET 2 SIX BIT CHARS INTO ONE WPRD |
| 2127 | JMS I [GETC /GET FIRST CHAR |
| 2128 | JMP I GET2C |
| 2129 | AND [77 |
| 2130 | CLL RTL |
| 2131 | RTL |
| 2132 | RTL |
| 2133 | DCA G2CTMP |
| 2134 | JMS I [GETC /GET SECOND CHAR |
| 2135 | JMP I GET2C |
| 2136 | ISZ GET2C /FIX RETURN ADDR |
| 2137 | AND [77 |
| 2138 | TAD G2CTMP |
| 2139 | JMP I GET2C |
| 2140 | STMNUM, 0 /PICK UP STATEMENT NUMBER |
| 2141 | DCA WORD4 /SAVE DEFINED BIT (IF ANY) |
| 2142 | DCA WORD2 /ZERO SOME STUFF |
| 2143 | DCA WORD3 |
| 2144 | JMS DIGIT /GET A DIGIT |
| 2145 | JMP I STMNUM /NONE THERE, NO STMT NUMBER |
| 2146 | TAD (-60 /IS IT A LEADING 0 ? |
| 2147 | SNA |
| 2148 | JMP .-4 /YES, IGNORE IT |
| 2149 | TAD (60 |
| 2150 | CLL RTL |
| 2151 | RTL |
| 2152 | RTL |
| 2153 | DCA WORD1 |
| 2154 | JMS DIGIT /GET SECOND DIGIT |
| 2155 | JMP ENDNUM /END OF NUMBER |
| 2156 | TAD WORD1 |
| 2157 | DCA WORD1 /COMBINE FIRST AND SECOND |
| 2158 | JMS DIGIT |
| 2159 | JMP ENDNUM |
| 2160 | CLL RTL |
| 2161 | RTL |
| 2162 | RTL |
| 2163 | DCA WORD2 |
| 2164 | JMS DIGIT |
| 2165 | JMP ENDNUM /COMBINE THIRD AND FOURTH |
| 2166 | TAD WORD2 |
| 2167 | DCA WORD2 |
| 2168 | JMS DIGIT /GET FIFTH DIGIT |
| 2169 | JMP ENDNUM |
| 2170 | CLL RTL |
| 2171 | RTL |
| 2172 | RTL |
| 2173 | DCA WORD3 |
| 2174 | ENDNUM, JMS I [LUKUP2 /LOOK UP IN S.T. |
| 2175 | SNLIST /STMT NUMBER LIST |
| 2176 | -3 |
| 2177 | ISZ STMNUM |
| 2178 | DCA SNUM /SAVE S.T. ADDRESS OF LABEL |
| 2179 | CDF 10 /SET TYPE WORD |
| 2180 | TAD SNUM /GET ADDR OF TYPE |
| 2181 | IAC |
| 2182 | DCA SNTEMP |
| 2183 | TAD I SNTEMP /GET TYPE WORD |
| 2184 | CLL |
| 2185 | TAD WORD4 /PUT IN THE DEFINITION BIT |
| 2186 | SNL |
| 2187 | DCA I SNTEMP /RESTORE IT IF NOT MULTIPLE DEFN |
| 2188 | CDF |
| 2189 | SNL CLA |
| 2190 | JMP I STMNUM |
| 2191 | JMS I [ERMSG |
| 2192 | 1514 |
| 2193 | JMP I STMNUM |
| 2194 | SNTEMP, |
| 2195 | DIGIT, 0 /GET A DIGIT |
| 2196 | JMS I [GETC /GET A CHAR |
| 2197 | JMP I DIGIT |
| 2198 | TAD (-272 /IS IT > 271 (9) |
| 2199 | SMA |
| 2200 | JMP NODIGT /YES, ITS GREATER |
| 2201 | TAD (272-260 /IS IT < 260 (0) |
| 2202 | SPA |
| 2203 | JMP NODIGT /YES, ITS LESS |
| 2204 | TAD (60 |
| 2205 | ISZ DIGIT |
| 2206 | JMP I DIGIT /TAKE SUCCESSFUL RETURN |
| 2207 | NODIGT, JMS I [BACK1 /RESTORE NON DIGIT |
| 2208 | JMP I DIGIT |
| 2209 | ASSIGN, JMS I [STMNUM /GET STMT NUMBER |
| 2210 | JMP BADASN |
| 2211 | JMS I [GET2C /LOOK FOR "TO" |
| 2212 | JMP BADASN |
| 2213 | TAD (-2417 |
| 2214 | SNA CLA |
| 2215 | JMS I [LEXPR /GET ASSIGN VARIABLE |
| 2216 | JMP BADASN |
| 2217 | TAD (ASNOPR /OUTPUT ASSIGN OPERATOR |
| 2218 | JMS I [OUTWRD |
| 2219 | TAD SNUM /NOW STMT NUMBER |
| 2220 | JMS I [OUTWRD |
| 2221 | JMP I [NEXTST |
| 2222 | BADASN, JMS I [ERMSG |
| 2223 | 0123 |
| 2224 | JMP I [NEXTST |
| 2225 | TTYOUT, 0 /TTY OUTPUT ROUTINE |
| 2226 | TLS |
| 2227 | TSF |
| 2228 | JMP .-1 |
| 2229 | CLA |
| 2230 | JMP I TTYOUT |
| 2231 | \f/ PRECEDENCE TABLE |
| 2232 | PAGE |
| 2233 | ADDOPR, 100 |
| 2234 | 1 |
| 2235 | SUBOPR, 100 |
| 2236 | 2 |
| 2237 | MULOPR, 200 |
| 2238 | 3 |
| 2239 | DIVOPR, 200 |
| 2240 | 4 |
| 2241 | EXPOPR, 500 |
| 2242 | 5 |
| 2243 | NOTOPR, 30 |
| 2244 | 6 |
| 2245 | UMOPR, 400 |
| 2246 | 7 |
| 2247 | EQOPR, 40 |
| 2248 | 16 |
| 2249 | NEOPR, 40 |
| 2250 | 17 |
| 2251 | GEOPR, 40 |
| 2252 | 10 |
| 2253 | GTOPR, 40 |
| 2254 | 11 |
| 2255 | LEOPR, 40 |
| 2256 | 12 |
| 2257 | LTOPR, 40 |
| 2258 | 13 |
| 2259 | ANDOPR, 20 |
| 2260 | 14 |
| 2261 | OROPR, 10 |
| 2262 | 15 |
| 2263 | XOROPR, 7 |
| 2264 | 20 |
| 2265 | EQVOPR, 7 |
| 2266 | 21 |
| 2267 | \f/ UTILITY ROUTINES |
| 2268 | BACK1, 0 /BACK UP ONE CHAR |
| 2269 | CLA CMA |
| 2270 | TAD NCHARS |
| 2271 | DCA NCHARS |
| 2272 | CLA CMA |
| 2273 | TAD CHRPTR |
| 2274 | DCA CHRPTR |
| 2275 | JMP I BACK1 |
| 2276 | OADD, 0 /ADD OPERAND TO FAC |
| 2277 | CLL |
| 2278 | TAD OPO |
| 2279 | TAD ACO |
| 2280 | DCA ACO |
| 2281 | RAL |
| 2282 | TAD OP6 |
| 2283 | TAD WORD6 |
| 2284 | DCA WORD6 |
| 2285 | RAL |
| 2286 | TAD OP5 |
| 2287 | TAD WORD5 |
| 2288 | DCA WORD5 |
| 2289 | RAL |
| 2290 | TAD OP4 |
| 2291 | TAD WORD4 |
| 2292 | DCA WORD4 |
| 2293 | RAL |
| 2294 | TAD OP3 |
| 2295 | TAD WORD3 |
| 2296 | DCA WORD3 |
| 2297 | RAL |
| 2298 | TAD OP2 |
| 2299 | TAD WORD2 |
| 2300 | DCA WORD2 |
| 2301 | JMP I OADD |
| 2302 | \f/ FLOATING POINT DIVIDE ROUTINE |
| 2303 | PAGE |
| 2304 | FPDIV, 0 |
| 2305 | JMS I DAR1 /UNNORMALIZE AC BY ONE |
| 2306 | TAD OP1 /COMPUTE FINAL EXPONENT |
| 2307 | CIA |
| 2308 | TAD WORD1 |
| 2309 | DCA OP1 /AND SAVE IT |
| 2310 | TAD DM74 /SET ITERATION COUNTER |
| 2311 | DCA DITCNT |
| 2312 | TAD WORD2 |
| 2313 | RAL /INITIALIZE LINK |
| 2314 | FPDVLP, CLA RAR /COMPARE SIGNS |
| 2315 | TAD OP2 |
| 2316 | SPA CLA |
| 2317 | JMP .+3 |
| 2318 | TAD OPMAC /NEGATE OPERAND |
| 2319 | JMS I DFNEG |
| 2320 | JMS I DOADD /ADD OPERAND AND FAC |
| 2321 | TAD D6 /RIGHT SHIFT QUOTIENT |
| 2322 | RAL /PRESERVING ADD OVERFLOW BIT |
| 2323 | DCA D6 |
| 2324 | TAD D5 |
| 2325 | RAL |
| 2326 | DCA D5 |
| 2327 | TAD D4 |
| 2328 | RAL |
| 2329 | DCA D4 |
| 2330 | TAD D3 |
| 2331 | RAL |
| 2332 | DCA D3 |
| 2333 | TAD D2 |
| 2334 | RAL |
| 2335 | DCA D2 |
| 2336 | JMS I DAL1 /LEFT SHIFT FAC ONE |
| 2337 | ISZ DITCNT /TEST ITERATION COUNT |
| 2338 | JMP FPDVLP |
| 2339 | TAD OP1 /PUT QUOTIENT INTO FAC |
| 2340 | DCA WORD1 |
| 2341 | TAD D2 |
| 2342 | DCA WORD2 |
| 2343 | TAD D3 |
| 2344 | DCA WORD3 |
| 2345 | TAD D4 |
| 2346 | DCA WORD4 |
| 2347 | TAD D5 |
| 2348 | DCA WORD5 |
| 2349 | TAD D6 |
| 2350 | DCA WORD6 |
| 2351 | DCA ACO |
| 2352 | JMS I DNORM /NORMALIZE |
| 2353 | JMP I FPDIV |
| 2354 | D2, 0 |
| 2355 | D3, 0 |
| 2356 | D4, 0 |
| 2357 | D5, 0 |
| 2358 | D6, 0 |
| 2359 | DITCNT, 0 |
| 2360 | DAR1, AR1 |
| 2361 | DAL1, AL1 |
| 2362 | DM74, -74 |
| 2363 | OPMAC, OPO-ACO |
| 2364 | DFNEG, NEGFAC |
| 2365 | DOADD, OADD |
| 2366 | DNORM, ANORM |
| 2367 | *STACKS-1 |
| 2368 | -1 /TO PREVENT SPURIOUS DO ENDS |
| 2369 | \f/ NUMERIC CONVERSION ROUTINE |
| 2370 | PAGE |
| 2371 | NUMBER, 0 /GENERAL NUMBER CONVERSION ROUTINE |
| 2372 | DCA ESWIT /ZERO E/D SWITCH |
| 2373 | DCA DECPT /ZERO DECIMAL POINT SWITCH |
| 2374 | DCA WORD1 /ZERO FAC |
| 2375 | DCA WORD2 |
| 2376 | DCA WORD3 |
| 2377 | DCA WORD4 |
| 2378 | DCA WORD5 |
| 2379 | DCA WORD6 |
| 2380 | DCA ACO |
| 2381 | DCA SIGN /CLEAR SIGN SWITCH |
| 2382 | JMS I [GETC /GET A CHAR |
| 2383 | JMP I NUMBER /NO CHAR IS NO NUMBER |
| 2384 | JMS CHKSGN /CHECK FOR SIGN |
| 2385 | SIGN, 0 /THIS SWITCH GETS SET |
| 2386 | DCA NDIGIT /ZERO DIGIT COUNT |
| 2387 | CONVLP, JMS I [DIGIT /GET A DIGIT |
| 2388 | JMP TRYDEC /IS THERE A DECIMAL POINT ? |
| 2389 | AND [17 |
| 2390 | DCA NXTDGT /SAVE THE DIGIT |
| 2391 | ISZ NDIGIT /INCR NUMBER OF DIGITS |
| 2392 | TAD WORD2 /PREPARE TO MULT BY 10 |
| 2393 | DCA OP2 |
| 2394 | TAD WORD3 |
| 2395 | DCA OP3 |
| 2396 | TAD WORD4 |
| 2397 | DCA OP4 |
| 2398 | TAD WORD5 |
| 2399 | DCA OP5 |
| 2400 | TAD WORD6 |
| 2401 | DCA OP6 |
| 2402 | TAD ACO |
| 2403 | DCA OPO |
| 2404 | JMS I (AL1 /DOUBLE FAC |
| 2405 | JMS I (AL1 /DOUBLE AGAIN |
| 2406 | JMS I (OADD /TIMES FIVE |
| 2407 | JMS I (AL1 /ONE MORE DOUBLING IS TIMES 10 |
| 2408 | DCA OP2 |
| 2409 | DCA OP3 /PUT NEWEST DIGIT INTO OPERAND |
| 2410 | DCA OP4 |
| 2411 | DCA OP5 |
| 2412 | DCA OP6 |
| 2413 | TAD NXTDGT |
| 2414 | DCA OPO |
| 2415 | JMS I (OADD /ADD IN NEWEST DIGIT |
| 2416 | JMP CONVLP |
| 2417 | TRYDEC, TAD DECPT /DECIMAL ALREADY ? |
| 2418 | SZA CLA |
| 2419 | JMP TRYE2 /YES, LOOK FOR EXPONENT |
| 2420 | JMS I [GETC /LOOK FOR . |
| 2421 | JMP DIGTST /SEE IF THERE WAS ANYTHING |
| 2422 | TAD (-256 |
| 2423 | SZA |
| 2424 | JMP TRYE1 /TRY FOR E |
| 2425 | JMS I [SAVECP /SAVE CHAR POS |
| 2426 | JMS I (CKEOPR /CHECK FOR SPECIAL CASE OF LIT.RE. |
| 2427 | JMP NOLDRE /NOT LIT.RE. |
| 2428 | JMS I [RESTCP |
| 2429 | JMS I [BACK1 /PUT BACK . IT BELONGS TO RELATIONAL |
| 2430 | DIGTST, TAD NDIGIT /ANY DIGITS ? |
| 2431 | SNA CLA |
| 2432 | JMP I NUMBER /NO, NO NUMBER |
| 2433 | JMP INTEGR /TAKE INTEGER EXIT |
| 2434 | NOLDRE, ISZ DECPT /SET DECIMAL POINT SW |
| 2435 | JMS I [RESTCP /RESTORE CHAR POS |
| 2436 | JMP CONVLP-1 /LOOP FOR OTHER DIGITS |
| 2437 | TRYE1, JMS I [BACK1 /PUT BACK NON . |
| 2438 | TAD NDIGIT /ANY DIGITS YET ? |
| 2439 | SNA CLA |
| 2440 | JMP I NUMBER /NO, NO NUMBER |
| 2441 | JMS EORD /LOOK OR E OR D |
| 2442 | JMP INTEGR |
| 2443 | TRYE2, JMS EORD /LOOK FOR E OR D |
| 2444 | FPNUM, ISZ NUMBER |
| 2445 | ISZ NUMBER |
| 2446 | DCA EXPON /ZERO EXPONENT |
| 2447 | JMS I (DODEC /HANDLE DIGITS RIGHT OF . |
| 2448 | JMP DOSIGN-1 /GO DO SIGN |
| 2449 | INTEGR, TAD (107 /PUT IN EXPONNT |
| 2450 | DCA WORD1 |
| 2451 | JMS I (ANORM /NORMALIZE |
| 2452 | ISZ NUMBER /BUMP RETURN |
| 2453 | DOSIGN, TAD SIGN /CHECK THE SIGN |
| 2454 | SZA CLA |
| 2455 | JMS I (NEGFAC /NEGATE IF NEGATIVE |
| 2456 | JMP I NUMBER /RETURN |
| 2457 | CHKSGN, 0 /CHECK FOR SIGN |
| 2458 | TAD (-255 /IS IT - ? |
| 2459 | SNA |
| 2460 | ISZ I CHKSGN /YES, SET SWITCH |
| 2461 | SZA |
| 2462 | TAD (255-253 /IS IT + ? |
| 2463 | SZA CLA |
| 2464 | JMS I [BACK1 /RETURN CHAR OTHERWISE |
| 2465 | JMP I CHKSGN |
| 2466 | EORD, 0 /LOOK FOR E OR D |
| 2467 | JMS I [GETC /LOOK FOR E OR D |
| 2468 | JMP I EORD |
| 2469 | TAD (-304 |
| 2470 | CLL RAR |
| 2471 | SZA CLA /E OR D? |
| 2472 | JMP NOEORD /NO |
| 2473 | SZL |
| 2474 | ISZ ESWIT /SET SWITCH IF E |
| 2475 | SNL |
| 2476 | ISZ DPUSED /SET D.P. SWITCH IF D |
| 2477 | JMP I (GETEXP /OK, GET EXPONENT |
| 2478 | NOEORD, JMS I [BACK1 /PUT IT BACK CAUSE ITS NOT OURS |
| 2479 | JMP I EORD |
| 2480 | NXTDGT, 0 |
| 2481 | REWIND, JMS I [EXPR /COMPILE UNIT |
| 2482 | JMP I [NEXTST |
| 2483 | TAD (REWOPR /OUTPUT REWIND OPERATOR |
| 2484 | JMS I [OUTWRD |
| 2485 | JMP I [NEXTST |
| 2486 | \f/ NUMERIC CONVERSION ROUTINE |
| 2487 | PAGE |
| 2488 | SMLNUM, 0 /INPUT A NUMBER <= 4095 |
| 2489 | EXPLUP, DCA EXPON /ZERO THE EXPONENT |
| 2490 | JMS I [DIGIT /GET THE NEXT DIGIT |
| 2491 | JMP I SMLNUM /NUMBER DONE |
| 2492 | AND [17 |
| 2493 | DCA OPO /SAVE THE DIGIT |
| 2494 | TAD EXPON /MULT BY 10 |
| 2495 | CLL RAL |
| 2496 | CLL RAL |
| 2497 | TAD EXPON |
| 2498 | CLL RAL |
| 2499 | TAD OPO /ADD IN DIGIT |
| 2500 | JMP EXPLUP /STORE BACK INTO EXPONENT |
| 2501 | GETEXP, DCA ESIGN /ZERO EXPONENT SIGN SWITCH |
| 2502 | JMS I [GETC /GET A CHAR |
| 2503 | JMP I (FPNUM+1 |
| 2504 | JMS I (CHKSGN /IS IT A SIGN |
| 2505 | FPRTNE, |
| 2506 | ESIGN, 0 /THIS IS THE SWITCH TO SET |
| 2507 | JMS SMLNUM /GO GET THE EXPONENT |
| 2508 | FIXEXP, TAD ESIGN /CHECK EXPONENT SIGN |
| 2509 | SNA CLA |
| 2510 | JMP .+4 |
| 2511 | TAD EXPON /COMPLEMENT EXPONENT |
| 2512 | CIA |
| 2513 | DCA EXPON |
| 2514 | JMS DODEC /GO HANLE EXPONENT |
| 2515 | CLL CML RTL /BUMP RETURN BY TWO (DP) OR 3 (FP) |
| 2516 | TAD ESWIT /DEPENDING ON E/D SWITCH |
| 2517 | TAD I [NUMBER |
| 2518 | DCA I [NUMBER |
| 2519 | JMP I (DOSIGN /CHECK THE SIGN |
| 2520 | DODEC, 0 |
| 2521 | TAD DO107 /NORMALIZE THE NUMBER |
| 2522 | DCA WORD1 |
| 2523 | JMS I (ANORM |
| 2524 | TAD DECPT /WAS THERE A DECIMAL POINT ? |
| 2525 | SZA CLA |
| 2526 | TAD NDIGIT /HOW MANY DIGITS TO THE RIGHT ? |
| 2527 | CIA |
| 2528 | TAD EXPON /SUBTRACT THAT NUMBER FROM EXP |
| 2529 | SMA |
| 2530 | JMP POSEXP /EXPONENT IS POSITIVE |
| 2531 | CIA |
| 2532 | DCA EXPON /ONLY NEED ABS VALUE |
| 2533 | TAD (FPDIV /DO DIVIDES |
| 2534 | JMP .+3 |
| 2535 | POSEXP, DCA EXPON |
| 2536 | TAD (FPMUL /DO MULTIPLIES |
| 2537 | DCA FPRTNE /MULTIPLY/DIVIDE ROUTINE |
| 2538 | TAD (PETABL-1 /POWERS OF TEN TABLE |
| 2539 | DCA X17 |
| 2540 | EXPMUL, TAD EXPON /LOOK AT THE EXPONENT |
| 2541 | SNA |
| 2542 | JMP I DODEC /IF 0 ITS THRU |
| 2543 | CLL RAR |
| 2544 | DCA EXPON /PUT LOWEST BIT INTO LINK |
| 2545 | SNL |
| 2546 | JMP SKPEXP /THIS ONE DOESN'T COUNT |
| 2547 | CDF 10 /3.01/ |
| 2548 | TAD I X17 /MOVE FACTOR INTO OPERAND |
| 2549 | DCA OP1 |
| 2550 | TAD I X17 |
| 2551 | DCA OP2 |
| 2552 | TAD I X17 |
| 2553 | DCA OP3 |
| 2554 | TAD I X17 |
| 2555 | DCA OP4 |
| 2556 | TAD I X17 |
| 2557 | DCA OP5 |
| 2558 | TAD I X17 |
| 2559 | DCA OP6 |
| 2560 | DCA OPO |
| 2561 | CDF |
| 2562 | JMS I FPRTNE /MULTIPLY OR DIVIDE BY THIS FACTOR |
| 2563 | JMP EXPMUL /CHECK NEXT BIT |
| 2564 | SKPEXP, TAD X17 /SKIP OVER THIS FACTOR |
| 2565 | TAD (6 |
| 2566 | JMP EXPMUL-1 |
| 2567 | AR1, 0 /SHIFT FAC RIGHT ONE |
| 2568 | TAD WORD2 |
| 2569 | CLL RAR |
| 2570 | DCA WORD2 |
| 2571 | TAD WORD3 |
| 2572 | RAR |
| 2573 | DCA WORD3 |
| 2574 | TAD WORD4 |
| 2575 | RAR |
| 2576 | DCA WORD4 |
| 2577 | TAD WORD5 |
| 2578 | RAR |
| 2579 | DCA WORD5 |
| 2580 | TAD WORD6 |
| 2581 | RAR |
| 2582 | DCA WORD6 |
| 2583 | TAD ACO |
| 2584 | RAR |
| 2585 | DCA ACO |
| 2586 | ISZ WORD1 |
| 2587 | DO107, 107 |
| 2588 | JMP I AR1 |
| 2589 | |
| 2590 | AL1, 0 /SHIFT FAC LEFT ONE |
| 2591 | TAD ACO |
| 2592 | CLL RAL |
| 2593 | DCA ACO |
| 2594 | TAD WORD6 |
| 2595 | RAL |
| 2596 | DCA WORD6 |
| 2597 | TAD WORD5 |
| 2598 | RAL |
| 2599 | DCA WORD5 |
| 2600 | TAD WORD4 |
| 2601 | RAL |
| 2602 | DCA WORD4 |
| 2603 | TAD WORD3 |
| 2604 | RAL |
| 2605 | DCA WORD3 |
| 2606 | TAD WORD2 |
| 2607 | RAL |
| 2608 | DCA WORD2 |
| 2609 | JMP I AL1 |
| 2610 | \f/ NUMERIC CONVERSION ROUTINE |
| 2611 | PAGE |
| 2612 | FPMUL, 0 /FLOATING MULTIPLY ROUTINE |
| 2613 | TAD WORD1 /COMPUTE NEW EXPONENT |
| 2614 | TAD OP1 |
| 2615 | DCA OP1 |
| 2616 | TAD WORD2 /SAVE AC MANTISSA |
| 2617 | DCA TW2 |
| 2618 | TAD WORD3 |
| 2619 | DCA TW3 |
| 2620 | TAD WORD4 |
| 2621 | DCA TW4 |
| 2622 | TAD WORD5 |
| 2623 | DCA TW5 |
| 2624 | TAD WORD6 |
| 2625 | DCA TW6 |
| 2626 | TAD (-74 /SET ITERATION COUNTER |
| 2627 | DCA ITRCNT |
| 2628 | DCA WORD2 /ZERO FAC MANTISSA |
| 2629 | DCA WORD3 |
| 2630 | DCA WORD4 |
| 2631 | DCA WORD5 |
| 2632 | DCA WORD6 |
| 2633 | DCA ACO |
| 2634 | MULLUP, JMS I (AR1 /SHIFT FAC RIGHT ONE |
| 2635 | TAD TW2 /SHIFT MULTIPLIER RIGHT |
| 2636 | CLL RAR |
| 2637 | DCA TW2 |
| 2638 | TAD TW3 |
| 2639 | RAR |
| 2640 | DCA TW3 |
| 2641 | TAD TW4 |
| 2642 | RAR |
| 2643 | DCA TW4 |
| 2644 | TAD TW5 |
| 2645 | RAR |
| 2646 | DCA TW5 |
| 2647 | TAD TW6 |
| 2648 | RAR |
| 2649 | DCA TW6 |
| 2650 | SZL |
| 2651 | JMS I (OADD /ADD IF LINK IS ONE |
| 2652 | ISZ ITRCNT /BUMP COUNT |
| 2653 | JMP MULLUP /LOOP |
| 2654 | TAD OP1 /PUT IN CORRECT EXPONENT |
| 2655 | DCA WORD1 |
| 2656 | JMS I (ANORM /NORMALIZE THE RESULT |
| 2657 | JMP I FPMUL |
| 2658 | TW2, 0 |
| 2659 | TW3, 0 |
| 2660 | TW4, 0 |
| 2661 | TW5, 0 |
| 2662 | TW6, 0 |
| 2663 | ANORM, 0 /NORMALIZE FAC |
| 2664 | TAD WORD2 /IS MANTISSA 0 ? |
| 2665 | SNA |
| 2666 | TAD WORD3 |
| 2667 | SNA |
| 2668 | TAD WORD4 |
| 2669 | SNA |
| 2670 | TAD WORD5 |
| 2671 | SNA |
| 2672 | TAD WORD6 |
| 2673 | SNA |
| 2674 | TAD ACO |
| 2675 | SNA CLA |
| 2676 | JMP ZEXP /YES, ZERO EXPONENT |
| 2677 | NORMLP, CLA CLL CML RTR /IS HIGH ORDER MANTISSA = 6000 |
| 2678 | TAD WORD2 |
| 2679 | SZA |
| 2680 | JMP NO6000 /NO, SKIP THIS STUFF |
| 2681 | TAD WORD3 /YES, IS THE REST 0 ? |
| 2682 | SNA |
| 2683 | TAD WORD4 |
| 2684 | SNA |
| 2685 | TAD WORD5 |
| 2686 | SNA |
| 2687 | TAD WORD6 |
| 2688 | SNA |
| 2689 | TAD ACO |
| 2690 | SZA CLA /SKIP IF 600000 ... 0000 |
| 2691 | NO6000, SPA CLA |
| 2692 | JMP I ANORM /NORM IS DONE WHEN BITS DIFFER |
| 2693 | JMS I (AL1 /SHIFT LEFT ONE |
| 2694 | CLA CMA /DECREMENT EXPONENT |
| 2695 | TAD WORD1 |
| 2696 | DCA WORD1 |
| 2697 | JMP NORMLP /LOOP |
| 2698 | ZEXP, DCA WORD1 |
| 2699 | JMP I ANORM |
| 2700 | NEGFAC, 0 /NEGATE FAC |
| 2701 | TAD (ACO /GET POINTER TO OPERAND |
| 2702 | DCA NFPTR |
| 2703 | TAD (-6 /SIX WORD NEGATE |
| 2704 | DCA NFCNT |
| 2705 | CLL |
| 2706 | NFLOOP, RAL |
| 2707 | TAD I NFPTR /GET NEXT WORD |
| 2708 | CLL CML CIA |
| 2709 | DCA I NFPTR /RESTORE AFTER COMPLEMENTING |
| 2710 | CML CLA CMA /LINK GETS COMPLEMENTED ONCE HERE |
| 2711 | TAD NFPTR /AND ONCE AGAIN HERE |
| 2712 | DCA NFPTR /RESTORE DECREMENTED POINTER |
| 2713 | ISZ NFCNT |
| 2714 | JMP NFLOOP |
| 2715 | JMP I NEGFAC |
| 2716 | NFPTR, 0 |
| 2717 | NFCNT, 0 |
| 2718 | ITRCNT, |
| 2719 | DHLRTH, 0 /HOLLERITH IN DATA SUBR |
| 2720 | ISZ TEMP |
| 2721 | SKP |
| 2722 | JMP I DHLRTH |
| 2723 | ISZ DHLRTH |
| 2724 | JMS I [GETCWB |
| 2725 | JMP DHOLER |
| 2726 | JMP I DHLRTH |
| 2727 | \f/ VARIABLE SCANNER |
| 2728 | PAGE |
| 2729 | GETNAM, 0 /GET VARIABLE NAME |
| 2730 | JMS LETTER /FIRST CHAR MUST BE ALPHABETIC |
| 2731 | JMP I GETNAM /NO VARIABLE |
| 2732 | DCA BUCKET /FIRST ONE IS THE BUCKET |
| 2733 | TAD (NAME1 |
| 2734 | DCA NPTR /POINTER TO NAME BUFFER |
| 2735 | CLL CMA RTL /SIX CHARS MAX (3 WORDS) |
| 2736 | DCA NCNT |
| 2737 | PAKLUP, JMS LETTER /GET A LETTER |
| 2738 | SKP |
| 2739 | JMP .+3 /WE GOT IT |
| 2740 | JMS I [DIGIT /NO LETTER, IS IT A DIGIT ? |
| 2741 | JMP NDONE /NO, NAMES OVER |
| 2742 | CLL RTL |
| 2743 | RTL |
| 2744 | RTL /MOVE CHAR TO A HIGHER PLACE |
| 2745 | DCA I NPTR /STORE IT |
| 2746 | ISZ NCNT /BUMP COUNTER |
| 2747 | JMP MORNAM /MORE TO COME |
| 2748 | SKP |
| 2749 | NDONE, DCA I NPTR /ZERO NEXT WORD |
| 2750 | ISZ GETNAM /FIX RETURN ADDR |
| 2751 | JMP I GETNAM |
| 2752 | MORNAM, JMS LETTER /GET NEXT CHAR |
| 2753 | SKP |
| 2754 | JMP .+3 /ITS A LETTER |
| 2755 | JMS I [DIGIT |
| 2756 | JMP NDONE+1 /NO GOOD, NAMES OVER |
| 2757 | TAD I NPTR |
| 2758 | DCA I NPTR /COMBINE TWO CHARS |
| 2759 | ISZ NPTR |
| 2760 | JMP PAKLUP |
| 2761 | NPTR, 0 |
| 2762 | NCNT=OADD |
| 2763 | \f/ DATA STATEMENT |
| 2764 | DATA, JMS I [IFCHEK /IF(..)DATA ???? |
| 2765 | TAD (DATAST /START DATA STATEMENT |
| 2766 | JMS I [OUTWRD |
| 2767 | DATLUP, CLA CMA /SET DIMNUM = -1 IF NO SUBSCRIPTS |
| 2768 | JMS I [GETSS /GET LIST ELEMENT |
| 2769 | JMP DATAER |
| 2770 | TAD (DPUSH /OUTPUT DPUSH OPERATOR |
| 2771 | JMS I [OUTWRD |
| 2772 | CMA |
| 2773 | TAD TEMP2 /FOLLOWED BY POINTER |
| 2774 | JMS I [OUTWRD |
| 2775 | TAD DIMNUM /FOLLOWED BY NUMBER |
| 2776 | JMS I [OUTWRD |
| 2777 | CDF 10 |
| 2778 | TAD I TEMP2 /LOOK AT TYE TYPE |
| 2779 | AND (20 /IS IT AN ARG ? |
| 2780 | CDF |
| 2781 | SZA CLA |
| 2782 | JMP DATAER /YES, THATS BAD |
| 2783 | JMS I [GETC /, ? |
| 2784 | JMP DATAER |
| 2785 | TAD (-254 |
| 2786 | SNA |
| 2787 | JMP DATLUP /LOOK FOR MORE |
| 2788 | TAD (254-257 // ? |
| 2789 | SZA CLA |
| 2790 | JMP DATAER |
| 2791 | JMP DLOOP2 /GO LOOK FOR ELEMENT |
| 2792 | DATA3, TAD (WORD1-1 |
| 2793 | DCA X10 /POINTER TO THE GOODS |
| 2794 | TAD I X10 /THEN STUFF |
| 2795 | JMS I [OUTWRD |
| 2796 | ISZ TEMP |
| 2797 | JMP .-3 |
| 2798 | NXTDE, TAD (ENDELM /OUTPUT END OF ELEMENT |
| 2799 | JMS I [OUTWRD |
| 2800 | JMS I [GETC /LOOK FOR COMMA |
| 2801 | JMP DATAER |
| 2802 | TAD (-254 |
| 2803 | SNA |
| 2804 | JMP DLOOP2 /YES, GET MORE DATA |
| 2805 | TAD (254-257 /SLASH ? |
| 2806 | SZA CLA |
| 2807 | JMP DATAER /NO, ERROR |
| 2808 | JMS I [GETC /ANOTHER DATA GROUP ? |
| 2809 | JMP I [NEXTST /NO |
| 2810 | TAD (-254 /COMMA ? |
| 2811 | SNA CLA |
| 2812 | JMP DATA+1 /START A NEW DATA STMT |
| 2813 | DATAER, JMS I [ERMSG |
| 2814 | 0401 /OK WHEN THIS IS AN AND |
| 2815 | JMP I [NEXTST |
| 2816 | DHOLER, JMS I [ERMSG |
| 2817 | 0410 /HOLLERITH DATA ERROR |
| 2818 | JMP I [NEXTST |
| 2819 | DQUOTE, 0 /GET CHAR FOR QUOTED DATA |
| 2820 | JMS I [GETCWB |
| 2821 | JMP DHOLER |
| 2822 | TAD [-247 |
| 2823 | SZA |
| 2824 | JMP DNOTQ2 |
| 2825 | JMS I [GETCWB |
| 2826 | JMP I DQUOTE |
| 2827 | TAD [-247 |
| 2828 | SNA CLA |
| 2829 | JMP DNOTQ2 /REPLACE '' BY ' |
| 2830 | JMS I [BACK1 |
| 2831 | JMP I DQUOTE |
| 2832 | DNOTQ2, TAD [247 /FIX CHAR |
| 2833 | ISZ DQUOTE |
| 2834 | JMP I DQUOTE |
| 2835 | OUT3WD, 0 /2.02/ OUTPUT 3 WORDS |
| 2836 | TAD [DATELM /2.02/ OUTPUT ELEMENT HEAD |
| 2837 | JMS I [OUTWRD /2.02/ |
| 2838 | TAD (3 /2.02/ AND SIZE |
| 2839 | JMS I [OUTWRD /2.02/ |
| 2840 | TAD WORD1 /2.02/ NOW THREE WORDS |
| 2841 | JMS I [OUTWRD /2.02/ |
| 2842 | TAD WORD2 /2.02/ |
| 2843 | JMS I [OUTWRD /2.02/ |
| 2844 | TAD WORD3 /2.02/ |
| 2845 | JMS I [OUTWRD /2.02/ |
| 2846 | JMP I OUT3WD /2.02/ |
| 2847 | \f/ DATA STATEMENT |
| 2848 | PAGE |
| 2849 | DLOOP2, JMS I [GETC |
| 2850 | JMP DATAER |
| 2851 | TAD (-250 /IS CHAR ( ? |
| 2852 | SZA |
| 2853 | JMP NOCMPD /NO, NOT COMPLEX DATA |
| 2854 | JMS I [NUMBER /GET REAL PART |
| 2855 | JMP DATAER |
| 2856 | SKP |
| 2857 | JMP DATAER /DP IS NG WITH COMPLEX |
| 2858 | JMS OUT3WD /2.02/ OUTPUT 3 WORDS |
| 2859 | JMS I [CHECKC /LOOK FOR COMMA |
| 2860 | -254 |
| 2861 | JMP DATAER /BAD IF NOT THERE |
| 2862 | JMS I [NUMBER /GET IMAGINARY PART |
| 2863 | JMP DATAER |
| 2864 | SKP |
| 2865 | JMP DATAER |
| 2866 | JMS I [CHECKC /LOOK FOR ) |
| 2867 | -251 |
| 2868 | JMP DATAER /NOT THERE |
| 2869 | JMP DATAFP /GO MOVE IMAGINARY PART |
| 2870 | NOCMPD, IAC /IS IT QUOTED STRING ? |
| 2871 | SZA |
| 2872 | JMP NQUOTD /NO |
| 2873 | TAD (DQUOTE /GET SUBR ADDRESS |
| 2874 | JMP HOLDAT /GO HANDLE IT |
| 2875 | NQUOTD, TAD (247-317 /IS IT AN O (OCTAL) |
| 2876 | SNA |
| 2877 | JMP I (XOCTAL /YES |
| 2878 | TAD (317-256 /IS IT . |
| 2879 | SNA CLA |
| 2880 | JMS I (TRUFAL /CHECK FOR TRUE OR FALSE |
| 2881 | JMP NOTF /NO TRUE-FALSE, TRY NUMBER |
| 2882 | CLL CML RTR /2000 |
| 2883 | DCA WORD2 |
| 2884 | TAD WORD2 |
| 2885 | SZA CLA |
| 2886 | IAC |
| 2887 | DCA WORD1 /TRUE=1.0 FALSE=0.0 |
| 2888 | DCA WORD3 |
| 2889 | JMP DATAFP /GO PUT IT |
| 2890 | NOTF, JMS I [BACK1 /PUT BACK CHAR |
| 2891 | JMS I [NUMBER /TRY FOR A NUMBER |
| 2892 | JMP DATAER /ELEMENT MISSING |
| 2893 | JMP TRYHOS /IF INTEGER, TRY FOR H OR * |
| 2894 | TAD (-3 |
| 2895 | DATAFP, TAD (-3 /FP DATA |
| 2896 | DCA TEMP /SIZE OF ITEM |
| 2897 | TAD [DATELM /DATA ELEMENT SIGNAL |
| 2898 | JMS I [OUTWRD |
| 2899 | TAD TEMP /THEN SIZE |
| 2900 | CIA /ALWAYS POSITIVE |
| 2901 | JMS I [OUTWRD |
| 2902 | JMP DATA3 /GO OUTPUT THE DATA |
| 2903 | TRYHOS, JMS I [GETC /LOOK FOR H |
| 2904 | JMP DATAER |
| 2905 | TAD (-310 |
| 2906 | SZA |
| 2907 | JMP TRYSTR /NOT H, MAYBE ITS * |
| 2908 | JMS I [FIXNUM /INTEGERIZE IT |
| 2909 | SNA |
| 2910 | JMP DHOLER /HOLLERITH DATA ERROR |
| 2911 | CMA |
| 2912 | DCA TEMP /SAVE COUNT |
| 2913 | TAD (DHLRTH /GET SUBR POINTER |
| 2914 | HOLDAT, DCA HCHAR |
| 2915 | CLL CMA RTL /2.02/ COUNT |
| 2916 | DCA TEMP2 /2.02/ BY THREES |
| 2917 | TAD (WORD1-1 /2.02/ |
| 2918 | DCA X10 /2.02/ POINTER |
| 2919 | HDLOOP, JMS I HCHAR /GET A CHAR |
| 2920 | JMP EOHD /2.02/ |
| 2921 | AND [77 /6 BITIZE IT |
| 2922 | CLL RTL |
| 2923 | RTL |
| 2924 | RTL /UPPER-PART-OF-WORDIZE |
| 2925 | DCA WORD3 /2.02/ STORAGIZE IT |
| 2926 | JMS I HCHAR /GET ANOTHER |
| 2927 | JMP LASTHD /LAST HALF WORD MUST GO OUT |
| 2928 | AND [77 |
| 2929 | TAD WORD3 /2.02/ COMBINIZE THE TWO HALVES |
| 2930 | DCA I X10 /2.02/ STORE IT |
| 2931 | ISZ TEMP2 /2.02/ THREE AT A TIME |
| 2932 | JMP HDLOOP /2.02/ |
| 2933 | JMS OUT3WD /2.02/ OUTPUT THREE |
| 2934 | JMP HOLDAT+1 /2.02/ GO DO NEXT THREE WDS |
| 2935 | EOHD, CLL CML RTL /2.02/ ANY CHARS IN THIS SET ? |
| 2936 | TAD TEMP2 /2.02/ |
| 2937 | SPA CLA /2.02/ |
| 2938 | JMP NXTDE /2.02/ NO, DO NEXT ELEMENT |
| 2939 | JMP .+4 /2.02/ YES, FILL IT OUT |
| 2940 | LASTHD, TAD WORD3 /2.02/ FILL OUT LOWER CHAR |
| 2941 | TAD (40 /2.02/ WITH A BLANK |
| 2942 | DCA I X10 /2.02/ |
| 2943 | TAD (4040 /2.02/ THEN FILL REST |
| 2944 | DCA I X10 /2.02/ WITH BLANKS |
| 2945 | TAD (4040 /2.02/ |
| 2946 | DCA I X10 /2.02/ |
| 2947 | JMP DATAFP /2.02/ GO OUTPUT IT |
| 2948 | TRYSTR, TAD (310-252 /* |
| 2949 | SNA CLA |
| 2950 | JMP .+3 |
| 2951 | JMS I [BACK1 /PUT BACK THAT CHAR |
| 2952 | JMP DATAFP /ITS JUST AN INTEGER |
| 2953 | TAD (DREPTC /REPETITION COUNT |
| 2954 | JMS I [OUTWRD |
| 2955 | JMS I [FIXNUM |
| 2956 | JMS I [OUTWRD /OUTPUT COUNT |
| 2957 | JMP DLOOP2 /LOOP |
| 2958 | \f/ INITIALIZE READ IN |
| 2959 | *6400 |
| 2960 | INITLN, TAD IX7772 /READ FIRST SIX CHARS |
| 2961 | DCA TEMP |
| 2962 | TAD IXLINM |
| 2963 | DCA CHRPTR |
| 2964 | INITLP, CIF 10 |
| 2965 | JMS I [ICHAR /READ A CHAR |
| 2966 | JMP INITLN |
| 2967 | TAD IXM211 /TAB ? |
| 2968 | SZA CLA |
| 2969 | JMP NIXTAB /NO THIS ONE |
| 2970 | TAD IX0240 |
| 2971 | DCA I CHRPTR |
| 2972 | ISZ TEMP |
| 2973 | JMP .-3 |
| 2974 | JMP CHKCOM /DO COMMENT CHECK |
| 2975 | NIXTAB, TAD CHAR |
| 2976 | DCA I CHRPTR /STORE THE CHAR |
| 2977 | ISZ TEMP |
| 2978 | JMP INITLP |
| 2979 | CHKCOM, TAD I IXLINE /COMMENT ? |
| 2980 | TAD IXM303 |
| 2981 | SNA CLA |
| 2982 | JMP IGNORE /IGNORE IT |
| 2983 | TAD I IXLNP5 /CONTINUATION ? |
| 2984 | TAD IXM240 |
| 2985 | SZA CLA |
| 2986 | JMP IGNORE |
| 2987 | TAD IX7700 /FIX CALL |
| 2988 | CDF 10 /SEE WHAT HAPPENS WHEN YOU MOVE A ROUTINE** |
| 2989 | DCA I IXINCL |
| 2990 | CDF /** |
| 2991 | CIF 10 |
| 2992 | JMS I IX200 /REMOVE MONITOR |
| 2993 | 11 |
| 2994 | CDF 10 /FIX FIELD ONE STUFF |
| 2995 | TAD I MOV1 |
| 2996 | DCA I MOV2 |
| 2997 | ISZ MOV1 |
| 2998 | ISZ MOV2 |
| 2999 | ISZ MOVCNT |
| 3000 | JMP .-5 |
| 3001 | CDF |
| 3002 | JMP I IXRDFS /LOOK FOR PROG HEADER |
| 3003 | MOV1, 2020 |
| 3004 | MOV2, 20 |
| 3005 | MOVCNT, -160 |
| 3006 | IGNORE, CIF 10 /** |
| 3007 | JMS I [ICHAR /SKIP TILL CARRIAGE RETURN |
| 3008 | JMP INITLN |
| 3009 | CLA |
| 3010 | JMP IGNORE |
| 3011 | IXRDFS, RDFRST |
| 3012 | IXINCL, INCALL |
| 3013 | IXM240, -240 |
| 3014 | IXM303, -303 |
| 3015 | IX0240, 0240 |
| 3016 | IX200, 200 |
| 3017 | IX7600, 7600 |
| 3018 | IX7772, 7772 |
| 3019 | IXM211, -211 |
| 3020 | IX7700, 7700 /V3C |
| 3021 | \f/ SEARCH FOR PROGRAM HEADER |
| 3022 | PAGE |
| 3023 | RDFRST, CIF 10 /** |
| 3024 | JMS I [ICHAR /THIS IS A DUPLICATE OF THE CODE |
| 3025 | JMP ENDLNF /AT LABEL 'RDLOOP' , ONLY THE |
| 3026 | TAD (-211 |
| 3027 | SNA |
| 3028 | TAD (240-211 |
| 3029 | TAD (211 |
| 3030 | DCA I CHRPTR /NAMES HAVE BEEN CHANGED TO |
| 3031 | ISZ CNT72 |
| 3032 | SKP |
| 3033 | JMP SKPFL2 |
| 3034 | TAD CHRPTR /PROTECT THE ASSEMBLY |
| 3035 | CIA CLL /(IT GETS THE FIRST LINE |
| 3036 | TAD (LINE+270 /WHICH MAY BE SUBROUTINE OR |
| 3037 | /FUNCTION. 1ST LINE SHORTER THAN REST BEC OF BUFFER OVERWRITES** |
| 3038 | SZL CLA /OR SOMETHING ELSE, IN WHICH CASE |
| 3039 | JMP RDFRST /ITS THE MAIN PROGRAM) |
| 3040 | JMS I [ERMSG /LINE TOO LONG |
| 3041 | 1424 |
| 3042 | JMP SKPFL /SKIP REST |
| 3043 | SKPFL2, CIF 10 /** |
| 3044 | JMS I [ICHAR |
| 3045 | JMP ENDLNF |
| 3046 | CLA |
| 3047 | JMP SKPFL2 |
| 3048 | SKPCMF, TAD X16 /BY ORDER OF THE EMPEROR |
| 3049 | DCA CHRPTR /MARIO DE NOBILI |
| 3050 | ENDLNF, TAD CHRPTR |
| 3051 | DCA X16 |
| 3052 | TAD CHRPTR |
| 3053 | DCA X10 |
| 3054 | TAD (-102 |
| 3055 | DCA CNT72 |
| 3056 | TAD (-6 |
| 3057 | DCA NCHARS |
| 3058 | GET6F, CIF 10 /** |
| 3059 | JMS I [ICHAR |
| 3060 | JMP SKPCMF |
| 3061 | TAD (-211 |
| 3062 | SZA CLA |
| 3063 | JMP NOTABF |
| 3064 | TAD (240 |
| 3065 | DCA I CHRPTR |
| 3066 | ISZ NCHARS |
| 3067 | JMP .-3 |
| 3068 | TAD (240 |
| 3069 | DCA CHAR |
| 3070 | JMP CCHEKF |
| 3071 | NOTABF, TAD CHAR |
| 3072 | DCA I CHRPTR |
| 3073 | ISZ NCHARS |
| 3074 | JMP GET6F |
| 3075 | CCHEKF, TAD I X10 |
| 3076 | TAD (-303 |
| 3077 | SZA CLA |
| 3078 | JMP NOCMTF |
| 3079 | SKPFL, CIF 10 /** |
| 3080 | JMS I [ICHAR |
| 3081 | JMP SKPCMF |
| 3082 | CLA |
| 3083 | JMP SKPFL |
| 3084 | NOCMTF, TAD CHAR |
| 3085 | TAD (-240 |
| 3086 | SNA CLA |
| 3087 | JMP GOTFST |
| 3088 | CCARDF, TAD X16 |
| 3089 | DCA CHRPTR |
| 3090 | JMP RDFRST |
| 3091 | GOTFST, TAD CHRPTR |
| 3092 | CIA |
| 3093 | TAD (LINE+4 |
| 3094 | DCA NCHARS |
| 3095 | TAD [LINE-1 |
| 3096 | DCA CHRPTR |
| 3097 | JMS I [SAVECP |
| 3098 | TAD (HDRLST-1 |
| 3099 | DCA X10 /PREPARE TO SEARCH THE LIST |
| 3100 | CLOOP1, CDF 10 /(FNC NAMES UP IN FLD 1)** |
| 3101 | TAD I X10 /OF LEGAL HEADER LINES |
| 3102 | CDF |
| 3103 | SZA /CODE IS AS UNDER 'CMDLUP' |
| 3104 | JMP CLOOP2 |
| 3105 | CLA CMA RAL |
| 3106 | TAD STACK |
| 3107 | DCA STACK |
| 3108 | CDF 10 /** |
| 3109 | TAD I X10 |
| 3110 | CDF |
| 3111 | DCA TEMP |
| 3112 | JMP I TEMP |
| 3113 | CLOOP2, DCA TEMP |
| 3114 | JMS I [GET2C |
| 3115 | JMP BADCMF |
| 3116 | CIA |
| 3117 | TAD TEMP |
| 3118 | SNA CLA |
| 3119 | JMP CLOOP1 |
| 3120 | SEARCH, CDF 10 /** |
| 3121 | TAD I X10 |
| 3122 | CDF |
| 3123 | SZA CLA |
| 3124 | JMP SEARCH |
| 3125 | ISZ X10 |
| 3126 | JMS I [RESTCP |
| 3127 | ISZ STACK |
| 3128 | ISZ STACK |
| 3129 | CDF 10 /** |
| 3130 | TAD I X10 |
| 3131 | CDF |
| 3132 | SZA |
| 3133 | JMP CLOOP2 |
| 3134 | BADCMF, JMS I [RESTCP /NOT A FUNCTION OR SUBROUTINE |
| 3135 | JMP I (LINE1 /SO GO TO MAIN PART OF COMPILER |
| 3136 | BADDIE, JMS I [MESSAG /SOMETHING MISSING FROM SYS |
| 3137 | 323 /S |
| 3138 | 331 /Y |
| 3139 | \f/ ANALYZE PROGRAM HEADER |
| 3140 | PAGE |
| 3141 | SUBRTN, CLA CMA /SET TO -1 FOR SUBR |
| 3142 | JMP XXXFUN+1 |
| 3143 | REAFUN, TAD (102 /SET TYPE TO REAL |
| 3144 | DCA TYPE |
| 3145 | JMP XXXFUN |
| 3146 | LOGFUN, IAC /SET TYPE OF FUN |
| 3147 | DBLFUN, IAC /WITH DOUBLEMINT GUM ! |
| 3148 | CMPFUN, IAC |
| 3149 | IAC |
| 3150 | INTFUN, TAD (101 |
| 3151 | DCA TYPE |
| 3152 | JMS I [CHECKC /LOOK FOR 'N' |
| 3153 | -316 |
| 3154 | JMP BADBGN |
| 3155 | XXXFUN, CLA IAC |
| 3156 | DCA FUNCTN /SET SWITCH |
| 3157 | CDF 10 /1.05/ KILL ENTRY FOR 'MAIN' |
| 3158 | DCA I (ALIST+14 /1.05/ BUT DO IT BEFORE THE M BUCKET |
| 3159 | CDF /1.05/ CONTAINS ANYTHING USEFULL |
| 3160 | JMS I [GETNAM /GET FUNC/SUBR NAME |
| 3161 | JMP BADBGN |
| 3162 | JMS I [LOOKUP /PUT INTO SYMBOL TABLE |
| 3163 | DCA PROGNM |
| 3164 | TAD PROGNM /SET UP TYPE |
| 3165 | IAC |
| 3166 | DCA TEMP |
| 3167 | TAD STACK |
| 3168 | DCA X12 /SAVE POINTER |
| 3169 | DCA TEMP2 /ZERO ARG COUNTER |
| 3170 | CDF 10 |
| 3171 | TAD TYPE /PUT IN THE TYPE BITS |
| 3172 | TAD (1000 |
| 3173 | DCA I TEMP |
| 3174 | CDF |
| 3175 | JMS I [CHECKC /LOOK OFR ( |
| 3176 | -250 |
| 3177 | JMP ISITFN /IS IT A FUNCTION ? |
| 3178 | ARGLUP, JMS I [GETNAM /GET THE ARG |
| 3179 | JMP BADBGN |
| 3180 | JMS I [LOOKUP |
| 3181 | IAC |
| 3182 | DCA TEMP /ADDR OF TYPE WORD |
| 3183 | CDF 10 |
| 3184 | TAD I TEMP |
| 3185 | SZA CLA |
| 3186 | JMP BADBGN /ALREADY AN ARG |
| 3187 | TAD (20 |
| 3188 | DCA I TEMP |
| 3189 | CDF |
| 3190 | CMA |
| 3191 | TAD TEMP /OUTPUT ADDR OF ARG |
| 3192 | JMS I [PUSH |
| 3193 | ISZ TEMP2 /KEEP COUNT |
| 3194 | JMS I [COMARP /LOOK FOR , OR ) |
| 3195 | JMP BADBGN /NEITHER |
| 3196 | JMP ARGLUP /, |
| 3197 | TAD TEMP2 /) HOW MANY ARGS ? |
| 3198 | CDF 10 |
| 3199 | DCA I NEXT /INTO ARG LIST |
| 3200 | TAD TEMP2 |
| 3201 | CIA |
| 3202 | DCA TEMP2 |
| 3203 | TAD NEXT /SAVE ADDR OF ARG LIST |
| 3204 | DCA ARGLST |
| 3205 | CDF |
| 3206 | TAD X12 /RESTORE THE STACK |
| 3207 | DCA STACK |
| 3208 | MOVARG, TAD I X12 /PUT ARGS INTO ARG LIST |
| 3209 | CDF 10 |
| 3210 | DCA I NEXT |
| 3211 | CDF |
| 3212 | ISZ TEMP2 |
| 3213 | JMP MOVARG |
| 3214 | JMP I [NEXTST /DO NEXT LINE |
| 3215 | TYPE=WORD6 |
| 3216 | ISITFN, TAD FUNCTN /IS IT A FUNCTION |
| 3217 | SPA SNA CLA /WITH NO ARGS ? |
| 3218 | JMP I [NEXTST /NO, WE'RE OK |
| 3219 | BADBGN, JMS I [ERMSG |
| 3220 | 2010 |
| 3221 | JMP I [NEXTST |
| 3222 | BDATA, JMS I [CHECKC /LOOK FOR A |
| 3223 | -301 |
| 3224 | JMP BADBGN |
| 3225 | CLL CMA RAL /SET FUNCTION SWITCH |
| 3226 | DCA FUNCTN /2.02/ STORE IT DUMMY!! |
| 3227 | TAD (BDLIST-1 /POINTER TO LIST OF PATCHES |
| 3228 | DCA X10 |
| 3229 | BDLOOP, CDF 10 |
| 3230 | TAD I X10 /GET PATCH LOCATION |
| 3231 | CDF |
| 3232 | SNA |
| 3233 | JMP I [NEXTST /NO MORE PATCHES |
| 3234 | DCA TEMP /SAVE PATCH ADDRESS |
| 3235 | TAD BADJMP /GET ERROR JUMP |
| 3236 | DCA I TEMP /STORE IT |
| 3237 | JMP BDLOOP /LOOP |
| 3238 | BADJMP, JMP I [BDERR |
| 3239 | \f/ INITIAL SYMBOL TABLE |
| 3240 | FIELD 1 |
| 3241 | *2020 |
| 3242 | NOPUNC |
| 3243 | *20 |
| 3244 | ENPUNC |
| 3245 | 0 |
| 3246 | BLNKCN, 111;0 /BLANK COMMON SLOT |
| 3247 | ALIST, 0;0;0;0;0;0;0;0;0;0;0;0;MAIN;0;0;0;0;0;0;0;0;0;0;0;0;0 |
| 3248 | HOLIST, 0 |
| 3249 | FPLIST, 0 |
| 3250 | DPLIST, 0 |
| 3251 | INTLST, ONE |
| 3252 | CMPLST, 0 |
| 3253 | SNLIST, 0 |
| 3254 | ONE, THREE;0;1;2000;0 |
| 3255 | THREE, SIX;0;2;3000;0 |
| 3256 | SIX, 0;0;3;3000;0 |
| 3257 | TRUE, 0;0145;0 |
| 3258 | MAIN, 0;1000;0;0111;1600 |
| 3259 | FREE, 0 |
| 3260 | \f/ BLOCK DATA PATCH LIST |
| 3261 | BDLIST, IF /BLOCK DATA PATCH LIST |
| 3262 | DOUBLE |
| 3263 | DO |
| 3264 | GOTO |
| 3265 | CALL |
| 3266 | READ |
| 3267 | REWIND |
| 3268 | ENDFIL |
| 3269 | FORMAT |
| 3270 | WRITE |
| 3271 | BACKSP |
| 3272 | ASSIGN |
| 3273 | STOP |
| 3274 | PAUZE |
| 3275 | DFINFL |
| 3276 | FIND |
| 3277 | ITSAR |
| 3278 | 0 |
| 3279 | \f/ INITIALIZATION |
| 3280 | *2200 |
| 3281 | START, SKP /NON-CHAINED ENTRY POINT |
| 3282 | JMP .+5 /CCL ENTRY |
| 3283 | CIF CDF 10 /START HERE |
| 3284 | JMS I (200 /COMMAND DECODE |
| 3285 | 5 |
| 3286 | 0624 /DEFAULT EXT IS .FT |
| 3287 | TAD I L7600 /IS AN OUTPUT FILE GIVEN ? |
| 3288 | SNA CLA |
| 3289 | JMP MYFILE /NO, USE FORTRN.TM |
| 3290 | MOVOFN, TAD I OFNAME /MOVE NAME INTO PAGE 0 |
| 3291 | CDF |
| 3292 | DCA I NAMEOF |
| 3293 | CDF 10 |
| 3294 | ISZ NAMEOF |
| 3295 | ISZ OFNAME |
| 3296 | ISZ OFNSIZ |
| 3297 | JMP MOVOFN |
| 3298 | EXTEST, TAD I (7604 /SET DEFAULT EXTENSIONS |
| 3299 | SZA |
| 3300 | JMP EXTSET |
| 3301 | TAD I (7643 |
| 3302 | SPA |
| 3303 | JMP GETRA /A WAS SET.USE RA |
| 3304 | AND L41 /CHECK FOR L+G |
| 3305 | SNA CLA |
| 3306 | TAD (0610 /USE RL |
| 3307 | TAD (1404 /USE LD |
| 3308 | EXTSET, DCA I (7604 |
| 3309 | TAD I (7604 |
| 3310 | CDF 0 |
| 3311 | DCA I NAMF |
| 3312 | CDF 10 |
| 3313 | TAD I (7611 |
| 3314 | SNA |
| 3315 | TAD (1423 /.LS FOR LISTING |
| 3316 | DCA I (7611 |
| 3317 | TAD I (7616 |
| 3318 | SNA |
| 3319 | TAD (1520 /.MP FOR LOAD MAP |
| 3320 | DCA I (7616 |
| 3321 | EFILE, CLA IAC /OPEN PASS1 OUTPUT FILE |
| 3322 | JMS I (200 |
| 3323 | 3 |
| 3324 | OBLOK, TMPFL2 |
| 3325 | OSIZE, 0 |
| 3326 | JMP OBAD /BADDIE |
| 3327 | CDF |
| 3328 | TAD OBLOK /SAVE STARTING BLOCK |
| 3329 | DCA OUBLOK |
| 3330 | TAD OBLOK |
| 3331 | DCA I (OUFILE |
| 3332 | TAD OSIZE |
| 3333 | DCA OULEN |
| 3334 | CDF 10 |
| 3335 | CLA IAC |
| 3336 | JMS I (200 /GET PASS2 |
| 3337 | 2 |
| 3338 | SPASS2, PASS2N |
| 3339 | 0 |
| 3340 | JMP OBAD |
| 3341 | CLA IAC |
| 3342 | JMS I (200 |
| 3343 | 2 |
| 3344 | SP2O, PAS2ON /GET PASS2 OVERLAY |
| 3345 | 0 |
| 3346 | JMP OBAD |
| 3347 | CDF /SAVE PASS2 AND PASS2O BLOCKS |
| 3348 | TAD SPASS2 |
| 3349 | DCA PASS2B |
| 3350 | TAD SP2O /SKIP FIRST BLOCK |
| 3351 | IAC /ITS THE CORE TABLE |
| 3352 | DCA I (PASS2O |
| 3353 | CIF |
| 3354 | JMP INITLN /GO START COMPILE |
| 3355 | MYFILE, CDF /PUT DEFAULT INTO 17600 |
| 3356 | TAD I NAMOF |
| 3357 | DCA I NAMEOF |
| 3358 | TAD I NAMOF /ALSO INTO PAGE 0 |
| 3359 | CDF 10 |
| 3360 | DCA I OFNAME |
| 3361 | ISZ NAMOF |
| 3362 | ISZ NAMEOF |
| 3363 | ISZ OFNAME |
| 3364 | ISZ OFNSIZ |
| 3365 | JMP MYFILE |
| 3366 | CLA IAC /SET DEV TO SYS |
| 3367 | DCA I L7600 |
| 3368 | JMP EXTEST /GO OPEN FILE |
| 3369 | OBAD, CIF CDF |
| 3370 | JMP BADDIE |
| 3371 | OFNAME, 7601 /IGNORE DEVICE (ALWAYS USE SYS) |
| 3372 | NAMEOF, TMPFIL+4 |
| 3373 | NAMOF, TMPFIL |
| 3374 | OFNSIZ, -3 |
| 3375 | TMPFL2, 0617;2224;2216;2415 /FORTRN.TM |
| 3376 | PASS2N, 2001;2323;6200;2326 /PASS2.SV |
| 3377 | PAS2ON, 2001;2323;6217;2326 /PASS2O.SV |
| 3378 | NAMF, TMPFIL+7 |
| 3379 | L7600, |
| 3380 | GETRA, 7600 /CLA |
| 3381 | TAD (2201 /V3C USE RA |
| 3382 | JMP EXTSET |
| 3383 | L41, 41 |
| 3384 | \f PAGE |
| 3385 | / PROGRAM HEADER LIST |
| 3386 | HDRLST, TEXT 'INTEGERFUNCTIO' |
| 3387 | INTFUN |
| 3388 | TEXT 'REALFUNCTION' |
| 3389 | REAFUN |
| 3390 | TEXT 'COMPLEXFUNCTIO' |
| 3391 | CMPFUN |
| 3392 | TEXT 'DOUBLEPRECISIONFUNCTIO' |
| 3393 | DBLFUN |
| 3394 | TEXT 'LOGICALFUNCTIO' |
| 3395 | LOGFUN |
| 3396 | TEXT 'FUNCTION' |
| 3397 | XXXFUN |
| 3398 | TEXT 'SUBROUTINE' |
| 3399 | SUBRTN |
| 3400 | TEXT 'BLOCKDAT' |
| 3401 | BDATA |
| 3402 | 0 |
| 3403 | \f/ PS-8 FILE INPUT ROUTINES |
| 3404 | /NEED TWO PAGES BEC. MOVING ICHAR OUT OF FIELD 1 REQUIRES |
| 3405 | /ALOT OF FIELD DIDDLING. |
| 3406 | *5400 |
| 3407 | MORCHR, TAD (214 /FIX CHAR |
| 3408 | CDF 0 /** |
| 3409 | DCA I QCHAR |
| 3410 | CDF 10 |
| 3411 | TAD I (ICHAR |
| 3412 | IAC /UPDATE ADDR |
| 3413 | DCA TCHAR |
| 3414 | CIF CDF 0 |
| 3415 | TAD I QCHAR /RETURN VALUE IN AC |
| 3416 | JMP I TCHAR |
| 3417 | TCHAR, 0 |
| 3418 | QCHAR, CHAR |
| 3419 | / EXTENDED OPERATOR LIST |
| 3420 | OPRLST, -01;-1604;ANDOPR |
| 3421 | -17;-2200;OROPR |
| 3422 | -05;-2100;EQOPR |
| 3423 | -16;-0500;NEOPR |
| 3424 | -07;-0500;GEOPR |
| 3425 | -07;-2400;GTOPR |
| 3426 | -14;-0500;LEOPR |
| 3427 | -14;-2400;LTOPR |
| 3428 | -30;-1722;XOROPR |
| 3429 | -05;-2126;EQVOPR |
| 3430 | 0 |
| 3431 | / EXPONENT TABLE |
| 3432 | PETABL, 0004;2400;0000 /1E1 |
| 3433 | 0000;0000;0000 |
| 3434 | 0007;3100;0000 /1E2 |
| 3435 | 0000;0000;0000 |
| 3436 | 0016;2342;0000 /1E4 |
| 3437 | 0000;0000;0000 |
| 3438 | 0033;2765;7020 /1E8 |
| 3439 | 0000;0000;0000 |
| 3440 | 0066;2160;6744 /1E16 |
| 3441 | 6770;1000;0 |
| 3442 | 0153;2356;1326 /1E32 |
| 3443 | 6501;2670;2655 |
| 3444 | 0325;3023;6017 /1E64 |
| 3445 | 5117;7747;6466 |
| 3446 | 0652;2235;6443 /1E128 |
| 3447 | 7114;0164;6145 |
| 3448 | 1523;2523;7565 /1E256 |
| 3449 | 7734;7374;7357 |
| 3450 | 3245;3430;6320 /1E512 |
| 3451 | 2565;1407;2176 |
| 3452 | ENDSTM, 211;"E;"N;"D;215;211;215;232 /V3C |
| 3453 | /FAKE END STATEMENT USED IF PROGRAM HAS NONE |
| 3454 | \f PAGE |
| 3455 | \f/MAIN PART OF OS/8 INPUT ROUTINES |
| 3456 | |
| 3457 | ICHAR, 0 /READ CHAR FROM INPUT FILE |
| 3458 | CDF 10 |
| 3459 | ISZ INJMP /BUMP THREE WAY UNPACK SWITCH |
| 3460 | ISZ INCHCT |
| 3461 | INJMPP, JMP INJMP |
| 3462 | / CDF ** |
| 3463 | TAD INEOF /DID LAST READ YEILD END OF FILE ? |
| 3464 | SNA CLA |
| 3465 | JMP INGBUF /NO, DO ANOTHER READ |
| 3466 | GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE |
| 3467 | JMP ENDIN /END OF INPUT |
| 3468 | INGBUF, TAD INCTR /BUMP RECORD COUNTER |
| 3469 | CLL IAC |
| 3470 | SNL |
| 3471 | DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED |
| 3472 | SZL |
| 3473 | ISZ INEOF /SET END OF FILE SWITCH |
| 3474 | CDF 10 /** |
| 3475 | CIF 0 /** |
| 3476 | JMS I INHNDL /DO THE READ |
| 3477 | 0210 /ONE BLOCK TO FIELD 1 |
| 3478 | INBUFP, INBUF |
| 3479 | INREC, 0 |
| 3480 | JMP INERR /HANDLER ERROR |
| 3481 | INBREC, ISZ INREC /BUMP RECORD NUMBER |
| 3482 | TAD INBUFP /RESET BUFFER POINTER |
| 3483 | SVIBPT, DCA INPTR /V3C |
| 3484 | TAD (-601 /SET CHAR COUNT |
| 3485 | DCA INCHCT |
| 3486 | TAD INJMPP /RESET THREE WAY JUMP SWITCH |
| 3487 | DCA INJMP |
| 3488 | JMP ICHAR+1 /GO AGAIN |
| 3489 | INERR, ISZ INEOF /EITHER EOF OR BADDIE |
| 3490 | SMA CLA |
| 3491 | JMP INBREC /END OF FILE, DO NEXT FILE |
| 3492 | JMP TERR /INPUT ERROR, GIVE I F AND EXIT |
| 3493 | ENDIN, TAD (ENDSTM /V3C IF NO END STATEMENT, FORCE ONE |
| 3494 | JMP SVIBPT |
| 3495 | |
| 3496 | /ENDIN, TAD INCALL /END OF INPUT IS USR IN CORE ? |
| 3497 | / TAD (-200 |
| 3498 | / CIF 0 /** |
| 3499 | / SZA CLA |
| 3500 | / JMP I (ENDX /NO, ITS END OF PROG |
| 3501 | TERR, JMS I (MESSAG /YES, BAD INPUT. WAS SQ.BRCK** |
| 3502 | 311 |
| 3503 | 306 |
| 3504 | INJMP, HLT /3 WAY CHAR UNPACK BRANCH |
| 3505 | JMP ICHAR1 |
| 3506 | JMP ICHAR2 |
| 3507 | ICHAR3, TAD INJMPP /RESET JUMP SWITCH |
| 3508 | DCA INJMP |
| 3509 | TAD I INPTR |
| 3510 | AND (7400 /COMBINE THE HIGH ORDER BITS |
| 3511 | CLL RTR /OF THE TWO WORDS |
| 3512 | RTR |
| 3513 | TAD INTMP /TO FORM THE THIRD CHAR |
| 3514 | RTR |
| 3515 | RTR |
| 3516 | ISZ INPTR /BUMP WORD POINTER |
| 3517 | JMP ICHAR1+1 /DO SOME COMMON STUFF |
| 3518 | ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS |
| 3519 | AND (7400 |
| 3520 | DCA INTMP /FOR THE THIRD CHAR |
| 3521 | ISZ INPTR /GO TO THE SECOND WORD |
| 3522 | ICHAR1, TAD I INPTR /GET THE LOW 8 BITS |
| 3523 | / CDF |
| 3524 | AND (177 /AND I MEAN ONLY 8 !! |
| 3525 | SNA /V3C YOU WERE WRONG - YOU MEANT ONLY 7 |
| 3526 | JMP ICHAR+1 |
| 3527 | TAD (-32 /IS IT ^Z (END OF FILE) |
| 3528 | SNA |
| 3529 | JMP GETNEW /YES, LOOK FOR THE NEXT FILE |
| 3530 | TAD (232-212 |
| 3531 | SNA |
| 3532 | JMP ICHAR+1 /IGNORE LINE FEEDS |
| 3533 | TAD (212-215 |
| 3534 | SNA |
| 3535 | JMP ICHARN /RETURN ON CARRIAGE RETURN ** |
| 3536 | IAC |
| 3537 | SNA |
| 3538 | JMP ICHAR+1 /IGNORE FORM FEEDS |
| 3539 | JMP I (MORCHR /** |
| 3540 | ICHARN, CIF CDF 0 |
| 3541 | JMP I ICHAR |
| 3542 | INTMP, 0 |
| 3543 | INFPTR, 7617 /POINTER TO INPUT FILE LIST |
| 3544 | INEOF, 1 |
| 3545 | INCHCT, |
| 3546 | INNEWF, -1 /FETCH HANDLER FOR NEXT FILE |
| 3547 | CDF 0 /** |
| 3548 | TAD (INDEVH+1 /THIS IS WHERE IT GOES ** |
| 3549 | DCA INHNDL |
| 3550 | CDF 10 |
| 3551 | TAD I INFPTR /GET NEXT INPUT FILE INFO |
| 3552 | SNA |
| 3553 | JMP I INNEWF /NO MORE FILES |
| 3554 | CDF 10 /WAS CIF 10** |
| 3555 | JMS I INCALL /CALL MONITOR |
| 3556 | 1 /FETCH HANDLER |
| 3557 | INHNDL, 0 /ENTRY ADDR GOES HERE |
| 3558 | JMP INERR+3 /THIS CAN'T HAPPEN HERE |
| 3559 | TAD I INFPTR /GET LENGTH |
| 3560 | AND (7760 |
| 3561 | SZA /A ZERO HERE MEANS >=256 BLOCKS |
| 3562 | TAD (17 /PUT IN SOME MORE BITS |
| 3563 | CLL CML RTR |
| 3564 | RTR |
| 3565 | DCA INCTR /STORE LENGTH OF FILE |
| 3566 | ISZ INFPTR |
| 3567 | TAD I INFPTR /GET STARTING RECORD NUMBER |
| 3568 | DCA INREC |
| 3569 | ISZ INFPTR |
| 3570 | DCA INEOF /CLEAR EOF FLAG |
| 3571 | ISZ INNEWF |
| 3572 | JMP I INNEWF |
| 3573 | INCTR, 0 |
| 3574 | INCALL, 200 /CHANGED TO 7700 AFTER FIRST TIME |
| 3575 | INPTR, 0 |
| 3576 | PAGE |
| 3577 | \f/ KEYWORD LIST |
| 3578 | CMDLST, -1106;0;IF /IF |
| 3579 | -0417 |
| 3580 | -2502 |
| 3581 | -1405 |
| 3582 | -2022 |
| 3583 | -0503 |
| 3584 | -1123 |
| 3585 | -1117;0;DOUBLE /DOUBLE PRECISION |
| 3586 | -0417;0;DO /DO |
| 3587 | -0717 |
| 3588 | -2417;0;GOTO /GOTO |
| 3589 | -0317 |
| 3590 | -1515 |
| 3591 | -1716;0;COMMON /COMMON |
| 3592 | -0317 |
| 3593 | -1520 |
| 3594 | -1405;0;COMPLE /COMPLEX |
| 3595 | -0317 |
| 3596 | -1624 |
| 3597 | -1116 |
| 3598 | -2505;0;NEXTST /CONTINUE |
| 3599 | -0301 |
| 3600 | -1414;0;CALL /CALL |
| 3601 | -2205 |
| 3602 | -0114;0;REAL /REAL |
| 3603 | -2205 |
| 3604 | -0104;0;READ /READ |
| 3605 | -2205 |
| 3606 | -2711 |
| 3607 | -1604;0;REWIND /REWIND |
| 3608 | -2205 |
| 3609 | -2425 |
| 3610 | -2216;0;RETURN /RETURN |
| 3611 | -0516 |
| 3612 | -0406 |
| 3613 | -1114;0;ENDFIL /ENDFILE |
| 3614 | -0516;0;XEND /END |
| 3615 | -0411 |
| 3616 | -1505 |
| 3617 | -1623 |
| 3618 | -1117;0;DIMENS /DIMENSION |
| 3619 | -0401 |
| 3620 | -2401;0;DATA /DATA |
| 3621 | -0617 |
| 3622 | -2215 |
| 3623 | -0124;0;FORMAT /FORMAT |
| 3624 | -2722 |
| 3625 | -1124;0;WRITE /WRITE |
| 3626 | -0521 |
| 3627 | -2511 |
| 3628 | -2601 |
| 3629 | -1405 |
| 3630 | -1603;0;EQUIV /EQUIVALENCE |
| 3631 | -0405 |
| 3632 | -0611 |
| 3633 | -1605 |
| 3634 | -0611 |
| 3635 | -1405;0;DFINFL /DEFINEFILE |
| 3636 | -1116 |
| 3637 | -2405 |
| 3638 | -0705;0;INTEGE /INTEGER |
| 3639 | -1417 |
| 3640 | -0711 |
| 3641 | -0301;0;LOGICA /LOGICAL |
| 3642 | -0530 |
| 3643 | -2405 |
| 3644 | -2216 |
| 3645 | -0114;0;EXTERN /EXTERNAL |
| 3646 | -0201 |
| 3647 | -0313 |
| 3648 | -2320 |
| 3649 | -0103;0;BACKSP /BACKSPACE |
| 3650 | -0123 |
| 3651 | -2311 |
| 3652 | -0716;0;ASSIGN /ASSIGN |
| 3653 | -2001 |
| 3654 | -2523;0;PAUZE /PAUSE |
| 3655 | -2324 |
| 3656 | -1720;0;STOP /STOP |
| 3657 | -0611 |
| 3658 | -1604;0;FIND /FIND |
| 3659 | 0 /END OF LIST |
| 3660 | $ |
| 3661 | \f |