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 /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 *7 61 000007 0001 LINENO, 1 /2.01/ LINE NUMBER 62 000010 0000 X10, 0 /AUTO INDEX REGISTERS 63 000011 0000 X11, 0 64 000012 0000 X12, 0 65 000013 0111 NEXT, FREE-1 /FREE SPACE POINTER 66 000014 4677 STACK, STACKS-1 /STACK POINTER 67 000015 0000 CHRPTR, 0 /INPUT BUFFER POINTER 68 000016 0000 X16, 0 69 000017 0000 X17, 0 70 000020 4677 STKLVL, STACKS-1 /STACK BASE LEVEL 71 000021 0000 BUCKET, 0 /FIRST CHAR OF NAME 72 000022 0000 WORD1, 0 /SIX WORD LITERAL BUFFER 73 000023 0000 WORD2, 0 74 000024 0000 WORD3, 0 75 000025 0000 WORD4, 0 76 000026 0000 WORD5, 0 77 000027 0000 WORD6, 0 78 000030 0000 ACO, 0 /FLOATING AC OVERFLOW WORD 79 000031 0000 OP1, 0 /SEVEN WORD OPERAND FOR "NUMBER" 80 000032 0000 OP2, 0 81 000033 0000 OP3, 0 82 000034 0000 OP4, 0 83 000035 0000 OP5, 0 84 000036 0000 OP6, 0 85 000037 0000 OPO, 0 86 000040 0000 CHAR, 0 /ICHAR PUTS CHARACTER HERE 87 000041 0000 NOCODE, 0 /IS 1 IF CODE GENERATION OFF 88 000042 0000 NCHARS, 0 /SIZE OF INPUT LINE 89 000043 0000 NUMELM, 0 /NUMBER OF VARS IN TYPED LIST 90 000044 0000 TEMP, 0 91 000045 0000 TEMP2, 0 92 000046 0000 DECPT, 0 /SET 1 IF NUMBER CONTAINED . 93 000047 0000 ESWIT, 0 /1 FOR E 0 FOR D 94 000050 0000 NDIGIT, 0 /NUMBER OF DIGITS TO RIGHT OF . 95 000051 3256 HCHAR, HCOUNT /HOLLERITH GETTER ROUTINE 96 000052 0000 SNUM, 0 /POINTER TO ST ENTRY FOR STMT NUMBER 97 000053 0000 IFSWIT, 0 /=1 IF INSIDE LOGICAL IF 98 000054 0000 EXPON, 0 /HOLDS EXPONENT FOR CONVERSION 99 000055 0617 TMPFIL, 0617;2224;2216;2415 /PASS1 OUTPUT FILE 000056 2224 000057 2216 000060 2415 100 000061 0000 0;0;0;0 /PASS2 OUTPUT FILE 000062 0000 000063 0000 000064 0000 101 000065 0000 DOEND, 0 /SET 1 IF THIS STMT WAS A IF, 102 /GOTO, RETURN, PAUSE, OR STOP 103 000066 0000 THSNUM, 0 /CURRENT STATEMENT NUMBER 104 000067 0000 DIMNUM, 0 /LINEARIZED SS FOR EQ 105 000070 0000 DPRDCT, 0 /HOLDS DIMENSION PRODUCT 106 000071 0000 EQTEMP, 0 /TEMP FOR EQUIVALENCE 107 000072 0000 MQ, 0 /MQ FOR 12 BIT MULTIPLY 108 000073 0000 MASTER, 0 /POINTER TO MASTER IN EQUIV GROUP 109 000074 0000 MNUM, 0 /LINEARIZED SS FOR MASTER 110 000075 0000 NSLAVE, 0 /NUMBER OF SLAVES IN GROUP 111 000076 0000 PASS2O, 0 /START OF PASS 2 OVERLAY SECTION 112 000077 0000 OUFILE, 0 /START OF PASS1 OUTPUT FILE 113 000100 0000 DSERES, 0 /MAGIC NUMBER 114 000101 0105 PROGNM, MAIN /POINTER TO PROG NAME 115 000102 0000 ARGLST, 0 /POINTER TO ARG LIST 116 000103 0000 FUNCTN, 0 /0=MAIN, 1=FUNCTION, -2=SUBROUTINE 117 000104 0000 SETBIT, 0 /TEMPS FOR DECLARATION SCANNER 118 000105 0000 BADBIT, 0 119 000106 0000 DOINDX, 0 /POINTER TO DO INDEX FOR DO LOOPS 120 000107 0000 TLTEMP, 0 /TEMP FOR TYPE ROUTINE 121 000110 0000 OWTEMP, 0 /TEMP FOR OUTWRD 122 000111 7676 CNT72, -102 /72 COLUMN COUNTER 123 000112 0000 DPUSED, 0 /=1 IF DOUBLE HARDWARE USED 124 000113 0004 VERS, VERSON /VERSION NUMBER 125 000114 7567 M211, -211 126 000115 0211 P211, 211 127 000116 0240 P240, 240 128 000117 6305 IXLNP5, LINE+5 /** 129 000120 6300 IXLINE, LINE 130 000121 6277 IXLINM, LINE-1 131 000122 0000 STMJMP, 0 /FOR DEFINE FILE 132 / 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 000200 6212 RDLOOP, CIF 10 /FOR OS/8 2 PG HANDLERS** 183 000201 4577 JMS I [ICHAR /GET CHAR FROM INPUT FILE 184 000202 5231 JMP ENDLIN /END LINE OR CR 185 000203 1114 TAD M211 /CHECK FOR TAB** 186 000204 7450 SNA 187 000205 1377 TAD (240-211 /CONVERT TO BLANK 188 000206 1115 TAD P211 /** 189 000207 3415 DCA I CHRPTR /SAVE CHAR 190 000210 2111 ISZ CNT72 /PAST COLUMN 72 ? 191 000211 7410 SKP 192 000212 5224 JMP SKPLIN /SKIP 73 TO 80 193 000213 1015 TAD CHRPTR 194 000214 7141 CIA CLL 195 000215 1376 TAD (LINE+670 196 000216 7630 SZL CLA /TEST FOR TOO MANY CONTINUATIONS 197 000217 5200 JMP RDLOOP 198 000220 4576 JMS I [ERMSG /LINE TOO LONG 199 000221 1424 1424 200 000222 1016 SKPCOM, TAD X16 /RESTORE CHRPTR 201 000223 3015 DCA CHRPTR 202 000224 6212 SKPLIN, CIF 10 /** 203 000225 4577 JMS I [ICHAR /SKIP REST OF LINE 204 000226 5231 JMP ENDLIN 205 000227 7200 CLA 206 000230 5224 JMP SKPLIN 207 000231 1015 ENDLIN, TAD CHRPTR /SAVE CHAR POSITION 208 000232 3016 DCA X16 209 000233 1015 TAD CHRPTR 210 000234 3010 DCA X10 /SAVE POSITION FOR COMMENT CHECK 211 000235 1375 TAD (-102 /SET COLUMN COUNT 212 000236 3111 DCA CNT72 213 000237 1350 TAD M6 214 000240 3042 DCA NCHARS 215 000241 6212 GET6, CIF 10 /** 216 000242 4577 JMS I [ICHAR /GET FIRST 6 CHARS 217 000243 5256 JMP SHORTL /IGNORE SHORT LINES 218 000244 1114 TAD M211 /IS CHAR A TAB ? ** 219 000245 7640 SZA CLA 220 000246 5261 JMP NOTAB /NO 221 000247 1116 TAD P240 /TREAT FIRST TAB AS SIX BLANKS 222 000250 3415 DCA I CHRPTR 223 000251 2042 ISZ NCHARS 224 000252 5247 JMP .-3 225 000253 1116 TAD P240 /FAKE CONTINUATION CHECK 226 000254 3040 DCA CHAR 227 000255 5265 JMP CCHECK /GO TO COMMENT CHECK 228 000256 1016 SHORTL, TAD X16 /RESET CHAR POINTER 229 000257 3015 DCA CHRPTR /TO IGNORE SHORT LINES 230 000260 5231 JMP ENDLIN 231 000261 1040 NOTAB, TAD CHAR 232 000262 3415 DCA I CHRPTR 233 000263 2042 ISZ NCHARS 234 000264 5241 JMP GET6 /LOOP 235 000265 1410 CCHECK, TAD I X10 /IS IT A COMMENT ? 236 000266 1374 TAD (-303 237 000267 7650 SNA CLA 238 000270 5222 JMP SKPCOM /COMMENT, SKIP REST 239 000271 1040 NOCMNT, TAD CHAR /WAS SIXTH CHAR A BLANK ? 240 000272 1352 TAD MMM240 241 000273 7650 SNA CLA 242 000274 5300 JMP GOTLIN /YES, NO MORE CONTINUATIONS 243 000275 1016 CCARD, TAD X16 /IGNORE THESE SIX CHARACTERS 244 000276 3015 DCA CHRPTR 245 000277 5200 JMP RDLOOP /CONTINUE WITH THIS LINE 246 000300 1015 GOTLIN, TAD CHRPTR /COMPUTE -NCHARS-1 247 000301 7041 CIA 248 000302 1373 TAD (LINE+4 249 000303 3042 DCA NCHARS 250 000304 1175 TAD [LINE-1 /RESET CHAR POINTER 251 000305 3015 DCA CHRPTR 252 000306 4574 JMS I [CKCTLC /CHECK FOR CONTROL C 253 000307 3066 LINE1, DCA THSNUM /ZERO CURRENT STMT NUMBER 254 000310 7130 CLL CML RAR /SET LABEL DEFINE BIT 255 000311 4573 JMS I [STMNUM /GO LOOK FOR LABEL 256 000312 5321 JMP COMPIL /NONE THERE 257 000313 1052 TAD SNUM /SAVE STATEMENT NUMBER 258 000314 3066 DCA THSNUM 259 000315 1372 TAD (DEFLBL /OUTPUT DEFINITION FOR THIS LABEL 260 000316 4572 JMS I [OUTWRD 261 000317 1052 TAD SNUM 262 000320 4572 JMS I [OUTWRD /FOLLOWED BY THE LABEL ADDRESS 263 000321 4571 COMPIL, JMS I [SAVECP 264 000322 2007 ISZ LINENO /2.01/ PUT LINE NUMBER 265 000323 1007 TAD LINENO /2.01/ INTO MQ 266 000324 7421 7421 /2.01/ 267 000325 7201 CLA IAC 268 000326 3041 DCA NOCODE /SET NOCODE SWITCH 269 000327 4576 JMS I [ERMSG /SET UP DEFAULT ERROR MESSAGE 270 000330 1513 1513 271 000331 4570 JMS I [LEXPR /IS IT ARITHMETIC ? 272 000332 5361 JMP NOTAR /NO 273 000333 4567 JMS I [GETC /LOOK FOR = 274 000334 5361 JMP NOTAR /NOT ARITHMETIC 275 000335 1355 TAD MMM275 /= 276 000336 7650 SNA CLA 277 000337 4566 JMS I [EXPR /SCAN LEFT PART 278 000340 5361 JMP NOTAR 279 000341 4576 JMS I [ERMSG /SET MESSAGE TO ILLEGAL OPERATOR 280 000342 1720 1720 281 000343 2042 ISZ NCHARS /SHOULD BE NOTHING LEFT 282 000344 5361 JMP NOTAR /IF THERE IS, ITS NOT ARITHMETIC 283 000345 4565 ITSAR, JMS I [RESTCP /RESTORE TO START OF LINE 284 000346 3041 DCA NOCODE /ALLON CODE 285 000347 4570 JMS I [LEXPR /GET LEFT SIDE 286 000350 7772 M6, -6 /V3C MUST BE HERE 287 000351 4567 JMS I [GETC /SKIP = 288 000352 7540 MMM240, -240 /SHOULD NEVER GET HERE 289 000353 7200 CLA 290 000354 4566 JMS I [EXPR /GET RIGHT SIDE 291 000355 7503 MMM275, -275 /SHOULD NEVER GET HERE 292 000356 1371 TAD (STOROP /OUTPUT STORE 293 000357 4572 JMS I [OUTWRD 294 000360 5564 JMP I [NEXTST /DO NEXT LINE 295 000361 4565 NOTAR, JMS I [RESTCP /RESTART LINE 296 000362 3041 DCA NOCODE 297 000363 4571 JMS I [SAVECP /RESAVE CHAR POSITION 298 000364 1370 TAD (CMDLST-1 299 000365 3010 DCA X10 300 000366 5767 JMP I (CMDLUP /GO SEARCH FOR KEYWORD 301 / KEYWORD SEARCH 302 000367 0400 PAGE 000370 5777 000371 0043 000372 0045 000373 6304 000374 7475 000375 7676 000376 7170 000377 0027 303 000400 6211 CMDLUP, CDF 10 /TABLE IN FIELD ONE 304 000401 1410 TAD I X10 /GET NEXT 2 CHARS OF KEYWORD 305 000402 7440 SZA 306 000403 5213 JMP CMDLP2 /NOT DONE YET 307 000404 7144 CLL CMA RAL /REMOVE CHAR POS FROM STACK 308 000405 1014 TAD STACK 309 000406 3014 DCA STACK 310 000407 1410 TAD I X10 /GET ROUTINE ADDRESS 311 000410 6201 CDF 312 000411 3122 DCA STMJMP 313 000412 5522 JMP I STMJMP /JUMP TO THE ROUTINE 314 000413 3044 CMDLP2, DCA TEMP /SAVE THE TWO CHARS 315 000414 6201 CDF 316 000415 4563 JMS I [GET2C /GET TWO CHARS FROM THE INPUT 317 000416 5222 JMP .+4 /NOT ENOUGH CHARS, CAN'T BE THIS ONE 318 000417 1044 TAD TEMP /COMPARE 319 000420 7650 SNA CLA 320 000421 5200 JMP CMDLUP /MATCHES, KEEP GOING 321 000422 4565 JMS I [RESTCP /RESTORE CHAR POS 322 000423 2014 ISZ STACK 323 000424 2014 ISZ STACK /AND SAVE IT AGAIN 324 000425 6211 CDF 10 325 000426 1410 TAD I X10 /FIND END OF THIS COMMAND 326 000427 7640 SZA CLA 327 000430 5226 JMP .-2 328 000431 2010 ISZ X10 /SKIP ROUTINE ADDRESS 329 000432 1410 TAD I X10 /IS THE LIST EXHAUSTED ? 330 000433 7440 SZA 331 000434 5213 JMP CMDLP2 /NO, GO AGAIN 332 000435 4576 BADCMD, JMS I [ERMSG /TREAT AS BAD ARITHMETIC STMT 333 000436 0000 ERCODE, 0 334 / END OF STMT PROC 335 NEXTLN, 336 NEXTST, 337 000437 1020 DOENDR, TAD STKLVL /RESET STACK POINTER 338 000440 3014 DCA STACK 339 000441 4562 JMS I [POP /LOOK FOR DO END 340 000442 7041 CIA 341 000443 1066 TAD THSNUM /DOES THIS LINE END A DO LOOP ? 342 000444 7640 SZA CLA 343 000445 5262 JMP NODOND /NO, REPLACE STACK AND COMPILE STMT 344 000446 1377 TAD (DOFINI 345 000447 4572 JMS I [OUTWRD /OUTPUT DO END COMMAND 346 000450 4562 JMS I [POP /GET INDEX VARIABLE 347 000451 4572 JMS I [OUTWRD 348 000452 1014 TAD STACK /RESET STACK BASE LEVEL 349 000453 3020 DCA STKLVL 350 000454 1065 TAD DOEND /WAS THIS A LEGAL ENDING STMT ? 351 000455 7640 SZA CLA 352 000456 4576 JMS I [ERMSG 353 000457 0504 0504 /DO END ERROR 354 000460 3065 DCA DOEND /KILL SWITCH 355 000461 5237 JMP DOENDR 356 000462 2014 NODOND, ISZ STACK /REPLACE STACK ENTRY 357 000463 3065 DCA DOEND /KILL SWITCH 358 000464 1376 TAD (EOLCOD /OUTPUT EOL CODE 359 000465 4572 JMS I [OUTWRD 360 000466 3236 DCA ERCODE /RESET ERROR CODE 361 000467 3053 DCA IFSWIT /KILL IF SWITCH 362 000470 1375 TAD (-6 /MOVE FIRST 6 CHARS 363 000471 3042 DCA NCHARS 364 000472 1175 TAD [LINE-1 /INTO START OF BUFFER 365 000473 3015 DCA CHRPTR 366 000474 1416 TAD I X16 367 000475 3415 DCA I CHRPTR 368 000476 2042 ISZ NCHARS 369 000477 5274 JMP .-3 370 000500 5774 JMP I (RDLOOP 371 / GOTO'S 372 000501 2065 GOTO, ISZ DOEND /DO END ILLEGAL 373 000502 4573 JMS I [STMNUM /IS IT A SIMPLE GOTO ? 374 000503 5311 JMP CMPGO2 /NO, SEE IF ITS A COMPUTED ONE 375 000504 1373 TAD (GO2OPR /OUTPUT GOTO OPERATOR 376 000505 4572 JMS I [OUTWRD 377 000506 1052 TAD SNUM /FOLLOWED BY STMT NUMBER 378 000507 4572 JMS I [OUTWRD 379 000510 5564 JMP I [NEXTST 380 000511 4567 CMPGO2, JMS I [GETC /LOOK FOR ( 381 000512 5365 JMP BADGO2 /BAD GOTO 382 000513 1372 TAD (-250 383 000514 7640 SZA CLA 384 000515 5357 JMP ASNGO2 /NOT ( , MAYBE ITS AN ASSIGNED GOTO 385 000516 1014 TAD STACK /SAVE STACK POSITION 386 000517 3012 DCA X12 387 000520 3044 DCA TEMP /ZERO BRANCH COUNTER 388 000521 4573 GO2LUP, JMS I [STMNUM /GET NEXT STMT NUMBER 389 000522 5365 JMP BADGO2 /MUST BE THERE 390 000523 1052 TAD SNUM 391 000524 4561 JMS I [PUSH /SAVE IT TEMPORARILY 392 000525 2044 ISZ TEMP /BUMP BRANCH COUNT 393 000526 4560 JMS I [COMARP /LOOK FOR COMMA OR RIGHT PAREN 394 000527 5365 JMP BADGO2 /NEITHER 395 000530 5321 JMP GO2LUP /COMMA, GO GET NEXT LABEL 396 000531 4567 JMS I [GETC /SKIP NEXT CHAR (ITS A COMMA) 397 000532 5365 JMP BADGO2 398 000533 7200 CLA 399 000534 1044 TAD TEMP /SAVE COUNT 400 000535 4561 JMS I [PUSH /ON STACK 401 000536 4566 JMS I [EXPR /COMPILE INDEX EXPR 402 000537 5564 JMP I [NEXTST 403 000540 1371 TAD (CGO2OP /OUTPUT COMPUTED GOTO OPERATOR 404 000541 4572 JMS I [OUTWRD 405 000542 4562 JMS I [POP /GET COUNT 406 000543 7041 CIA 407 000544 3044 DCA TEMP /SAVE COMPLEMENT 408 000545 1044 TAD TEMP 409 000546 7041 CIA 410 000547 4572 JMS I [OUTWRD /OUTPUT COUNT 411 000550 1012 TAD X12 /RESTORE STACK POINTER 412 000551 3014 DCA STACK 413 000552 1412 TAD I X12 /MOVE STMT NUMBERS TO OUTPUT 414 000553 4572 JMS I [OUTWRD 415 000554 2044 ISZ TEMP 416 000555 5352 JMP .-3 417 000556 5564 JMP I [NEXTST 418 000557 4557 ASNGO2, JMS I [BACK1 /PUT BACK NON ( 419 000560 4570 JMS I [LEXPR /GET ASSIGN VAR 420 000561 5365 JMP BADGO2 421 000562 1370 TAD (AGO2OP /OUTPUT GOTO OPERATOR 422 000563 4572 JMS I [OUTWRD 423 000564 5564 JMP I [NEXTST 424 000565 4576 BADGO2, JMS I [ERMSG 425 000566 0724 0724 426 000567 5564 JMP I [NEXTST 427 / I/O STATEMENTS 428 000570 0061 PAGE 000571 0060 000572 7530 000573 0057 000574 0200 000575 7772 000576 0037 000577 0046 429 000600 0000 RDWR, 0 /SUBR FOR IO STATEMENTS 430 000601 4556 JMS I [CHECKC /LOOK FOR ( 431 000602 7530 M250, -250 432 000603 5275 JMP BADRD 433 000604 4566 JMS I [EXPR /COMPILE UNIT 434 000605 5555 JMP I [BADCMD 435 000606 4560 JMS I [COMARP 436 000607 5777 JMP DAQUOT /LOOK FOR ' (DIRECT ACCESS I/O) 437 000610 5347 JMP RDFMT /, 438 000611 1376 TAD (BINRD1 /FORMATLESS READ/WRITE 439 000612 1600 IOSTRT, TAD I RDWR /ADD ADJUSTOR 440 000613 4572 JMS I [OUTWRD /OUTPUT BINARY READ 441 000614 4561 IOLIST, JMS I [PUSH /MARK STACK 442 000615 4567 JMS I [GETC /IS IT AN IMPLIED DO ? 443 000616 5340 JMP ENDIOL /NO, END OF LIST 444 000617 1202 TAD M250 445 000620 7640 SZA CLA 446 000621 5300 JMP TRYIOE /NO, LOOK FOR IO ELEMENT 447 000622 4571 JMS I [SAVECP /SAVE CHAR POS AT START OF IDO 448 000623 3337 DCA IDOPAR /ZERO PAREN COUNTER 449 000624 4577 FINDND, JMS I [GETNAM /GET A NAME IF THERE IS ONE 450 000625 0067 XPURGE, PRGSTK /DON'T WORRY ITS A NOP 451 000626 4567 JMS I [GETC /GET A CHAR 452 000627 5340 JMP ENDIOL 453 000630 1360 TAD M251 /IS IT A ) ? 454 000631 7450 SNA 455 000632 5270 JMP RPIOL /YES 456 000633 7001 IAC /IS IT ( ? 457 000634 7450 SNA 458 000635 5266 JMP LPIOL /YES 459 000636 1375 TAD (250-275 /IS IT = ? 460 000637 7640 SZA CLA 461 000640 5224 JMP FINDND /NONE OF THESE 462 000641 1337 TAD IDOPAR /IS PAREN COUNT 0 ? 463 000642 7640 SZA CLA 464 000643 5224 JMP FINDND /NO, ITS FROM AN INNER LOOP 465 000644 4554 JMS I [LOOKUP /THIS ELEMENT IS THE DO INDEX 466 000645 3106 DCA DOINDX 467 000646 4774 JMS I (DOSTUF /COMPILE THE LOOP 468 000647 5275 JMP BADIOL /ERROR IN DO PARMS 469 000650 4556 JMS I [CHECKC /MUST HAVE ) 470 000651 7527 -251 471 000652 5275 JMP BADIOL 472 000653 1015 TAD CHRPTR /SAVE CHAR POSITION 473 000654 3044 DCA TEMP 474 000655 1042 TAD NCHARS 475 000656 3045 DCA TEMP2 476 000657 4565 JMS I [RESTCP /RESTORE TO START OF IMPLIED LOOP 477 000660 1045 TAD TEMP2 /NOW SAVE POS AFTER LOOP 478 000661 4561 JMS I [PUSH 479 000662 1044 TAD TEMP 480 000663 4561 JMS I [PUSH 481 000664 1106 TAD DOINDX /AND DO INDEX 482 000665 5214 JMP IOLIST 483 000666 2337 LPIOL, ISZ IDOPAR /( INCREASES COUNT 484 000667 5224 JMP FINDND 485 000670 7040 RPIOL, CMA /) DECREASES COUNT 486 000671 1337 TAD IDOPAR 487 000672 7500 SMA 488 000673 5223 JMP FINDND-1 489 000674 7200 CLA 490 BADIOL, 491 000675 4576 BADRD, JMS I [ERMSG /BAD IO STMT 492 000676 2227 2227 493 000677 5564 JMP I [NEXTST 494 000700 4557 TRYIOE, JMS I [BACK1 /PUT BACK NON ( 495 000701 4570 JMS I [LEXPR /GET IOLIST ELEMENT 496 000702 5275 JMP BADRD /NOT THERE, ERROR 497 000703 4567 JMS I [GETC /LOOK FOR A COMMA 498 000704 5310 JMP .+4 /EOL 499 000705 1373 TAD (-254 500 000706 7440 SZA 501 000707 5313 JMP NOTIOL /NOT AN ELEMENT 502 000710 1372 TAD (IOLMNT /OUTPUT OPCODE 503 000711 4572 JMS I [OUTWRD 504 000712 5215 JMP IOLIST+1 505 000713 1371 NOTIOL, TAD (254-275 /IS IT AN = (END OF IDO) 506 000714 7640 SZA CLA 507 000715 5275 JMP BADIOL /NO, BAD 508 000716 4562 JMS I [POP /GET STUFF FROM THE STACK 509 000717 7450 SNA 510 000720 5275 JMP BADIOL /ZERO IS BAD 511 000721 3106 DCA DOINDX /THIS IS THE INDEX 512 000722 4565 JMS I [RESTCP /GET THE CHAR POSITION 513 000723 1225 TAD XPURGE /OUTPUT PURGE OPERATOR 514 000724 4572 JMS I [OUTWRD /BECAUSE AN EXTRA IS ON THE STK 515 000725 1370 TAD (DOFINI /END LOOP 516 000726 4572 JMS I [OUTWRD 517 000727 1106 TAD DOINDX 518 000730 4572 JMS I [OUTWRD 519 000731 4567 JMS I [GETC /END OF LIST ? 520 000732 5340 JMP ENDIOL 521 000733 1373 TAD (-254 522 000734 7640 SZA CLA 523 000735 5275 JMP BADIOL /MUST BE A COMMA 524 000736 5215 JMP IOLIST+1 525 000737 0000 IDOPAR, 0 526 000740 4562 ENDIOL, JMS I [POP /IS THE MARK THERE ? 527 000741 7640 SZA CLA 528 000742 5275 JMP BADRD /NO, ERROR 529 000743 1600 TAD I RDWR 530 000744 1367 TAD (RCLOSE /END OF IO OPERATION 531 000745 4572 JMS I [OUTWRD 532 000746 5564 JMP I [NEXTST 533 000747 4573 RDFMT, JMS I [STMNUM /LOOK FOR FMT LINE NUMBER 534 000750 5363 JMP RTFMT 535 000751 4572 JMS I [OUTWRD /OUTPUT PUSH COMMAND 536 000752 1052 TAD SNUM /OUTPUT STMT NUMBER OF FORMAT 537 000753 4572 JMS I [OUTWRD 538 000754 1366 RDLIST, TAD (FMTRD1 /START OF FORMATTED READ 539 000755 1600 TAD I RDWR /ADD ADJUSTOR 540 000756 4572 JMS I [OUTWRD 541 000757 4556 JMS I [CHECKC /LOOK FOR ) 542 000760 7527 M251, -251 543 000761 5275 JMP BADRD 544 000762 5214 JMP IOLIST /GO GET IO LIST 545 000763 4570 RTFMT, JMS I [LEXPR /GET R.T. FORMAT 546 000764 5275 JMP BADRD 547 000765 5354 JMP RDLIST /GET LIST 548 /DIRECT ACCESS I/O 549 000766 0025 PAGE 000767 0026 000770 0046 000771 7757 000772 0062 000773 7524 000774 2324 000775 7753 000776 0024 000777 1000 550 001000 4557 DAQUOT, JMS I [BACK1 551 001001 4556 JMS I [CHECKC /LOOK FOR ' 552 001002 7531 -247 553 001003 5777 JMP BADRD /SYNTAX IS NO GOOD 554 001004 4566 JMS I [EXPR /GET RECORD NUMBER EXPR 555 001005 5777 JMP BADRD 556 001006 4556 JMS I [CHECKC /LOOK FOR ) 557 001007 7527 -251 558 001010 5777 JMP BADRD 559 001011 1376 TAD (DARD1 /DIRECT ACCESS OPEN 560 001012 5775 JMP IOSTRT 561 001013 5564 FIND, JMP I [NEXTST /COOL ISN'T IT ? 562 001014 4566 DFINFL, JMS I [EXPR /COMPILE UNIT 563 001015 5261 JMP BADDEF /BAD DEFINE STMT 564 001016 3122 DCA STMJMP /PERMIT VARIABLE FOR LOG UNIT 565 001017 4556 JMS I [CHECKC /( 566 001020 7530 -250 567 001021 5261 JMP BADDEF 568 001022 4566 JMS I [EXPR /NUMBER OF RECORDS 569 001023 5261 JMP BADDEF 570 001024 4556 JMS I [CHECKC /, 571 001025 7524 -254 572 001026 5261 JMP BADDEF 573 001027 4566 JMS I [EXPR /RECORD SIZE 574 001030 5261 JMP BADDEF 575 001031 4556 JMS I [CHECKC /, 576 001032 7524 -254 577 001033 5261 JMP BADDEF 578 001034 4556 JMS I [CHECKC /U 579 001035 7453 -325 580 001036 5261 JMP BADDEF 581 001037 4556 JMS I [CHECKC /, 582 001040 7524 MCOMA, -254 583 001041 5261 JMP BADDEF 584 001042 4577 JMS I [GETNAM /GET INDEX VARIABLE 585 001043 5261 JMP BADDEF 586 001044 4572 JMS I [OUTWRD 587 001045 4554 JMS I [LOOKUP 588 001046 4572 JMS I [OUTWRD /OUTPUT INDEX VAR 589 001047 1374 TAD (DEFFIL /OUTPUT DEFINE OPERATOR 590 001050 4572 JMS I [OUTWRD 591 001051 4556 JMS I [CHECKC /) 592 001052 7527 -251 593 001053 5261 JMP BADDEF 594 001054 4567 JMS I [GETC /ANOTHER DEFINE ? 595 001055 5564 JMP I [NEXTST 596 001056 1240 TAD MCOMA /, ? 597 001057 7650 SNA CLA 598 001060 5214 JMP DFINFL /YES, ANOTHER FILE 599 001061 4576 BADDEF, JMS I [ERMSG /BAD DEFINE FILE STMT 600 001062 0406 0406 601 001063 5564 JMP I [NEXTST 602 001064 0000 RESTCP, 0 /RESTORE CHAR POSITION FROM STACK 603 001065 4562 JMS I [POP 604 001066 3015 DCA CHRPTR 605 001067 4562 JMS I [POP 606 001070 3042 DCA NCHARS 607 001071 5664 JMP I RESTCP 608 001072 4556 INTEGE, JMS I [CHECKC /INTEGER STMT 609 001073 7456 -322 610 001074 5555 JMP I [BADCMD 611 001075 4553 JMS I [TYPLST 612 001076 0101 0101 613 001077 0100 0100 614 001100 7000 NOP 615 001101 5564 JMP I [NEXTST 616 001102 4556 PAUZE, JMS I [CHECKC /LOOK FOR E 617 001103 7473 -305 618 001104 5555 JMP I [BADCMD 619 001105 4567 JMS I [GETC /ANY EXPR ? 620 001106 5315 JMP NOARGP /MAKE IT PAUSE 1 621 001107 4557 JMS I [BACK1 /PUT IT BACK 622 001110 4566 JMS I [EXPR /GET PAUSE NUMBER 623 001111 0022 XPAUZ, PAUSOP 624 001112 1311 OPAUZ, TAD XPAUZ /OUTPUT PAUSE OPERATOR 625 001113 4572 JMS I [OUTWRD 626 001114 5564 JMP I [NEXTST 627 001115 4572 NOARGP, JMS I [OUTWRD /PUSH 1.0 628 001116 1152 TAD [ONE 629 001117 4572 JMS I [OUTWRD 630 001120 5312 JMP OPAUZ /GO PUT OPERATOR 631 001121 4773 READ, JMS I (RDWR /COMPILE READ STMT 632 001122 0000 0 633 001123 4556 WRITE, JMS I [CHECKC /LOOK FOR E 634 001124 7473 -305 635 001125 5555 JMP I [BADCMD 636 001126 4773 JMS I (RDWR /COMPILE WRITE 637 001127 0004 BINWR1-BINRD1 638 001130 6401 CKCTLC, 6401 /CHECK FOR CONTROL C 639 001131 1372 TAD (7600 640 001132 6034 KRS 641 001133 1371 TAD (-7603 /^C 642 001134 7650 SNA CLA 643 001135 6031 KSF 644 001136 5730 JMP I CKCTLC 645 001137 5772 JMP I (7600 646 647 001140 3022 XOCTAL, DCA WORD1 /** 648 001141 3023 DCA WORD2 649 001142 3024 DCA WORD3 /STATEMENT NUM LEFT THERE** 650 001143 3026 DCA WORD5 651 001144 3027 DCA WORD6 652 001145 3025 XCTAL1, DCA WORD4 653 001146 4551 JMS I [DIGIT /GET NEXT DIGIT 654 001147 5360 JMP ENDOXT /NO DIGITS LEFT 655 001150 0150 AND [7 /THROW AWAY SOME BITS 656 001151 3044 DCA TEMP 657 001152 4770 JMS I (AL1 /MOVE WORD LEFT THREE 658 001153 4770 JMS I (AL1 659 001154 4770 JMS I (AL1 660 001155 1025 TAD WORD4 /ADD DIGIT TO WORD4 661 001156 1044 TAD TEMP 662 001157 5345 JMP XCTAL1 /LOOP 663 001160 1023 ENDOXT, TAD WORD2 /PUT WORDS INTO THE LEFT PLACE 664 001161 3022 DCA WORD1 665 001162 1024 TAD WORD3 666 001163 3023 DCA WORD2 667 001164 1025 TAD WORD4 668 001165 3024 DCA WORD3 669 001166 5767 JMP DATAFP /GO STUFF IT AWAY 670 / DIMENSION, COMMON, REAL 671 001167 6056 PAGE 001170 5344 001171 0175 001172 7600 001173 0600 001174 0034 001175 0612 001176 0027 001177 0675 672 001200 4547 DIMENS, JMS I [IFCHEK 673 001201 4556 JMS I [CHECKC /CHECK FOR "N" 674 001202 7462 -316 675 001203 5555 JMP I [BADCMD /NO GOOD 676 001204 4553 JMS I [TYPLST /PROCESS LIST 677 001205 0000 0000 /DIMENSION IS THE SIMPLEST CASE 678 001206 0000 0000 679 001207 7000 NOP /ERROR RETURN 680 001210 5564 JMP I [NEXTST 681 001211 4547 REAL, JMS I [IFCHEK /CHECK FOR INSIDE IF 682 001212 4553 JMS I [TYPLST /PROCESS LIST 683 001213 0102 0102 /TYPE-REAL 684 001214 0100 0100 685 001215 7000 NOP 686 001216 5564 JMP I [NEXTST 687 001217 4556 COMPLE, JMS I [CHECKC /CHECK FOR "X" 688 001220 7450 -330 689 001221 5555 JMP I [BADCMD 690 001222 4547 JMS I [IFCHEK 691 001223 4553 JMS I [TYPLST /PROCESS COMPLEX LIST 692 001224 0103 0103 693 001225 0100 0100 694 001226 7000 NOP 695 001227 7201 CLA IAC /SET DP SWITCH 696 001230 3112 DCA DPUSED 697 001231 5564 JMP I [NEXTST 698 001232 4547 COMMON, JMS I [IFCHEK /BAD INSIDE LOGICAL IF 699 001233 4567 JMS I [GETC /CHECK FOR SLASH 700 001234 5555 JMP I [BADCMD 701 001235 1243 TAD M257 702 001236 7640 SZA CLA 703 001237 5324 JMP BLANKC /MUST BE BLANK COMMON 704 001240 4577 JMS I [GETNAM /GET NAME OF COMMON 705 001241 5320 JMP DBLSLS /MIGHT BE // 706 001242 4556 JMS I [CHECKC /LOOK FOR / 707 001243 7521 M257, -257 708 001244 5330 JMP BADCOM 709 001245 4554 JMS I [LOOKUP /LOOKUP COMMON NAME 710 001246 7001 IAC 711 001247 3333 DCA COMNAM /SAVE ADDR OF TYPE WORD 712 001250 6211 CDF 10 713 001251 1733 TAD I COMNAM /LOOK AT TYPE 714 001252 7440 SZA 715 001253 1377 TAD (-111 /MUST BE COMMON OR UNDEF. 716 001254 7640 SZA CLA 717 001255 5330 JMP BADCOM 718 001256 1376 TAD (111 /SET CORRECT BITS 719 001257 3733 DCA I COMNAM 720 001260 6201 CDF 721 001261 4553 DOCOMN, JMS I [TYPLST /HANDLE LIST 722 001262 4000 4000 723 001263 5460 5460 724 001264 5564 JMP I [NEXTST 725 001265 1012 TAD X12 726 001266 3014 DCA STACK /RESET STACK 727 001267 6211 CDF 10 728 001270 2333 ISZ COMNAM /POINTER TO COMMON INFO 729 001271 3413 DCA I NEXT /ZERO NEXT PTR WORD 730 001272 1733 TAD I COMNAM /LOOK FOR END OF LIST 731 001273 7450 SNA 732 001274 5277 JMP EOCL /THIS IS IT 733 001275 3333 DCA COMNAM /PROCEED DOWN LIST 734 001276 5272 JMP .-4 735 001277 1013 EOCL, TAD NEXT /HOOK IN NEXT PART 736 001300 3733 DCA I COMNAM 737 001301 1043 TAD NUMELM 738 001302 3413 DCA I NEXT /NUMBER IN THIS PART 739 001303 1043 TAD NUMELM 740 001304 7041 CIA 741 001305 3043 DCA NUMELM 742 001306 6201 CDF 743 001307 1412 TAD I X12 /MOVE VARIABLE PTRS 744 001310 6211 CDF 10 745 001311 3413 DCA I NEXT 746 001312 2043 ISZ NUMELM 747 001313 5306 JMP .-5 748 001314 6201 CDF 749 001315 4567 JMS I [GETC /ANOTHER BLOCK ? 750 001316 5564 JMP I [NEXTST /NO 751 001317 5235 JMP COMMON+3 /MAYBE 752 001320 4556 DBLSLS, JMS I [CHECKC /LOOK FOR SECOND SLASH 753 001321 7521 -257 754 001322 5330 JMP BADCOM 755 001323 7410 SKP 756 001324 4557 BLANKC, JMS I [BACK1 /PUT BACK NON SLASH 757 001325 1375 TAD (BLNKCN /USE BLANK COMMON 758 001326 3333 DCA COMNAM 759 001327 5261 JMP DOCOMN 760 001330 4576 BADCOM, JMS I [ERMSG /ERROR IN COMMON STMT 761 001331 0317 0317 762 001332 5564 JMP I [NEXTST 763 001333 0000 COMNAM, 0 764 / EXTERNAL, FORMAT, BACKSPACE 765 001334 4553 EXTERN, JMS I [TYPLST /PROCESS LIST 766 001335 1000 1000 767 001336 6660 6660 768 001337 7000 NOP 769 001340 5564 JMP I [NEXTST 770 001341 1374 FORMAT, TAD (FMTOPR /OUTPUT FORMAT OPERATOR 771 001342 4572 JMS I [OUTWRD 772 001343 1042 TAD NCHARS /GET NUMBER OF WORDS 773 001344 7041 CIA 774 001345 7110 CLL RAR /NWORDS=(NCHARS+1)/2 775 001346 4572 FMTLUP, JMS I [OUTWRD /OUTPUT IT 776 001347 4546 JMS I [GETCWB /GET THE CHARS 777 001350 5564 JMP I [NEXTST /NO MORE 778 001351 0145 AND [77 779 001352 7106 CLL RTL /SHIFT LEFT 6 780 001353 7006 RTL 781 001354 7006 RTL 782 001355 3044 DCA TEMP 783 001356 4546 JMS I [GETCWB /GET OTHER HALF 784 001357 7000 NOP /IGNORE END OF LINE 785 001360 0145 AND [77 786 001361 1044 TAD TEMP /PUT THEM TOGETHER 787 001362 5346 JMP FMTLUP /LOOP 788 /NOTE : THE ENTIRE FORMAT INCLUDING PARENTHESIS () 789 / IS PASSED TO THE CODE 790 001363 4556 BACKSP, JMS I [CHECKC /CHECK FOR "E" 791 001364 7473 -305 792 001365 5555 JMP I [BADCMD 793 001366 4566 JMS I [EXPR /COMPILE UNIT EXPR 794 001367 5555 JMP I [BADCMD 795 001370 1373 TAD (BAKOPR /OUTPUT BACKSPACE OPERATOR 796 001371 4572 JMS I [OUTWRD 797 001372 5564 JMP I [NEXTST 798 / OUTPUT ROUTINE 799 001373 0055 PAGE 001374 0056 001375 0021 001376 0111 001377 7667 800 001400 7200 OUPTR, OUBUF 801 001401 7377 OCOUNT, -401 802 001402 0000 OUTWRD, 0 /OUTPUT ROUTINE 803 001403 3110 DCA OWTEMP /SAVE WORD 804 001404 1041 TAD NOCODE 805 001405 7640 SZA CLA 806 001406 5602 JMP I OUTWRD /COOL IT IF NOCODE 807 001407 2201 ISZ OCOUNT /TEST FOR BUFFER FULL 808 001410 5216 JMP NOWRIT /STILL SOME ROOM 809 001411 4225 JMS OUDUMP /DUMP THE BUFFER 810 001412 1235 TAD OUBLOK-1 /RESET BUFFER PARAMETERS 811 001413 3200 DCA OUPTR 812 001414 1377 TAD (-400 813 001415 3201 DCA OCOUNT 814 001416 1110 NOWRIT, TAD OWTEMP /PUT WORD 815 001417 6211 CDF 10 816 001420 3600 DCA I OUPTR /INTO BUFFER 817 001421 6201 CDF 818 001422 2200 ISZ OUPTR /MOVE POINTER 819 001423 5602 JMP I OUTWRD 820 001424 0000 OULEN, 0 /NUMBER OF BLOCKS LEFT IN HOLE 821 001425 0000 OUDUMP, 0 /DUMP OUT BUFFER 822 001426 1224 TAD OULEN /ANY ROOM LEFT ? 823 001427 7450 SNA 824 001430 5243 JMP OUERR 825 001431 7001 IAC 826 001432 3224 DCA OULEN 827 001433 4776 JMS I (7607 /CALL SYSTEM HANDLER 828 001434 4210 4210 829 001435 7200 OUBUF 830 001436 0000 OUBLOK, 0 831 001437 5243 JMP OUERR 832 001440 2236 ISZ OUBLOK /INCREMENT BLOCK NUMBER 833 001441 2271 ISZ FILSIZ /ALSO SIZE OF FILE 834 001442 5625 JMP I OUDUMP 835 001443 4544 OUERR, JMS I [MESSAG /ERROR IN WRITING OR OPENING FILE 836 001444 0317 317 837 001445 0306 306 838 / END PASS ONE 839 001446 4556 XEND, JMS I [CHECKC /LOOK FOR "D" 840 001447 7474 -304 841 001450 5555 JMP I [BADCMD 842 001451 4567 JMS I [GETC /END MUST BE ALL 843 001452 5255 JMP ENDX 844 001453 7700 L7700, SMA CLA /NEVER SKIPS 845 001454 5555 JMP I [BADCMD 846 001455 6201 ENDX, CDF 0 847 001456 1375 TAD (ENDOPR /OUTPUT END OF FILE 848 001457 4572 JMS I [OUTWRD 849 001460 4225 JMS OUDUMP /DUMP BUFFER 850 001461 6212 CIF 10 851 001462 4653 JMS I L7700 /LOCK MONITOR IN 852 001463 0010 10 853 001464 6212 CIF 10 854 001465 7201 CLA IAC 855 001466 4766 JMS I L200 /CLOSE TEMP FILE 856 001467 0004 4 857 001470 0055 TMPFIL 858 001471 0000 FILSIZ, 0 859 001472 5243 JMP OUERR 860 001473 6212 CIF 10 861 001474 7201 CLA IAC 862 001475 4766 JMS I L200 /OPEN PASS 2 OUTPUT FILE 863 001476 0003 L3, 3 864 001477 0061 OBLK, TMPFIL+4 /STARTING BLOCK 865 001500 0000 0 /SIZE 866 001501 5243 JMP OUERR /ERROR 867 001502 1374 TAD (COMREG-1 /SAVE IMPORTANT STUFF 868 001503 3010 DCA X10 869 001504 1013 TAD NEXT /ADDR OF FREE SPACE 870 001505 3410 DCA I X10 871 001506 1020 TAD STKLVL /STACK LEVEL 872 001507 3410 DCA I X10 873 001510 1077 TAD OUFILE /START OF PASS1 OUTPUT FILE 874 001511 3410 DCA I X10 875 001512 1271 TAD FILSIZ /ALSO THE SIZE 876 001513 3410 DCA I X10 877 001514 1076 TAD PASS2O /START OF PASS2 OVERLAY 878 001515 3410 DCA I X10 879 001516 1277 TAD OBLK /START OF PASS2 OUTPUT FILE 880 001517 3410 DCA I X10 881 001520 1300 TAD OBLK+1 /AND MAX SIZE 882 001521 3410 DCA I X10 883 001522 1101 TAD PROGNM /POINTER TO PROG NAME 884 001523 3410 DCA I X10 885 001524 1102 TAD ARGLST /AND ARG LIST 886 001525 3410 DCA I X10 887 001526 1103 TAD FUNCTN /AND PROG SWITCH 888 001527 3410 DCA I X10 889 001530 1112 TAD DPUSED /STORE THE DP SWITCH 890 001531 3410 DCA I X10 891 001532 1113 TAD VERS /AND THE VERSION NUMBER 892 001533 3410 DCA I X10 893 001534 6212 CIF 10 894 001535 4766 JMS I L200 /CHAIN TO PASS TWO 895 001536 0006 6 896 001537 0000 PASS2B, 0 /FILLED BY ONCE ONLY CODE FOR PASS 1 897 001540 1373 RETURN, TAD (RETOPR /OUTPUT RETURN CODE 898 001541 4572 JMS I [OUTWRD 899 001542 2065 ISZ DOEND /DO END ILLEGAL HERE 900 001543 5564 JMP I [NEXTST 901 001544 0000 COMARP, 0 /LOOK FOR COMMA OR RIGHT PAREN 902 001545 4567 JMS I [GETC 903 001546 5744 JMP I COMARP 904 001547 1143 TAD [-254 /COMMA ? 905 001550 7450 SNA 906 001551 5356 JMP .+5 907 001552 1276 TAD L3 /RIGHT PAREN ? 908 001553 7640 SZA CLA 909 001554 5744 JMP I COMARP 910 001555 2344 ISZ COMARP 911 001556 2344 ISZ COMARP /COMMA INCR ONCE 912 001557 5744 JMP I COMARP 913 001560 4556 LOGICA, JMS I [CHECKC /LOOK FOR L 914 001561 7464 -314 915 001562 5555 JMP I [BADCMD /NO GOOD 916 001563 4553 JMS I [TYPLST /PROCESS LIST 917 001564 0105 0105 918 001565 0100 0100 919 001566 0200 L200, 0200 /NOP 920 001567 5564 JMP I [NEXTST 921 / EQUIVALENCE (UGH!) 922 001573 0041 PAGE 001574 4577 001575 0044 001576 7607 001577 7400 923 001600 4547 EQUIV, JMS I [IFCHEK /BAD WITH IF 924 001601 4556 JMS I [CHECKC /LOOK FOR "E" 925 001602 7473 -305 926 001603 5555 JMP I [BADCMD 927 001604 4556 EQVLUP, JMS I [CHECKC /LOOK FOR ( 928 001605 7530 -250 929 001606 5275 JMP BADEQU 930 001607 1014 TAD STACK /SAVE STACK POS 931 001610 3017 DCA X17 932 001611 3075 DCA NSLAVE /NUMBER OF SLAVES = 0 933 001612 4542 JMS I [GETSS /GET THE MASTER 934 001613 5275 JMP BADEQU 935 001614 6211 SVMSTR, CDF 10 /1.03/ CHECK FOR ALREADY EQUIVALENCED 936 001615 1445 TAD I TEMP2 /1.03/ 937 001616 6201 CDF /1.03/ 938 001617 0377 AND (200 /1.03/ (AS A SLAVE) 939 001620 7640 SZA CLA /1.03/ 940 001621 5337 JMP DOFUNY /3.01/BACK UP TO ITS MASTER 941 001622 1045 TAD TEMP2 /SAVE THE MASTER TYPE ADDRESS 942 001623 3073 DCA MASTER 943 001624 3336 DCA SFUDGE /3.01/CLEAR OFFSET FUDGE 944 001625 1067 TAD DIMNUM /SAVE THE MASTER SUBSCRIPT 945 001626 3074 DCA MNUM 946 001627 4560 GETSLV, JMS I [COMARP /LOOK FOR , OR ) 947 001630 5275 JMP BADEQU 948 001631 5303 JMP DOSLAV /, 949 001632 1075 TAD NSLAVE /COMPLEMENT THE NUMBER OF SLAVES 950 001633 7450 SNA 951 001634 5270 JMP ENDGRP /NO SLAVES 952 001635 7041 CIA 953 001636 3075 DCA NSLAVE 954 001637 1017 TAD X17 /RESTACK THE STORE 955 001640 3014 DCA STACK 956 001641 1417 EQLOOP, TAD I X17 /GET NEXT SUBSCRIPT NUMBER 957 001642 3044 DCA TEMP 958 001643 1417 TAD I X17 /AND NEXT TYPE WORD ADDRESS 959 001644 3045 DCA TEMP2 960 001645 6211 CDF 10 961 001646 1445 TAD I TEMP2 /LOOK AT TYPE WORD 962 001647 1377 TAD (200 /SET EQUIVALENCE BIT 963 001650 3445 DCA I TEMP2 964 001651 2045 ISZ TEMP2 /MOVE TO EQUIVALENCE/DIMENSION PTR 965 001652 1445 TAD I TEMP2 /PROPAGATE DIMENSION POINTER 966 001653 3413 DCA I NEXT /TO EQUIVALENCE INFO BLOCK 967 001654 1013 TAD NEXT /NOW STORE EQ INFO BLK ADDRESS 968 001655 3445 DCA I TEMP2 /INTO EQ-DIM POINTER WORD 969 001656 7240 CLA CMA 970 001657 1073 TAD MASTER /STORE S.T. ADDR OF MASTER 971 001660 3413 DCA I NEXT /INTO THE EQUIVALENCE BLOCK 972 001661 1074 TAD MNUM /OUTPUT NUMBERS 973 001662 3413 DCA I NEXT 974 001663 1044 TAD TEMP 975 001664 3413 DCA I NEXT 976 001665 6201 CDF 977 001666 2075 ISZ NSLAVE /ANY MORE SLAVES ? 978 001667 5241 JMP EQLOOP /YES, EQUIVALENCE NOT YET ATTAINED 979 001670 4567 ENDGRP, JMS I [GETC /FINI, ALL VARIABLES ARE CREATED 980 001671 5564 JMP I [NEXTST /EQUIVALENCED 981 001672 1376 TAD (-254 /IS NEXT CHAR A COMMA ? 982 001673 7650 SNA CLA 983 001674 5204 JMP EQVLUP /IF YES, DO NEXT GROUP 984 001675 4576 BADEQU, JMS I [ERMSG /SYNTAX ERROR IN EQUIVALENCE 985 001676 2123 2123 986 001677 5564 JMP I [NEXTST 987 001700 4576 EQUCOM, JMS I [ERMSG /MULTIPLE LEVELS OF EQUIVALENCE OR 988 001701 2114 2114 /MORE THAN ONE COMMON VARIABLE 989 001702 5564 JMP I [NEXTST 990 001703 2075 DOSLAV, ISZ NSLAVE /ANOTHER SLAVE VARIABLE 991 001704 4542 JMS I [GETSS /GET THE GOODS 992 001705 5275 JMP BADEQU 993 001706 6211 CDF 10 994 001707 1445 TAD I TEMP2 /LOOK AT THE TYPE 995 001710 7700 SMA CLA 996 001711 5323 JMP SVSLAV /IT ISN'T IN COMMON 997 001712 1473 TAD I MASTER /LOOK AT THE MASTERS TYPE 998 001713 7710 SPA CLA 999 001714 5300 JMP EQUCOM /MASTER IS IN COMMON TOO .. BAD 1000 001715 6201 CDF 1001 001716 1074 TAD MNUM /SAVE THE MAGIC NUMBER 1002 001717 4561 JMS I [PUSH 1003 001720 1073 TAD MASTER 1004 001721 4561 JMS I [PUSH /AND THE S.T. ADDRESS 1005 001722 5214 JMP SVMSTR /NOW GO MAKE THE NEW ONE MASTER 1006 001723 1445 SVSLAV, TAD I TEMP2 /1.03/ PREVIOUSLY EQUIVALENCED ? 1007 001724 0377 AND (200 /1.03/ 1008 001725 7640 SZA CLA /1.03/ 1009 001726 5300 JMP EQUCOM /1.03/ YES, ERROR 1010 001727 1067 TAD DIMNUM /SAVE THE NEW SLAVE 1011 001730 1336 TAD SFUDGE /3.01/ADD OFFSET FUDGE 1012 001731 6201 CDF 1013 001732 4561 JMS I [PUSH 1014 001733 1045 TAD TEMP2 1015 001734 4561 JMS I [PUSH 1016 001735 5227 JMP GETSLV /AND GO GET THE NEXT SLAVE 1017 1018 001736 0000 SFUDGE, 0 1019 /ROUTINE TO HANDLE TRIVIAL CASES OF EQUIVALENCE CHAINING 1020 /THIS WHOLE PAGE IS 3.01 1021 1022 001737 7201 DOFUNY, CLA IAC 1023 001740 1045 TAD TEMP2 1024 001741 3073 DCA MASTER /GET POINTER TO EQUIVALENCE BLOCK 1025 001742 6211 CDF 10 1026 001743 1473 TAD I MASTER 1027 001744 3012 DCA X12 1028 001745 7201 CLA IAC 1029 001746 1412 TAD I X12 /GET ADDRESS OF "REAL" MASTER'S 1030 001747 3073 DCA MASTER /TYPE WORD 1031 001750 1412 TAD I X12 1032 001751 1067 TAD DIMNUM 1033 001752 3074 DCA MNUM /OFFSETS ARE ADDITIVE 1034 001753 1412 TAD I X12 1035 001754 3336 DCA SFUDGE /SAVE OTHER HALF OF OFFSET TO ADD 1036 001755 6201 CDF /TO SLAVES 1037 001756 5227 JMP GETSLV / (PRAY) 1038 001776 7524 PAGE 001777 0200 1039 / EQUIVALENCE (UGH!) 1040 002000 1420 O1420, 1420 /1.03/ MUST BE FIRST ON PAGE 1041 002001 0000 GETSS, 0 /GET THE LINEARIZED SUBSCRIPT 1042 002002 3067 DCA DIMNUM 1043 002003 4577 JMS I [GETNAM /GET THE VARIABLE 1044 002004 5601 JMP I GETSS 1045 002005 4554 JMS I [LOOKUP 1046 002006 7001 IAC /ADDRESS OF TYPE WORD 1047 002007 3045 DCA TEMP2 1048 002010 6211 CDF 10 1049 002011 1445 TAD I TEMP2 1050 002012 6201 CDF 1051 002013 0200 O200, AND O1420 /1.03/ EXT, STMTFUN, SUBARG ? 1052 002014 7640 SZA CLA 1053 002015 5601 JMP I GETSS 1054 002016 1014 TAD STACK 1055 002017 3012 DCA X12 /SAVE STACK POSITION 1056 002020 3044 DCA TEMP /ZERO NUMBER OF DIMENSIONS 1057 002021 1045 TAD TEMP2 1058 002022 7001 IAC 1059 002023 3071 DCA EQTEMP /ADDRESS OF EQ-DIM POINTER 1060 002024 4567 JMS I [GETC 1061 002025 5601 JMP I GETSS 1062 002026 1377 TAD (-250 /LOOK FOR ( 1063 002027 7650 SNA CLA 1064 002030 5233 JMP DIMGET-1 /OK 1065 002031 4557 JMS I [BACK1 1066 002032 5326 JMP RGETSS 1067 002033 3067 DCA DIMNUM /DATA CALLS GETSS WITH AC = 7777 1068 002034 4776 DIMGET, JMS I (SMLNUM /GET A SUBSCRIPT 1069 002035 7240 CLA CMA 1070 002036 1054 TAD EXPON /SS-1 1071 002037 4561 JMS I [PUSH /SAVE SS 1072 002040 2044 ISZ TEMP /BUMP COUNT OF SS 1073 002041 4560 JMS I [COMARP /LOOK FOR , OR ) 1074 002042 5601 JMP I GETSS 1075 002043 5234 JMP DIMGET /, 1076 002044 7201 CLA IAC /) 1077 002045 3070 DCA DPRDCT /SET DIMENSION PRODUCT TO 1 1078 002046 1012 TAD X12 /RESTORE STACK POSITION 1079 002047 3014 DCA STACK 1080 002050 1044 TAD TEMP /COMPLEMENT NUMBER OF SS 1081 002051 7041 CIA 1082 002052 3044 DCA TEMP 1083 002053 6211 CDF 10 1084 002054 7132 CLL CML RTR /2000 1085 002055 0445 AND I TEMP2 /HAS VARIABLE BEEN DIMENSIONED ? 1086 002056 7650 SNA CLA 1087 002057 5601 JMP I GETSS /NO, THATS BAD 1088 002060 1471 TAD I EQTEMP /GET ADDRESS OF DIMENSION BLOCK 1089 002061 3071 DCA EQTEMP 1090 002062 1471 TAD I EQTEMP /IS NUMBER OF DIMENSIONS 1091 002063 1044 TAD TEMP /EQUAL TO NUMBER OF SUBSCRIPTS ? 1092 002064 7640 SZA CLA 1093 002065 5330 JMP TRY1SS /1.03/ SEE IF ITS ONE SUBSCRIPT 1094 002066 7301 CLA CLL IAC /+1 V3C 1095 002067 1471 TAD I EQTEMP /+ NUMBER OF DIMENSIONS 1096 002070 1071 TAD EQTEMP /+ ADDRESS OF COUNT WORD 1097 002071 3071 DCA EQTEMP /GIVES ADDRESS OF NEXT TO LAST DIMENSION 1098 002072 6201 LINEAR, CDF 1099 002073 1412 TAD I X12 /GET NEXT SS - 1 1100 002074 3072 DCA MQ 1101 002075 1070 TAD DPRDCT /MULTIPLY BY THE DIMENSION PRODUCT 1102 002076 4340 JMS MUL12 /WHERE D.P. = 1,D1,D1D2,D1D2D3,... 1103 002077 1067 TAD DIMNUM /ACCUMULATE THE SUM 1104 002100 3067 DCA DIMNUM 1105 002101 6211 CDF 10 1106 002102 1471 TAD I EQTEMP /ADDR OF LITERAL 1107 002103 7001 IAC 1108 002104 3011 DCA X11 /WORKING POINTER TO VALUE 1109 002105 1411 TAD I X11 /GET DIMENSION INTO FAC 1110 002106 3022 DCA WORD1 1111 002107 1411 TAD I X11 1112 002110 3023 DCA WORD2 1113 002111 1411 TAD I X11 1114 002112 3024 DCA WORD3 1115 002113 6201 CDF 1116 002114 4541 JMS I [FIXNUM /GO FIX IT 1117 002115 3072 DCA MQ 1118 002116 1070 TAD DPRDCT /OF THE D.P. SERIES (ABOVE) 1119 002117 4340 JMS MUL12 1120 002120 3070 DCA DPRDCT 1121 002121 7201 CLA IAC /V3C BUMP POSITION POINTER 1122 002122 1071 TAD EQTEMP 1123 002123 3071 DCA EQTEMP 1124 002124 2044 ISZ TEMP /ANY MORE SS ? 1125 002125 5272 JMP LINEAR /YES 1126 002126 2201 RGETSS, ISZ GETSS 1127 002127 5601 JMP I GETSS 1128 002130 7201 TRY1SS, CLA IAC /1.03/ 1129 002131 1044 TAD TEMP /1.03/ ONLY ONE SS ? 1130 002132 7640 SZA CLA /1.03/ 1131 002133 5601 JMP I GETSS /1.03/ MORE, THATS NO GOOD 1132 002134 6201 CDF /1.03/ 1133 002135 1412 TAD I X12 /1.03/ GET THE SUBSCRIPT 1134 002136 3067 DCA DIMNUM /1.03/ AND RETURN IT 1135 002137 5326 JMP RGETSS /1.03/ 1136 002140 0000 MUL12, 0 /12 BIT UNSIGNED MULTIPLY 1137 002141 3032 DCA OP2 /SAVE OPERAND 1138 002142 1375 TAD (-15 /SET SHIFT COUNT 1139 002143 3034 DCA SC 1140 002144 5353 JMP STMUL 1141 002145 1033 M12LUP, TAD AC 1142 002146 7420 SNL 1143 002147 5352 JMP .+3 1144 002150 7100 CLL 1145 002151 1032 TAD OP2 1146 002152 7010 RAR 1147 002153 3033 STMUL, DCA AC 1148 002154 1072 TAD MQ 1149 002155 7010 RAR 1150 002156 3072 DCA MQ 1151 002157 2034 ISZ SC 1152 002160 5345 JMP M12LUP 1153 002161 1072 TAD MQ /RETURN VALUE 1154 002162 5740 JMP I MUL12 1155 AC=OP3 1156 SC=OP4 1157 / IF STATEMENTS 1158 002175 7763 PAGE 002176 5200 002177 7530 1159 002200 4566 IF, JMS I [EXPR /COMPILE CONDITION EXPRESSION 1160 002201 5555 JMP I [BADCMD 1161 002202 4573 JMS I [STMNUM /IS IT ARITHMETIC IF ? 1162 002203 5224 JMP LOGIF 1163 002204 1377 TAD (ARTHIF /START IF COMMAND 1164 002205 4572 JMS I [OUTWRD 1165 002206 7146 CLL CMA RTL 1166 002207 3044 DCA TEMP 1167 002210 2065 ISZ DOEND /DO END ILLEGAL HERE 1168 002211 5217 JMP IFLABL /GET IF LABELS 1169 002212 4556 IFLOOP, JMS I [CHECKC /LOOK FOR , 1170 002213 7524 -254 1171 002214 5564 JMP I [NEXTST 1172 002215 4573 JMS I [STMNUM /GET NEXT STMT NUMBER 1173 002216 5235 JMP BADIF 1174 002217 1052 IFLABL, TAD SNUM /OUTPUT LABEL 1175 002220 4572 JMS I [OUTWRD 1176 002221 2044 ISZ TEMP 1177 002222 5212 JMP IFLOOP 1178 002223 5564 JMP I [NEXTST 1179 002224 4231 LOGIF, JMS IFCHEK /IF()IF()... NOT LEGAL 1180 002225 2053 ISZ IFSWIT /CLEAR IF SWITCH 1181 002226 1376 TAD (LIFBGN /START LOGICAL IF 1182 002227 4572 JMS I [OUTWRD 1183 002230 5775 JMP I (COMPIL /COMPILE THE STATEMENT 1184 DOSWT, 1185 002231 0000 IFCHEK, 0 /CHECK IF SWITCH 1186 002232 1053 TAD IFSWIT 1187 002233 7650 SNA CLA 1188 002234 5631 JMP I IFCHEK 1189 002235 4576 BADIF, JMS I [ERMSG 1190 002236 1111 1111 1191 002237 5564 JMP I [NEXTST 1192 / CALL STMT 1193 002240 4571 CALL, JMS I [SAVECP /SAVE CHAR POS 1194 002241 4577 JMS I [GETNAM /GET SUBROUTINE NAME 1195 002242 5275 JMP BADCAL /NO NAME HERE IS BAD 1196 002243 4554 JMS I [LOOKUP /GET ADDRESS OF TYPE WORD 1197 002244 7001 IAC 1198 002245 3044 DCA TEMP 1199 002246 6211 CDF 10 1200 002247 1444 TAD I TEMP /LOOK AT TYPE 1201 002250 0374 AND (6640 /ANYTHING BUT EXT OR ARG ? 1202 002251 7640 SZA CLA 1203 002252 5275 JMP BADCAL /YES, BAD 1204 002253 1444 TAD I TEMP /SET EXT BIT 1205 002254 0373 AND (137 /LEAVE TYPE AND ARG BITS 1206 002255 1372 TAD (1000 1207 002256 3444 DCA I TEMP 1208 002257 6201 CDF 1209 002260 4565 JMS I [RESTCP /RESTORE CHAR POS 1210 002261 7201 CLA IAC /SIGNAL THAT THIS IS A CALL 1211 002262 4570 JMS I [LEXPR /COMPILE IT 1212 002263 0070 XSTORE, DOSTOR /DON'T WORRY VIRGINIA, ITS A NOP 1213 002264 1110 TAD OWTEMP /WHAT WAS THE LAST THING OUT ? 1214 002265 7100 CLL 1215 002266 1371 TAD (-63 /IF LESS THAN 63 1216 002267 7620 SNL CLA 1217 002270 5564 JMP I [NEXTST /IT WAS AN ARG COUNT 1218 002271 1140 TAD [ARGSOP /OTHERWISE IT WAS AN ARG LESS CALL 1219 002272 4572 JMS I [OUTWRD /SO TELL PASS 2 ABOUT IT 1220 002273 4572 JMS I [OUTWRD 1221 002274 5564 JMP I [NEXTST 1222 002275 4576 BADCAL, JMS I [ERMSG 1223 002276 2316 2316 1224 002277 5564 JMP I [NEXTST 1225 / DO DAH, DO DAH 1226 002300 4547 DO, JMS I [IFCHEK /IF(...)DO IS ILLEGAL 1227 002301 4573 JMS I [STMNUM /LOOK FOR ENDING STMT NUMBER 1228 002302 5555 JMP I [BADCMD 1229 002303 4577 JMS I [GETNAM /LOOKUP INDEX VARIABLE 1230 002304 5555 JMP I [BADCMD 1231 002305 4554 JMS I [LOOKUP 1232 002306 3106 DCA DOINDX 1233 002307 4556 JMS I [CHECKC /LOOK FOR = 1234 002310 7503 -275 1235 002311 5555 JMP I [BADCMD 1236 002312 2065 ISZ DOEND /CAN'T END DO LOOP ON A DO 1237 002313 4324 JMS DOSTUF /GET DO PARAMETERS 1238 002314 5361 JMP BADDO 1239 002315 1106 TAD DOINDX /PUSH DO INDEX 1240 002316 4561 JMS I [PUSH 1241 002317 1052 TAD SNUM /PUSH ENDING STMT NUMBER 1242 002320 4561 JMS I [PUSH 1243 002321 1014 TAD STACK 1244 002322 3020 DCA STKLVL /SAVE NEW STACK BASE 1245 002323 5564 JMP I [NEXTST 1246 1247 002324 0000 DOSTUF, 0 /SUBR FOR DO LOOP STUFF 1248 002325 4572 JMS I [OUTWRD /OUTPUT DO INDEX 1249 002326 1106 TAD DOINDX 1250 002327 4572 JMS I [OUTWRD 1251 002330 4566 JMS I [EXPR /GET EXPR FOR INITIAL VALUE 1252 002331 5724 JMP I DOSTUF 1253 002332 1263 TAD XSTORE /YES 1254 002333 4572 JMS I [OUTWRD 1255 002334 4556 JMS I [CHECKC /LOOK FOR COMMA 1256 002335 7524 N254, -254 1257 002336 5724 JMP I DOSTUF 1258 002337 4566 JMS I [EXPR /GET EXPR FOR FINAL VALUE 1259 002340 5724 JMP I DOSTUF 1260 002341 4567 JMS I [GETC /LOOK FOR A COMMA 1261 002342 5355 JMP STEP1 /USE STEP OF 1 1262 002343 1335 TAD N254 1263 002344 7640 SZA CLA 1264 002345 5354 JMP STEP1-1 1265 002346 4566 JMS I [EXPR /GET EXPR FOR STEP 1266 002347 5724 JMP I DOSTUF 1267 002350 2324 DORET, ISZ DOSTUF 1268 002351 1370 TAD (DOBEGN /DO BEGIN OPERATOR 1269 002352 4572 JMS I [OUTWRD 1270 002353 5724 JMP I DOSTUF 1271 002354 4557 JMS I [BACK1 /PUT BACK NON , (OFFICER BELOW LT.) 1272 002355 4572 STEP1, JMS I [OUTWRD /OUTPUT A PUSH 1.0 1273 002356 1367 TAD (ONE 1274 002357 4572 JMS I [OUTWRD 1275 002360 5350 JMP DORET /FINISH DO STUFF 1276 002361 4576 BADDO, JMS I [ERMSG /BAD DO COMMAND 1277 002362 0417 0417 1278 002363 5564 JMP I [NEXTST 1279 002364 4576 BDERR, JMS I [ERMSG /ILLEGAL IN BLOCK DATA 1280 002365 0223 0223 1281 002366 5564 JMP I [NEXTST 1282 / TYPE STATEMENT SUBROUTINE 1283 002367 0063 PAGE 002370 0051 002371 7715 002372 1000 002373 0137 002374 6640 002375 0321 002376 0050 002377 0047 1284 002400 0000 TYPLST, 0 /HANDLE LIST FOR TYPE DELL 1285 002401 1014 TAD STACK 1286 002402 3012 DCA X12 /SAVE STACK POINTER 1287 002403 3043 DCA NUMELM 1288 002404 1600 TAD I TYPLST /GET SET BITS 1289 002405 3104 DCA SETBIT 1290 002406 2200 ISZ TYPLST 1291 002407 1600 TAD I TYPLST /AND ILLEGAL BITS 1292 002410 3105 DCA BADBIT 1293 002411 2200 ISZ TYPLST 1294 002412 4577 LSTLUP, JMS I [GETNAM /GET VARIABLE 1295 002413 5326 JMP BADLST 1296 002414 4554 JMS I [LOOKUP /S.T. SEARCH 1297 002415 3107 DCA TLTEMP /SAVE VAR ADDRESS 1298 002416 1107 TAD TLTEMP /PUT IT ON THE STACK 1299 002417 2107 ISZ TLTEMP /NOW POINT TO TYPE WORD 1300 002420 4561 JMS I [PUSH /INCREMENT NUMBER 1301 002421 2043 ISZ NUMELM /INCREMENT NUMBER 1302 002422 6211 CDF 10 1303 002423 1507 TAD I TLTEMP /COMPARE TYPES 1304 002424 0105 AND BADBIT /CHECK FOR ILLEGAL BITS 1305 002425 7640 SZA CLA 1306 002426 5331 JMP TYPAGN /ATTEMPT TO RE-TYPE 1307 002427 1104 TAD SETBIT /GET SET BITS 1308 002430 7040 CMA /GENERATE MASK 1309 002431 0507 AND I TLTEMP 1310 002432 1104 TAD SETBIT /DO THE SET 1311 002433 3507 DCA I TLTEMP /BUT NOT DIMENSION BIT 1312 002434 6201 CDF 1313 002435 4567 GETDIM, JMS I [GETC 1314 002436 5343 JMP EOL 1315 002437 1377 TAD (-250 /LOOK FOR ( 1316 002440 7440 SZA 1317 002441 5337 JMP NOTDIM /NOT DIMENSIONED 1318 002442 7201 CLA IAC /INITIALIZE MAGIC NUMBER 1319 002443 3100 DCA DSERES 1320 002444 7201 CLA IAC 1321 002445 3070 DCA DPRDCT /AND DIMENSION PRODUCT 1322 002446 1014 TAD STACK 1323 002447 3017 DCA X17 /SAVE STACK POINTER 1324 002450 3045 DCA TEMP2 /DIMENSION COUNT=0 1325 002451 5776 JMP I (DIMLUP /GET DIMENSIONS 1326 002452 1017 PUTDIM, TAD X17 1327 002453 3014 DCA STACK /RESTORE STACK 1328 002454 6211 CDF 10 1329 002455 1375 TAD (3400 /DIM, EXT, SF ? 1330 002456 0507 AND I TLTEMP 1331 002457 7640 SZA CLA 1332 002460 5334 JMP DIMAGN /ATTEMPT TP RE-DIMENSION 1333 002461 7132 CLL CML RTR 1334 002462 1507 TAD I TLTEMP /SET DIMENSION BIT 1335 002463 3507 DCA I TLTEMP 1336 002464 2107 ISZ TLTEMP 1337 002465 1045 TAD TEMP2 /NUMBER OF DIMS. 1338 002466 3413 DCA I NEXT 1339 002467 1507 TAD I TLTEMP /GET EQUIVALENCE POINTER 1340 002470 7440 SZA 1341 002471 3107 DCA TLTEMP 1342 002472 1013 TAD NEXT /STORE POINTER TO 1343 002473 3507 DCA I TLTEMP /DIMENSION INFORMATION 1344 002474 1070 TAD DPRDCT /SAVE DIM PRODUCT 1345 002475 3413 DCA I NEXT 1346 002476 1100 TAD DSERES /AND MAGIC NUMBER 1347 002477 3413 DCA I NEXT 1348 002500 3413 DCA I NEXT /ZERO MAGIC LITERAL POINTER 1349 002501 1045 TAD TEMP2 1350 002502 7041 CIA 1351 002503 3045 DCA TEMP2 /LEAVE LAST DIM 1352 002504 6201 CDF 1353 002505 1417 MOVDIM, TAD I X17 /1.03/ GET THE DIMENSION 1354 002506 6211 CDF 10 /1.03/ 1355 002507 3413 DCA I NEXT /1.03/ INTO THE DIMENSION INFO BLOCK 1356 002510 6201 CDF /1.03/ 1357 002511 2045 ISZ TEMP2 /1.03/ 1358 002512 5305 JMP MOVDIM /1.03/ 1359 002513 4567 NEXTEL, JMS I [GETC /LOOK FOR , 1360 002514 5343 JMP TLRETN 1361 002515 1374 TAD (-254 1362 002516 7650 SNA CLA 1363 002517 5212 JMP LSTLUP /OK, GET NEXT MEMBER 1364 002520 4557 ENDLST, JMS I [BACK1 1365 002521 2200 ISZ TYPLST 1366 002522 5600 JMP I TYPLST 1367 002523 4576 BADDIM, JMS I [ERMSG /DIMENSION ERROR 1368 002524 0204 0204 1369 002525 5600 JMP I TYPLST 1370 002526 4576 BADLST, JMS I [ERMSG /ERROR IN LIST 1371 002527 2404 2404 1372 002530 5600 JMP I TYPLST 1373 002531 4576 TYPAGN, JMS I [ERMSG 1374 002532 2224 2224 /RE-TYPE 1375 002533 5235 JMP GETDIM 1376 002534 4576 DIMAGN, JMS I [ERMSG /ATTEMPT TO RE DIMENSION 1377 002535 2204 2204 1378 002536 5313 JMP NEXTEL 1379 002537 1373 NOTDIM, TAD (250-254 /IS IT A COMMA? 1380 002540 7640 SZA CLA 1381 002541 5320 JMP ENDLST 1382 002542 5212 JMP LSTLUP /GET NEXT ELEMENT 1383 EOL, 1384 002543 2200 TLRETN, ISZ TYPLST 1385 002544 5600 JMP I TYPLST /TAKE OK EXIT 1386 002545 4556 ENDFIL, JMS I [CHECKC /LOOK FOR "E" 1387 002546 7473 -305 1388 002547 5555 JMP I [BADCMD 1389 002550 4566 JMS I [EXPR /COMPILE UNIT 1390 002551 5555 JMP I [BADCMD 1391 002552 1372 TAD (ENDFOP /OUTPUT ENDFILE OPERATOR 1392 002553 4572 JMS I [OUTWRD 1393 002554 5564 JMP I [NEXTST 1394 002555 4556 DOUBLE, JMS I [CHECKC /LOOK FOR N 1395 002556 7462 -316 1396 002557 5555 JMP I [BADCMD 1397 1398 002560 4547 JMS I [IFCHEK /NOT ON AN IF 1399 002561 4553 JMS I [TYPLST /PROCESS LIST 1400 002562 0104 0104 1401 002563 0100 0100 1402 002564 7000 NOP 1403 002565 7201 CLA IAC /SET THE DP SWITCH 1404 002566 3112 DCA DPUSED 1405 002567 5564 JMP I [NEXTST 1406 / SYMBOL TABLE LOOKERUPPER 1407 002572 0052 PAGE 002573 7774 002574 7524 002575 3400 002576 3460 002577 7530 1408 002600 0000 LOOKUP, 0 /SYMBOL TABLE LOOKUP FOR VARIABLE ENTRY 1409 002601 1041 TAD NOCODE /IS THIS IN NOCODE MODE ? 1410 002602 7640 SZA CLA 1411 002603 5600 JMP I LOOKUP /YES, DO NOTHING 1412 002604 1021 TAD BUCKET 1413 002605 1377 TAD (ALIST-1 /GET START OF CORRECT BUCKET 1414 002606 6211 CDF 10 1415 002607 3300 LOOK, DCA OLDN3 /SAVE ADDR OF PREVIOUS ENTRY 1416 002610 1700 TAD I OLDN3 /GET ADDR OF NEXT ENTRY 1417 002611 7450 SNA 1418 002612 5244 JMP HOOKIN /NO NEXT ENTRY, ATTACH NEW ENTRY 1419 002613 1376 TAD (2 /SKIP OVER TYPE AND DIM POINTER 1420 002614 3010 DCA X10 1421 002615 1375 TAD (NAME1 1422 002616 3302 DCA PNAME /SETUP POINTER TO NAME 1423 002617 6201 CDF 1424 002620 1702 CHKNAM, TAD I PNAME /GET WORD NAME 1425 002621 7141 CIA CLL 1426 002622 6211 CDF 10 1427 002623 1410 TAD I X10 /COMPARE WITH THIS ENTRY 1428 002624 7640 SZA CLA 1429 002625 5240 JMP NOTSAM /DIFFERENT 1430 002626 6201 CDF 1431 002627 1702 TAD I PNAME 1432 002630 0145 AND [77 /WAS THIS THE END OF NAME? 1433 002631 2302 ISZ PNAME 1434 002632 7640 SZA CLA 1435 002633 5220 JMP CHKNAM /NO, KEEP COMPARING 1436 002634 6211 CDF 10 1437 002635 1700 RLOOKU, TAD I OLDN3 /GET ADDR OF START OF ENTRY 1438 002636 6201 CDF /AND RETURN IT IN THE AC 1439 002637 5600 JMP I LOOKUP /RETURN ADDR OF SYMBOL 1440 002640 7430 NOTSAM, SZL 1441 002641 5244 JMP HOOKIN /NEW SYMBOL .NOT. 1551 003022 5225 JMP .+3 /.TRUE. 1552 003023 1373 TAD (NOTOPR /FALSE=.NOT.TRUE 1553 003024 4561 JMS I [PUSH 1554 003025 4572 JMS I [OUTWRD 1555 003026 1372 TAD (TRUE 1556 003027 4572 JMS I [OUTWRD 1557 003030 5771 JMP I (NOSS 1558 003031 1021 CKNOT, TAD BUCKET 1559 003032 1370 TAD (-16 1560 003033 7640 SZA CLA 1561 003034 5243 JMP OPRAND /MIGHT BE LITERAL .XXXXXX 1562 003035 1373 TAD (NOTOPR /PUSH .NOT. OPERATOR 1563 003036 4561 JMS I [PUSH 1564 003037 5204 JMP UNOPR 1565 003040 1367 UMINUS, TAD (UMOPR /PUSH UNARY MINUS 1566 003041 4561 JMS I [PUSH 1567 003042 5204 JMP UNOPR 1568 003043 4557 OPRAND, JMS I [BACK1 /PUT BACK NON UNARY OPERATOR 1569 003044 4577 JMS I [GETNAM /LOOK FOR VARIABLE REFERENCE 1570 003045 5250 JMP NOTVAR /NOPE. 1571 003046 4554 JMS I [LOOKUP /SYMBOL TABLE SEARCH 1572 003047 5537 JMP I [OPR8R /GO OUTPUT PUSH-VAR 1573 003050 4536 NOTVAR, JMS I [NUMBER /LOOK FOR A LITERAL 1574 003051 5276 JMP NOTNUM /NO KIND OF NUMBER 1575 003052 5264 JMP HOLCHK /INTEGER 1576 003053 5260 JMP DPLIT /DOUBLE PRECISION 1577 003054 4535 FPLIT, JMS I [LUKUP2 /FLOATING, ENTER INTO TABLE 1578 003055 0056 FPLIST 1579 003056 7775 -3 1580 003057 5534 JMP I [OPR8RL /PUSH VARIABLE, NO SUBSCRIPTS 1581 003060 4535 DPLIT, JMS I [LUKUP2 /DOUBLE-PREC., ENTER IN TABLE 1582 003061 0057 DPLIST 1583 003062 7772 -6 1584 003063 5534 JMP I [OPR8RL 1585 003064 4567 HOLCHK, JMS I [GETC /IS THIS HOLLERITH? 1586 003065 5272 JMP .+5 1587 003066 1366 TAD (-310 1588 003067 7650 SNA CLA 1589 003070 5765 JMP I (HFIELD /YES 1590 003071 4557 JMS I [BACK1 1591 003072 4535 JMS I [LUKUP2 /FIND THE ENTRY 1592 003073 0060 INTLST 1593 003074 7775 -3 1594 003075 5534 JMP I [OPR8RL 1595 003076 4567 NOTNUM, JMS I [GETC /LOOK FOR COMPLEX LITERAL 1596 003077 5356 JMP MISARG /MISSING OPERAND 1597 003100 1364 TAD (-250 /OPEN PAREN? 1598 003101 7440 SZA 1599 003102 5763 JMP QUOTE /GO LOOK FOR A STRING 1600 003103 4571 JMS I [SAVECP /SAVE CHAR POSITION 1601 003104 4536 JMS I [NUMBER /GET REAL PART 1602 003105 5762 JMP I (NCMPLX /NO NUMBER 1603 003106 7410 SKP /INTEGER-OK 1604 003107 5762 JMP I (NCMPLX /DOUBLE-NOT LEGAL FOR COMPLEX 1605 003110 4556 JMS I [CHECKC /LOOK FOR , 1606 003111 7524 -254 1607 003112 5762 JMP I (NCMPLX /NO, CAN'T BE COMPLEX LIT. 1608 003113 1022 TAD WORD1 /SAVE REAL PART 1609 003114 3044 DCA TEMP 1610 003115 1023 TAD WORD2 1611 003116 3045 DCA TEMP2 1612 003117 1024 TAD WORD3 1613 003120 3040 DCA CHAR 1614 003121 4536 JMS I [NUMBER /GET IMAGINARY PART 1615 003122 5353 JMP BADCL /NOT THERE, BAD 1616 003123 7410 SKP /I 1617 003124 5353 JMP BADCL /D-BAD 1618 003125 4556 JMS I [CHECKC /LOOK FOR ) 1619 003126 7527 -251 1620 003127 5353 JMP BADCL /NO ) BAD 1621 003130 1022 TAD WORD1 /PUT IMAGINARY PART 1622 003131 3025 DCA WORD4 1623 003132 1023 TAD WORD2 /INTO SECOND AHLF 1624 003133 3026 DCA WORD5 1625 003134 1024 TAD WORD3 /OF COMPLEX LITERAL 1626 003135 3027 DCA WORD6 1627 003136 1044 TAD TEMP /NOW RESTORE REAL PART 1628 003137 3022 DCA WORD1 1629 003140 1045 TAD TEMP2 1630 003141 3023 DCA WORD2 1631 003142 1040 TAD CHAR 1632 003143 3024 DCA WORD3 1633 003144 7144 CLL CMA RAL /REMOVE CHAR POS FROM STACK 1634 003145 1014 TAD STACK /SINCE OTHERWISE IT GOES OUT 1635 003146 3014 DCA STACK /AS CODE 1636 003147 4535 JMS I [LUKUP2 /WHICH WE WILL NOW SEARCH 1637 003150 0061 CMPLST /USE COMPLEX LIST 1638 003151 7772 -6 1639 003152 5534 JMP I [OPR8RL 1640 003153 4576 BADCL, JMS I [ERMSG /BAD COMPLEX LITERAL 1641 003154 0314 0314 1642 003155 5533 JMP I [BADEXP 1643 003156 4576 MISARG, JMS I [ERMSG /MISSING OPERAND 1644 003157 1517 1517 1645 003160 5533 JMP I [BADEXP 1646 / EXPRESSION ANALYZER 1647 003162 3267 PAGE 003163 3342 003164 7530 003165 3220 003166 7470 003167 4414 003170 7762 003171 3447 003172 0102 003173 4412 003174 4044 003175 7777 003176 7776 003177 7525 1648 003200 0000 HQUOTE, 0 /SUBR FOR QUOTE STRINGS 1649 003201 4546 JMS I [GETCWB /GET CHAR 1650 003202 5247 JMP BADH 1651 003203 1132 TAD [-247 /IS IT ' 1652 003204 7440 SZA 1653 003205 5215 JMP NOTQ2 /NO 1654 003206 4546 JMS I [GETCWB 1655 003207 5252 JMP LUHOL 1656 003210 1132 TAD [-247 /LOOK FOR '' 1657 003211 7650 SNA CLA 1658 003212 5215 JMP NOTQ2 /REPLACE '' BY ' 1659 003213 4557 JMS I [BACK1 /ITS END OF STRING 1660 003214 5252 JMP LUHOL 1661 003215 1131 NOTQ2, TAD [247 /RESTORE CHAR 1662 003216 0145 AND [77 1663 003217 5600 JMP I HQUOTE 1664 003220 4541 HFIELD, JMS I [FIXNUM /INTEGERIZE NUMBER 1665 003221 7450 SNA 1666 003222 5247 JMP BADH /ZERO IS BAD 1667 003223 7140 CMA CLL 1668 003224 3044 DCA TEMP 1669 003225 1377 TAD (HCOUNT /SET SUBR POINTER 1670 003226 3051 DOHOL, DCA HCHAR 1671 003227 1376 TAD (-MAXHOL /SET COUNTER FOR MAX 1672 003230 3266 DCA HOLCTR 1673 003231 1375 TAD (NAME1 /SET UP NAME POINTER 1674 003232 3045 DCA TEMP2 1675 003233 3445 PAKHOL, DCA I TEMP2 /PACK HOLLERITH STRING 1676 003234 4451 JMS I HCHAR 1677 003235 7106 CLL RTL 1678 003236 7006 RTL 1679 003237 7006 RTL 1680 003240 3445 DCA I TEMP2 1681 003241 4451 JMS I HCHAR 1682 003242 1445 TAD I TEMP2 1683 003243 3445 DCA I TEMP2 1684 003244 2045 ISZ TEMP2 1685 003245 2266 ISZ HOLCTR /CHECK FOR TOO MANY 1686 003246 5233 JMP PAKHOL 1687 003247 4576 BADH, JMS I [ERMSG /BAD OR TOO BIG HOLLERITH FIELD 1688 003250 1017 1017 1689 003251 5533 JMP I [BADEXP 1690 003252 1374 LUHOL, TAD (33 /LOOK UP THIS LITERAL 1691 003253 3021 DCA BUCKET 1692 003254 4554 JMS I [LOOKUP 1693 003255 5534 JMP I [OPR8RL 1694 003256 0000 HCOUNT, 0 1695 003257 2044 ISZ TEMP /CHECK COUNT 1696 003260 7410 SKP 1697 003261 5252 JMP LUHOL /EXPIRED 1698 003262 4546 JMS I [GETCWB /GET CHAR 1699 003263 5247 JMP BADH 1700 003264 0145 AND [77 /6-BIT IZE IT 1701 003265 5656 JMP I HCOUNT 1702 003266 0000 HOLCTR, 0 /COUNTER FOR HOLLERITH FIELDS 1703 003267 4565 NCMPLX, JMS I [RESTCP /NOT COMPLEX LITERAL 1704 003270 4566 JMS I [EXPR /MUST BE SUB EXPRESSION 1705 003271 5301 JMP BADEXP 1706 003272 4567 JMS I [GETC /LOOK FOR ) 1707 003273 5277 JMP PARMM 1708 003274 1373 TAD (-251 1709 003275 7650 SNA CLA 1710 003276 5772 JMP I (NOSS /NO SUBSCRIPT LEGAL AFTER SUB EXPR 1711 003277 4576 PARMM, JMS I [ERMSG /MISSING ) 1712 003300 1515 1515 1713 003301 4562 BADEXP, JMS I [POP /BAD EXPRESSION, 1714 003302 7640 SZA CLA 1715 003303 5301 JMP BADEXP /LOOK FOR STACK MARKER 1716 003304 4562 JMS I [POP 1717 003305 3044 DCA TEMP /RETURN ADDR. 1718 003306 5444 JMP I TEMP 1719 003307 4557 JMS I [BACK1 /PUT BACK TEMINAL CHAR 1720 003310 4562 ENDEXP, JMS I [POP /GET NEXT THING FROM STACK 1721 003311 7450 SNA 1722 003312 5320 JMP EXPDUN /IF ZERO, FINISH 1723 003313 7001 IAC /GET ADDR OF OPERATION NUMBER 1724 003314 3044 DCA TEMP 1725 003315 1444 TAD I TEMP /GET OPERATOR VALUE 1726 003316 4572 JMS I [OUTWRD /OUTPUT OPERATOR XXXXXX 1727 003317 5310 JMP ENDEXP /LOOP 1728 003320 4562 EXPDUN, JMS I [POP /GET RETURN ADDR 1729 003321 7001 IAC 1730 003322 3044 DCA TEMP 1731 003323 5444 JMP I TEMP 1732 003324 0000 LETTER, 0 /GET A LETTER 1733 003325 4567 JMS I [GETC 1734 003326 5724 JMP I LETTER 1735 003327 1371 TAD (-301 1736 003330 7510 SPA 1737 003331 5340 JMP NLETR 1738 003332 1370 TAD (301-333 1739 003333 7500 SMA 1740 003334 5340 JMP NLETR 1741 003335 1374 TAD (33 1742 003336 2324 ISZ LETTER 1743 003337 5724 JMP I LETTER 1744 003340 4557 NLETR, JMS I [BACK1 1745 003341 5724 JMP I LETTER 1746 003342 1367 QUOTE, TAD (250-247 /IS IT ' 1747 003343 7440 SZA 1748 003344 5766 JMP MISARG /NO, OPERAND IS MISSING 1749 003345 1365 TAD (HQUOTE /SET SUBR POINTER 1750 003346 5226 JMP DOHOL 1751 003347 0000 CHECKC, 0 /CHECK FOR A SINGLE CHAR 1752 003350 1747 TAD I CHECKC /GET THE CHAR 1753 003351 3361 DCA CCTEMP 1754 003352 2347 ISZ CHECKC /SKIP PAST THE CHAR 1755 003353 4567 JMS I [GETC /GET CHAR FROM INPUT 1756 003354 5747 JMP I CHECKC /DIDN'T MAKE IT 1757 003355 1361 TAD CCTEMP /IS THIS IT ? 1758 003356 7650 SNA CLA 1759 003357 2347 ISZ CHECKC /YES 1760 003360 5747 JMP I CHECKC 1761 003361 0000 CCTEMP, 0 1762 / EXPRESSION ANALYZER 1763 003365 3200 PAGE 003366 3156 003367 0001 003370 7746 003371 7477 003372 3447 003373 7527 003374 0033 003375 6200 003376 7700 003377 3256 1764 003400 4576 BADFSS, JMS I [ERMSG 1765 003401 2323 2323 1766 003402 5533 JMP I [BADEXP 1767 003403 3044 OPR8R, DCA TEMP 1768 003404 4572 JMS I [OUTWRD /PUSH 1769 003405 1044 TAD TEMP 1770 003406 4572 JMS I [OUTWRD /OUTPUT OPERAND PTR 1771 003407 4567 JMS I [GETC 1772 003410 5530 JMP I [ENDEXP 1773 003411 1377 TAD (-250 /IS IT S.S. OR FUNCTION 1774 003412 7440 SZA 1775 003413 5776 JMP NOTFSS 1776 003414 1122 TAD STMJMP 1777 003415 1375 TAD (-DFINFL 1778 003416 7650 SNA CLA /FOR D.F.,PERMIT VARPARENS 1779 003417 5776 JMP NOTFSS 1780 003420 2044 ISZ TEMP /LOOK AT TYPE 1781 003421 6211 CDF 10 1782 003422 1374 TAD (3420 /DIM, EXT, SF, OR ARG ? 1783 003423 0444 AND I TEMP 1784 003424 7640 SZA CLA 1785 003425 5231 JMP NOTFUN /NOT A FUNCTION REFERENCE 1786 003426 1444 TAD I TEMP 1787 003427 1373 TAD (1000 /SET EXT BIT 1788 003430 3444 DCA I TEMP 1789 003431 6201 NOTFUN, CDF 1790 003432 7410 SKP 1791 003433 4562 JMS I [POP /PUT COUNT INTO AC 1792 003434 7001 SSFUN, IAC /INCREMENT ARG COUNT 1793 003435 4561 JMS I [PUSH /SAVE IT ON THE STACK 1794 003436 4566 JMS I [EXPR /GET ARG (OR S.S.) 1795 003437 5533 JMP I [BADEXP 1796 003440 4560 JMS I [COMARP /LOOK FOR , OR ) 1797 003441 5200 JMP BADFSS /NEITHER 1798 003442 5233 JMP SSFUN-1 /, GET NEXT ARG (SUBSCRIPT?) 1799 003443 1372 TAD (ARGSOP /YES, OUTPUT ARGLIST OPER 1800 003444 4572 JMS I [OUTWRD 1801 003445 4562 JMS I [POP /AND THE COUNT 1802 003446 4572 JMS I [OUTWRD 1803 003447 4567 NOSS, JMS I [GETC /GET NEXT CHAR 1804 003450 5530 JMP I [ENDEXP 1805 003451 1371 TAD (-253 /PREPARE IT 1806 003452 5770 JMP NOTFSS+1 1807 003453 3044 OPR8RL, DCA TEMP /SAVE ADDR OF LITERAL 1808 003454 4572 JMS I [OUTWRD 1809 003455 1044 TAD TEMP 1810 003456 4572 JMS I [OUTWRD 1811 003457 5247 JMP NOSS 1812 / TYPLST PART TWO 1813 003460 4536 DIMLUP, JMS I [NUMBER /GET DIMENSION 1814 003461 5315 JMP VARDIM /MAYBE ITS VAR DIM ? 1815 003462 5265 JMP .+3 /OK, INTEGER 1816 003463 5767 JMP BADDIM 1817 003464 5767 JMP BADDIM /DP AND FP ARE BAD 1818 003465 4541 JMS I [FIXNUM /FIX IT FOR SOME STUFF 1819 003466 3072 DCA MQ 1820 003467 1070 TAD DPRDCT /GET NEW DIMENSION PRODUCT 1821 003470 4527 JMS I [MUL12 1822 003471 3070 DCA DPRDCT 1823 003472 2045 ISZ TEMP2 /INCREMENT DIM COUNT 1824 003473 1023 TAD WORD2 /IF WORD2 OR AC NON ZERO 1825 003474 1033 TAD AC /DIM IS TOO BIG 1826 003475 7640 SZA CLA /1.03/ 1827 003476 5767 JMP BADDIM /1.03/ 1828 003477 4766 JMS I (ANORM /1.03/ RENORMALIZE THE NUMBER 1829 003500 4535 JMS I [LUKUP2 /1.03/ ENTER IT INTO LITERAL LIST 1830 003501 0060 INTLST /1.03/ 1831 003502 7775 -3 /1.03/ 1832 003503 4561 PSHDIM, JMS I [PUSH /1.03/ AND SAVE ON THE STACK 1833 003504 4560 JMS I [COMARP /LOOK FOR , OR ) 1834 003505 5767 JMP BADDIM 1835 003506 7410 SKP /COMMA MEANS ANOTHER DIM FOLLOWS 1836 003507 5765 JMP PUTDIM /) MEANS END OF DIMS 1837 003510 1100 TAD DSERES /FORM NEXT VALUE OF MAGIC NUMBER 1838 003511 1070 TAD DPRDCT 1839 003512 3100 DCA DSERES 1840 003513 5260 JMP DIMLUP /NOW LOOP FOR NEXT DIM 1841 003514 0000 VDTEMP, 0 1842 003515 6211 VARDIM, CDF 10 /IS ARRAY AN ARG ? 1843 003516 1507 TAD I TLTEMP 1844 003517 6201 CDF 1845 003520 0364 AND (20 1846 003521 7650 SNA CLA 1847 003522 5767 JMP BADDIM /NO, BAD DIMENSION 1848 003523 4577 JMS I [GETNAM /OK, GET DIMENSION 1849 003524 5767 JMP BADDIM 1850 003525 4554 JMS I [LOOKUP 1851 003526 7001 IAC 1852 003527 3314 DCA VDTEMP /ADDR OF TYPE WORD 1853 003530 6211 CDF 10 /IS THA VARIABLE AN ARG ? 1854 003531 1714 TAD I VDTEMP 1855 003532 0364 AND (20 1856 003533 6201 CDF 1857 003534 7650 SNA CLA 1858 003535 5767 JMP BADDIM /NO, THATS BAD 1859 003536 3070 DCA DPRDCT /3.02 ZERO DIM PRODUCT 1860 003537 2045 ISZ TEMP2 /INCREMENT DIM COUNT 1861 003540 7040 CMA /1.03/ 1862 003541 1314 TAD VDTEMP /1.03/ SAVE DIMENSION VARIABLE 1863 003542 5303 JMP PSHDIM /3.02 SAVE DIM ON STACK 1864 003543 0000 MESSAG, 0 /PRINT PASS1 IMMEDIATE ERROR 1865 003544 1743 TAD I MESSAG /GET CHAR ONE 1866 003545 2343 ISZ MESSAG 1867 003546 4763 JMS I (TTYOUT 1868 003547 1743 TAD I MESSAG /GET CHAR TWO 1869 003550 4763 JMS I (TTYOUT 1870 003551 1362 TAD (215 /CR 1871 003552 4763 JMS I (TTYOUT 1872 003553 1361 TAD (212 /LF 1873 003554 4763 JMS I (TTYOUT 1874 003555 5760 JMP I (7605 /EXIT TO MONITOR 1875 / EXPRESSION ANALYZER REVISITED 1876 003560 7605 PAGE 003561 0212 003562 0215 003563 4355 003564 0020 003565 2452 003566 5463 003567 2523 003570 3601 003571 7525 003572 0036 003573 1000 003574 3420 003575 6764 003576 3600 003577 7530 1877 003600 1377 NOTFSS, TAD (250-253 /IS IT + 1878 003601 7440 SZA 1879 003602 5205 JMP .+3 1880 003603 1376 TAD (ADDOPR /YES 1881 003604 5303 JMP GOTOPR 1882 003605 1375 TAD (253-255 /IS IT - 1883 003606 7440 SZA 1884 003607 5212 JMP .+3 1885 003610 1374 TAD (SUBOPR /YES 1886 003611 5303 JMP GOTOPR 1887 003612 1373 TAD (255-252 /IS IT * 1888 003613 7440 SZA 1889 003614 5227 JMP NOTMUL /NO 1890 003615 4567 JMS I [GETC 1891 003616 5225 JMP NOTEXP 1892 003617 1372 TAD (-252 /IS IT ** 1893 003620 7640 SZA CLA 1894 003621 5224 JMP .+3 1895 003622 1371 TAD (EXPOPR /YES 1896 003623 5303 JMP GOTOPR 1897 003624 4557 JMS I [BACK1 1898 003625 1370 NOTEXP, TAD (MULOPR /IT WAS * 1899 003626 5303 JMP GOTOPR 1900 003627 1367 NOTMUL, TAD (252-257 /IS IT / 1901 003630 7440 SZA 1902 003631 5234 JMP .+3 1903 003632 1366 TAD (DIVOPR /YES 1904 003633 5303 JMP GOTOPR 1905 003634 7001 IAC /IS IT . 1906 003635 7640 SZA CLA 1907 003636 5765 JMP I (ENDEXP-1 /NO, END OF EXPR 1908 003637 4250 JMS CKEOPR /LOOK FOR EXTENDED OPERATOR 1909 003640 5300 JMP BADOPR /NONE THERE 1910 003641 4556 JMS I [CHECKC /CHECK FOR CLOSING . 1911 003642 7522 -256 1912 003643 5300 JMP BADOPR /NOT THERE 1913 003644 6211 CDF 10 /3.01/ 1914 003645 1410 TAD I X10 /GET OPERATOR POINTER 1915 003646 6201 CDF 1916 003647 5303 JMP GOTOPR 1917 003650 0000 CKEOPR, 0 /CHECK FOR EXTENDED OPERATOR 1918 003651 4577 JMS I [GETNAM /GET NAME 1919 003652 5650 JMP I CKEOPR /NONE 1920 003653 1364 TAD (OPRLST-1 /PTR TO LIST 1921 003654 3010 DCA X10 1922 003655 6211 OPRLUP, CDF 10 /3.01/ 1923 003656 1410 TAD I X10 /COMPARE FIRST CHAR 1924 003657 6201 CDF 0 1925 003660 7450 SNA 1926 003661 5650 JMP I CKEOPR /END OF LIST 1927 003662 1021 TAD BUCKET 1928 003663 7640 SZA CLA 1929 003664 5275 JMP NOTHIS /NOT THIS ONE 1930 003665 6211 CDF 10 /3.01/ 1931 003666 1410 TAD I X10 1932 003667 6201 CDF 1933 003670 1763 TAD I (NAME1 /COMPARE 2ND AND 3RD 1934 003671 7640 SZA CLA 1935 003672 5276 JMP NOTHIS+1 /NOT THIS ONE 1936 003673 2250 ISZ CKEOPR /BUMP RETURN 1937 003674 5650 JMP I CKEOPR 1938 003675 2010 NOTHIS, ISZ X10 /BUMP LIST PTR 1939 003676 2010 ISZ X10 /AGAIN 1940 003677 5255 JMP OPRLUP /KEEP GOING 1941 003700 4576 BADOPR, JMS I [ERMSG /NOT LEGAL EXT. OPER. 1942 003701 1720 1720 1943 003702 5533 JMP I [BADEXP 1944 003703 3022 GOTOPR, DCA NEWOP /SAVE NEWEST OPER. 1945 003704 4562 JMS I [POP /GET STACK TOP 1946 003705 7450 SNA 1947 003706 5316 JMP PUSH2 /EMPTY 1948 003707 3023 DCA OLDOP 1949 003710 1423 TAD I OLDOP /COMPARE PREC. 1950 003711 7041 CIA 1951 003712 1422 TAD I NEWOP /NEW-OLD 1952 003713 7750 SPA SNA CLA 1953 003714 5322 JMP OUTOLD /OLD>NEW 1954 003715 1023 TAD OLDOP 1955 003716 4561 PUSH2, JMS I [PUSH /OLD < NEW 1956 003717 1022 TAD NEWOP /GO PUSH BOTH 1957 003720 4561 JMS I [PUSH 1958 003721 5762 JMP I (UNOPR /GO LOOK FOR NEXT OPERAND 1959 003722 2023 OUTOLD, ISZ OLDOP /OUTPUT OPERATOR 1960 003723 1423 TAD I OLDOP 1961 003724 4572 JMS I [OUTWRD 1962 003725 5304 JMP GOTOPR+1 /TRY NEXT STACK ELEMENT 1963 NEWOP=WORD1 1964 OLDOP=WORD2 1965 / UTILITIES 1966 003726 0000 GETCWB, 0 /GET A CHARACTER (PRESERVE BLANKS) 1967 003727 2042 ISZ NCHARS 1968 003730 5334 JMP .+4 1969 003731 7240 CLA CMA 1970 003732 3042 DCA NCHARS /RESET NCHARS 1971 003733 5726 JMP I GETCWB 1972 003734 2326 ISZ GETCWB 1973 003735 1415 TAD I CHRPTR /GET THE CHAR 1974 003736 5726 JMP I GETCWB 1975 003737 0000 SAVECP, 0 /SAVE CHAR POSITION 1976 003740 1042 TAD NCHARS 1977 003741 4561 JMS I [PUSH 1978 003742 1015 TAD CHRPTR 1979 003743 4561 JMS I [PUSH 1980 003744 5737 JMP I SAVECP 1981 003745 0000 FIXNUM, 0 /FIX FAC (I'M MOVING IT AGAIN) 1982 003746 1022 TAD WORD1 /IS IT FIXED ? 1983 003747 1361 TAD (-27 1984 003750 7450 SNA 1985 003751 5356 JMP RETFN /YES, EXPONENT IS 23 1986 003752 7700 SMA CLA 1987 003753 5745 JMP I FIXNUM /BAD IF EXP IS >23 1988 003754 4760 JMS I (AR1 /RIGHT SHIFT ONE 1989 003755 5346 JMP FIXNUM+1 /TEST AGAIN 1990 003756 1024 RETFN, TAD WORD3 /RETURN LOWEST 12 BITS 1991 003757 5745 JMP I FIXNUM 1992 / UTILITIES 1993 003760 5316 PAGE 003761 7751 003762 3004 003763 6200 003764 5413 003765 3307 003766 4406 003767 7773 003770 4404 003771 4410 003772 7526 003773 0003 003774 4402 003775 7776 003776 4400 003777 7775 1994 004000 0000 GETC, 0 /GET A CHARACTER (IGNORING BLANKS) 1995 004001 2042 ISZ NCHARS 1996 004002 5206 JMP .+4 1997 004003 7240 CLA CMA 1998 004004 3042 DCA NCHARS 1999 004005 5600 JMP I GETC 2000 004006 1415 TAD I CHRPTR 2001 004007 1377 TAD (-240 /IS IT A BLANK 2002 004010 7450 SNA 2003 004011 5201 JMP GETC+1 /YES IGNORE IT 2004 004012 1376 TAD (240 /FIX CHAR 2005 004013 2200 ISZ GETC 2006 004014 5600 JMP I GETC 2007 004015 0000 ERMSG, 0 /ERROR MESSAGE HANDLER 2008 004016 6201 CDF 2009 004017 1041 TAD NOCODE /IS CODE GENERATION ON ? 2010 004020 7640 SZA CLA 2011 004021 5230 JMP NOTOUT /NO 2012 004022 1375 TAD (ERRCOD /ERROR CODE TO OUTPUT FILE 2013 004023 4572 JMS I [OUTWRD 2014 004024 1615 TAD I ERMSG 2015 004025 2215 ISZ ERMSG 2016 004026 4572 JMS I [OUTWRD 2017 004027 5615 JMP I ERMSG /RETURN 2018 004030 1615 NOTOUT, TAD I ERMSG /SAVE THE ERROR CODE 2019 004031 2215 ISZ ERMSG 2020 004032 3774 DCA ERCODE 2021 004033 5615 JMP I ERMSG 2022 004034 0000 POP, 0 /PUT TOP OF STACK INTO AC 2023 004035 1014 TAD STACK 2024 004036 3215 DCA ERMSG 2025 004037 7240 CLA CMA 2026 004040 1014 TAD STACK 2027 004041 3014 DCA STACK /DECREMENT STACK POINTER 2028 004042 1615 TAD I ERMSG 2029 004043 5634 JMP I POP 2030 004044 0000 TRUFAL, 0 /CHECK FOR LOGICAL LITERALS 2031 004045 4577 JMS I [GETNAM 2032 004046 5644 JMP I TRUFAL 2033 004047 4556 JMS I [CHECKC /LOOK FOR TERMINAL . 2034 004050 7522 -256 2035 004051 5644 JMP I TRUFAL 2036 004052 1021 TAD BUCKET /LOOK AT FIRST CHAR 2037 004053 1373 TAD (-24 2038 004054 7450 SNA 2039 004055 5262 JMP .+5 /ITS "T" 2040 004056 1372 TAD (24-6 2041 004057 7640 SZA CLA 2042 004060 5644 JMP I TRUFAL /ITS NEITHER 2043 004061 2244 ISZ TRUFAL /ITS "F" 2044 004062 2244 ISZ TRUFAL 2045 004063 5644 JMP I TRUFAL 2046 / LEFT HALF EXPRESSION ANALYZER 2047 004064 0000 LEXPR, 0 /GET LEFT HAND EXPRESSION 2048 004065 3364 DCA LETEMP /SAVE CALL SWITCH 2049 004066 4577 JMS I [GETNAM /LOOK FOR VAR NAME 2050 004067 5351 JMP MSNGOP /MUST BE THERE 2051 004070 4572 JMS I [OUTWRD /OUTPUT A ZERO (PUSH) 2052 004071 4554 JMS I [LOOKUP /SEEK OUT ENTRY FOR THIS VAR 2053 004072 3044 DCA TEMP 2054 004073 1044 TAD TEMP 2055 004074 4572 JMS I [OUTWRD 2056 004075 4567 JMS I [GETC /LOOK FOR DIMENSIONS 2057 004076 5347 JMP LEXPOK /NO ( 2058 004077 1371 TAD (-250 2059 004100 7640 SZA CLA 2060 004101 5346 JMP LEXPOK-1 /NO ( 2061 004102 2044 ISZ TEMP /LOOK AT TYPE 2062 004103 6211 CDF 10 2063 004104 7132 CLL CML RTR /DIMENSIONED ? 2064 004105 0444 AND I TEMP 2065 004106 1364 TAD LETEMP /OR A CALL ? 2066 004107 1041 TAD NOCODE /OR CODE OFF ? 2067 004110 7640 SZA CLA 2068 004111 5327 JMP NOTSF /YES, NOT AN ARITHMETIC S.F. 2069 004112 1444 TAD I TEMP 2070 004113 0370 AND (1420 /EXT, SF, OR ARG ? 2071 004114 7650 SNA CLA /V3C 2072 004115 1126 TAD [-M6 /SEE IF CALLED FROM SPECIAL PLACE 2073 004116 1264 TAD LEXPR /V3C COMPARE WITH ENTRY PT 2074 004117 7640 SZA CLA 2075 004120 5361 JMP ASFERR /THIS IS BAD IF SO 2076 004121 1444 TAD I TEMP 2077 004122 1367 TAD (400 2078 004123 3444 DCA I TEMP /SET A.S.F. BIT 2079 004124 6201 CDF 2080 004125 1366 TAD (ASFDEF /DEFINE ASF 2081 004126 4572 JMS I [OUTWRD 2082 004127 6201 NOTSF, CDF 2083 004130 7410 SKP 2084 004131 4562 JMS I [POP /ARG COUNT TO AC 2085 004132 7001 SSLOOP, IAC /INCREMENT SS COUNT 2086 004133 4561 JMS I [PUSH /SAVE ON THE STACK 2087 004134 4566 JMS I [EXPR /COMPILE SUBSCRIPT 2088 004135 5356 JMP FSSBAD+2 /ERROR WITHIN SS 2089 004136 4560 JMS I [COMARP /LOOK FOR , OR ) 2090 004137 5354 JMP FSSBAD /NEITHER (THERE WAS A BUG HERE) 2091 004140 5331 JMP SSLOOP-1 /, GET NEXT ARG/SS 2092 004141 1365 TAD (ARGSOP /OUTPUT SS OPERATOR 2093 004142 4572 JMS I [OUTWRD 2094 004143 4562 JMS I [POP /THEN COUNT 2095 004144 4572 JMS I [OUTWRD 2096 004145 7410 SKP 2097 004146 4557 JMS I [BACK1 /PUT BACK A CHARACTER 2098 004147 2264 LEXPOK, ISZ LEXPR 2099 004150 5664 JMP I LEXPR /RETURN 2100 004151 4576 MSNGOP, JMS I [ERMSG /MISSING OPERAND 2101 004152 1517 1517 2102 004153 5664 JMP I LEXPR 2103 004154 4576 FSSBAD, JMS I [ERMSG /MISSING COMMA OR CLOSE PARENTHESIS 2104 004155 2323 2323 2105 004156 4562 JMS I [POP /GET ARG COUNT OFF STACK 2106 004157 7200 CLA 2107 004160 5664 JMP I LEXPR 2108 004161 4576 ASFERR, JMS I [ERMSG /BAD ARITHMETIC STMT FUNCTION 2109 004162 2306 2306 2110 004163 5327 JMP NOTSF /DO THE REST OF THE ASF DEF 2111 004164 0000 LETEMP, 0 2112 /UTILITIES 2113 004165 0036 PAGE 004166 0035 004167 0400 004170 1420 004171 7530 004172 0016 004173 7754 004174 0436 004175 0040 004176 0240 004177 7540 2114 G2CTMP, 2115 004200 0000 PUSH, 0 /PUT AC ONTO STACK 2116 004201 3414 DCA I STACK /STORE 2117 004202 1377 TAD (STACKS+100 /CHECK FOR STACK OVERFLOW 2118 004203 7141 CIA CLL 2119 004204 1014 TAD STACK 2120 004205 7620 SNL CLA 2121 004206 5600 JMP I PUSH /OK, RETURN 2122 004207 3041 DCA NOCODE /SET CODE GENERATION ON 2123 004210 4576 JMS I [ERMSG 2124 004211 2004 2004 2125 004212 5564 JMP I [NEXTST 2126 004213 0000 GET2C, 0 /GET 2 SIX BIT CHARS INTO ONE WPRD 2127 004214 4567 JMS I [GETC /GET FIRST CHAR 2128 004215 5613 JMP I GET2C 2129 004216 0145 AND [77 2130 004217 7106 CLL RTL 2131 004220 7006 RTL 2132 004221 7006 RTL 2133 004222 3200 DCA G2CTMP 2134 004223 4567 JMS I [GETC /GET SECOND CHAR 2135 004224 5613 JMP I GET2C 2136 004225 2213 ISZ GET2C /FIX RETURN ADDR 2137 004226 0145 AND [77 2138 004227 1200 TAD G2CTMP 2139 004230 5613 JMP I GET2C 2140 004231 0000 STMNUM, 0 /PICK UP STATEMENT NUMBER 2141 004232 3025 DCA WORD4 /SAVE DEFINED BIT (IF ANY) 2142 004233 3023 DCA WORD2 /ZERO SOME STUFF 2143 004234 3024 DCA WORD3 2144 004235 4317 JMS DIGIT /GET A DIGIT 2145 004236 5631 JMP I STMNUM /NONE THERE, NO STMT NUMBER 2146 004237 1376 TAD (-60 /IS IT A LEADING 0 ? 2147 004240 7450 SNA 2148 004241 5235 JMP .-4 /YES, IGNORE IT 2149 004242 1375 TAD (60 2150 004243 7106 CLL RTL 2151 004244 7006 RTL 2152 004245 7006 RTL 2153 004246 3022 DCA WORD1 2154 004247 4317 JMS DIGIT /GET SECOND DIGIT 2155 004250 5273 JMP ENDNUM /END OF NUMBER 2156 004251 1022 TAD WORD1 2157 004252 3022 DCA WORD1 /COMBINE FIRST AND SECOND 2158 004253 4317 JMS DIGIT 2159 004254 5273 JMP ENDNUM 2160 004255 7106 CLL RTL 2161 004256 7006 RTL 2162 004257 7006 RTL 2163 004260 3023 DCA WORD2 2164 004261 4317 JMS DIGIT 2165 004262 5273 JMP ENDNUM /COMBINE THIRD AND FOURTH 2166 004263 1023 TAD WORD2 2167 004264 3023 DCA WORD2 2168 004265 4317 JMS DIGIT /GET FIFTH DIGIT 2169 004266 5273 JMP ENDNUM 2170 004267 7106 CLL RTL 2171 004270 7006 RTL 2172 004271 7006 RTL 2173 004272 3024 DCA WORD3 2174 004273 4535 ENDNUM, JMS I [LUKUP2 /LOOK UP IN S.T. 2175 004274 0062 SNLIST /STMT NUMBER LIST 2176 004275 7775 -3 2177 004276 2231 ISZ STMNUM 2178 004277 3052 DCA SNUM /SAVE S.T. ADDRESS OF LABEL 2179 004300 6211 CDF 10 /SET TYPE WORD 2180 004301 1052 TAD SNUM /GET ADDR OF TYPE 2181 004302 7001 IAC 2182 004303 3317 DCA SNTEMP 2183 004304 1717 TAD I SNTEMP /GET TYPE WORD 2184 004305 7100 CLL 2185 004306 1025 TAD WORD4 /PUT IN THE DEFINITION BIT 2186 004307 7420 SNL 2187 004310 3717 DCA I SNTEMP /RESTORE IT IF NOT MULTIPLE DEFN 2188 004311 6201 CDF 2189 004312 7620 SNL CLA 2190 004313 5631 JMP I STMNUM 2191 004314 4576 JMS I [ERMSG 2192 004315 1514 1514 2193 004316 5631 JMP I STMNUM 2194 SNTEMP, 2195 004317 0000 DIGIT, 0 /GET A DIGIT 2196 004320 4567 JMS I [GETC /GET A CHAR 2197 004321 5717 JMP I DIGIT 2198 004322 1374 TAD (-272 /IS IT > 271 (9) 2199 004323 7500 SMA 2200 004324 5333 JMP NODIGT /YES, ITS GREATER 2201 004325 1373 TAD (272-260 /IS IT < 260 (0) 2202 004326 7510 SPA 2203 004327 5333 JMP NODIGT /YES, ITS LESS 2204 004330 1375 TAD (60 2205 004331 2317 ISZ DIGIT 2206 004332 5717 JMP I DIGIT /TAKE SUCCESSFUL RETURN 2207 004333 4557 NODIGT, JMS I [BACK1 /RESTORE NON DIGIT 2208 004334 5717 JMP I DIGIT 2209 004335 4573 ASSIGN, JMS I [STMNUM /GET STMT NUMBER 2210 004336 5352 JMP BADASN 2211 004337 4563 JMS I [GET2C /LOOK FOR "TO" 2212 004340 5352 JMP BADASN 2213 004341 1372 TAD (-2417 2214 004342 7650 SNA CLA 2215 004343 4570 JMS I [LEXPR /GET ASSIGN VARIABLE 2216 004344 5352 JMP BADASN 2217 004345 1371 TAD (ASNOPR /OUTPUT ASSIGN OPERATOR 2218 004346 4572 JMS I [OUTWRD 2219 004347 1052 TAD SNUM /NOW STMT NUMBER 2220 004350 4572 JMS I [OUTWRD 2221 004351 5564 JMP I [NEXTST 2222 004352 4576 BADASN, JMS I [ERMSG 2223 004353 0123 0123 2224 004354 5564 JMP I [NEXTST 2225 004355 0000 TTYOUT, 0 /TTY OUTPUT ROUTINE 2226 004356 6046 TLS 2227 004357 6041 TSF 2228 004360 5357 JMP .-1 2229 004361 7200 CLA 2230 004362 5755 JMP I TTYOUT 2231 / PRECEDENCE TABLE 2232 004371 0054 PAGE 004372 5361 004373 0012 004374 7506 004375 0060 004376 7720 004377 5000 2233 004400 0100 ADDOPR, 100 2234 004401 0001 1 2235 004402 0100 SUBOPR, 100 2236 004403 0002 2 2237 004404 0200 MULOPR, 200 2238 004405 0003 3 2239 004406 0200 DIVOPR, 200 2240 004407 0004 4 2241 004410 0500 EXPOPR, 500 2242 004411 0005 5 2243 004412 0030 NOTOPR, 30 2244 004413 0006 6 2245 004414 0400 UMOPR, 400 2246 004415 0007 7 2247 004416 0040 EQOPR, 40 2248 004417 0016 16 2249 004420 0040 NEOPR, 40 2250 004421 0017 17 2251 004422 0040 GEOPR, 40 2252 004423 0010 10 2253 004424 0040 GTOPR, 40 2254 004425 0011 11 2255 004426 0040 LEOPR, 40 2256 004427 0012 12 2257 004430 0040 LTOPR, 40 2258 004431 0013 13 2259 004432 0020 ANDOPR, 20 2260 004433 0014 14 2261 004434 0010 OROPR, 10 2262 004435 0015 15 2263 004436 0007 XOROPR, 7 2264 004437 0020 20 2265 004440 0007 EQVOPR, 7 2266 004441 0021 21 2267 / UTILITY ROUTINES 2268 004442 0000 BACK1, 0 /BACK UP ONE CHAR 2269 004443 7240 CLA CMA 2270 004444 1042 TAD NCHARS 2271 004445 3042 DCA NCHARS 2272 004446 7240 CLA CMA 2273 004447 1015 TAD CHRPTR 2274 004450 3015 DCA CHRPTR 2275 004451 5642 JMP I BACK1 2276 004452 0000 OADD, 0 /ADD OPERAND TO FAC 2277 004453 7100 CLL 2278 004454 1037 TAD OPO 2279 004455 1030 TAD ACO 2280 004456 3030 DCA ACO 2281 004457 7004 RAL 2282 004460 1036 TAD OP6 2283 004461 1027 TAD WORD6 2284 004462 3027 DCA WORD6 2285 004463 7004 RAL 2286 004464 1035 TAD OP5 2287 004465 1026 TAD WORD5 2288 004466 3026 DCA WORD5 2289 004467 7004 RAL 2290 004470 1034 TAD OP4 2291 004471 1025 TAD WORD4 2292 004472 3025 DCA WORD4 2293 004473 7004 RAL 2294 004474 1033 TAD OP3 2295 004475 1024 TAD WORD3 2296 004476 3024 DCA WORD3 2297 004477 7004 RAL 2298 004500 1032 TAD OP2 2299 004501 1023 TAD WORD2 2300 004502 3023 DCA WORD2 2301 004503 5652 JMP I OADD 2302 / FLOATING POINT DIVIDE ROUTINE 2303 PAGE 2304 004600 0000 FPDIV, 0 2305 004601 4670 JMS I DAR1 /UNNORMALIZE AC BY ONE 2306 004602 1031 TAD OP1 /COMPUTE FINAL EXPONENT 2307 004603 7041 CIA 2308 004604 1022 TAD WORD1 2309 004605 3031 DCA OP1 /AND SAVE IT 2310 004606 1272 TAD DM74 /SET ITERATION COUNTER 2311 004607 3267 DCA DITCNT 2312 004610 1023 TAD WORD2 2313 004611 7004 RAL /INITIALIZE LINK 2314 004612 7210 FPDVLP, CLA RAR /COMPARE SIGNS 2315 004613 1032 TAD OP2 2316 004614 7710 SPA CLA 2317 004615 5220 JMP .+3 2318 004616 1273 TAD OPMAC /NEGATE OPERAND 2319 004617 4674 JMS I DFNEG 2320 004620 4675 JMS I DOADD /ADD OPERAND AND FAC 2321 004621 1266 TAD D6 /RIGHT SHIFT QUOTIENT 2322 004622 7004 RAL /PRESERVING ADD OVERFLOW BIT 2323 004623 3266 DCA D6 2324 004624 1265 TAD D5 2325 004625 7004 RAL 2326 004626 3265 DCA D5 2327 004627 1264 TAD D4 2328 004630 7004 RAL 2329 004631 3264 DCA D4 2330 004632 1263 TAD D3 2331 004633 7004 RAL 2332 004634 3263 DCA D3 2333 004635 1262 TAD D2 2334 004636 7004 RAL 2335 004637 3262 DCA D2 2336 004640 4671 JMS I DAL1 /LEFT SHIFT FAC ONE 2337 004641 2267 ISZ DITCNT /TEST ITERATION COUNT 2338 004642 5212 JMP FPDVLP 2339 004643 1031 TAD OP1 /PUT QUOTIENT INTO FAC 2340 004644 3022 DCA WORD1 2341 004645 1262 TAD D2 2342 004646 3023 DCA WORD2 2343 004647 1263 TAD D3 2344 004650 3024 DCA WORD3 2345 004651 1264 TAD D4 2346 004652 3025 DCA WORD4 2347 004653 1265 TAD D5 2348 004654 3026 DCA WORD5 2349 004655 1266 TAD D6 2350 004656 3027 DCA WORD6 2351 004657 3030 DCA ACO 2352 004660 4676 JMS I DNORM /NORMALIZE 2353 004661 5600 JMP I FPDIV 2354 004662 0000 D2, 0 2355 004663 0000 D3, 0 2356 004664 0000 D4, 0 2357 004665 0000 D5, 0 2358 004666 0000 D6, 0 2359 004667 0000 DITCNT, 0 2360 004670 5316 DAR1, AR1 2361 004671 5344 DAL1, AL1 2362 004672 7704 DM74, -74 2363 004673 0007 OPMAC, OPO-ACO 2364 004674 5530 DFNEG, NEGFAC 2365 004675 4452 DOADD, OADD 2366 004676 5463 DNORM, ANORM 2367 *STACKS-1 2368 004677 7777 -1 /TO PREVENT SPURIOUS DO ENDS 2369 / NUMERIC CONVERSION ROUTINE 2370 PAGE 2371 005000 0000 NUMBER, 0 /GENERAL NUMBER CONVERSION ROUTINE 2372 005001 3047 DCA ESWIT /ZERO E/D SWITCH 2373 005002 3046 DCA DECPT /ZERO DECIMAL POINT SWITCH 2374 005003 3022 DCA WORD1 /ZERO FAC 2375 005004 3023 DCA WORD2 2376 005005 3024 DCA WORD3 2377 005006 3025 DCA WORD4 2378 005007 3026 DCA WORD5 2379 005010 3027 DCA WORD6 2380 005011 3030 DCA ACO 2381 005012 3216 DCA SIGN /CLEAR SIGN SWITCH 2382 005013 4567 JMS I [GETC /GET A CHAR 2383 005014 5600 JMP I NUMBER /NO CHAR IS NO NUMBER 2384 005015 4326 JMS CHKSGN /CHECK FOR SIGN 2385 005016 0000 SIGN, 0 /THIS SWITCH GETS SET 2386 005017 3050 DCA NDIGIT /ZERO DIGIT COUNT 2387 005020 4551 CONVLP, JMS I [DIGIT /GET A DIGIT 2388 005021 5256 JMP TRYDEC /IS THERE A DECIMAL POINT ? 2389 005022 0125 AND [17 2390 005023 3355 DCA NXTDGT /SAVE THE DIGIT 2391 005024 2050 ISZ NDIGIT /INCR NUMBER OF DIGITS 2392 005025 1023 TAD WORD2 /PREPARE TO MULT BY 10 2393 005026 3032 DCA OP2 2394 005027 1024 TAD WORD3 2395 005030 3033 DCA OP3 2396 005031 1025 TAD WORD4 2397 005032 3034 DCA OP4 2398 005033 1026 TAD WORD5 2399 005034 3035 DCA OP5 2400 005035 1027 TAD WORD6 2401 005036 3036 DCA OP6 2402 005037 1030 TAD ACO 2403 005040 3037 DCA OPO 2404 005041 4777 JMS I (AL1 /DOUBLE FAC 2405 005042 4777 JMS I (AL1 /DOUBLE AGAIN 2406 005043 4776 JMS I (OADD /TIMES FIVE 2407 005044 4777 JMS I (AL1 /ONE MORE DOUBLING IS TIMES 10 2408 005045 3032 DCA OP2 2409 005046 3033 DCA OP3 /PUT NEWEST DIGIT INTO OPERAND 2410 005047 3034 DCA OP4 2411 005050 3035 DCA OP5 2412 005051 3036 DCA OP6 2413 005052 1355 TAD NXTDGT 2414 005053 3037 DCA OPO 2415 005054 4776 JMS I (OADD /ADD IN NEWEST DIGIT 2416 005055 5220 JMP CONVLP 2417 005056 1046 TRYDEC, TAD DECPT /DECIMAL ALREADY ? 2418 005057 7640 SZA CLA 2419 005060 5310 JMP TRYE2 /YES, LOOK FOR EXPONENT 2420 005061 4567 JMS I [GETC /LOOK FOR . 2421 005062 5273 JMP DIGTST /SEE IF THERE WAS ANYTHING 2422 005063 1375 TAD (-256 2423 005064 7440 SZA 2424 005065 5302 JMP TRYE1 /TRY FOR E 2425 005066 4571 JMS I [SAVECP /SAVE CHAR POS 2426 005067 4774 JMS I (CKEOPR /CHECK FOR SPECIAL CASE OF LIT.RE. 2427 005070 5277 JMP NOLDRE /NOT LIT.RE. 2428 005071 4565 JMS I [RESTCP 2429 005072 4557 JMS I [BACK1 /PUT BACK . IT BELONGS TO RELATIONAL 2430 005073 1050 DIGTST, TAD NDIGIT /ANY DIGITS ? 2431 005074 7650 SNA CLA 2432 005075 5600 JMP I NUMBER /NO, NO NUMBER 2433 005076 5316 JMP INTEGR /TAKE INTEGER EXIT 2434 005077 2046 NOLDRE, ISZ DECPT /SET DECIMAL POINT SW 2435 005100 4565 JMS I [RESTCP /RESTORE CHAR POS 2436 005101 5217 JMP CONVLP-1 /LOOP FOR OTHER DIGITS 2437 005102 4557 TRYE1, JMS I [BACK1 /PUT BACK NON . 2438 005103 1050 TAD NDIGIT /ANY DIGITS YET ? 2439 005104 7650 SNA CLA 2440 005105 5600 JMP I NUMBER /NO, NO NUMBER 2441 005106 4337 JMS EORD /LOOK OR E OR D 2442 005107 5316 JMP INTEGR 2443 005110 4337 TRYE2, JMS EORD /LOOK FOR E OR D 2444 005111 2200 FPNUM, ISZ NUMBER 2445 005112 2200 ISZ NUMBER 2446 005113 3054 DCA EXPON /ZERO EXPONENT 2447 005114 4773 JMS I (DODEC /HANDLE DIGITS RIGHT OF . 2448 005115 5321 JMP DOSIGN-1 /GO DO SIGN 2449 005116 1372 INTEGR, TAD (107 /PUT IN EXPONNT 2450 005117 3022 DCA WORD1 2451 005120 4771 JMS I (ANORM /NORMALIZE 2452 005121 2200 ISZ NUMBER /BUMP RETURN 2453 005122 1216 DOSIGN, TAD SIGN /CHECK THE SIGN 2454 005123 7640 SZA CLA 2455 005124 4770 JMS I (NEGFAC /NEGATE IF NEGATIVE 2456 005125 5600 JMP I NUMBER /RETURN 2457 005126 0000 CHKSGN, 0 /CHECK FOR SIGN 2458 005127 1367 TAD (-255 /IS IT - ? 2459 005130 7450 SNA 2460 005131 2726 ISZ I CHKSGN /YES, SET SWITCH 2461 005132 7440 SZA 2462 005133 1366 TAD (255-253 /IS IT + ? 2463 005134 7640 SZA CLA 2464 005135 4557 JMS I [BACK1 /RETURN CHAR OTHERWISE 2465 005136 5726 JMP I CHKSGN 2466 005137 0000 EORD, 0 /LOOK FOR E OR D 2467 005140 4567 JMS I [GETC /LOOK FOR E OR D 2468 005141 5737 JMP I EORD 2469 005142 1365 TAD (-304 2470 005143 7110 CLL RAR 2471 005144 7640 SZA CLA /E OR D? 2472 005145 5353 JMP NOEORD /NO 2473 005146 7430 SZL 2474 005147 2047 ISZ ESWIT /SET SWITCH IF E 2475 005150 7420 SNL 2476 005151 2112 ISZ DPUSED /SET D.P. SWITCH IF D 2477 005152 5764 JMP I (GETEXP /OK, GET EXPONENT 2478 005153 4557 NOEORD, JMS I [BACK1 /PUT IT BACK CAUSE ITS NOT OURS 2479 005154 5737 JMP I EORD 2480 005155 0000 NXTDGT, 0 2481 005156 4566 REWIND, JMS I [EXPR /COMPILE UNIT 2482 005157 5564 JMP I [NEXTST 2483 005160 1363 TAD (REWOPR /OUTPUT REWIND OPERATOR 2484 005161 4572 JMS I [OUTWRD 2485 005162 5564 JMP I [NEXTST 2486 / NUMERIC CONVERSION ROUTINE 2487 005163 0042 PAGE 005164 5215 005165 7474 005166 0002 005167 7523 005170 5530 005171 5463 005172 0107 005173 5237 005174 3650 005175 7522 005176 4452 005177 5344 2488 005200 0000 SMLNUM, 0 /INPUT A NUMBER <= 4095 2489 005201 3054 EXPLUP, DCA EXPON /ZERO THE EXPONENT 2490 005202 4551 JMS I [DIGIT /GET THE NEXT DIGIT 2491 005203 5600 JMP I SMLNUM /NUMBER DONE 2492 005204 0125 AND [17 2493 005205 3037 DCA OPO /SAVE THE DIGIT 2494 005206 1054 TAD EXPON /MULT BY 10 2495 005207 7104 CLL RAL 2496 005210 7104 CLL RAL 2497 005211 1054 TAD EXPON 2498 005212 7104 CLL RAL 2499 005213 1037 TAD OPO /ADD IN DIGIT 2500 005214 5201 JMP EXPLUP /STORE BACK INTO EXPONENT 2501 005215 3221 GETEXP, DCA ESIGN /ZERO EXPONENT SIGN SWITCH 2502 005216 4567 JMS I [GETC /GET A CHAR 2503 005217 5777 JMP I (FPNUM+1 2504 005220 4776 JMS I (CHKSGN /IS IT A SIGN 2505 FPRTNE, 2506 005221 0000 ESIGN, 0 /THIS IS THE SWITCH TO SET 2507 005222 4200 JMS SMLNUM /GO GET THE EXPONENT 2508 005223 1221 FIXEXP, TAD ESIGN /CHECK EXPONENT SIGN 2509 005224 7650 SNA CLA 2510 005225 5231 JMP .+4 2511 005226 1054 TAD EXPON /COMPLEMENT EXPONENT 2512 005227 7041 CIA 2513 005230 3054 DCA EXPON 2514 005231 4237 JMS DODEC /GO HANLE EXPONENT 2515 005232 7126 CLL CML RTL /BUMP RETURN BY TWO (DP) OR 3 (FP) 2516 005233 1047 TAD ESWIT /DEPENDING ON E/D SWITCH 2517 005234 1536 TAD I [NUMBER 2518 005235 3536 DCA I [NUMBER 2519 005236 5775 JMP I (DOSIGN /CHECK THE SIGN 2520 005237 0000 DODEC, 0 2521 005240 1342 TAD DO107 /NORMALIZE THE NUMBER 2522 005241 3022 DCA WORD1 2523 005242 4774 JMS I (ANORM 2524 005243 1046 TAD DECPT /WAS THERE A DECIMAL POINT ? 2525 005244 7640 SZA CLA 2526 005245 1050 TAD NDIGIT /HOW MANY DIGITS TO THE RIGHT ? 2527 005246 7041 CIA 2528 005247 1054 TAD EXPON /SUBTRACT THAT NUMBER FROM EXP 2529 005250 7500 SMA 2530 005251 5256 JMP POSEXP /EXPONENT IS POSITIVE 2531 005252 7041 CIA 2532 005253 3054 DCA EXPON /ONLY NEED ABS VALUE 2533 005254 1373 TAD (FPDIV /DO DIVIDES 2534 005255 5260 JMP .+3 2535 005256 3054 POSEXP, DCA EXPON 2536 005257 1372 TAD (FPMUL /DO MULTIPLIES 2537 005260 3221 DCA FPRTNE /MULTIPLY/DIVIDE ROUTINE 2538 005261 1371 TAD (PETABL-1 /POWERS OF TEN TABLE 2539 005262 3017 DCA X17 2540 005263 1054 EXPMUL, TAD EXPON /LOOK AT THE EXPONENT 2541 005264 7450 SNA 2542 005265 5637 JMP I DODEC /IF 0 ITS THRU 2543 005266 7110 CLL RAR 2544 005267 3054 DCA EXPON /PUT LOWEST BIT INTO LINK 2545 005270 7420 SNL 2546 005271 5313 JMP SKPEXP /THIS ONE DOESN'T COUNT 2547 005272 6211 CDF 10 /3.01/ 2548 005273 1417 TAD I X17 /MOVE FACTOR INTO OPERAND 2549 005274 3031 DCA OP1 2550 005275 1417 TAD I X17 2551 005276 3032 DCA OP2 2552 005277 1417 TAD I X17 2553 005300 3033 DCA OP3 2554 005301 1417 TAD I X17 2555 005302 3034 DCA OP4 2556 005303 1417 TAD I X17 2557 005304 3035 DCA OP5 2558 005305 1417 TAD I X17 2559 005306 3036 DCA OP6 2560 005307 3037 DCA OPO 2561 005310 6201 CDF 2562 005311 4621 JMS I FPRTNE /MULTIPLY OR DIVIDE BY THIS FACTOR 2563 005312 5263 JMP EXPMUL /CHECK NEXT BIT 2564 005313 1017 SKPEXP, TAD X17 /SKIP OVER THIS FACTOR 2565 005314 1370 TAD (6 2566 005315 5262 JMP EXPMUL-1 2567 005316 0000 AR1, 0 /SHIFT FAC RIGHT ONE 2568 005317 1023 TAD WORD2 2569 005320 7110 CLL RAR 2570 005321 3023 DCA WORD2 2571 005322 1024 TAD WORD3 2572 005323 7010 RAR 2573 005324 3024 DCA WORD3 2574 005325 1025 TAD WORD4 2575 005326 7010 RAR 2576 005327 3025 DCA WORD4 2577 005330 1026 TAD WORD5 2578 005331 7010 RAR 2579 005332 3026 DCA WORD5 2580 005333 1027 TAD WORD6 2581 005334 7010 RAR 2582 005335 3027 DCA WORD6 2583 005336 1030 TAD ACO 2584 005337 7010 RAR 2585 005340 3030 DCA ACO 2586 005341 2022 ISZ WORD1 2587 005342 0107 DO107, 107 2588 005343 5716 JMP I AR1 2589 2590 005344 0000 AL1, 0 /SHIFT FAC LEFT ONE 2591 005345 1030 TAD ACO 2592 005346 7104 CLL RAL 2593 005347 3030 DCA ACO 2594 005350 1027 TAD WORD6 2595 005351 7004 RAL 2596 005352 3027 DCA WORD6 2597 005353 1026 TAD WORD5 2598 005354 7004 RAL 2599 005355 3026 DCA WORD5 2600 005356 1025 TAD WORD4 2601 005357 7004 RAL 2602 005360 3025 DCA WORD4 2603 005361 1024 TAD WORD3 2604 005362 7004 RAL 2605 005363 3024 DCA WORD3 2606 005364 1023 TAD WORD2 2607 005365 7004 RAL 2608 005366 3023 DCA WORD2 2609 005367 5744 JMP I AL1 2610 / NUMERIC CONVERSION ROUTINE 2611 005370 0006 PAGE 005371 5452 005372 5400 005373 4600 005374 5463 005375 5122 005376 5126 005377 5112 2612 005400 0000 FPMUL, 0 /FLOATING MULTIPLY ROUTINE 2613 005401 1022 TAD WORD1 /COMPUTE NEW EXPONENT 2614 005402 1031 TAD OP1 2615 005403 3031 DCA OP1 2616 005404 1023 TAD WORD2 /SAVE AC MANTISSA 2617 005405 3256 DCA TW2 2618 005406 1024 TAD WORD3 2619 005407 3257 DCA TW3 2620 005410 1025 TAD WORD4 2621 005411 3260 DCA TW4 2622 005412 1026 TAD WORD5 2623 005413 3261 DCA TW5 2624 005414 1027 TAD WORD6 2625 005415 3262 DCA TW6 2626 005416 1377 TAD (-74 /SET ITERATION COUNTER 2627 005417 3352 DCA ITRCNT 2628 005420 3023 DCA WORD2 /ZERO FAC MANTISSA 2629 005421 3024 DCA WORD3 2630 005422 3025 DCA WORD4 2631 005423 3026 DCA WORD5 2632 005424 3027 DCA WORD6 2633 005425 3030 DCA ACO 2634 005426 4776 MULLUP, JMS I (AR1 /SHIFT FAC RIGHT ONE 2635 005427 1256 TAD TW2 /SHIFT MULTIPLIER RIGHT 2636 005430 7110 CLL RAR 2637 005431 3256 DCA TW2 2638 005432 1257 TAD TW3 2639 005433 7010 RAR 2640 005434 3257 DCA TW3 2641 005435 1260 TAD TW4 2642 005436 7010 RAR 2643 005437 3260 DCA TW4 2644 005440 1261 TAD TW5 2645 005441 7010 RAR 2646 005442 3261 DCA TW5 2647 005443 1262 TAD TW6 2648 005444 7010 RAR 2649 005445 3262 DCA TW6 2650 005446 7430 SZL 2651 005447 4775 JMS I (OADD /ADD IF LINK IS ONE 2652 005450 2352 ISZ ITRCNT /BUMP COUNT 2653 005451 5226 JMP MULLUP /LOOP 2654 005452 1031 TAD OP1 /PUT IN CORRECT EXPONENT 2655 005453 3022 DCA WORD1 2656 005454 4774 JMS I (ANORM /NORMALIZE THE RESULT 2657 005455 5600 JMP I FPMUL 2658 005456 0000 TW2, 0 2659 005457 0000 TW3, 0 2660 005460 0000 TW4, 0 2661 005461 0000 TW5, 0 2662 005462 0000 TW6, 0 2663 005463 0000 ANORM, 0 /NORMALIZE FAC 2664 005464 1023 TAD WORD2 /IS MANTISSA 0 ? 2665 005465 7450 SNA 2666 005466 1024 TAD WORD3 2667 005467 7450 SNA 2668 005470 1025 TAD WORD4 2669 005471 7450 SNA 2670 005472 1026 TAD WORD5 2671 005473 7450 SNA 2672 005474 1027 TAD WORD6 2673 005475 7450 SNA 2674 005476 1030 TAD ACO 2675 005477 7650 SNA CLA 2676 005500 5326 JMP ZEXP /YES, ZERO EXPONENT 2677 005501 7332 NORMLP, CLA CLL CML RTR /IS HIGH ORDER MANTISSA = 6000 2678 005502 1023 TAD WORD2 2679 005503 7440 SZA 2680 005504 5317 JMP NO6000 /NO, SKIP THIS STUFF 2681 005505 1024 TAD WORD3 /YES, IS THE REST 0 ? 2682 005506 7450 SNA 2683 005507 1025 TAD WORD4 2684 005510 7450 SNA 2685 005511 1026 TAD WORD5 2686 005512 7450 SNA 2687 005513 1027 TAD WORD6 2688 005514 7450 SNA 2689 005515 1030 TAD ACO 2690 005516 7640 SZA CLA /SKIP IF 600000 ... 0000 2691 005517 7710 NO6000, SPA CLA 2692 005520 5663 JMP I ANORM /NORM IS DONE WHEN BITS DIFFER 2693 005521 4773 JMS I (AL1 /SHIFT LEFT ONE 2694 005522 7240 CLA CMA /DECREMENT EXPONENT 2695 005523 1022 TAD WORD1 2696 005524 3022 DCA WORD1 2697 005525 5301 JMP NORMLP /LOOP 2698 005526 3022 ZEXP, DCA WORD1 2699 005527 5663 JMP I ANORM 2700 005530 0000 NEGFAC, 0 /NEGATE FAC 2701 005531 1372 TAD (ACO /GET POINTER TO OPERAND 2702 005532 3350 DCA NFPTR 2703 005533 1371 TAD (-6 /SIX WORD NEGATE 2704 005534 3351 DCA NFCNT 2705 005535 7100 CLL 2706 005536 7004 NFLOOP, RAL 2707 005537 1750 TAD I NFPTR /GET NEXT WORD 2708 005540 7161 CLL CML CIA 2709 005541 3750 DCA I NFPTR /RESTORE AFTER COMPLEMENTING 2710 005542 7260 CML CLA CMA /LINK GETS COMPLEMENTED ONCE HERE 2711 005543 1350 TAD NFPTR /AND ONCE AGAIN HERE 2712 005544 3350 DCA NFPTR /RESTORE DECREMENTED POINTER 2713 005545 2351 ISZ NFCNT 2714 005546 5336 JMP NFLOOP 2715 005547 5730 JMP I NEGFAC 2716 005550 0000 NFPTR, 0 2717 005551 0000 NFCNT, 0 2718 ITRCNT, 2719 005552 0000 DHLRTH, 0 /HOLLERITH IN DATA SUBR 2720 005553 2044 ISZ TEMP 2721 005554 7410 SKP 2722 005555 5752 JMP I DHLRTH 2723 005556 2352 ISZ DHLRTH 2724 005557 4546 JMS I [GETCWB 2725 005560 5770 JMP DHOLER 2726 005561 5752 JMP I DHLRTH 2727 / VARIABLE SCANNER 2728 005570 5725 PAGE 005571 7772 005572 0030 005573 5344 005574 5463 005575 4452 005576 5316 005577 7704 2729 005600 0000 GETNAM, 0 /GET VARIABLE NAME 2730 005601 4777 JMS LETTER /FIRST CHAR MUST BE ALPHABETIC 2731 005602 5600 JMP I GETNAM /NO VARIABLE 2732 005603 3021 DCA BUCKET /FIRST ONE IS THE BUCKET 2733 005604 1376 TAD (NAME1 2734 005605 3240 DCA NPTR /POINTER TO NAME BUFFER 2735 005606 7146 CLL CMA RTL /SIX CHARS MAX (3 WORDS) 2736 005607 3775 DCA NCNT 2737 005610 4777 PAKLUP, JMS LETTER /GET A LETTER 2738 005611 7410 SKP 2739 005612 5215 JMP .+3 /WE GOT IT 2740 005613 4551 JMS I [DIGIT /NO LETTER, IS IT A DIGIT ? 2741 005614 5224 JMP NDONE /NO, NAMES OVER 2742 005615 7106 CLL RTL 2743 005616 7006 RTL 2744 005617 7006 RTL /MOVE CHAR TO A HIGHER PLACE 2745 005620 3640 DCA I NPTR /STORE IT 2746 005621 2775 ISZ NCNT /BUMP COUNTER 2747 005622 5227 JMP MORNAM /MORE TO COME 2748 005623 7410 SKP 2749 005624 3640 NDONE, DCA I NPTR /ZERO NEXT WORD 2750 005625 2200 ISZ GETNAM /FIX RETURN ADDR 2751 005626 5600 JMP I GETNAM 2752 005627 4777 MORNAM, JMS LETTER /GET NEXT CHAR 2753 005630 7410 SKP 2754 005631 5234 JMP .+3 /ITS A LETTER 2755 005632 4551 JMS I [DIGIT 2756 005633 5225 JMP NDONE+1 /NO GOOD, NAMES OVER 2757 005634 1640 TAD I NPTR 2758 005635 3640 DCA I NPTR /COMBINE TWO CHARS 2759 005636 2240 ISZ NPTR 2760 005637 5210 JMP PAKLUP 2761 005640 0000 NPTR, 0 2762 NCNT=OADD 2763 / DATA STATEMENT 2764 005641 4547 DATA, JMS I [IFCHEK /IF(..)DATA ???? 2765 005642 1374 TAD (DATAST /START DATA STATEMENT 2766 005643 4572 JMS I [OUTWRD 2767 005644 7240 DATLUP, CLA CMA /SET DIMNUM = -1 IF NO SUBSCRIPTS 2768 005645 4542 JMS I [GETSS /GET LIST ELEMENT 2769 005646 5322 JMP DATAER 2770 005647 1373 TAD (DPUSH /OUTPUT DPUSH OPERATOR 2771 005650 4572 JMS I [OUTWRD 2772 005651 7040 CMA 2773 005652 1045 TAD TEMP2 /FOLLOWED BY POINTER 2774 005653 4572 JMS I [OUTWRD 2775 005654 1067 TAD DIMNUM /FOLLOWED BY NUMBER 2776 005655 4572 JMS I [OUTWRD 2777 005656 6211 CDF 10 2778 005657 1445 TAD I TEMP2 /LOOK AT TYE TYPE 2779 005660 0372 AND (20 /IS IT AN ARG ? 2780 005661 6201 CDF 2781 005662 7640 SZA CLA 2782 005663 5322 JMP DATAER /YES, THATS BAD 2783 005664 4567 JMS I [GETC /, ? 2784 005665 5322 JMP DATAER 2785 005666 1371 TAD (-254 2786 005667 7450 SNA 2787 005670 5244 JMP DATLUP /LOOK FOR MORE 2788 005671 1370 TAD (254-257 // ? 2789 005672 7640 SZA CLA 2790 005673 5322 JMP DATAER 2791 005674 5767 JMP DLOOP2 /GO LOOK FOR ELEMENT 2792 005675 1366 DATA3, TAD (WORD1-1 2793 005676 3010 DCA X10 /POINTER TO THE GOODS 2794 005677 1410 TAD I X10 /THEN STUFF 2795 005700 4572 JMS I [OUTWRD 2796 005701 2044 ISZ TEMP 2797 005702 5277 JMP .-3 2798 005703 1365 NXTDE, TAD (ENDELM /OUTPUT END OF ELEMENT 2799 005704 4572 JMS I [OUTWRD 2800 005705 4567 JMS I [GETC /LOOK FOR COMMA 2801 005706 5322 JMP DATAER 2802 005707 1371 TAD (-254 2803 005710 7450 SNA 2804 005711 5767 JMP DLOOP2 /YES, GET MORE DATA 2805 005712 1370 TAD (254-257 /SLASH ? 2806 005713 7640 SZA CLA 2807 005714 5322 JMP DATAER /NO, ERROR 2808 005715 4567 JMS I [GETC /ANOTHER DATA GROUP ? 2809 005716 5564 JMP I [NEXTST /NO 2810 005717 1371 TAD (-254 /COMMA ? 2811 005720 7650 SNA CLA 2812 005721 5242 JMP DATA+1 /START A NEW DATA STMT 2813 005722 4576 DATAER, JMS I [ERMSG 2814 005723 0401 0401 /OK WHEN THIS IS AN AND 2815 005724 5564 JMP I [NEXTST 2816 005725 4576 DHOLER, JMS I [ERMSG 2817 005726 0410 0410 /HOLLERITH DATA ERROR 2818 005727 5564 JMP I [NEXTST 2819 005730 0000 DQUOTE, 0 /GET CHAR FOR QUOTED DATA 2820 005731 4546 JMS I [GETCWB 2821 005732 5325 JMP DHOLER 2822 005733 1132 TAD [-247 2823 005734 7440 SZA 2824 005735 5345 JMP DNOTQ2 2825 005736 4546 JMS I [GETCWB 2826 005737 5730 JMP I DQUOTE 2827 005740 1132 TAD [-247 2828 005741 7650 SNA CLA 2829 005742 5345 JMP DNOTQ2 /REPLACE '' BY ' 2830 005743 4557 JMS I [BACK1 2831 005744 5730 JMP I DQUOTE 2832 005745 1131 DNOTQ2, TAD [247 /FIX CHAR 2833 005746 2330 ISZ DQUOTE 2834 005747 5730 JMP I DQUOTE 2835 005750 0000 OUT3WD, 0 /2.02/ OUTPUT 3 WORDS 2836 005751 1152 TAD [DATELM /2.02/ OUTPUT ELEMENT HEAD 2837 005752 4572 JMS I [OUTWRD /2.02/ 2838 005753 1364 TAD (3 /2.02/ AND SIZE 2839 005754 4572 JMS I [OUTWRD /2.02/ 2840 005755 1022 TAD WORD1 /2.02/ NOW THREE WORDS 2841 005756 4572 JMS I [OUTWRD /2.02/ 2842 005757 1023 TAD WORD2 /2.02/ 2843 005760 4572 JMS I [OUTWRD /2.02/ 2844 005761 1024 TAD WORD3 /2.02/ 2845 005762 4572 JMS I [OUTWRD /2.02/ 2846 005763 5750 JMP I OUT3WD /2.02/ 2847 / DATA STATEMENT 2848 005764 0003 PAGE 005765 0066 005766 0021 005767 6000 005770 7775 005771 7524 005772 0020 005773 0023 005774 0065 005775 4452 005776 6200 005777 3324 2849 006000 4567 DLOOP2, JMS I [GETC 2850 006001 5777 JMP DATAER 2851 006002 1376 TAD (-250 /IS CHAR ( ? 2852 006003 7440 SZA 2853 006004 5225 JMP NOCMPD /NO, NOT COMPLEX DATA 2854 006005 4536 JMS I [NUMBER /GET REAL PART 2855 006006 5777 JMP DATAER 2856 006007 7410 SKP 2857 006010 5777 JMP DATAER /DP IS NG WITH COMPLEX 2858 006011 4775 JMS OUT3WD /2.02/ OUTPUT 3 WORDS 2859 006012 4556 JMS I [CHECKC /LOOK FOR COMMA 2860 006013 7524 -254 2861 006014 5777 JMP DATAER /BAD IF NOT THERE 2862 006015 4536 JMS I [NUMBER /GET IMAGINARY PART 2863 006016 5777 JMP DATAER 2864 006017 7410 SKP 2865 006020 5777 JMP DATAER 2866 006021 4556 JMS I [CHECKC /LOOK FOR ) 2867 006022 7527 -251 2868 006023 5777 JMP DATAER /NOT THERE 2869 006024 5256 JMP DATAFP /GO MOVE IMAGINARY PART 2870 006025 7001 NOCMPD, IAC /IS IT QUOTED STRING ? 2871 006026 7440 SZA 2872 006027 5232 JMP NQUOTD /NO 2873 006030 1374 TAD (DQUOTE /GET SUBR ADDRESS 2874 006031 5301 JMP HOLDAT /GO HANDLE IT 2875 006032 1373 NQUOTD, TAD (247-317 /IS IT AN O (OCTAL) 2876 006033 7450 SNA 2877 006034 5772 JMP I (XOCTAL /YES 2878 006035 1371 TAD (317-256 /IS IT . 2879 006036 7650 SNA CLA 2880 006037 4770 JMS I (TRUFAL /CHECK FOR TRUE OR FALSE 2881 006040 5251 JMP NOTF /NO TRUE-FALSE, TRY NUMBER 2882 006041 7132 CLL CML RTR /2000 2883 006042 3023 DCA WORD2 2884 006043 1023 TAD WORD2 2885 006044 7640 SZA CLA 2886 006045 7001 IAC 2887 006046 3022 DCA WORD1 /TRUE=1.0 FALSE=0.0 2888 006047 3024 DCA WORD3 2889 006050 5256 JMP DATAFP /GO PUT IT 2890 006051 4557 NOTF, JMS I [BACK1 /PUT BACK CHAR 2891 006052 4536 JMS I [NUMBER /TRY FOR A NUMBER 2892 006053 5777 JMP DATAER /ELEMENT MISSING 2893 006054 5266 JMP TRYHOS /IF INTEGER, TRY FOR H OR * 2894 006055 1367 TAD (-3 2895 006056 1367 DATAFP, TAD (-3 /FP DATA 2896 006057 3044 DCA TEMP /SIZE OF ITEM 2897 006060 1152 TAD [DATELM /DATA ELEMENT SIGNAL 2898 006061 4572 JMS I [OUTWRD 2899 006062 1044 TAD TEMP /THEN SIZE 2900 006063 7041 CIA /ALWAYS POSITIVE 2901 006064 4572 JMS I [OUTWRD 2902 006065 5766 JMP DATA3 /GO OUTPUT THE DATA 2903 006066 4567 TRYHOS, JMS I [GETC /LOOK FOR H 2904 006067 5777 JMP DATAER 2905 006070 1365 TAD (-310 2906 006071 7440 SZA 2907 006072 5343 JMP TRYSTR /NOT H, MAYBE ITS * 2908 006073 4541 JMS I [FIXNUM /INTEGERIZE IT 2909 006074 7450 SNA 2910 006075 5764 JMP DHOLER /HOLLERITH DATA ERROR 2911 006076 7040 CMA 2912 006077 3044 DCA TEMP /SAVE COUNT 2913 006100 1363 TAD (DHLRTH /GET SUBR POINTER 2914 006101 3051 HOLDAT, DCA HCHAR 2915 006102 7146 CLL CMA RTL /2.02/ COUNT 2916 006103 3045 DCA TEMP2 /2.02/ BY THREES 2917 006104 1362 TAD (WORD1-1 /2.02/ 2918 006105 3010 DCA X10 /2.02/ POINTER 2919 006106 4451 HDLOOP, JMS I HCHAR /GET A CHAR 2920 006107 5326 JMP EOHD /2.02/ 2921 006110 0145 AND [77 /6 BITIZE IT 2922 006111 7106 CLL RTL 2923 006112 7006 RTL 2924 006113 7006 RTL /UPPER-PART-OF-WORDIZE 2925 006114 3024 DCA WORD3 /2.02/ STORAGIZE IT 2926 006115 4451 JMS I HCHAR /GET ANOTHER 2927 006116 5333 JMP LASTHD /LAST HALF WORD MUST GO OUT 2928 006117 0145 AND [77 2929 006120 1024 TAD WORD3 /2.02/ COMBINIZE THE TWO HALVES 2930 006121 3410 DCA I X10 /2.02/ STORE IT 2931 006122 2045 ISZ TEMP2 /2.02/ THREE AT A TIME 2932 006123 5306 JMP HDLOOP /2.02/ 2933 006124 4775 JMS OUT3WD /2.02/ OUTPUT THREE 2934 006125 5302 JMP HOLDAT+1 /2.02/ GO DO NEXT THREE WDS 2935 006126 7126 EOHD, CLL CML RTL /2.02/ ANY CHARS IN THIS SET ? 2936 006127 1045 TAD TEMP2 /2.02/ 2937 006130 7710 SPA CLA /2.02/ 2938 006131 5761 JMP NXTDE /2.02/ NO, DO NEXT ELEMENT 2939 006132 5336 JMP .+4 /2.02/ YES, FILL IT OUT 2940 006133 1024 LASTHD, TAD WORD3 /2.02/ FILL OUT LOWER CHAR 2941 006134 1360 TAD (40 /2.02/ WITH A BLANK 2942 006135 3410 DCA I X10 /2.02/ 2943 006136 1357 TAD (4040 /2.02/ THEN FILL REST 2944 006137 3410 DCA I X10 /2.02/ WITH BLANKS 2945 006140 1357 TAD (4040 /2.02/ 2946 006141 3410 DCA I X10 /2.02/ 2947 006142 5256 JMP DATAFP /2.02/ GO OUTPUT IT 2948 006143 1356 TRYSTR, TAD (310-252 /* 2949 006144 7650 SNA CLA 2950 006145 5350 JMP .+3 2951 006146 4557 JMS I [BACK1 /PUT BACK THAT CHAR 2952 006147 5256 JMP DATAFP /ITS JUST AN INTEGER 2953 006150 1355 TAD (DREPTC /REPETITION COUNT 2954 006151 4572 JMS I [OUTWRD 2955 006152 4541 JMS I [FIXNUM 2956 006153 4572 JMS I [OUTWRD /OUTPUT COUNT 2957 006154 5200 JMP DLOOP2 /LOOP 2958 / INITIALIZE READ IN 2959 006155 0064 *6400 006156 0036 006157 4040 006160 0040 006161 5703 006162 0021 006163 5552 006164 5725 006165 7470 006166 5675 006167 7775 006170 4044 006171 0041 006172 1140 006173 7730 006174 5730 006175 5750 006176 7530 006177 5722 2960 006400 1272 INITLN, TAD IX7772 /READ FIRST SIX CHARS 2961 006401 3044 DCA TEMP 2962 006402 1121 TAD IXLINM 2963 006403 3015 DCA CHRPTR 2964 006404 6212 INITLP, CIF 10 2965 006405 4577 JMS I [ICHAR /READ A CHAR 2966 006406 5200 JMP INITLN 2967 006407 1273 TAD IXM211 /TAB ? 2968 006410 7640 SZA CLA 2969 006411 5217 JMP NIXTAB /NO THIS ONE 2970 006412 1267 TAD IX0240 2971 006413 3415 DCA I CHRPTR 2972 006414 2044 ISZ TEMP 2973 006415 5212 JMP .-3 2974 006416 5223 JMP CHKCOM /DO COMMENT CHECK 2975 006417 1040 NIXTAB, TAD CHAR 2976 006420 3415 DCA I CHRPTR /STORE THE CHAR 2977 006421 2044 ISZ TEMP 2978 006422 5204 JMP INITLP 2979 006423 1520 CHKCOM, TAD I IXLINE /COMMENT ? 2980 006424 1266 TAD IXM303 2981 006425 7650 SNA CLA 2982 006426 5256 JMP IGNORE /IGNORE IT 2983 006427 1517 TAD I IXLNP5 /CONTINUATION ? 2984 006430 1265 TAD IXM240 2985 006431 7640 SZA CLA 2986 006432 5256 JMP IGNORE 2987 006433 1274 TAD IX7700 /FIX CALL 2988 006434 6211 CDF 10 /SEE WHAT HAPPENS WHEN YOU MOVE A ROUTINE** 2989 006435 3664 DCA I IXINCL 2990 006436 6201 CDF /** 2991 006437 6212 CIF 10 2992 006440 4670 JMS I IX200 /REMOVE MONITOR 2993 006441 0011 11 2994 006442 6211 CDF 10 /FIX FIELD ONE STUFF 2995 006443 1653 TAD I MOV1 2996 006444 3654 DCA I MOV2 2997 006445 2253 ISZ MOV1 2998 006446 2254 ISZ MOV2 2999 006447 2255 ISZ MOVCNT 3000 006450 5243 JMP .-5 3001 006451 6201 CDF 3002 006452 5663 JMP I IXRDFS /LOOK FOR PROG HEADER 3003 006453 2020 MOV1, 2020 3004 006454 0020 MOV2, 20 3005 006455 7620 MOVCNT, -160 3006 006456 6212 IGNORE, CIF 10 /** 3007 006457 4577 JMS I [ICHAR /SKIP TILL CARRIAGE RETURN 3008 006460 5200 JMP INITLN 3009 006461 7200 CLA 3010 006462 5256 JMP IGNORE 3011 006463 6600 IXRDFS, RDFRST 3012 006464 5754 IXINCL, INCALL 3013 006465 7540 IXM240, -240 3014 006466 7475 IXM303, -303 3015 006467 0240 IX0240, 0240 3016 006470 0200 IX200, 200 3017 006471 7600 IX7600, 7600 3018 006472 7772 IX7772, 7772 3019 006473 7567 IXM211, -211 3020 006474 7700 IX7700, 7700 /V3C 3021 / SEARCH FOR PROGRAM HEADER 3022 PAGE 3023 006600 6212 RDFRST, CIF 10 /** 3024 006601 4577 JMS I [ICHAR /THIS IS A DUPLICATE OF THE CODE 3025 006602 5232 JMP ENDLNF /AT LABEL 'RDLOOP' , ONLY THE 3026 006603 1377 TAD (-211 3027 006604 7450 SNA 3028 006605 1376 TAD (240-211 3029 006606 1375 TAD (211 3030 006607 3415 DCA I CHRPTR /NAMES HAVE BEEN CHANGED TO 3031 006610 2111 ISZ CNT72 3032 006611 7410 SKP 3033 006612 5223 JMP SKPFL2 3034 006613 1015 TAD CHRPTR /PROTECT THE ASSEMBLY 3035 006614 7141 CIA CLL /(IT GETS THE FIRST LINE 3036 006615 1374 TAD (LINE+270 /WHICH MAY BE SUBROUTINE OR 3037 /FUNCTION. 1ST LINE SHORTER THAN REST BEC OF BUFFER OVERWRITES** 3038 006616 7630 SZL CLA /OR SOMETHING ELSE, IN WHICH CASE 3039 006617 5200 JMP RDFRST /ITS THE MAIN PROGRAM) 3040 006620 4576 JMS I [ERMSG /LINE TOO LONG 3041 006621 1424 1424 3042 006622 5267 JMP SKPFL /SKIP REST 3043 006623 6212 SKPFL2, CIF 10 /** 3044 006624 4577 JMS I [ICHAR 3045 006625 5232 JMP ENDLNF 3046 006626 7200 CLA 3047 006627 5223 JMP SKPFL2 3048 006630 1016 SKPCMF, TAD X16 /BY ORDER OF THE EMPEROR 3049 006631 3015 DCA CHRPTR /MARIO DE NOBILI 3050 006632 1015 ENDLNF, TAD CHRPTR 3051 006633 3016 DCA X16 3052 006634 1015 TAD CHRPTR 3053 006635 3010 DCA X10 3054 006636 1373 TAD (-102 3055 006637 3111 DCA CNT72 3056 006640 1372 TAD (-6 3057 006641 3042 DCA NCHARS 3058 006642 6212 GET6F, CIF 10 /** 3059 006643 4577 JMS I [ICHAR 3060 006644 5230 JMP SKPCMF 3061 006645 1377 TAD (-211 3062 006646 7640 SZA CLA 3063 006647 5257 JMP NOTABF 3064 006650 1371 TAD (240 3065 006651 3415 DCA I CHRPTR 3066 006652 2042 ISZ NCHARS 3067 006653 5250 JMP .-3 3068 006654 1371 TAD (240 3069 006655 3040 DCA CHAR 3070 006656 5263 JMP CCHEKF 3071 006657 1040 NOTABF, TAD CHAR 3072 006660 3415 DCA I CHRPTR 3073 006661 2042 ISZ NCHARS 3074 006662 5242 JMP GET6F 3075 006663 1410 CCHEKF, TAD I X10 3076 006664 1370 TAD (-303 3077 006665 7640 SZA CLA 3078 006666 5274 JMP NOCMTF 3079 006667 6212 SKPFL, CIF 10 /** 3080 006670 4577 JMS I [ICHAR 3081 006671 5230 JMP SKPCMF 3082 006672 7200 CLA 3083 006673 5267 JMP SKPFL 3084 006674 1040 NOCMTF, TAD CHAR 3085 006675 1367 TAD (-240 3086 006676 7650 SNA CLA 3087 006677 5303 JMP GOTFST 3088 006700 1016 CCARDF, TAD X16 3089 006701 3015 DCA CHRPTR 3090 006702 5200 JMP RDFRST 3091 006703 1015 GOTFST, TAD CHRPTR 3092 006704 7041 CIA 3093 006705 1366 TAD (LINE+4 3094 006706 3042 DCA NCHARS 3095 006707 1175 TAD [LINE-1 3096 006710 3015 DCA CHRPTR 3097 006711 4571 JMS I [SAVECP 3098 006712 1365 TAD (HDRLST-1 3099 006713 3010 DCA X10 /PREPARE TO SEARCH THE LIST 3100 006714 6211 CLOOP1, CDF 10 /(FNC NAMES UP IN FLD 1)** 3101 006715 1410 TAD I X10 /OF LEGAL HEADER LINES 3102 006716 6201 CDF 3103 006717 7440 SZA /CODE IS AS UNDER 'CMDLUP' 3104 006720 5331 JMP CLOOP2 3105 006721 7244 CLA CMA RAL 3106 006722 1014 TAD STACK 3107 006723 3014 DCA STACK 3108 006724 6211 CDF 10 /** 3109 006725 1410 TAD I X10 3110 006726 6201 CDF 3111 006727 3044 DCA TEMP 3112 006730 5444 JMP I TEMP 3113 006731 3044 CLOOP2, DCA TEMP 3114 006732 4563 JMS I [GET2C 3115 006733 5356 JMP BADCMF 3116 006734 7041 CIA 3117 006735 1044 TAD TEMP 3118 006736 7650 SNA CLA 3119 006737 5314 JMP CLOOP1 3120 006740 6211 SEARCH, CDF 10 /** 3121 006741 1410 TAD I X10 3122 006742 6201 CDF 3123 006743 7640 SZA CLA 3124 006744 5340 JMP SEARCH 3125 006745 2010 ISZ X10 3126 006746 4565 JMS I [RESTCP 3127 006747 2014 ISZ STACK 3128 006750 2014 ISZ STACK 3129 006751 6211 CDF 10 /** 3130 006752 1410 TAD I X10 3131 006753 6201 CDF 3132 006754 7440 SZA 3133 006755 5331 JMP CLOOP2 3134 006756 4565 BADCMF, JMS I [RESTCP /NOT A FUNCTION OR SUBROUTINE 3135 006757 5764 JMP I (LINE1 /SO GO TO MAIN PART OF COMPILER 3136 006760 4544 BADDIE, JMS I [MESSAG /SOMETHING MISSING FROM SYS 3137 006761 0323 323 /S 3138 006762 0331 331 /Y 3139 / ANALYZE PROGRAM HEADER 3140 006764 0307 PAGE 006765 2377 006766 6304 006767 7540 006770 7475 006771 0240 006772 7772 006773 7676 006774 6570 006775 0211 006776 0027 006777 7567 3141 007000 7240 SUBRTN, CLA CMA /SET TO -1 FOR SUBR 3142 007001 5217 JMP XXXFUN+1 3143 007002 1377 REAFUN, TAD (102 /SET TYPE TO REAL 3144 007003 3027 DCA TYPE 3145 007004 5216 JMP XXXFUN 3146 007005 7001 LOGFUN, IAC /SET TYPE OF FUN 3147 007006 7001 DBLFUN, IAC /WITH DOUBLEMINT GUM ! 3148 007007 7001 CMPFUN, IAC 3149 007010 7001 IAC 3150 007011 1376 INTFUN, TAD (101 3151 007012 3027 DCA TYPE 3152 007013 4556 JMS I [CHECKC /LOOK FOR 'N' 3153 007014 7462 -316 3154 007015 5315 JMP BADBGN 3155 007016 7201 XXXFUN, CLA IAC 3156 007017 3103 DCA FUNCTN /SET SWITCH 3157 007020 6211 CDF 10 /1.05/ KILL ENTRY FOR 'MAIN' 3158 007021 3775 DCA I (ALIST+14 /1.05/ BUT DO IT BEFORE THE M BUCKET 3159 007022 6201 CDF /1.05/ CONTAINS ANYTHING USEFULL 3160 007023 4577 JMS I [GETNAM /GET FUNC/SUBR NAME 3161 007024 5315 JMP BADBGN 3162 007025 4554 JMS I [LOOKUP /PUT INTO SYMBOL TABLE 3163 007026 3101 DCA PROGNM 3164 007027 1101 TAD PROGNM /SET UP TYPE 3165 007030 7001 IAC 3166 007031 3044 DCA TEMP 3167 007032 1014 TAD STACK 3168 007033 3012 DCA X12 /SAVE POINTER 3169 007034 3045 DCA TEMP2 /ZERO ARG COUNTER 3170 007035 6211 CDF 10 3171 007036 1027 TAD TYPE /PUT IN THE TYPE BITS 3172 007037 1374 TAD (1000 3173 007040 3444 DCA I TEMP 3174 007041 6201 CDF 3175 007042 4556 JMS I [CHECKC /LOOK OFR ( 3176 007043 7530 -250 3177 007044 5312 JMP ISITFN /IS IT A FUNCTION ? 3178 007045 4577 ARGLUP, JMS I [GETNAM /GET THE ARG 3179 007046 5315 JMP BADBGN 3180 007047 4554 JMS I [LOOKUP 3181 007050 7001 IAC 3182 007051 3044 DCA TEMP /ADDR OF TYPE WORD 3183 007052 6211 CDF 10 3184 007053 1444 TAD I TEMP 3185 007054 7640 SZA CLA 3186 007055 5315 JMP BADBGN /ALREADY AN ARG 3187 007056 1373 TAD (20 3188 007057 3444 DCA I TEMP 3189 007060 6201 CDF 3190 007061 7040 CMA 3191 007062 1044 TAD TEMP /OUTPUT ADDR OF ARG 3192 007063 4561 JMS I [PUSH 3193 007064 2045 ISZ TEMP2 /KEEP COUNT 3194 007065 4560 JMS I [COMARP /LOOK FOR , OR ) 3195 007066 5315 JMP BADBGN /NEITHER 3196 007067 5245 JMP ARGLUP /, 3197 007070 1045 TAD TEMP2 /) HOW MANY ARGS ? 3198 007071 6211 CDF 10 3199 007072 3413 DCA I NEXT /INTO ARG LIST 3200 007073 1045 TAD TEMP2 3201 007074 7041 CIA 3202 007075 3045 DCA TEMP2 3203 007076 1013 TAD NEXT /SAVE ADDR OF ARG LIST 3204 007077 3102 DCA ARGLST 3205 007100 6201 CDF 3206 007101 1012 TAD X12 /RESTORE THE STACK 3207 007102 3014 DCA STACK 3208 007103 1412 MOVARG, TAD I X12 /PUT ARGS INTO ARG LIST 3209 007104 6211 CDF 10 3210 007105 3413 DCA I NEXT 3211 007106 6201 CDF 3212 007107 2045 ISZ TEMP2 3213 007110 5303 JMP MOVARG 3214 007111 5564 JMP I [NEXTST /DO NEXT LINE 3215 TYPE=WORD6 3216 007112 1103 ISITFN, TAD FUNCTN /IS IT A FUNCTION 3217 007113 7750 SPA SNA CLA /WITH NO ARGS ? 3218 007114 5564 JMP I [NEXTST /NO, WE'RE OK 3219 007115 4576 BADBGN, JMS I [ERMSG 3220 007116 2010 2010 3221 007117 5564 JMP I [NEXTST 3222 007120 4556 BDATA, JMS I [CHECKC /LOOK FOR A 3223 007121 7477 -301 3224 007122 5315 JMP BADBGN 3225 007123 7144 CLL CMA RAL /SET FUNCTION SWITCH 3226 007124 3103 DCA FUNCTN /2.02/ STORE IT DUMMY!! 3227 007125 1372 TAD (BDLIST-1 /POINTER TO LIST OF PATCHES 3228 007126 3010 DCA X10 3229 007127 6211 BDLOOP, CDF 10 3230 007130 1410 TAD I X10 /GET PATCH LOCATION 3231 007131 6201 CDF 3232 007132 7450 SNA 3233 007133 5564 JMP I [NEXTST /NO MORE PATCHES 3234 007134 3044 DCA TEMP /SAVE PATCH ADDRESS 3235 007135 1340 TAD BADJMP /GET ERROR JUMP 3236 007136 3444 DCA I TEMP /STORE IT 3237 007137 5327 JMP BDLOOP /LOOP 3238 007140 5524 BADJMP, JMP I [BDERR 3239 / INITIAL SYMBOL TABLE 3240 007172 0112 FIELD 1 007173 0020 007174 1000 007175 0037 007176 0101 007177 0102 000124 2364 000125 0017 000126 7430 000127 2140 000130 3310 000131 0247 000132 7531 000133 3301 000134 3453 000135 2702 000136 5000 000137 3403 000140 0036 000141 3745 000142 2001 000143 7524 000144 3543 000145 0077 000146 3726 000147 2231 000150 0007 000151 4317 000152 0063 000153 2400 000154 2600 000155 0435 000156 3347 000157 4442 000160 1544 000161 4200 000162 4034 000163 4213 000164 0437 000165 1064 000166 3000 000167 4000 000170 4064 000171 3737 000172 1402 000173 4231 000174 1130 000175 6277 000176 4015 000177 5600 3241 *2020 3242 NOPUNC 3243 *20 3244 ENPUNC 3245 010020 0000 0 3246 010021 0111 BLNKCN, 111;0 /BLANK COMMON SLOT 010022 0000 3247 010023 0000 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 010024 0000 010025 0000 010026 0000 010027 0000 010030 0000 010031 0000 010032 0000 010033 0000 010034 0000 010035 0000 010036 0000 010037 0105 010040 0000 010041 0000 010042 0000 010043 0000 010044 0000 010045 0000 010046 0000 010047 0000 010050 0000 010051 0000 010052 0000 010053 0000 010054 0000 3248 010055 0000 HOLIST, 0 3249 010056 0000 FPLIST, 0 3250 010057 0000 DPLIST, 0 3251 010060 0063 INTLST, ONE 3252 010061 0000 CMPLST, 0 3253 010062 0000 SNLIST, 0 3254 010063 0070 ONE, THREE;0;1;2000;0 010064 0000 010065 0001 010066 2000 010067 0000 3255 010070 0075 THREE, SIX;0;2;3000;0 010071 0000 010072 0002 010073 3000 010074 0000 3256 010075 0000 SIX, 0;0;3;3000;0 010076 0000 010077 0003 010100 3000 010101 0000 3257 010102 0000 TRUE, 0;0145;0 010103 0145 010104 0000 3258 010105 0000 MAIN, 0;1000;0;0111;1600 010106 1000 010107 0000 010110 0111 010111 1600 3259 010112 0000 FREE, 0 3260 / BLOCK DATA PATCH LIST 3261 010113 2200 BDLIST, IF /BLOCK DATA PATCH LIST 3262 010114 2555 DOUBLE 3263 010115 2300 DO 3264 010116 0501 GOTO 3265 010117 2240 CALL 3266 010120 1121 READ 3267 010121 5156 REWIND 3268 010122 2545 ENDFIL 3269 010123 1341 FORMAT 3270 010124 1123 WRITE 3271 010125 1363 BACKSP 3272 010126 4335 ASSIGN 3273 010127 2765 STOP 3274 010130 1102 PAUZE 3275 010131 1014 DFINFL 3276 010132 1013 FIND 3277 010133 0345 ITSAR 3278 010134 0000 0 3279 / INITIALIZATION 3280 *2200 3281 012200 7410 START, SKP /NON-CHAINED ENTRY POINT 3282 012201 5206 JMP .+5 /CCL ENTRY 3283 012202 6213 CIF CDF 10 /START HERE 3284 012203 4777 JMS I (200 /COMMAND DECODE 3285 012204 0005 5 3286 012205 0624 0624 /DEFAULT EXT IS .FT 3287 012206 1753 TAD I L7600 /IS AN OUTPUT FILE GIVEN ? 3288 012207 7650 SNA CLA 3289 012210 5312 JMP MYFILE /NO, USE FORTRN.TM 3290 012211 1732 MOVOFN, TAD I OFNAME /MOVE NAME INTO PAGE 0 3291 012212 6201 CDF 3292 012213 3733 DCA I NAMEOF 3293 012214 6211 CDF 10 3294 012215 2333 ISZ NAMEOF 3295 012216 2332 ISZ OFNAME 3296 012217 2335 ISZ OFNSIZ 3297 012220 5211 JMP MOVOFN 3298 012221 1776 EXTEST, TAD I (7604 /SET DEFAULT EXTENSIONS 3299 012222 7440 SZA 3300 012223 5233 JMP EXTSET 3301 012224 1775 TAD I (7643 3302 012225 7510 SPA 3303 012226 5353 JMP GETRA /A WAS SET.USE RA 3304 012227 0356 AND L41 /CHECK FOR L+G 3305 012230 7650 SNA CLA 3306 012231 1374 TAD (0610 /USE RL 3307 012232 1373 TAD (1404 /USE LD 3308 012233 3776 EXTSET, DCA I (7604 3309 012234 1776 TAD I (7604 3310 012235 6201 CDF 0 3311 012236 3752 DCA I NAMF 3312 012237 6211 CDF 10 3313 012240 1772 TAD I (7611 3314 012241 7450 SNA 3315 012242 1371 TAD (1423 /.LS FOR LISTING 3316 012243 3772 DCA I (7611 3317 012244 1770 TAD I (7616 3318 012245 7450 SNA 3319 012246 1367 TAD (1520 /.MP FOR LOAD MAP 3320 012247 3770 DCA I (7616 3321 012250 7201 EFILE, CLA IAC /OPEN PASS1 OUTPUT FILE 3322 012251 4777 JMS I (200 3323 012252 0003 3 3324 012253 2336 OBLOK, TMPFL2 3325 012254 0000 OSIZE, 0 3326 012255 5330 JMP OBAD /BADDIE 3327 012256 6201 CDF 3328 012257 1253 TAD OBLOK /SAVE STARTING BLOCK 3329 012260 3766 DCA OUBLOK 3330 012261 1253 TAD OBLOK 3331 012262 3765 DCA I (OUFILE 3332 012263 1254 TAD OSIZE 3333 012264 3764 DCA OULEN 3334 012265 6211 CDF 10 3335 012266 7201 CLA IAC 3336 012267 4777 JMS I (200 /GET PASS2 3337 012270 0002 2 3338 012271 2342 SPASS2, PASS2N 3339 012272 0000 0 3340 012273 5330 JMP OBAD 3341 012274 7201 CLA IAC 3342 012275 4777 JMS I (200 3343 012276 0002 2 3344 012277 2346 SP2O, PAS2ON /GET PASS2 OVERLAY 3345 012300 0000 0 3346 012301 5330 JMP OBAD 3347 012302 6201 CDF /SAVE PASS2 AND PASS2O BLOCKS 3348 012303 1271 TAD SPASS2 3349 012304 3763 DCA PASS2B 3350 012305 1277 TAD SP2O /SKIP FIRST BLOCK 3351 012306 7001 IAC /ITS THE CORE TABLE 3352 012307 3762 DCA I (PASS2O 3353 012310 6202 CIF 3354 012311 5761 JMP INITLN /GO START COMPILE 3355 012312 6201 MYFILE, CDF /PUT DEFAULT INTO 17600 3356 012313 1734 TAD I NAMOF 3357 012314 3733 DCA I NAMEOF 3358 012315 1734 TAD I NAMOF /ALSO INTO PAGE 0 3359 012316 6211 CDF 10 3360 012317 3732 DCA I OFNAME 3361 012320 2334 ISZ NAMOF 3362 012321 2333 ISZ NAMEOF 3363 012322 2332 ISZ OFNAME 3364 012323 2335 ISZ OFNSIZ 3365 012324 5312 JMP MYFILE 3366 012325 7201 CLA IAC /SET DEV TO SYS 3367 012326 3753 DCA I L7600 3368 012327 5221 JMP EXTEST /GO OPEN FILE 3369 012330 6203 OBAD, CIF CDF 3370 012331 5760 JMP BADDIE 3371 012332 7601 OFNAME, 7601 /IGNORE DEVICE (ALWAYS USE SYS) 3372 012333 0061 NAMEOF, TMPFIL+4 3373 012334 0055 NAMOF, TMPFIL 3374 012335 7775 OFNSIZ, -3 3375 012336 0617 TMPFL2, 0617;2224;2216;2415 /FORTRN.TM 012337 2224 012340 2216 012341 2415 3376 012342 2001 PASS2N, 2001;2323;6200;2326 /PASS2.SV 012343 2323 012344 6200 012345 2326 3377 012346 2001 PAS2ON, 2001;2323;6217;2326 /PASS2O.SV 012347 2323 012350 6217 012351 2326 3378 012352 0064 NAMF, TMPFIL+7 3379 L7600, 3380 012353 7600 GETRA, 7600 /CLA 3381 012354 1357 TAD (2201 /V3C USE RA 3382 012355 5233 JMP EXTSET 3383 012356 0041 L41, 41 3384 012357 2201 PAGE 012360 6760 012361 6400 012362 0076 012363 1537 012364 1424 012365 0077 012366 1436 012367 1520 012370 7616 012371 1423 012372 7611 012373 1404 012374 0610 012375 7643 012376 7604 012377 0200 3385 / PROGRAM HEADER LIST 3386 012400 1116 HDRLST, TEXT 'INTEGERFUNCTIO' 012401 2405 012402 0705 012403 2206 012404 2516 012405 0324 012406 1117 012407 0000 3387 012410 7011 INTFUN 3388 012411 2205 TEXT 'REALFUNCTION' 012412 0114 012413 0625 012414 1603 012415 2411 012416 1716 012417 0000 3389 012420 7002 REAFUN 3390 012421 0317 TEXT 'COMPLEXFUNCTIO' 012422 1520 012423 1405 012424 3006 012425 2516 012426 0324 012427 1117 012430 0000 3391 012431 7007 CMPFUN 3392 012432 0417 TEXT 'DOUBLEPRECISIONFUNCTIO' 012433 2502 012434 1405 012435 2022 012436 0503 012437 1123 012440 1117 012441 1606 012442 2516 012443 0324 012444 1117 012445 0000 3393 012446 7006 DBLFUN 3394 012447 1417 TEXT 'LOGICALFUNCTIO' 012450 0711 012451 0301 012452 1406 012453 2516 012454 0324 012455 1117 012456 0000 3395 012457 7005 LOGFUN 3396 012460 0625 TEXT 'FUNCTION' 012461 1603 012462 2411 012463 1716 012464 0000 3397 012465 7016 XXXFUN 3398 012466 2325 TEXT 'SUBROUTINE' 012467 0222 012470 1725 012471 2411 012472 1605 012473 0000 3399 012474 7000 SUBRTN 3400 012475 0214 TEXT 'BLOCKDAT' 012476 1703 012477 1304 012500 0124 012501 0000 3401 012502 7120 BDATA 3402 012503 0000 0 3403 / 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 015400 1377 MORCHR, TAD (214 /FIX CHAR 3408 015401 6201 CDF 0 /** 3409 015402 3613 DCA I QCHAR 3410 015403 6211 CDF 10 3411 015404 1776 TAD I (ICHAR 3412 015405 7001 IAC /UPDATE ADDR 3413 015406 3212 DCA TCHAR 3414 015407 6203 CIF CDF 0 3415 015410 1613 TAD I QCHAR /RETURN VALUE IN AC 3416 015411 5612 JMP I TCHAR 3417 015412 0000 TCHAR, 0 3418 015413 0040 QCHAR, CHAR 3419 / EXTENDED OPERATOR LIST 3420 015414 7777 OPRLST, -01;-1604;ANDOPR 015415 6174 015416 4432 3421 015417 7761 -17;-2200;OROPR 015420 5600 015421 4434 3422 015422 7773 -05;-2100;EQOPR 015423 5700 015424 4416 3423 015425 7762 -16;-0500;NEOPR 015426 7300 015427 4420 3424 015430 7771 -07;-0500;GEOPR 015431 7300 015432 4422 3425 015433 7771 -07;-2400;GTOPR 015434 5400 015435 4424 3426 015436 7764 -14;-0500;LEOPR 015437 7300 015440 4426 3427 015441 7764 -14;-2400;LTOPR 015442 5400 015443 4430 3428 015444 7750 -30;-1722;XOROPR 015445 6056 015446 4436 3429 015447 7773 -05;-2126;EQVOPR 015450 5652 015451 4440 3430 015452 0000 0 3431 / EXPONENT TABLE 3432 015453 0004 PETABL, 0004;2400;0000 /1E1 015454 2400 015455 0000 3433 015456 0000 0000;0000;0000 015457 0000 015460 0000 3434 015461 0007 0007;3100;0000 /1E2 015462 3100 015463 0000 3435 015464 0000 0000;0000;0000 015465 0000 015466 0000 3436 015467 0016 0016;2342;0000 /1E4 015470 2342 015471 0000 3437 015472 0000 0000;0000;0000 015473 0000 015474 0000 3438 015475 0033 0033;2765;7020 /1E8 015476 2765 015477 7020 3439 015500 0000 0000;0000;0000 015501 0000 015502 0000 3440 015503 0066 0066;2160;6744 /1E16 015504 2160 015505 6744 3441 015506 6770 6770;1000;0 015507 1000 015510 0000 3442 015511 0153 0153;2356;1326 /1E32 015512 2356 015513 1326 3443 015514 6501 6501;2670;2655 015515 2670 015516 2655 3444 015517 0325 0325;3023;6017 /1E64 015520 3023 015521 6017 3445 015522 5117 5117;7747;6466 015523 7747 015524 6466 3446 015525 0652 0652;2235;6443 /1E128 015526 2235 015527 6443 3447 015530 7114 7114;0164;6145 015531 0164 015532 6145 3448 015533 1523 1523;2523;7565 /1E256 015534 2523 015535 7565 3449 015536 7734 7734;7374;7357 015537 7374 015540 7357 3450 015541 3245 3245;3430;6320 /1E512 015542 3430 015543 6320 3451 015544 2565 2565;1407;2176 015545 1407 015546 2176 3452 015547 0211 ENDSTM, 211;"E;"N;"D;215;211;215;232 /V3C 015550 0305 015551 0316 015552 0304 015553 0215 015554 0211 015555 0215 015556 0232 3453 /FAKE END STATEMENT USED IF PROGRAM HAS NONE 3454 015576 5600 PAGE 015577 0214 3455 /MAIN PART OF OS/8 INPUT ROUTINES 3456 3457 015600 0000 ICHAR, 0 /READ CHAR FROM INPUT FILE 3458 015601 6211 CDF 10 3459 015602 2250 ISZ INJMP /BUMP THREE WAY UNPACK SWITCH 3460 015603 2320 ISZ INCHCT 3461 015604 5250 INJMPP, JMP INJMP 3462 / CDF ** 3463 015605 1317 TAD INEOF /DID LAST READ YEILD END OF FILE ? 3464 015606 7650 SNA CLA 3465 015607 5212 JMP INGBUF /NO, DO ANOTHER READ 3466 015610 4320 GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE 3467 015611 5243 JMP ENDIN /END OF INPUT 3468 015612 1353 INGBUF, TAD INCTR /BUMP RECORD COUNTER 3469 015613 7101 CLL IAC 3470 015614 7420 SNL 3471 015615 3353 DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED 3472 015616 7430 SZL 3473 015617 2317 ISZ INEOF /SET END OF FILE SWITCH 3474 015620 6211 CDF 10 /** 3475 015621 6202 CIF 0 /** 3476 015622 4733 JMS I INHNDL /DO THE READ 3477 015623 0210 0210 /ONE BLOCK TO FIELD 1 3478 015624 6600 INBUFP, INBUF 3479 015625 0000 INREC, 0 3480 015626 5237 JMP INERR /HANDLER ERROR 3481 015627 2225 INBREC, ISZ INREC /BUMP RECORD NUMBER 3482 015630 1224 TAD INBUFP /RESET BUFFER POINTER 3483 015631 3355 SVIBPT, DCA INPTR /V3C 3484 015632 1377 TAD (-601 /SET CHAR COUNT 3485 015633 3320 DCA INCHCT 3486 015634 1204 TAD INJMPP /RESET THREE WAY JUMP SWITCH 3487 015635 3250 DCA INJMP 3488 015636 5201 JMP ICHAR+1 /GO AGAIN 3489 015637 2317 INERR, ISZ INEOF /EITHER EOF OR BADDIE 3490 015640 7700 SMA CLA 3491 015641 5227 JMP INBREC /END OF FILE, DO NEXT FILE 3492 015642 5245 JMP TERR /INPUT ERROR, GIVE I F AND EXIT 3493 015643 1376 ENDIN, TAD (ENDSTM /V3C IF NO END STATEMENT, FORCE ONE 3494 015644 5231 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 015645 4775 TERR, JMS I (MESSAG /YES, BAD INPUT. WAS SQ.BRCK** 3502 015646 0311 311 3503 015647 0306 306 3504 015650 7402 INJMP, HLT /3 WAY CHAR UNPACK BRANCH 3505 015651 5272 JMP ICHAR1 3506 015652 5266 JMP ICHAR2 3507 015653 1204 ICHAR3, TAD INJMPP /RESET JUMP SWITCH 3508 015654 3250 DCA INJMP 3509 015655 1755 TAD I INPTR 3510 015656 0374 AND (7400 /COMBINE THE HIGH ORDER BITS 3511 015657 7112 CLL RTR /OF THE TWO WORDS 3512 015660 7012 RTR 3513 015661 1315 TAD INTMP /TO FORM THE THIRD CHAR 3514 015662 7012 RTR 3515 015663 7012 RTR 3516 015664 2355 ISZ INPTR /BUMP WORD POINTER 3517 015665 5273 JMP ICHAR1+1 /DO SOME COMMON STUFF 3518 015666 1755 ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS 3519 015667 0374 AND (7400 3520 015670 3315 DCA INTMP /FOR THE THIRD CHAR 3521 015671 2355 ISZ INPTR /GO TO THE SECOND WORD 3522 015672 1755 ICHAR1, TAD I INPTR /GET THE LOW 8 BITS 3523 / CDF 3524 015673 0373 AND (177 /AND I MEAN ONLY 8 !! 3525 015674 7450 SNA /V3C YOU WERE WRONG - YOU MEANT ONLY 7 3526 015675 5201 JMP ICHAR+1 3527 015676 1372 TAD (-32 /IS IT ^Z (END OF FILE) 3528 015677 7450 SNA 3529 015700 5210 JMP GETNEW /YES, LOOK FOR THE NEXT FILE 3530 015701 1371 TAD (232-212 3531 015702 7450 SNA 3532 015703 5201 JMP ICHAR+1 /IGNORE LINE FEEDS 3533 015704 1370 TAD (212-215 3534 015705 7450 SNA 3535 015706 5313 JMP ICHARN /RETURN ON CARRIAGE RETURN ** 3536 015707 7001 IAC 3537 015710 7450 SNA 3538 015711 5201 JMP ICHAR+1 /IGNORE FORM FEEDS 3539 015712 5767 JMP I (MORCHR /** 3540 015713 6203 ICHARN, CIF CDF 0 3541 015714 5600 JMP I ICHAR 3542 015715 0000 INTMP, 0 3543 015716 7617 INFPTR, 7617 /POINTER TO INPUT FILE LIST 3544 015717 0001 INEOF, 1 3545 INCHCT, 3546 015720 7777 INNEWF, -1 /FETCH HANDLER FOR NEXT FILE 3547 015721 6201 CDF 0 /** 3548 015722 1366 TAD (INDEVH+1 /THIS IS WHERE IT GOES ** 3549 015723 3333 DCA INHNDL 3550 015724 6211 CDF 10 3551 015725 1716 TAD I INFPTR /GET NEXT INPUT FILE INFO 3552 015726 7450 SNA 3553 015727 5720 JMP I INNEWF /NO MORE FILES 3554 015730 6211 CDF 10 /WAS CIF 10** 3555 015731 4754 JMS I INCALL /CALL MONITOR 3556 015732 0001 1 /FETCH HANDLER 3557 015733 0000 INHNDL, 0 /ENTRY ADDR GOES HERE 3558 015734 5242 JMP INERR+3 /THIS CAN'T HAPPEN HERE 3559 015735 1716 TAD I INFPTR /GET LENGTH 3560 015736 0365 AND (7760 3561 015737 7440 SZA /A ZERO HERE MEANS >=256 BLOCKS 3562 015740 1364 TAD (17 /PUT IN SOME MORE BITS 3563 015741 7132 CLL CML RTR 3564 015742 7012 RTR 3565 015743 3353 DCA INCTR /STORE LENGTH OF FILE 3566 015744 2316 ISZ INFPTR 3567 015745 1716 TAD I INFPTR /GET STARTING RECORD NUMBER 3568 015746 3225 DCA INREC 3569 015747 2316 ISZ INFPTR 3570 015750 3317 DCA INEOF /CLEAR EOF FLAG 3571 015751 2320 ISZ INNEWF 3572 015752 5720 JMP I INNEWF 3573 015753 0000 INCTR, 0 3574 015754 0200 INCALL, 200 /CHANGED TO 7700 AFTER FIRST TIME 3575 015755 0000 INPTR, 0 3576 015764 0017 PAGE 015765 7760 015766 7201 015767 5400 015770 7775 015771 0020 015772 7746 015773 0177 015774 7400 015775 3543 015776 5547 015777 7177 3577 / KEYWORD LIST 3578 016000 6672 CMDLST, -1106;0;IF /IF 016001 0000 016002 2200 3579 016003 7361 -0417 3580 016004 5276 -2502 3581 016005 6373 -1405 3582 016006 5756 -2022 3583 016007 7275 -0503 3584 016010 6655 -1123 3585 016011 6661 -1117;0;DOUBLE /DOUBLE PRECISION 016012 0000 016013 2555 3586 016014 7361 -0417;0;DO /DO 016015 0000 016016 2300 3587 016017 7061 -0717 3588 016020 5361 -2417;0;GOTO /GOTO 016021 0000 016022 0501 3589 016023 7461 -0317 3590 016024 6263 -1515 3591 016025 6062 -1716;0;COMMON /COMMON 016026 0000 016027 1232 3592 016030 7461 -0317 3593 016031 6260 -1520 3594 016032 6373 -1405;0;COMPLE /COMPLEX 016033 0000 016034 1217 3595 016035 7461 -0317 3596 016036 6154 -1624 3597 016037 6662 -1116 3598 016040 5273 -2505;0;NEXTST /CONTINUE 016041 0000 016042 0437 3599 016043 7477 -0301 3600 016044 6364 -1414;0;CALL /CALL 016045 0000 016046 2240 3601 016047 5573 -2205 3602 016050 7664 -0114;0;REAL /REAL 016051 0000 016052 1211 3603 016053 5573 -2205 3604 016054 7674 -0104;0;READ /READ 016055 0000 016056 1121 3605 016057 5573 -2205 3606 016060 5067 -2711 3607 016061 6174 -1604;0;REWIND /REWIND 016062 0000 016063 5156 3608 016064 5573 -2205 3609 016065 5353 -2425 3610 016066 5562 -2216;0;RETURN /RETURN 016067 0000 016070 1540 3611 016071 7262 -0516 3612 016072 7372 -0406 3613 016073 6664 -1114;0;ENDFIL /ENDFILE 016074 0000 016075 2545 3614 016076 7262 -0516;0;XEND /END 016077 0000 016100 1446 3615 016101 7367 -0411 3616 016102 6273 -1505 3617 016103 6155 -1623 3618 016104 6661 -1117;0;DIMENS /DIMENSION 016105 0000 016106 1200 3619 016107 7377 -0401 3620 016110 5377 -2401;0;DATA /DATA 016111 0000 016112 5641 3621 016113 7161 -0617 3622 016114 5563 -2215 3623 016115 7654 -0124;0;FORMAT /FORMAT 016116 0000 016117 1341 3624 016120 5056 -2722 3625 016121 6654 -1124;0;WRITE /WRITE 016122 0000 016123 1123 3626 016124 7257 -0521 3627 016125 5267 -2511 3628 016126 5177 -2601 3629 016127 6373 -1405 3630 016130 6175 -1603;0;EQUIV /EQUIVALENCE 016131 0000 016132 1600 3631 016133 7373 -0405 3632 016134 7167 -0611 3633 016135 6173 -1605 3634 016136 7167 -0611 3635 016137 6373 -1405;0;DFINFL /DEFINEFILE 016140 0000 016141 1014 3636 016142 6662 -1116 3637 016143 5373 -2405 3638 016144 7073 -0705;0;INTEGE /INTEGER 016145 0000 016146 1072 3639 016147 6361 -1417 3640 016150 7067 -0711 3641 016151 7477 -0301;0;LOGICA /LOGICAL 016152 0000 016153 1560 3642 016154 7250 -0530 3643 016155 5373 -2405 3644 016156 5562 -2216 3645 016157 7664 -0114;0;EXTERN /EXTERNAL 016160 0000 016161 1334 3646 016162 7577 -0201 3647 016163 7465 -0313 3648 016164 5460 -2320 3649 016165 7675 -0103;0;BACKSP /BACKSPACE 016166 0000 016167 1363 3650 016170 7655 -0123 3651 016171 5467 -2311 3652 016172 7062 -0716;0;ASSIGN /ASSIGN 016173 0000 016174 4335 3653 016175 5777 -2001 3654 016176 5255 -2523;0;PAUZE /PAUSE 016177 0000 016200 1102 3655 016201 5454 -2324 3656 016202 6060 -1720;0;STOP /STOP 016203 0000 016204 2765 3657 016205 7167 -0611 3658 016206 6174 -1604;0;FIND /FIND 016207 0000 016210 1013 3659 016211 0000 0 /END OF LIST 3660 $ AC 0033 ACO 0030 ADDOPR 4400 AGO2OP 0061 AL1 5344 ALIST 0023 ANDOPR 4432 ANORM 5463 AR1 5316 ARGLST 0102 ARGLUP 7045 ARGSOP 0036 ARTHIF 0047 ASFDEF 0035 ASFERR 4161 ASNGO2 0557 ASNOPR 0054 ASSIGN 4335 BACK1 4442 BACKSP 1363 BADASN 4352 BADBGN 7115 BADBIT 0105 BADCAL 2275 BADCL 3153 BADCMD 0435 BADCMF 6756 BADCOM 1330 BADDEF 1061 BADDIE 6760 BADDIM 2523 BADDO 2361 BADEQU 1675 BADEXP 3301 BADFSS 3400 BADGO2 0565 BADH 3247 BADIF 2235 BADIOL 0675 BADJMP 7140 BADLST 2526 BADOPR 3700 BADRD 0675 BAKOPR 0055 BDATA 7120 BDERR 2364 BDLIST 0113 BDLOOP 7127 BINRD1 0024 BINWR1 0030 BLANKC 1324 BLNKCN 0021 BUCKET 0021 CALL 2240 CCARD 0275 unreferenced CCARDF 6700 unreferenced CCHECK 0265 CCHEKF 6663 CCTEMP 3361 CGO2OP 0060 CHAR 0040 CHECKC 3347 CHKCOM 6423 CHKNAM 2620 CHKSGN 5126 CHKVAL 2730 CHRPTR 0015 CKCTLC 1130 CKEOPR 3650 CKNOT 3031 CLOOP1 6714 CLOOP2 6731 CMDLP2 0413 CMDLST 6000 CMDLUP 0400 CMPFUN 7007 CMPGO2 0511 CMPLST 0061 CNT72 0111 COMARP 1544 COMMON 1232 COMNAM 1333 COMPIL 0321 COMPLE 1217 COMREG 4600 CONVLP 5020 D2 4662 D3 4663 D4 4664 D5 4665 D6 4666 DAL1 4671 DAQUOT 1000 DAR1 4670 DARD1 0027 DATA 5641 DATA3 5675 DATAER 5722 DATAFP 6056 DATAST 0065 DATELM 0063 DATLUP 5644 DAWR1 0033 DBLFUN 7006 DBLSLS 1320 DECPT 0046 DEFFIL 0034 DEFLBL 0045 DFINFL 1014 DFNEG 4674 DHLRTH 5552 DHOLER 5725 DIGIT 4317 DIGTST 5073 DIMAGN 2534 DIMENS 1200 DIMGET 2034 DIMLUP 3460 DIMNUM 0067 DITCNT 4667 DIVOPR 4406 DLOOP2 6000 DM74 4672 DNORM 4676 DNOTQ2 5745 DO 2300 DO107 5342 DOADD 4675 DOBEGN 0051 DOCOMN 1261 DODEC 5237 DOEND 0065 DOENDR 0437 DOFINI 0046 DOFUNY 1737 DOHOL 3226 DOINDX 0106 DORET 2350 DOSIGN 5122 DOSLAV 1703 DOSTOR 0070 DOSTUF 2324 DOSWT 2231 unreferenced DOUBLE 2555 DPLIST 0057 DPLIT 3060 DPRDCT 0070 DPUSED 0112 DPUSH 0023 DQUOTE 5730 DREPTC 0064 DSERES 0100 EFILE 2250 unreferenced ENDELM 0066 ENDEXP 3310 ENDFIL 2545 ENDFOP 0052 ENDGRP 1670 ENDIN 5643 ENDIOL 0740 ENDLIN 0231 ENDLNF 6632 ENDLST 2520 ENDNUM 4273 ENDOPR 0044 ENDOXT 1160 ENDSTM 5547 ENDX 1455 ENTERN 2655 ENTERV 2757 EOCL 1277 EOHD 6126 EOL 2543 EOLCOD 0037 EORD 5137 EQLOOP 1641 EQOPR 4416 EQTEMP 0071 EQUCOM 1700 EQUIV 1600 EQVLUP 1604 EQVOPR 4440 ERCODE 0436 ERMSG 4015 ERRCOD 0040 ESIGN 5221 ESWIT 0047 EXPDUN 3320 EXPLUP 5201 EXPMUL 5263 EXPON 0054 EXPOPR 4410 EXPR 3000 EXTERN 1334 EXTEST 2221 EXTSET 2233 FILSIZ 1471 FIND 1013 FINDND 0624 FIXEXP 5223 unreferenced FIXNUM 3745 FMTLUP 1346 FMTOPR 0056 FMTRD1 0025 FMTWR1 0031 FORMAT 1341 FPDIV 4600 FPDVLP 4612 FPLIST 0056 FPLIT 3054 unreferenced FPMUL 5400 FPNUM 5111 FPRTNE 5221 FREE 0112 FSSBAD 4154 FUNCTN 0103 G2CTMP 4200 GEOPR 4422 GET2C 4213 GET6 0241 GET6F 6642 GETC 4000 GETCWB 3726 GETDIM 2435 GETEXP 5215 GETNAM 5600 GETNEW 5610 GETRA 2353 GETSLV 1627 GETSS 2001 GO2LUP 0521 GO2OPR 0057 GOTFST 6703 GOTLIN 0300 GOTO 0501 GOTOPR 3703 GTOPR 4424 HCHAR 0051 HCOUNT 3256 HDLOOP 6106 HDRLST 2400 HFIELD 3220 HOKIN2 2747 HOLCHK 3064 HOLCTR 3266 HOLDAT 6101 HOLIST 0055 unreferenced HOOKIN 2644 HQUOTE 3200 ICHAR 5600 ICHAR1 5672 ICHAR2 5666 ICHAR3 5653 unreferenced ICHARN 5713 IDOPAR 0737 IF 2200 IFCHEK 2231 IFLABL 2217 IFLOOP 2212 IFSWIT 0053 IGNORE 6456 INBREC 5627 INBUF 6600 INBUFP 5624 INCALL 5754 INCHCT 5720 INCTR 5753 INDEVH 7200 INEOF 5717 INERR 5637 INFPTR 5716 INGBUF 5612 INHNDL 5733 INITLN 6400 INITLP 6404 INJMP 5650 INJMPP 5604 INNEWF 5720 INPTR 5755 INREC 5625 INTEGE 1072 INTEGR 5116 INTFUN 7011 INTLST 0060 INTMP 5715 IOLIST 0614 IOLMNT 0062 IOSTRT 0612 ISITFN 7112 ITRCNT 5552 ITSAR 0345 IX0240 6467 IX200 6470 IX7600 6471 unreferenced IX7700 6474 IX7772 6472 IXINCL 6464 IXLINE 0120 IXLINM 0121 IXLNP5 0117 IXM211 6473 IXM240 6465 IXM303 6466 IXRDFS 6463 L200 1566 L3 1476 L41 2356 L7600 2353 L7700 1453 LASTHD 6133 LEOPR 4426 LETEMP 4164 LETTER 3324 LEXPOK 4147 LEXPR 4064 LIFBGN 0050 LINE 6300 LINE1 0307 LINEAR 2072 LINENO 0007 LOGFUN 7005 LOGICA 1560 LOGIF 2224 LOOK 2607 LOOK2 2717 LOOKUP 2600 LPIOL 0666 LSTLUP 2412 LTEMP 2702 LTOPR 4430 LUHOL 3252 LUKUP2 2702 M12LUP 2145 M211 0114 M250 0602 M251 0760 M257 1243 M6 0350 MAIN 0105 MASTER 0073 MAXHOL 0100 MCOMA 1040 MESSAG 3543 MISARG 3156 MMM240 0352 MMM275 0355 MNUM 0074 MORCHR 5400 MORNAM 5627 MOV1 6453 MOV2 6454 MOVARG 7103 MOVCNT 6455 MOVDIM 2505 MOVOFN 2211 MQ 0072 MSNGOP 4151 MUL12 2140 MULLUP 5426 MULOPR 4404 MYFILE 2312 N254 2335 N3SIZE 2701 NAME1 6200 NAMEOF 2333 NAMF 2352 NAMOF 2334 NCHARS 0042 NCMPLX 3267 NCNT 4452 NDIGIT 0050 NDONE 5624 NEGFAC 5530 NEOPR 4420 NEWOP 0022 NEXT 0013 NEXTEL 2513 NEXTLN 0437 unreferenced NEXTST 0437 NFCNT 5551 NFLOOP 5536 NFPTR 5550 NIXTAB 6417 NLETR 3340 NO6000 5517 NOARGP 1115 NOCMNT 0271 unreferenced NOCMPD 6025 NOCMTF 6674 NOCODE 0041 NODIGT 4333 NODOND 0462 NOEORD 5153 NOLDRE 5077 NORMLP 5501 NOSS 3447 NOTAB 0261 NOTABF 6657 NOTAR 0361 NOTDIM 2537 NOTEXP 3625 NOTF 6051 NOTFSS 3600 NOTFUN 3431 NOTHIS 3675 NOTIOL 0713 NOTMUL 3627 NOTNUM 3076 NOTOPR 4412 NOTOUT 4030 NOTQ2 3215 NOTSAM 2640 NOTSF 4127 NOTSM2 2742 NOTVAR 3050 NOWRIT 1416 NPTR 5640 NQUOTD 6032 NSLAVE 0075 NUMBER 5000 NUMELM 0043 NXTDE 5703 NXTDGT 5155 O1420 2000 O200 2013 unreferenced OADD 4452 OBAD 2330 OBLK 1477 OBLOK 2253 OCOUNT 1401 OFNAME 2332 OFNSIZ 2335 OLDN3 2700 OLDOP 0023 ONE 0063 OP1 0031 OP2 0032 OP3 0033 OP4 0034 OP5 0035 OP6 0036 OPAUZ 1112 OPMAC 4673 OPO 0037 OPR8R 3403 OPR8RL 3453 OPRAND 3043 OPRLST 5414 OPRLUP 3655 OROPR 4434 OSIZE 2254 OUBLOK 1436 OUBUF 7200 OUDUMP 1425 OUERR 1443 OUFILE 0077 OULEN 1424 OUPTR 1400 OUT3WD 5750 OUTOLD 3722 OUTWRD 1402 OWTEMP 0110 P211 0115 P240 0116 PAKHOL 3233 PAKLUP 5610 PARMM 3277 PAS2ON 2346 PASS2B 1537 PASS2N 2342 PASS2O 0076 PAUSOP 0022 PAUZE 1102 PETABL 5453 PNAME 2702 POP 4034 POSEXP 5256 PRGSTK 0067 PROGNM 0101 PSHDIM 3503 PUSH 4200 PUSH2 3716 PUTDIM 2452 QCHAR 5413 QUOTE 3342 RCLOSE 0026 RDFMT 0747 RDFRST 6600 RDLIST 0754 RDLOOP 0200 RDWR 0600 READ 1121 REAFUN 7002 REAL 1211 RESTCP 1064 RETFN 3756 RETOPR 0041 RETURN 1540 REWIND 5156 REWOPR 0042 RGETSS 2126 RLOOKU 2635 RPIOL 0670 RTFMT 0763 SAVECP 3737 SC 0034 SEARCH 6740 SETBIT 0104 SFUDGE 1736 SHORTL 0256 SIGN 5016 SIX 0075 SKPCMF 6630 SKPCOM 0222 SKPEXP 5313 SKPFL 6667 SKPFL2 6623 SKPLIN 0224 SMLNUM 5200 SNLIST 0062 SNTEMP 4317 SNUM 0052 SP2O 2277 SPASS2 2271 SSFUN 3434 SSLOOP 4132 STACK 0014 STACKS 4700 START 2200 unreferenced STCHEK 2667 STEP1 2355 STKLVL 0020 STMJMP 0122 STMNUM 4231 STMUL 2153 STOP 2765 STOPOP 0053 STOROP 0043 SUBOPR 4402 SUBRTN 7000 SVIBPT 5631 SVMSTR 1614 SVSLAV 1723 TCHAR 5412 TEMP 0044 TEMP2 0045 TERR 5645 THREE 0070 THSNUM 0066 TLRETN 2543 TLTEMP 0107 TMPFIL 0055 TMPFL2 2336 TRUE 0102 TRUFAL 4044 TRY1SS 2130 TRYDEC 5056 TRYE1 5102 TRYE2 5110 TRYHOS 6066 TRYIOE 0700 TRYSTR 6143 TTYOUT 4355 TW2 5456 TW3 5457 TW4 5460 TW5 5461 TW6 5462 TYPAGN 2531 TYPE 0027 TYPLST 2400 UMINUS 3040 UMOPR 4414 UNOPR 3004 VARDIM 3515 VDTEMP 3514 VERS 0113 VERSON 0004 WCLOSE 0032 WORD1 0022 WORD2 0023 WORD3 0024 WORD4 0025 WORD5 0026 WORD6 0027 WRITE 1123 X10 0010 X11 0011 X12 0012 X16 0016 X17 0017 XCTAL1 1145 XEND 1446 XOCTAL 1140 XOROPR 4436 XPAUZ 1111 XPURGE 0625 XSTORE 2263 XXXFUN 7016 ZEXP 5526