1 /LISP FOR PS/8 2 /RELEASE 3 3 /THIS IS A MODIFICATION OF DECUS 8-102A. 4 5 /THE CCITT2 CODE SECTION HAS BEEN DELETED. 6 /THE FOLLOWING ROUTINES HAVE BEEN ADDED: 7 / 8 /A TIMES ROUTINE 9 /A CLEAR ROUTINE 10 /AN EXIT ROUTINE 11 /A LINEPRINTER ROUTINE 12 /A BUFFERED TELETYPE INPUT ROUTINE WITH 13 /LINE-EDITING CAPABILITIES; 14 /ROUTINES TO CHANGE THE INPUT AND OUTPUT 15 /TO PS/8 ASCII FILES ON ANY DEVICE. 16 17 /THE SYSTEM WAS MOVED TO FIELD 1 IN 18 /ORDER TO LEAVE ROOM FOR DEVICE HANDLERS 19 /IN FIELD 0. 20 21 /MODIFIED BY LARRY DAVIS 22 /WASHINGTON UNIVERSITY 23 /ST. LOUIS, MISSOURI 24 25 /JANUARY 28,1972. 26 27 /MODIFIED SLIGHTLY ON MARCH 9,1972 28 /FUNCTION ZEXPR WAS ADDED. 29 30 /CORRECTED AND MODIFIED ON MAY 15, 1973 31 /BY TORBJORN ALM 32 /AUTOCODE AB 33 /SOLNA, SWEDEN 34 /A NUMBER OF ARITHMETIC AND LOGICAL ZEXPR 35 /FUNCTIONS HAVE BEEN ADDED, SOME OF WHICH 36 /USE EAE, MODE A(PDP-8/I AND -8/E). 37 / 38 39 40 /THE FOLLOWING DEFINITIONS HAD TO BE MADE 41 /FOR THE ASSEMBLER 42 43 RSF=6011 44 RRB=6012 45 RFC=6014 46 KLSF=6351 47 KLLS=6356 48 49 LEND=7577 /LAST LIST LOCATION. 50 /LP08 - LS8E 51 PSKF=6661 52 PCLF=6662 53 PSTB=6664 54 /EAE-MODE A 55 CAM=7621 56 MQA=7501 57 MQL=7421 58 SWP=7521 59 SCA=7441 60 SCL=7641 61 MUY=7405 62 DVI=7407 63 NMI=7411 64 SHL=7413 65 ASR=7415 66 LSR=7417 67 FIELD 0 68 69 *34 70 000034 0015 PQUOTI, QUOTIENT /POINTER TO QUOTIENT CELL IN FIELD 1 71 000035 0000 ZA1P, 0 /POINTER TO 1ST ARGUMENT. 72 000036 0000 TEMPAD, 0 /TEMPORARY STORAGE USED BY 73 /SEVERAL ROUTINES. 74 000037 0000 ZA2P, 0 /POINTER TO 2ND ARGUMENT. 75 000040 0171 PLRET2, LRET2 /POINTER TO LISP RETURN ADDRESS. 76 000041 0000 ZA3P, 0 /POINTER TO 3RD ARGUMENT. 77 78 /RETURN TO LISP SYSTEM WITH NO ARGUMENT. 79 000042 6213 ZRET2, CDF CIF 10 80 000043 5440 JMP I PLRET2 81 82 /RETURN TO LISP SYSTEM WITH A NUMERICAL VALUE 83 /WHICH IS IN THE ACCUMULATOR. 84 000044 6213 ZVRET2, CDF CIF 10 85 000045 5446 JMP I .+1 86 000046 3175 RMASK+2 87 *100 88 000100 0035 PA1P, A1P 89 000101 0037 PA2P, A2P 90 000102 0041 PA3P, A3P 91 000103 0000 NUMB, 0 /IF FIRST ARGUMENT TO IOPEN OR 92 /OOPEN WAS A NUMBER,STORE HERE. 93 000104 0000 NUMB1, 0 /NUMBER FOR OUTPUT OPENING. 94 /INPUT FILE NAME. 95 000105 0000 INDEV1, 0 96 000106 0000 INDEV2, 0 97 000107 0000 INFIL1, 0 98 000110 0000 0 99 000111 0000 0 100 000112 0000 0 101 /OUTPUT FILE NAME. 102 000113 0000 OUDEV1, 0 103 000114 0000 OUDEV2, 0 104 000115 0000 OUFIL1, 0 105 000116 0000 0 106 000117 0000 0 107 000120 0000 0 108 000121 0105 PPINNAME,INDEV1 109 000122 0113 PPOUTNAM,OUDEV1 110 000123 0000 PNAME, 0 /POINTER TO NEXT WORD FOR 111 /STORING FILE NAME. 112 000124 3134 P1ERR, ERR /POINTER TO THE ERROR ROUTINE. 113 000125 1000 PGETNAM,GETNAM 114 000126 0000 IHNDLR, 0 /POINTER TO INPUT HANDLER 115 000127 0000 OHNDLR, 0 /POINTER TO OUTPUT HANDLER. 116 000130 0000 FINPTR, 0 117 000131 0107 PFILN1, INFIL1 118 000132 0115 PFILN2, OUFIL1 119 120 /RETURN FROM SUBROUTINE IN FIELD 0. 121 000133 1147 F1RET, TAD KN3 122 000134 3142 DCA RLOCA /SAVE RETURN ADDRESS 123 000135 6213 CIF CDF 10 124 000136 1542 TAD I RLOCA /RETURN ADDRESS 125 000137 3142 DCA RLOCA 126 000140 1143 TAD RVAL /VALUE TO RETURN WITH 127 000141 5542 JMP I RLOCA 128 129 000142 0000 RLOCA, 0 130 000143 0000 RVAL, 0 131 000144 0000 KOUTCHAR,0 /REPLACED BY A POINTER TO OUTPUT ROUTINE 132 000145 0600 P1LPTOUT,LPTOUT 133 000146 1475 P1FOCHAR,FOCHAR 134 000147 7775 KN3, -3 135 000150 7700 K7700A, 7700 /LOCATION OF USR 136 000151 7400 FI7400, 7400 137 138 /THE FOLLOWING WOULD NOT FIT ON GETNAM PAGE. 139 000152 0077 KP77, 77 140 000153 3600 KP3600, 3600 141 000154 7772 KM6, -6 142 000155 0036 K36, 36 143 000156 0000 TMNAM, 0 144 000157 0000 NCTR, 0 145 000160 0000 PNAME1, 0 146 /ERROR IN OPENING OR CLOSING A FILE. 147 000161 7200 ERROR1, CLA 148 000162 6213 CDF CIF 10 149 000163 4524 JMS I P1ERR /PRINT ERROR MESSAGE 150 /AND RESTART. 151 /ERROR IN OUTPUTTING A CHARACTER 152 000164 7200 OUERR1, CLA 153 000165 1171 TAD P1OUTSUB /RESET OUTPUT TO TTY 154 000166 6213 CDF CIF 10 155 000167 3572 DCA I PPOUTCH 156 000170 4524 JMS I P1ERR 157 000171 3217 P1OUTSUB,OUTSUB 158 000172 2124 PPOUTCH,POUTCH 159 000173 0000 PTARG1, 0 160 000174 0000 PTARG2, 0 161 /DEFAULT DEVICE NAME. 162 000175 6546 K6546, 6546 /"DS" 163 000176 0055 K55, 55 /"K" 164 *200 165 166 /THIS ROUTINE IS THE BUFFERED TELETYPE 167 /INPUT ROUTINE. IT WILL BUFFER UP TO A 168 /CARRIAGE RETURN. 169 /ON A LINE, THE FOLLOWING CHARACTERS 170 /HAVE SPECIAL MEANING. 171 /A RUBOUT DELETES THE PREVIOUS CHARACTER 172 /A ^U DELETES THE WHOLE CURRENT LINE. 173 /A ^R DOES A JMP 3001 174 /A ^C DOES A JMP 3000 175 /A CARRIAGE RETURN ECHOES A CARRIAGE RETURN 176 /LINE FEED PAIR. 177 /AN ALTMODE IS THE SAME AS A CARRIAGE 178 /RETURN, AND INSERTS A CARRIAGE RETURN 179 /IN THE CODE. HOWEVER,IT DOES NOT ECHO. 180 /NOTE: CHARACTERS ARE NOT TRANSMITTED 181 /UNTIL A CARRIAGE RETURN OR ALTMODE OCCURS. 182 183 000200 0000 BTTY, 0 184 000201 2200 ISZ BTTY /SKIP OVER ADDRESS. 185 000202 7200 CLA 186 000203 1264 TAD TFLAG 187 000204 7700 SMA CLA 188 000205 5214 JMP TREAD /BUFFER EMPTY. READ IN. 189 000206 2264 ISZ TFLAG 190 000207 7000 NOP 191 000210 1667 CRRET, TAD I CPOINT /GET NEXT CHARACTER IN 192 /BUFFER. 193 000211 2267 ISZ CPOINT 194 000212 6213 BRET, CDF CIF 10 195 000213 5600 JMP I BTTY /RETURN WITH CHAR IN AC. 196 197 /BUFFER EMPTY-READ IN A NEW BUFFER. 198 000214 7200 TREAD, CLA 199 000215 1270 TAD BPOINT 200 000216 3267 DCA CPOINT /INITIALIZE BUFFER POINTER. 201 000217 3264 DCA TFLAG /SAY NO CHARACTERS TYPED YET. 202 000220 6031 RLOOP, KSF 203 000221 5220 JMP .-1 /WAIT TILL SOMETHING TYPED. 204 000222 6036 KRB /READ CHARACTER 205 000223 3363 DCA TMCHAR /SAVE CHARACTER 206 000224 1363 TAD TMCHAR 207 000225 1370 TAD KM377 208 000226 7450 SNA 209 000227 5326 JMP RUBOUT /HAD RUBOUT. 210 000230 7001 IAC 211 000231 7001 IAC 212 000232 7450 SNA 213 000233 5316 JMP ALTM /HAD ALTMODE.SAME AS C.R. 214 000234 1372 TAD K150 215 000235 7450 SNA 216 000236 5323 JMP CNTRU /HAD ^U 217 000237 1367 TAD KP3 218 000240 7450 SNA 219 000241 5376 JMP CNTRR /HAD ^R 220 000242 1366 TAD KP17 221 000243 7450 SNA 222 000244 5665 JMP I PCNTRC /HAD ^C 223 000245 1365 TAD KM12 224 000246 7650 SNA CLA 225 000247 5314 JMP CRET /HAD CARRIAGE RETURN. 226 000250 1266 TAD KMLASTL /NEGATIVE OF LAST 227 /BUFFER LOCATION + 1. 228 000251 1267 TAD CPOINT /SEE IF BUFFER IS FULL. 229 000252 7700 SMA CLA 230 000253 5220 JMP RLOOP /BUFFER IS FULL. IGNORE 231 /ANYTHING BUT CONTROL 232 /CHARACTERS. 233 000254 7240 CLA CMA /-1 IN AC. 234 000255 1264 TAD TFLAG /SAY ONE MORE CHAR. IN 235 /BUFFER. 236 000256 3264 DCA TFLAG 237 000257 1363 TAD TMCHAR /NOW PUT CHAR IN BUFFER. 238 000260 4271 JMS ECHO /ECHO IF SPECIFIED. 239 000261 3667 DCA I CPOINT 240 000262 2267 ISZ CPOINT /POINT TO NEXT BUFFER LOCATION 241 000263 5220 JMP RLOOP /GET NEXT CHARACTER. 242 000264 0000 TFLAG, 0 /CONTAINS THE NEGATIVE OF THE 243 /NUMBER OF CHARACTERS REMAINING 244 /IN THE BUFFER. 245 000265 0407 PCNTRC, CNTRC 246 000266 2177 KMLASTL,-LASTL-2 247 000267 0000 CPOINT, 0 /POINTER TO THE NEXT BUFFER 248 /LOCATION. 249 000270 5400 BPOINT, TBUF /POINTER TO THE FIRST LOCATION 250 /IN THE BUFFER. 251 252 253 /ECHO TTY CHAR IF MODE SPECIFIES THIS. 254 000271 0000 ECHO, 0 255 000272 3364 DCA TEMP /SAVE AC TEMPORARILY 256 000273 6211 CDF 10 257 000274 1762 TAD I PMODE /GET MODE 258 000275 6201 CDF 0 259 000276 0373 AND KP45 260 000277 7640 SZA CLA 261 000300 5306 JMP ECHO1 262 000301 1364 TAD TEMP 263 000302 6041 TSF 264 000303 5302 JMP .-1 /WAIT TILL TTY FREE 265 000304 6046 TLS 266 000305 5671 JMP I ECHO 267 000306 1364 ECHO1, TAD TEMP /NO ECHO 268 000307 5671 JMP I ECHO 269 270 271 000310 0336 CNTU, 336 /STRING FOR CONTROL U 272 000311 0325 325 273 000312 0215 K215, 215 274 000313 0212 KP212, 212 275 000314 4344 CRET, JMS TSTRING 276 000315 0312 K215 /TYPE C.R. AND L.F. 277 000316 1312 ALTM, TAD K215 /NOW PUT C.R. IN BUFFER 278 000317 3667 DCA I CPOINT 279 000320 1270 TAD BPOINT /NOW RESET BUFFER POINTER 280 000321 3267 DCA CPOINT 281 000322 5210 JMP CRRET /NOW RETURN WITH 1ST CHAR. 282 283 284 285 000323 4344 CNTRU, JMS TSTRING 286 000324 0310 CNTU 287 000325 5214 JMP TREAD /REINITIALIZE BUFFER. 288 289 000326 1270 RUBOUT, TAD BPOINT /SEE IF ANY CHARS IN BUFFER 290 000327 7041 CIA 291 000330 1267 TAD CPOINT 292 000331 7650 SNA CLA 293 000332 5220 JMP RLOOP /NO CHARS IN BUFFER. IGNORE 294 000333 7240 CLA CMA 295 000334 1267 TAD CPOINT /RESET BUFFER POINTER 296 000335 3267 DCA CPOINT 297 000336 2264 ISZ TFLAG /RESET CHARACTER COUNTER 298 000337 7000 NOP 299 000340 1371 TAD K334 300 000341 4271 JMS ECHO /ECHO BACKSLASH 301 000342 7200 CLA 302 000343 5220 JMP RLOOP /RETURN 303 304 /TSTRING WILL TYPE A CHARACTER STRING WHICH 305 /IS ENDED BY A NEGATIVE NUMBER. 306 000344 0000 TSTRING,0 307 000345 7200 CLA 308 000346 1744 TAD I TSTRING /GET ADDRESS OF STRING 309 000347 3361 DCA TMSTR 310 000350 2344 ISZ TSTRING 311 000351 7200 TSLOOP, CLA 312 000352 1761 TAD I TMSTR /GET NEXT CHARACTER IN STRING 313 000353 7710 SPA CLA 314 000354 5744 JMP I TSTRING /RETURN. HAD DELIMITER. 315 000355 1761 TAD I TMSTR 316 000356 4271 JMS ECHO /TYPE CHARACTER 317 000357 2361 ISZ TMSTR /INCREMENT POINTER 318 000360 5351 JMP TSLOOP 319 320 000361 0000 TMSTR, 0 /POINTER TO STRING. 321 000362 3154 PMODE, MODE 322 000363 0000 TMCHAR, 0 /STORE CHARACTER TEMPORARILY 323 000364 0000 TEMP, 0 324 000365 7766 KM12, -12 325 000366 0017 KP17, 17 326 000367 0003 KP3, 3 327 000370 7401 KM377, -377 328 000371 0334 K334, 334 329 000372 0150 K150, 150 330 000373 0045 KP45, 45 /MASK FOR CHECKING ECHO. 331 000374 0336 CNTR, 336 /STRING FOR CONTROL R 332 000375 0322 322 333 000376 4344 CNTRR, JMS TSTRING /TYPE ^R. 334 000377 0374 CNTR 335 000400 7200 CLA 336 000401 3617 DCA I PTFLAG /CLEAR BUFFER 337 000402 6213 CDF CIF 10 /BACK TO FIELD 10 338 000403 5604 JMP I .+1 339 000404 3001 INIT1 /RESTART,BUT DON'T CLEAR. 340 341 000405 0336 CNTC, 336 /STRING FOR CONTROL C 342 000406 0303 303 343 344 000407 4616 CNTRC, JMS I PTSTRING 345 000410 0405 CNTC 346 000411 7200 CLA 347 000412 3617 DCA I PTFLAG /CLEAR BUFFER. 348 000413 6213 CDF CIF 10 349 000414 5615 JMP I .+1 350 000415 3000 INIT /RESTART AND CLEAR. 351 000416 0344 PTSTRING,TSTRING 352 000417 0264 PTFLAG, TFLAG 353 354 PAGE 355 /LINEPRINTER SUBROUTINE. 356 /THIS SUBROUTINE IS CURRENTLY FOR THE 357 /KLEINSCHMIDT LINE PRINTER. 358 /IT CONTAINS THE CHARACTER TO PRINT ON 359 /THE KLEINSCHMIDT IN THE ACCUMULATOR ON 360 /ENTRY. 361 362 000600 0000 LPTOUT, 0 363 000601 5226 JMP LPTLS8 /STANDARD LPT 364 000602 3221 DCA TCHAR 365 000603 1221 TAD TCHAR 366 000604 1223 TAD KM215 /SEE IF C.R. 367 000605 7450 SNA 368 000606 1224 TAD K22 /HAD CARRIAGE RETURN 369 /CONVERT THE CODE. 370 000607 1222 TAD KPL3 /SEE IF LINE FEED. 371 000610 7450 SNA 372 000611 1224 TAD K22 /HAD LINE FEED. CONVERT 373 /THE CODE. 374 000612 1225 TAD K212 375 000613 6356 KLLS /PRINT ON KLEINSCHMIDT 376 000614 6351 KLSF /SKIP IF KLEINSCHMIDT DONE 377 000615 5214 JMP .-1 378 000616 7200 CLA 379 000617 1221 TAD TCHAR 380 000620 5600 JMP I LPTOUT /RETURN. 381 382 000621 0000 TCHAR, 0 383 000622 0003 KPL3, 3 384 000623 7563 KM215, -215 385 000624 0022 K22, 22 386 000625 0212 K212, 212 387 000626 6666 LPTLS8, PCLF PSTB /NORMAL LS8/LE8 PRINTER CODE 388 000627 6661 PSKF /FOR USE OF KLEINSMIDT PRINTER 389 000630 5227 JMP .-1 /INSERT 7000 INTO 601 390 000631 5600 JMP I LPTOUT /EXIT 391 PAGE 392 /GET FILE NAME SUBROUTINE. 393 394 001000 0000 GETNAM, 0 395 001001 6211 CDF 10 /CHANGE TO FIELD OF CELLS. 396 001002 7200 CLA 397 001003 1123 TAD PNAME 398 001004 3160 DCA PNAME1 /SAVE POINTER TO NAME. 399 001005 3103 DCA NUMB /ZERO FLAG WHICH TELLS 400 /IF FIRST ARGUMENT WAS A 401 /NUMBER OR NOT. 402 001006 1500 TAD I PA1P /GET FIRST ARGUMENT POINTER 403 001007 3173 DCA PTARG1 /POINTER TO CDR PART OF 1ST 404 /ARGUMENT. 405 001010 1173 TAD PTARG1 406 001011 7001 IAC 407 001012 3174 DCA PTARG2 /POINTER TO CAR PART OF 1ST 408 /ARGUMENT. 409 001013 7240 CLA CMA /SEE IF IT IS A NUMBER. 410 001014 1574 TAD I PTARG2 411 001015 7450 SNA 412 001016 5361 JMP ARG1N /FIRST ARGUMENT WAS A NUMBER. 413 001017 7001 IAC /RESTORE ARGUMENT 414 /SEE IF IT IS AN ATOM 415 001020 7110 CLL RAR 416 001021 7420 SNL 417 001022 5161 JMP ERROR1 /FIRST ARGUMENT WAS NOT AN 418 /ATOM. 419 001023 7004 RAL /RESTORE ADDRESS 420 /PICK UP DEVICE NAME 421 001024 3174 DCA PTARG2 422 001025 1574 TAD I PTARG2 423 001026 4372 JMS SAVNAM /SAVE THIS NAME. 424 /GET NEXT TWO CHARACTERS 425 001027 7240 CLA CMA 426 001030 1174 TAD PTARG2 427 001031 3174 DCA PTARG2 /POINT TO CDR PART 428 001032 1574 TAD I PTARG2 429 001033 7450 SNA 430 001034 5240 JMP GETFLN /NO MORE OF NAME. 431 001035 7001 IAC /POINT TO NAME PART. 432 001036 3174 DCA PTARG2 433 001037 1574 TAD I PTARG2 434 001040 4372 GETFLN, JMS SAVNAM /SAVE 2ND WORD OF 435 /DEVICE NAME. 436 /NOW GET FILE NAME. 437 001041 1501 TAD I PA2P 438 001042 3173 DCA PTARG1 /SAVE ADDRESS OF CDR PART 439 /OF 2ND ARGUMENT. 440 001043 1173 TAD PTARG1 441 001044 7001 IAC 442 001045 3174 DCA PTARG2 /SAVE CAR PART OF 2ND ARG 443 001046 7240 CLA CMA 444 001047 1574 TAD I PTARG2 /SEE IF NUMBER 445 001050 7450 SNA 446 001051 5367 JMP ARG2N /IT WAS A NUMBER, SO ZERO 447 /FILE NAME. 448 001052 7001 IAC 449 /SEE IF IT IS AN ATOM 450 001053 7110 CLL RAR 451 001054 7420 SNL 452 001055 5161 JMP ERROR1 /ERROR-SECOND ARGUMENT WAS 453 /NOT AN ATOM. 454 001056 7004 RAL 455 001057 3174 DCA PTARG2 /SAVE POINTER TO CAR PART. 456 001060 7240 CLA CMA 457 001061 1174 TAD PTARG2 458 001062 3173 DCA PTARG1 /SAVE POINTER TO CDR PART. 459 001063 1574 TAD I PTARG2 /GET 1ST 2 CHARS OF NAME 460 001064 4372 JMS SAVNAM 461 001065 1573 TAD I PTARG1 /GET POINTER TO NEXT CELL 462 001066 7450 SNA 463 001067 5370 JMP ARG22 /NIL.ZERO REST OF NAME. 464 001070 3173 DCA PTARG1 465 001071 1173 TAD PTARG1 466 001072 7001 IAC 467 001073 3174 DCA PTARG2 /POINTER TO CAR PART 468 001074 1574 TAD I PTARG2 /GET SECOND PAIR OF 469 /CHARACTERS OF NAME. 470 001075 4372 JMS SAVNAM 471 001076 1573 TAD I PTARG1 /GET POINTER TO CDR PART 472 001077 7450 SNA 473 001100 5304 JMP GETEXT /NIL. ZERO REST OF NAME. 474 001101 7001 IAC 475 001102 3174 DCA PTARG2 476 001103 1574 TAD I PTARG2 /GET 3RD PAIR OF 477 /CHARACTERS OF NAME. 478 001104 4372 GETEXT, JMS SAVNAM 479 480 /NOW PICK UP EXTENSION. 481 001105 1502 TAD I PA3P 482 001106 3173 DCA PTARG1 /ADDRESS OF CDR PART OF 483 /THIRD ARGUMENT. 484 001107 1173 TAD PTARG1 485 001110 7001 IAC 486 001111 3174 DCA PTARG2 /SAVE ADDRESS OF CAR PART 487 001112 7240 CLA CMA 488 001113 1574 TAD I PTARG2 /SEE IF NUMBER. 489 001114 7450 SNA 490 001115 5325 JMP SAVEXT 491 001116 7001 IAC 492 /SEE IF IT IS AN ATOM. 493 001117 7110 CLL RAR 494 001120 7420 SNL 495 001121 5161 JMP ERROR1 /3RD ARGUMENT WAS NOT ATOMIC 496 001122 7004 RAL 497 001123 3174 DCA PTARG2 /SAVE POINTER TO ATOM NAME. 498 001124 1574 TAD I PTARG2 /GET EXTENSION. 499 001125 4372 SAVEXT, JMS SAVNAM 500 /CONVERT INTERNAL CHARACTERS TO 6-BIT ASCII. 501 /IF 0, LEAVE 0. OTHERWISE, ADD 36 AND MASK. 502 503 001126 6201 CDF 0 504 001127 7200 CLA 505 001130 1154 TAD KM6 /GO THROUGH LOOP 6 TIMES. 506 001131 3157 DCA NCTR /LOOP COUNTER. 507 001132 1560 NMLOOP, TAD I PNAME1 /GET NEXT WORD OF NAME. 508 001133 0150 AND K7700A 509 001134 7440 SZA 510 001135 1153 TAD KP3600 511 001136 7112 CLL RTR 512 001137 7012 RTR 513 001140 7012 RTR /SWAP CHARACTERS. 514 001141 3156 DCA TMNAM /HAVE ASCII FOR HIGH-ORDER CHAR 515 001142 1560 TAD I PNAME1 516 001143 0152 AND KP77 517 001144 7440 SZA 518 001145 1155 TAD K36 519 001146 0152 AND KP77 /HAVE ASCII FOR LOW CHAR. 520 001147 7106 CLL RTL 521 001150 7006 RTL 522 001151 7006 RTL 523 001152 1156 TAD TMNAM /HAVE BOTH IN ASCII. 524 001153 3560 DCA I PNAME1 525 001154 2160 ISZ PNAME1 /POINT TO NEXT WORD OF NAME 526 001155 2157 ISZ NCTR /INCREMENT LOOP COUNTER 527 001156 5332 JMP NMLOOP 528 001157 6211 CDF 10 529 001160 5600 JMP I GETNAM /RETURN. 530 531 /FIRST ARGUMENT WAS A NUMBER. 532 001161 1573 ARG1N, TAD I PTARG1 /GET THE NUMBER. 533 001162 3103 DCA NUMB 534 001163 1175 TAD K6546 /"DS" 535 001164 4372 JMS SAVNAM /DSK IS DEFAULT DEVICE NAME. 536 001165 1176 TAD K55 537 001166 5240 JMP GETFLN 538 539 /SECOND ARGUMENT WAS A NUMBER-ZERO THE FILE NAME. 540 001167 4372 ARG2N, JMS SAVNAM 541 001170 4372 ARG22, JMS SAVNAM 542 001171 5304 JMP GETEXT 543 544 545 /STORE AC IN FIELD 0 LOCATION POINTED TO 546 /BY PNAME, AND INCREMENT PNAME. 547 001172 0000 SAVNAM, 0 548 001173 6201 CDF 0 549 001174 3523 DCA I PNAME 550 001175 2123 ISZ PNAME 551 001176 6211 CDF 10 552 001177 5772 JMP I SAVNAM 553 PAGE 554 /OPEN AN INPUT FILE. 555 556 001200 0000 IOPENR, 0 557 001201 7200 CLA 558 001202 1121 TAD PPINNAME 559 001203 3123 DCA PNAME /SET POINTER TO INPUT NAME 560 001204 4525 JMS I PGETNAM /GET THE FILE'S DEVICE, 561 /NAME,AND EXTENSION. 562 /MOVE THE DEVICE NAME. 563 001205 1105 TAD INDEV1 564 001206 3217 DCA ASDEV1 565 001207 1106 TAD INDEV2 566 001210 3220 DCA ASDEV2 567 /SET LOCATION FOR DEVICE HANDLER TO BE 568 /LOADED INTO. 569 001211 1254 TAD PINDBUF 570 001212 3221 DCA ASPAG /ALLOW 2 PAGE HANDLERS. 571 572 /LOAD THE DEVICE HANDLER 573 001213 6201 CDF 0 574 001214 6212 CIF 10 575 001215 4550 JMS I K7700A /CALL USR 576 001216 0001 1 /FETCH DEVICE HANDLER. 577 001217 0000 ASDEV1, 0 /DEVICE NAME. 578 001220 0000 ASDEV2, 0 /THIS IS CHANGED TO THE 579 /DEVICE NUMBER. 580 001221 0000 ASPAG, 0 /LOCATION OF HANDLER. 581 001222 5255 JMP ASERR /ERROR-COULD NOT FIND THE 582 /DEVICE NAME. 583 /NOW LOOK UP THE FILE. 584 001223 7200 CLA 585 001224 1131 TAD PFILN1 586 001225 3232 DCA FLUNAM 587 001226 1220 TAD ASDEV2 /LOAD DEVICE NUMBER. 588 001227 6212 CIF 10 589 001230 4550 JMS I K7700A /CALL USR 590 001231 0002 2 /LOOKUP FILE. 591 001232 0000 FLUNAM, 0 /POINTER TO THE FILE 592 /NAME. REPLACED BY BLOCK #. 593 001233 0000 FLUCNT, 0 /REPLACED BY LENGTH AS A 594 /NEGATIVE NUMBER. 595 001234 5255 JMP ASERR /ERROR IN LOOKUP. 596 001235 7240 CLA CMA 597 001236 3335 DCA FICHCT /SET INPUT CHARACTER COUNT 598 /FOR A READ ON FIRST CALL. 599 001237 1232 TAD FLUNAM /GET FILE STARTING 600 /BLOCK NUMBER. 601 001240 3273 DCA FINREC 602 001241 1221 TAD ASPAG /GET HANDLER ENTRY POINT. 603 001242 3126 DCA IHNDLR 604 001243 1337 TAD FIN10 605 001244 3336 DCA FINTMP /SAY ON PROPER PART OF WORD. 606 /MOVE INPUT POINTER TO GCHAR SUBROUTINE. 607 001245 1342 TAD KGCHAR 608 001246 6211 CDF 10 609 001247 3740 DCA I P1PINSUB 610 001250 6201 CDF 0 611 001251 3143 DCA RVAL /ZERO RETURN VALUE. 612 /I.E. RETURN NIL. 613 001252 1200 TAD IOPENR 614 001253 5133 JMP F1RET /RETURN. 615 616 001254 7201 PINDBUF,INDBUF+1 /LOCATION TO LOAD DEVICE 617 /HANDLER , WITH BIT 1 SET 618 /TO ALLOW 2-PAGE HANDLERS. 619 620 /ERROR IN OPENING INPUT FILE. 621 001255 7200 ASERR, CLA 622 001256 6213 CDF CIF 10 623 001257 4524 JMS I P1ERR 624 625 /GET A CHARACTER ROUTINE 626 001260 0000 GTCHAR, 0 627 001261 7200 CLA 628 001262 2335 FNXTCH, ISZ FICHCT /BUMP CHARACTER COUNT. 629 001263 5305 JMP FIGET 630 /SEE IF OUT OF DATA 631 001264 1233 TAD FLUCNT 632 001265 7500 SMA 633 001266 5330 JMP ERROR2 /OUT OF DATA. 634 001267 7200 CLA 635 001270 4526 JMS I IHNDLR /BUFFER EMPTY. READ IN 636 /A NEW BUFFER. 637 001271 0200 FI200, 200 /READ IN 2 PAGES. 638 001272 6200 FINBUF, INBUFL /BUFFER LOCATION. 639 001273 0000 FINREC, 0 /REPLACED BY BLOCK #. 640 001274 5330 JMP ERROR2 /ERROR IN READING. 641 001275 2233 ISZ FLUCNT /INCREMENT BLOCK COUNT. 642 001276 7000 NOP 643 001277 2273 ISZ FINREC /INCREMENT BLOCK NUMBER. 644 001300 7240 CLA CMA 645 001301 1272 TAD FINBUF 646 001302 3130 DCA FINPTR /POINTER TO NEXT BUFFER 647 /CHARACTER. 648 001303 1310 TAD FI7200 /SAVE CHARACTER COUNT. 649 001304 3335 DCA FICHCT 650 001305 1336 FIGET, TAD FINTMP /GET HIGH-ORDER BIT BUFFER. 651 001306 7510 SPA /ON THIRD CHAR? 652 001307 5325 JMP FITHRD /YES-OUTPUT COMBINED HIGH- 653 /ORDER BITS. 654 001310 7200 FI7200, CLA 655 001311 2130 ISZ FINPTR 656 001312 1530 TAD I FINPTR 657 001313 0151 AND FI7400 658 001314 7104 RAL CLL 659 001315 1336 TAD FINTMP /PUT THE HIGH-ORDER BITS ONTO 660 /THE HOB BUFFER. 661 001316 7006 FINXX, RTL 662 001317 7006 RTL 663 001320 3336 DCA FINTMP 664 001321 1530 TAD I FINPTR /GET CHARACTER. 665 001322 0343 AND KP377 666 001323 6213 CDF CIF 10 667 001324 5660 JMP I GTCHAR /RETURN. 668 001325 3530 FITHRD, DCA I FINPTR /FUDGE 3RD CHARACTER INTO BUFFER 669 001326 7120 CLL CML 670 001327 5316 JMP FINXX /RESET FINTMP TO 10. 671 672 /ERROR IN READING INPUT FILE. 673 001330 7200 ERROR2, CLA 674 001331 6213 CDF CIF 10 675 001332 1341 TAD K1INSUB /RESET INPUT TO TTY 676 001333 3740 DCA I P1PINSUB 677 001334 4524 JMS I P1ERR /GIVE ERROR MESSAGE 678 679 001335 0000 FICHCT, 0 /INPUT CHARACTER COUNT. 680 001336 0000 FINTMP, 0 /HIGH-ORDER BITS BUFFER. 681 001337 0010 FIN10, 10 682 001340 0100 P1PINSUB,PINSUB 683 001341 3155 K1INSUB,INSUB 684 001342 2400 KGCHAR, GCHAR 685 001343 0377 KP377, 377 686 PAGE 687 /OPEN AN OUTPUT FILE 688 689 001400 0000 OOPENR, 0 690 001401 7200 CLA 691 /MOVE POINTER FROM BASIC OUTPUT ROUTINE. 692 001402 6211 CDF 10 693 001403 1266 TAD KPCHAR 694 001404 3667 DCA I KPOUTCH 695 001405 6201 CDF 0 696 001406 1122 TAD PPOUTNAME 697 001407 3123 DCA PNAME /SET POINTER TO OUTPUT NAME. 698 001410 4525 JMS I PGETNAM /GET THE FILE'S DEVICE,NAME, 699 /AND EXTENSION 700 001411 1103 TAD NUMB 701 001412 3104 DCA NUMB1 /MOVE TO NUMB1 702 001413 1104 TAD NUMB1 703 001414 7440 SZA 704 001415 5261 JMP OSPEC /SPECIAL OUTPUT DEVICE SPECIFIED. 705 /MOVE THE DEVICE NAME. 706 001416 1113 TAD OUDEV1 707 001417 3230 DCA OSDEV1 708 001420 1114 TAD OUDEV2 709 001421 3231 DCA OSDEV2 710 001422 1270 TAD POUDBUF /LOCATION FOR OUTPUT 711 /DEVICE HANDLER. 712 001423 3232 DCA OSPAG 713 /LOAD THE DEVICE HANDLER. 714 001424 6201 CDF 0 715 001425 6212 CIF 10 716 001426 4550 JMS I K7700A /CALL USR 717 001427 0001 1 /FETCH DEVICE HANDLER 718 001430 0000 OSDEV1, 0 /DEVICE NAME. 719 001431 0000 OSDEV2, 0 /THIS IS REPLACED BY DEVICE # 720 001432 0000 OSPAG, 0 /PAGE TO LOAD HANDLER INTO. 721 001433 4264 JMS OUERR /ERROR-COULD NOT FIND THE 722 /DEVICE NAME. 723 /NOW ENTER THE FILE 724 001434 7200 CLA 725 001435 3772 DCA I KFOCCNT /ZERO COUNT OF # OF BLOCKS WRITTEN 726 001436 1132 TAD PFILN2 727 001437 3244 DCA FOONAM /POINTER TO FILE NAME 728 001440 1231 TAD OSDEV2 /DEVICE NUMBER 729 001441 6212 CIF 10 730 001442 4550 JMS I K7700A /CALL USR 731 001443 0003 3 /ENTER. 732 001444 0000 FOONAM, 0 /POINTER TO FILE NAME. 733 001445 0000 FOOCNT, 0 /LENGTH OF FILE. 734 001446 5264 JMP OUERR /ERROR RETURN 735 001447 1244 TAD FOONAM /GET STARTING BLOCK NUMBER 736 001450 3307 DCA FOUREC 737 001451 4354 JMS FOSETP /SET UP POINTERS. 738 001452 1232 TAD OSPAG /HANDLER LOCATION 739 001453 3127 DCA OHNDLR 740 /SET POINTER TO PROPER VALUE ROUTINE 741 001454 1146 TAD P1FOCHAR 742 001455 3144 ORET, DCA KOUTCHAR 743 001456 3143 DCA RVAL /RETURN NIL. 744 001457 1200 TAD OOPENR 745 001460 5133 JMP F1RET /RETURN. 746 747 /WANT TO OUTPUT TO LINEPRINTER. 748 001461 7200 OSPEC, CLA 749 001462 1145 TAD P1LPTOUT 750 001463 5255 JMP ORET 751 752 /ERROR OPENING OUTPUT FILE. 753 001464 6213 OUERR, CDF CIF 10 754 001465 4524 JMS I P1ERR 755 756 001466 2405 KPCHAR,PCHAR 757 001467 2124 KPOUTCH,POUTCH 758 001470 6600 POUDBUF,OUDBUF /POINTER TO OUTPUT DEVICE LOCATION 759 /PUT A CHARACTER ROUTINE. 760 001471 0000 PTCHAR, 0 761 001472 4544 JMS I KOUTCHAR/GO TO OUTPUT ROUTINE. 762 001473 6213 CDF CIF 10 763 001474 5671 JMP I PTCHAR /RETURN. 764 765 /OUTPUT A CHARACTER TO OUTPUT FILE. 766 001475 0000 FOCHAR, 0 767 001476 3365 DCA TEMOUT /SAVE AC TO RESTORE ON RETURN. 768 001477 1365 TAD TEMOUT 769 001500 3366 DCA FOUTMP 770 001501 2317 FOLOOP, ISZ FOUJMP 771 001502 2367 ISZ FOCHCT /BUMP CHARACTER COUNT 772 001503 5317 FOJMP, JMP FOUJMP /TAKE A BRANCH OF THE 773 /THREE WAY JUMP. 774 001504 4527 JMS I OHNDLR /BUFFER FULL. WRITE IT OUT. 775 001505 4200 4200 /WRITE 2 PAGES 776 001506 5600 FOUBUF, OUBUF /BUFFER LOCATION. 777 001507 0000 FOUREC, 0 /BLOCK NUMBER 778 001510 5164 JMP OUERR1 /WRITE ERROR. 779 001511 2307 ISZ FOUREC /INCREMENT BLOCK NUMBER. 780 001512 2772 ISZ I KFOCCNT /INCREMENT COUNT OF 781 /BLOCKS WRITTEN. 782 001513 4354 JMS FOSETP /RESET POINTERS. 783 001514 2245 ISZ FOOCNT /INCREMENT COUNT OF BLOCKS 784 001515 5301 JMP FOLOOP /NOW GO PUT THE CHARACTER 785 /INTO THE NEW BUFFER. 786 001516 5164 JMP OUERR1 /ERROR-NO MORE ROOM FOR FILE 787 001517 5317 FOUJMP, JMP . /THREE WAY SWITCH. 788 001520 5347 JMP FOUCH1 789 001521 5344 JMP FOUCH2 790 001522 1366 FOUCH3, TAD FOUTMP 791 001523 7006 RTL 792 001524 7006 RTL 793 001525 3366 DCA FOUTMP 794 001526 1366 TAD FOUTMP 795 001527 0151 AND FI7400 796 001530 1770 TAD I FOPOLD /PUT HIGH-ORDER BITS 797 /OF CHARACTER 3 798 001531 3770 DCA I FOPOLD /INTO HIGH-ORDER BITS 799 /OF CHARACTER 1. 800 001532 1366 TAD FOUTMP 801 001533 7006 RTL 802 001534 7006 RTL 803 001535 0151 AND FI7400 804 001536 1771 TAD I FOUPTR /PUT LOW-ORDER BITS 805 /OF CHARACTER 3 806 001537 3771 DCA I FOUPTR /INTO HIGH-ORDER BITS OF 807 /CHARACTER 2. 808 001540 1303 TAD FOJMP 809 001541 3317 DCA FOUJMP 810 001542 2371 ISZ FOUPTR 811 001543 5351 JMP DFEXIT /RETURN. 812 001544 1371 FOUCH2, TAD FOUPTR 813 001545 3370 DCA FOPOLD /SAVE POINTER TO CHAR 1. 814 001546 2371 ISZ FOUPTR 815 001547 1366 FOUCH1, TAD FOUTMP 816 001550 3771 DCA I FOUPTR /STORE CHAR 1 OR 2 817 001551 1365 DFEXIT, TAD TEMOUT /RESTORE AC 818 001552 5675 JMP I FOCHAR /RETURN. 819 820 001553 0600 PLPTOUT,LPTOUT /POINTER TO LINE PRINTER 821 /ROUTINE. 822 001554 0000 FOSETP, 0 823 001555 1364 TAD FO7177 824 001556 3367 DCA FOCHCT /INITIALIZE OUTPUT CHARACTER 825 /COUNT. 826 001557 1306 TAD FOUBUF 827 001560 3371 DCA FOUPTR /POINTER TO BUFFER. 828 001561 1303 TAD FOJMP 829 001562 3317 DCA FOUJMP /SET 3-WAY SWITCH. 830 001563 5754 JMP I FOSETP 831 001564 7177 FO7177, 7177 /WRITE 600 CHARACTERS/BUFFER. 832 001565 0000 TEMOUT, 0 /STORE CHARACTER TEMPORARILY 833 001566 0000 FOUTMP, 0 834 001567 0000 FOCHCT, 0 /OUTPUT CHARACTER COUNT. 835 001570 0000 FOPOLD, 0 836 001571 0000 FOUPTR, 0 /POINTER TO NEXT LOCATION 837 /IN OUTPUT BUFFER. 838 001572 1643 KFOCCNT,FOCCNT 839 PAGE 840 /CLOSE INPUT FILE-JUST RESET POINTER TO 841 /TELETYPE. 842 843 001600 0000 ICLOSR, 0 844 001601 7200 CLA 845 001602 1210 TAD KPTTYIN /POINTER TO TTY INPUT 846 /ROUTINE. 847 001603 6211 CDF 10 848 001604 3611 DCA I PPINSUB 849 001605 3143 DCA RVAL /RETURN NIL 850 001606 1200 TAD ICLOSR 851 001607 5133 JMP F1RET /RETURN. 852 001610 3155 KPTTYIN,INSUB 853 001611 0100 PPINSUB,PINSUB 854 855 /CLOSE OUTPUT FILE. IF SPECIAL OUTPUT DEVICE, 856 /JUST RESET POINTER. OTHERWISE,OUTPUT ^Z 857 /AND CLOSE OUTPUT FILE. 858 001612 0000 OCLOSR, 0 859 001613 7200 CLA 860 001614 1104 TAD NUMB1 861 001615 7440 SZA 862 001616 5245 JMP CNGPT /SPECIAL OUTPUT-CHANGE POINTER 863 /OUTPUT A ^Z 864 001617 1257 TAD K232 865 001620 4654 JMS I PFOCHAR 866 001621 6201 CDF 0 867 /WRITE OUT THE LAST BLOCK. 868 001622 7200 CLA 869 001623 1660 TAD I KFOUBUF 870 001624 3231 DCA COUBUF 871 001625 1661 TAD I KFOUREC 872 001626 3232 DCA COUREC /BLOCK NUMBER 873 001627 4527 JMS I OHNDLR 874 001630 4200 4200 /WRITE 2 PAGES. 875 001631 0000 COUBUF, 0 /BUFFER LOCATION 876 001632 0000 COUREC, 0 /BLOCK NUMBER 877 001633 5662 JMP I KOUERR /ERROR. 878 001634 2243 ISZ FOCCNT /INCREMENT COUNT OF 879 /BLOCKS WRITTEN. 880 001635 6212 CIF 10 881 001636 7200 CLA 882 001637 1655 TAD I POSDEV2 /GET DEVICE NUMBER. 883 001640 4550 JMS I K7700A /CALL USR 884 001641 0004 4 /CLOSE FILE 885 001642 0115 FOCNAM, OUFIL1 /FILE NAME LOCATION. 886 001643 0000 FOCCNT, 0 /CLOSING LENGTH. 887 001644 5656 JMP I POUERR /ERROR. 888 001645 7200 CNGPT, CLA 889 001646 1171 TAD P1OUTSUB/POINTER TO OUTPUT ROUTINE 890 001647 6211 CDF 10 891 001650 3572 DCA I PPOUTCH /RESET POINTER TO OUTPUT ROUTINE 892 001651 3143 DCA RVAL /RETURN NIL 893 001652 1212 TAD OCLOSR 894 001653 5133 JMP F1RET /RETURN. 895 001654 1475 PFOCHAR,FOCHAR 896 001655 1431 POSDEV2,OSDEV2 /POINTER TO OUTPUT DEVICE #. 897 001656 1464 POUERR, OUERR 898 001657 0232 K232, 232 /CODE FOR ^Z. 899 900 001660 1506 KFOUBUF,FOUBUF 901 001661 1507 KFOUREC,FOUREC 902 001662 1464 KOUERR, OUERR 903 /MOVE A1P,A2P,AND A3P TO 904 /ZA1P,ZA2P,AND ZA3P RESPECTIVELY. 905 /RETURNS WITH DATA FIELD =10. 906 001663 0000 MOVARG, 0 907 001664 6211 CDF 10 908 001665 7200 CLA 909 001666 1500 TAD I PA1P 910 001667 3035 DCA ZA1P 911 001670 1501 TAD I PA2P 912 001671 3037 DCA ZA2P 913 001672 1502 TAD I PA3P 914 001673 3041 DCA ZA3P 915 001674 5663 JMP I MOVARG 916 917 918 /ZEXPR ROUTINE. JUMPS TO 919 /THE LOCATION SPECIFIED AS THE 920 /FIRST ARGUMENT, WITH POINTERS TO THE 921 /SECOND AND THIRD ARGUMENTS IN 922 /FIELD 0 LOCATIONS ZA2P AND ZA3P. 923 924 001675 4263 ZEXPR0, JMS MOVARG /MOVE THE ARGUMENT 925 /POINTERS. 926 001676 1435 TAD I A1P /GET ADDRESS TO TRANSFER TO. 927 001677 3036 DCA TEMPAD 928 001700 1437 TAD I A2P /HAVE 2ND ARGUMENT IN AC. 929 001701 6201 CDF 0 930 001702 5436 JMP I TEMPAD /GO TO THIS ROUTINE. 931 932 933 /CHANGE FIELD 0 LOCATION SPECIFIED IN AC. 934 001703 3036 CNGLOC, DCA TEMPAD /SAVE ADDRESS. 935 001704 6211 CDF 10 936 001705 1441 TAD I ZA3P 937 CNGLOZ, 938 001706 3436 DCA I TEMPAD /CHANGE LOCATION. 939 001707 5042 JMP ZRET2 /RETURN. 940 941 942 /RETURN WITH THE CONTENTS OF THE ADDRESS SPECIFIED IN 943 /THE ACCUMULATOR. 944 001710 3036 GETCON, DCA TEMPAD 945 001711 1436 TAD I TEMPAD 946 001712 5044 JMP ZVRET2 /RETURN THIS NUMERICAL VALUE. 947 948 /PRINT CHARACTER SPECIFIED IN 2ND ARGUMENT 949 /ON THE LINE PRINTER. 950 001713 4716 PRLPT, JMS I PLPT /HAVE CHAR IN AC ON ENTRY. 951 001714 7200 CLA /RETURN VALUE NIL. 952 001715 5042 JMP ZRET2 /RETURN. 953 001716 0600 PLPT, LPTOUT /POINTER TO LINE PRINTER ROUTINE. 954 955 /CHANGE FIELD 2 LOCATION SPECIFIED IN AC 956 001717 3036 CNGLO2, DCA TEMPAD /SAVE ADDRESS 957 001720 6211 CDF 10 958 001721 1441 TAD I ZA3P /GET VALUE TO BE SAVED 959 001722 6221 CDF 20 960 001723 5306 JMP CNGLOZ 961 /CHANGE FIELD 3 LOCATION SPECIFIED IN AC 962 001724 3036 CNGLO3, DCA TEMPAD /SAVE ADDRESS 963 001725 6211 CDF 10 964 001726 1441 TAD I ZA3P /GET VALUE TO BE SAVED 965 001727 6231 CDF 30 966 001730 5306 JMP CNGLOZ 967 /GET FIELD 2 CONTENT OF ADDRESS IN AC 968 001731 6221 GETCO2, CDF 20 /SET DF 969 001732 5310 JMP GETCON 970 /GET FIELD 3 CONTENT OF ADDRESS IN AC 971 001733 6231 GETCO3, CDF 30 /SET DF 972 001734 5310 JMP GETCON 973 /XOR OF ARG2 AND AND ARG3 974 001735 6211 XORX, CDF 10 /RESET DF WITH ARG2 IN AC 975 001736 1441 TAD I A3P /ADD ARG3 976 001737 3036 DCA TEMPAD /TEMPAD = A+B 977 001740 1441 TAD I A3P /GET ARG2 978 001741 0437 AND I A2P /MASK WITH ARG3 979 001742 7040 CMA 980 001743 1036 TAD TEMPAD /AC = A+B-(A.B)=A.XOR.B 981 001744 5044 JMP ZVRET2 982 /OR OF ARG2 AND ARG3. NO EAE 983 001745 6211 ORX, CDF 10 /RESET DF, ARG2 IN AC 984 001746 7040 CMA / 985 001747 3036 DCA TEMPAD / 986 001750 1441 TAD I A3P /A.OR.B = 987 001751 7040 CMA / 988 001752 0036 AND TEMPAD /.NOT.(.NOT.A.AND..NOT.B) 989 001753 7040 CMA / 990 001754 5044 JMP ZVRET2 /RETURN VALUE 991 /OR OF ARG2 AND ARG3, MODE A EAE 992 001755 7421 OREAEX, MQL /ARG2 TO MQ 993 001756 6211 CDF 10 /RESET DF 994 001757 1441 TAD I A3P /ARG3 TO AC 995 001760 7501 MQA /AC.OR.MQ TO AC 996 001761 5044 JMP ZVRET2 /RETURN VALUE 997 *2000 998 /LOGICAL SHIFT ARG2*(2**ARG3), NO EAE 999 002000 3036 LFTSHX, DCA TEMPAD /SAVE ARG2 1000 002001 6211 CDF 10 /RESTORE DF 1001 002002 1441 TAD I A3P /GET ARG3 1002 002003 7450 SNA /ARG3=0? 1003 002004 5216 JMP NOSHIFT /YES RETURN ARG2 1004 002005 7510 SPA /N > 0? 1005 002006 5220 JMP RIGHTSH /NO, RIGHT SHIFTS 1006 002007 7041 CMA IAC /LEFT SHIFTLOOP 1007 002010 3253 DCA TEMPAX /SAVE COUNT 1008 002011 1036 TAD TEMPAD 1009 002012 7104 CLL RAL 1010 002013 2253 ISZ TEMPAX 1011 002014 5212 JMP .-2 1012 002015 5044 JMP ZVRET2 /RETURN VALUE 1013 002016 1036 NOSHIFT, TAD TEMPAD /PICK UP ARG2 1014 002017 5044 JMP ZVRET2 /RETURN IT 1015 002020 3253 RIGHTSH, DCA TEMPAX /STORE COUNT 1016 002021 1036 TAD TEMPAD /GET ARG2 1017 002022 7110 CLL RAR /SHIFT RIGHT 1018 002023 2253 ISZ TEMPAX /STEP COUNT 1019 002024 5222 JMP .-2 /ONCE MORE 1020 002025 5044 JMP ZVRET2 /RETURN VALUE 1021 /LOGICAL SHIFT ARG2*(2**ARG3), EAE VERSION 1022 002026 3036 LFTEAX, DCA TEMPAD /STORE ARG2 1023 002027 6211 CDF 10 /RESTORE DF 1024 002030 1441 TAD I A3P /GET ARG3 1025 002031 7450 SNA 1026 002032 5216 JMP NOSHIFT /ARG3=0 1027 002033 7510 SPA 1028 002034 5245 JMP RIGEAS /ARG3 > 0, RIGHT SHIFT 1029 002035 7041 CMA IAC /SUBTRACT BY ONE 1030 002036 7040 CMA 1031 002037 3243 DCA LFTSHC 1032 002040 7621 CAM /CLEAR MQ 1033 002041 1036 TAD TEMPAD 1034 002042 7413 SHL /SHIFT IT LEFT 1035 002043 0000 LFTSHC, .-. 1036 002044 5044 JMP ZVRET2 /RETURN RESULT 1037 002045 7040 RIGEAS, CMA /CHANGE SIGN AND BACK ONE 1038 002046 3251 DCA RIGSHC /STORE IN SHIFTCOUNT 1039 002047 1036 TAD TEMPAD /GET ARG2 1040 002050 7417 LSR /LOGICAL RIGHT SHIFT 1041 002051 0000 RIGSHC, .-. 1042 002052 5044 JMP ZVRET2 /RETURN VALUE 1043 /REMAINDER (ARG2 ARG3) IS RETURNED 1044 /QUOTIENT IS RETURNED IN 15 1045 /RETREIVED BY EXPR(3172 15 -1) 1046 / 1047 002053 0000 TEMPAX, 0 /TEMP STORAGE 1048 002054 3036 REMX, DCA TEMPAD /STORE ARG2 1049 002055 6211 CDF 10 /RESTORE DF 1050 002056 3434 DCA I PQUOTI /CLEAR QUOTIENT 1051 002057 1441 TAD I A3P /GET ARG3 1052 002060 7450 SNA /=0? 1053 002061 5322 JMP FEX /YES, ERROR 1054 002062 3253 DCA TEMPAX /STORE ARG3 1055 002063 1253 TAD TEMPAX /GET IT AGAIN 1056 002064 7161 CLL CML CMA IAC /-ARG3, 13 BITS 1057 002065 1036 TAD TEMPAD /ADD ARG2 1058 002066 7530 SZL SPA /STILL GREATER 1059 002067 5273 JMP .+4 /NO, READY 1060 002070 3036 DCA TEMPAD /STORE NEW ONE 1061 002071 2434 ISZ I PQUOTI /STEP QUOTIENT 1062 002072 5263 JMP .-7 /ONCE MORE 1063 002073 7200 CLA 1064 002074 1036 TAD TEMPAD /GET LAST REM 1065 002075 5044 JMP ZVRET2 /RETURN IT 1066 /REMAINDER, EAE VERSION 1067 002076 7421 REMEAE, MQL /ARG2 TO MQ 1068 002077 6211 CDF 10 /RESTORE DF 1069 002100 1441 TAD I A3P /GET ARG3 1070 002101 3303 DCA .+2 /STORE IN 2:ND WORD 1071 002102 7407 REMDVI, DVI /DIVIDE ARG2/ARG3 1072 002103 0000 .-. 1073 002104 7430 SZL /OVERFLOW 1074 002105 5322 JMP FEX /YES 1075 002106 7521 SWP /LET AC AND MQ EXCHANGE CONTENT 1076 002107 3434 DCA I PQUOTI /AC - QUOTIENT 1077 002110 7701 MQA CLA /MQ - REMAINDER 1078 002111 5044 JMP ZVRET2 1079 /PRODUCT, EAE VERSION FOR QUICK TIMES 1080 002112 7421 TIMEAE, MQL /ARG2 TO MQ 1081 002113 6211 CDF 10 /GET DF 1082 002114 1441 TAD I A3P /GET ARG3 1083 002115 3317 DCA .+2 /STORE IN 2:ND WORD 1084 002116 7405 MUY /ARG2*ARG3, 12 BITS 1085 002117 0000 .-. / 1086 002120 7701 MQA CLA /12 LAST BITS TO AC 1087 002121 5044 JMP ZVRET2 /RETURN IT 1088 002122 7200 FEX, CLA 1089 002123 6213 CIF CDF 10 1090 002124 4524 JMS I P1ERR 1091 /PRODUCT, TWO. WORD RESULT 1092 /ARG2*ARG3+<15> - <15>, RESULT 1093 002125 7421 TIMEXT, MQL /ARG2 TO MQ 1094 002126 6211 CDF 10 /RESTORE DF 1095 002127 1441 TAD I A3P /GET ARG3 1096 002130 3333 DCA .+3 /STORE IN 2:ND WORD 1097 002131 1434 TAD I PQUOTI /GET <15> 1098 002132 7405 MUY /MULTIPLY 1099 002133 0000 .-. / 1100 002134 3434 DCA I PQUOTI /STORE FIRST WORD 1101 002135 7501 MQA /GET 2:ND ONE 1102 002136 5044 JMP ZVRET2 /RETURN IT 1103 /QUOTIENT, TWO WORD NOMINATOR 1104 /(<15>,ARG)/ARG3 - RESULT,<15> 1105 /ARG3 > <15> 1106 / 1107 002137 7421 REMEXT, MQL /ARG2 TO MQ 1108 002140 6211 CDF 10 /RESTORE DF 1109 002141 1441 TAD I A3P /GET ARG3 1110 002142 3303 DCA REMDVI+1 /STORE IND 2:ND WORD 1111 002143 1434 TAD I PQUOTI /<15> TO AC 1112 002144 5302 JMP REMDVI /DIVIDE 1113 *2200 1114 /13 BIT ADDER, UNSIGNED, EAE INDEPENDENT 1115 /<15> + ARG2 + ARG3 => <15>(CARRY), RESULT 1116 /<15> IS THE QUOTIENT CELL, USED FOR CARRY 1117 002200 6211 ADDWCA, CDF 10 /RESET DF 1118 002201 7100 CLL /CLEAR LINK BIT 1119 002202 1441 TAD I A3P /ADD ARG2 1120 002203 1434 TAD I PQUOTI /ADD OLD CARRY 1121 002204 3777 DCA TEMPAX /SAVE AC IN TEMPAX 1122 002205 7004 RAL /LINK TO AC 1123 002206 3434 DCA I PQUOTI /STORE IN <15> 1124 002207 1777 TAD TEMPAX /GET SUM TO AC 1125 002210 5044 JMP ZVRET2 /RETURN VALUE 1126 /BINARY PUNCH ROUTINE 1127 /IF ARG3 >=0,PUNCH ARG2, ARG3 1128 /IF ARG3<0, PUNCH ARG2. -ARG3 TIMES 1129 002211 3036 STUTX, DCA TEMPAD /SAVE ARG2 1130 002212 6211 CDF 10 /RESTORE DF 1131 002213 1036 TAD TEMPAD /GET ARG2 1132 002214 4231 JMS STANSA /PUT IT 1133 002215 1441 TAD I A3P /GET ARG3 1134 002216 7510 SPA />=0? 1135 002217 5222 JMP STUX /NO, REPEAT 1136 002220 4231 JMS STANSA /PUT IT 1137 002221 5042 JMP ZRET2 /EXIT 1138 002222 3777 STUX, DCA TEMPAX /SAVE COUNT 1139 002223 5226 JMP .+3 /BYPASS ONCE 1140 002224 1036 TAD TEMPAD /GET ARG2 1141 002225 4231 JMS STANSA /PUT IT ONCE MORE 1142 002226 2777 ISZ TEMPAX /STEP COUNT 1143 002227 5224 JMP .-3 /ONCE MORE 1144 002230 5042 JMP ZRET2 /EXIT 1145 002231 0000 STANSA, 0 /BASIC PUNCH ROUTINE 1146 002232 6026 6026 1147 002233 6021 6021 1148 002234 5233 JMP .-1 1149 002235 7600 P7600, 7600 /CLA AND A CONSTANT 1150 002236 5631 JMP I STANSA 1151 1152 002237 6211 SETDEC, CDF 10 /SET DECIMAL MODE 1153 002240 1267 TAD SETDA /1037 1154 002241 3670 DCA I SETDA+1 /2506 1155 002242 1271 TAD SETDA+2 /1750 1156 002243 3672 DCA I SETDA+3 /2034 1157 002244 1273 TAD SETDA+4 /144 1158 002245 3674 DCA I SETDA+5 /2035 1159 002246 1275 TAD SETDA+6 /12 1160 002247 3676 DCA I SETDA+7 /2036 1161 002250 1277 TAD SETDA+10/7061 1162 002251 3700 DCA I SETDA+11/2046 1163 002252 5042 JMP ZRET2 /EXIT 1164 1165 002253 6211 SETOCT, CDF 10 /SET OCTAL UNSIGNED MODE 1166 002254 1301 TAD SETOA /7000 1167 002255 3670 DCA I SETDA+1 /2506 1168 002256 1302 TAD SETOA+1 /1000 1169 002257 3672 DCA I SETDA+3 /2034 1170 002260 1303 TAD SETOA+2 /100 1171 002261 3674 DCA I SETDA+5 /2035 1172 002262 1304 TAD SETOA+3 /10 1173 002263 3676 DCA I SETDA+7 /2036 1174 002264 1305 TAD SETOA+4 /7000 1175 002265 3700 DCA I SETDA+11/2046 1176 002266 5042 JMP ZRET2 1177 002267 1037 SETDA, 1037; RDNUM1; 1750; K1000; 144; K100 002270 2536 002271 1750 002272 2034 002273 0144 002274 2035 1178 002275 0012 12; K10; 7061; PRNTA5 002276 2036 002277 7061 002300 2046 1179 002301 7000 SETOA, 7000; 1000; 100; 10; 7000 002302 1000 002303 0100 002304 0010 002305 7000 1180 002306 0235 CPAGE, AND P7600 /MASK OUT PAGE 1181 002307 7041 CMA IAC 1182 002310 3036 DCA TEMPAD /STORE NEGATIVE ARG2 MASKED 1183 002311 6211 CDF 10 1184 002312 1437 TAD I A2P /GET ARG 2 1185 002313 1441 TAD I A3P /ADD ARG 3 1186 002314 0235 AND P7600 /MASK OUT PAGE 1187 002315 3231 DCA STANSA /SAVE IT A WHILE 1188 002316 1231 TAD STANSA /PIC IT UP 1189 002317 1036 TAD TEMPAD /COMPARE WITH MASKED ARG 2 1190 002320 7640 SZA CLA 1191 002321 5324 JMP CPAGE1 /NOT SAME PAGE 1192 002322 1437 TAD I A2P /SAME PAGE, GET ARG 2 1193 002323 5044 JMP ZVRET2 /EXIT 1194 002324 1231 CPAGE1, TAD STANSA /NOT SAME PAGE, GET NEXT PAGE START 1195 002325 5044 JMP ZVRET2 /EXIT 1196 002377 2053 *5400 1197 /BEGINNING OF TELETYPE INPUT BUFFER. 1198 005400 0000 TBUF, 0 1199 *5577 1200 /END OF TELETYPE INPUT BUFFER. 1201 005577 0000 LASTL, 0 1202 1203 *5600 1204 005600 0000 OUBUF, 0 /LOCATION OF OUTPUT BUFFER. 1205 1206 *6200 1207 006200 0000 INBUFL, 0 /LOCATION OF INPUT BUFFER 1208 1209 *6600 1210 006600 0000 OUDBUF,0 /LOCATION TO LOAD OUTPUT DEVICE HANDLER 1211 1212 *7200 1213 007200 0000 INDBUF, 0 /LOCATION TO LOAD INPUT DEVICE HANDLER 1214 FIELD 1 1215 /PAGE ZERO LOCATIONS 1216 1217 /LOCATION 102 IS STILL UNUSED. 1218 1219 *0 1220 010000 0000 NIL, 0 /ATOM NIL 1221 010001 0000 NIL1, 0 1222 010002 0002 K2, 2 1223 010003 0003 K3, 3 1224 010004 0004 K4, 4 1225 010005 0005 K5, 5 1226 010006 0000 GCCNT, 0 /CUMULATIVE NUMBER OF TIMES THE 1227 /GARBAGE COLLECTOR HAS BEEN CALLED 1228 010007 0077 K77, 77 1229 010010 0000 XR10, 0 /THESE FOUR INDEX REGISTERS 1230 010011 0000 XR11, 0 /ARE USED BY SEVERAL PARTS 1231 010012 0000 XR12, 0 /OF THE LISP SYSTEM. 1232 010013 0000 XR13, 0 1233 010014 0000 CHAR, 0 /INPUT CHARACTER BUFFER 1234 010015 0000 QUOTIENT, 0 /USED BY ZEXPR ROUTINES FOR 1235 /MULTIPLY AND DIVIDE AND MULTIPLE 1236 /PRECISION INTEGER ARITHMETIC ROUTINES. 1237 010016 0000 LINCNT, 0 /LINE COUNT, COUNTING FROM -77 TO 0. 1238 010017 0000 CGENSYM,0 /COUNTER USED BY GENSYM 1239 010020 3624 L20, PAPVAL 1240 /THESE LOCATIONS ARE 1241 010021 0000 TEMP1, 0 /USED FOR STORING DIFFERENT 1242 010022 0000 L22, 0 /THINGS AT DIFFERENT TIMES. 1243 010023 0000 L23, 0 1244 010024 3622 PTRUE, TRUE /POINTER TO THE ATOM "T" 1245 010025 0000 ALP, 0 /POINTER TO THE ASSOCIATION LIST 1246 010026 3764 POBJST, OBJST /POINTER TO THE START OF THE 1247 /OBJECT LIST 1248 010027 0000 SP, 0 /STACK POINTER 1249 010030 0000 FLIST, 0 /POINTER TO THE NEXT CELL IN 1250 /THE FREE LIST. 1251 010031 0000 L31, 0 /THESE LOCATIONS ARE USED 1252 010032 0000 L32, 0 /FOR STORING VALUES 1253 010033 0000 L33, 0 1254 010034 3676 PB1ARG, B1ARG /POINTER TO THE BEGINNING OF THE 1255 /SYSTEM SUBROUTINES WITH 1256 /ONE ARGUMENT. 1257 010035 0000 A1P, 0 /POINTER TO THE FIRST ARGUMENT 1258 010036 3714 PB2ARG, B2ARG /POINTER TO THE BEGINNING OF THE 1259 /SYSTEM SUBROUTINES WITH TWO 1260 /ARGUMENTS. 1261 010037 0000 A2P, 0 /POINTER TO THE SECOND ARGUMENT 1262 010040 3742 PB3ARG, B3ARG /POINTER TO THE BEGINNING OF THE 1263 /SYSTEM SUBROUTINES WITH THREE 1264 /ARGUMENTS. 1265 010041 0000 A3P, 0 /POINTER TO THE THIRD ARGUMENT 1266 010042 3754 POBJ, OBJ /POINTER TO OBJECT. 1267 010043 3614 PSOBJ, SOBJ /POINTER TO THE SYSTEM OBJECT LIST 1268 010044 3765 PBEG, LBEG /POINTER TO THE BEGINNING OF 1269 /THE LIST SPACE 1270 010045 4166 LLEN, LBEG-LEND /-LENGTH OF THE LIST SPACE 1271 010046 3265 PSYMT, SYMT /POINTER TO THE ATOMIC SYMBOL TABLE 1272 010047 0216 PDISP, DISP /POINTER TO THE DISPATCH ROUTINE 1273 010050 1136 PASSOC, ASSOC /POINTER TO ASSOC ROUTINE 1274 010051 2650 PCKUSER,CKUSER /POINTER TO ROUTINE WHICH 1275 /CHECKS TO SEE IF IT IS USER- 1276 /DEFINED. 1277 010052 1012 PGETARG,GETARG /POINTER TO THE ROUTINE TO 1278 /GET AN ARGUMENT. 1279 010053 1520 PGETTOP,GETTOP /POINTER TO GETTOP ROUTINE 1280 010054 0771 PCDR, CDR /POINTER TO CDR ROUTINE 1281 010055 1652 PGARB, GARB /POINTER TO ROUTINE WHICH 1282 /CHECKS TO SEE IF A GARBAGE 1283 /COLLECTION IS NECESSARY. 1284 010056 0672 PLIST1, LIST1 1285 010057 0720 PLIST5, LIST5 1286 010060 3134 PERR, ERR /POINTER TO THE ERROR ROUTINE 1287 010061 1116 PGET, GET /POINTER TO THE GET ROUTINE 1288 010062 2211 PPRINCC,PRINCC /POINTER TO THE PRINT CHARACTER ROUTINE 1289 010063 2172 PPRINT, PRINT /POINTER TO THE PRINT 1290 /S-EXPRESSION ROUTINE 1291 010064 2510 PREAD, READ /POINTER TO THE READ 1292 /S-EXPRESSION ROUTINE 1293 010065 3224 PRDPCK, RDPCK /POINTER TO THE READ AND 1294 /PACK 2 CHARACTERS ROUTINE 1295 010066 2312 PFETCHC,FETCHC /POINTER TO THE FETCH A 1296 /CHARACTER ROUTINE 1297 010067 2151 PTERPRI,TERPRI /POINTER TO THE PRINT A 1298 /CARRIAGE RETURN AND LINE 1299 /FEED ROUTINE 1300 010070 3207 PA1PPL1,A1PPL1 1301 010071 1160 PLOOKUP,LOOKUP 1302 010072 1475 PCAR, CAR /POINTER TO THE CAR ROUTINE 1303 010073 0000 INRET, 0 /RETURN ADDRESS FROM THE 1304 /INPUT ROUTINE. 1305 /PAGE ZERO ROUTINES AND POINTERS 1306 1307 /TELETYPE INPUT ROUTINE 1308 010074 6203 TTYIN, CDF CIF 0 /GO TO BUFFERED TTYIN ROUTINE. 1309 010075 4476 JMS I .+1 1310 010076 0200 BTTY 1311 010077 5473 JMP I INRET /RETURN. 1312 1313 1314 010100 3155 PINSUB, INSUB /POINTER TO THE BASIC 1315 /INPUT ROUTINE. 1316 010101 1504 PSCR6, SCR6 /POINTER TO THE SCALE RIGHT 1317 /SIX ROUTINE 1318 010102 0000 0 /THIS LOCATION IS UNUSED. 1319 010103 3040 PSETM2, SETM2 /POINTER TO THE ROUTINE TO 1320 /SET THE ACCUMULATOR TO -2 1321 1322 /LISP NUMBER ROUTINE. CHECKS TO SEE IF 1323 /ARGUMENT IS A NUMBER. RETURNS NIL IF IT 1324 /IS NOT. OTHERWISE, IT RETURNS A POINTER TO "TRUE". 1325 1326 010104 0000 NUMBER, 0 1327 010105 1035 TAD A1P 1328 010106 3011 DCA XR11 1329 010107 7040 CMA 1330 010110 1411 TAD I XR11 1331 010111 7650 SNA CLA 1332 010112 1024 TAD PTRUE /HAD A NUMBER 1333 010113 5504 JMP I NUMBER 1334 1335 1336 /LISP ATOM ROUTINE. CHECKS TO SEE IF THE ARGUMENT 1337 /IS AN ATOM. IF IT IS , RETURNS A POINTER TO 1338 /"TRUE". OTHERWISE, RETURNS NIL. 1339 1340 010114 0000 ATOM, 0 1341 010115 4470 JMS I PA1PPL1 1342 010116 7001 IAC 1343 010117 0421 AND I TEMP1 1344 010120 7640 SZA CLA 1345 010121 1024 TAD PTRUE /IT WAS AN ATOM. 1346 010122 5514 JMP I ATOM /RETURN. 1347 1348 1349 /POP ROUTINE. POPS THE STACK. RETURNS WITH 1350 /THE PREVIOUS CONTENTS OF THE TOP OF THE 1351 /STACK IN THE AC. 1352 1353 010123 0000 POP, 0 1354 010124 7200 CLA 1355 010125 1027 TAD SP /STACK POINTER 1356 010126 3010 DCA XR10 1357 010127 1427 TAD I SP 1358 010130 3027 DCA SP /RESET THE STACK 1359 /POINTER TO POINT TO 1360 /CELL BEFORE THIS. 1361 010131 1410 TAD I XR10 /GET THE CONTENTS OF 1362 /THE POPPED CELL. 1363 010132 5523 JMP I POP 1364 1365 1366 /PUSH ROUTINE. PUSHES THE CONTENTS OF THE 1367 /ACCUMULATOR ON THE TOP OF THE STACK. 1368 1369 010133 0000 PUSH, 0 1370 010134 2030 ISZ FLIST /FLIST NOW POINTS TO THE 1371 /DATA PART OF THE NEXT FREE 1372 /CELL. 1373 010135 3430 DCA I FLIST /PUSH THE AC. 1374 010136 1027 TAD SP 1375 010137 3023 DCA L23 1376 010140 7040 CMA 1377 010141 1030 TAD FLIST /AC NOW CONTAINS POINTER 1378 /TO THIS CELL. 1379 010142 3027 DCA SP /SAVE THE POINTER TO 1380 /TO THE TOP OF THE STACK. 1381 010143 1427 TAD I SP /POINTER TO THE NEXT 1382 /CELL AVAILABLE IN FREE LIST 1383 010144 3030 DCA FLIST /RESET FREE LIST POINTER 1384 010145 1023 TAD L23 /POINTER TO PREVIOUS TOP 1385 /OF STACK. 1386 010146 3427 DCA I SP /NOTE THAT THE STACK IS 1387 /MERELY A LIST IN THE FREE 1388 /SPACE. 1389 010147 4455 JMS I PGARB /SEE IF FREE SPACE IS 1390 /EXHAUSTED, AND IF SO, 1391 /INITIATE A GARBAGE COLLECT. 1392 010150 5533 JMP I PUSH /RETURN. 1393 1394 1395 /NUCEL ROUTINE. 1396 /CONS ROUTINE. GETS A NEW CELL FROM THE FREE 1397 /LIST, AND PLACES C(A1P) IN THE BOTTOM HALF, 1398 /AND PLACES C(A2P) IN THE TOP HALF. 1399 /RETURNS A POINTER TO THE CELL. 1400 1401 NUCEL, 1402 010151 0000 CONS, 0 1403 010152 2030 ISZ FLIST /POINT TO BOTTOM OF NEXT CELL 1404 010153 1035 TAD A1P 1405 010154 3430 DCA I FLIST /SAVE C(A1P) IN BOTTOM OF CELL 1406 010155 7040 CMA 1407 010156 1030 TAD FLIST 1408 010157 3035 DCA A1P /SAVE POINTER TO THIS CELL 1409 010160 1435 TAD I A1P /POINTER TO NEXT CELL IN 1410 /FREE SPACE. 1411 010161 3030 DCA FLIST /RESET THE FREE LIST POINTER 1412 010162 1037 TAD A2P 1413 010163 3435 DCA I A1P /SAVE C(A2P) IN TOP OF CELL 1414 010164 3037 DCA A2P 1415 010165 4455 JMS I PGARB /SEE IF FREE SPACE IS EXHAUSTED, 1416 /AND IF SO, INITIATE A 1417 /GARBAGE COLLECT. 1418 010166 1035 TAD A1P /POINTER TO THE CELL 1419 010167 5551 JMP I CONS 1420 1421 1422 /POP A1P AND EV,AND RETURN WITH A1P IN AC. 1423 010170 4123 LRET1, JMS POP 1424 1425 /POP EV AND RETURN 1426 010171 3035 LRET2, DCA A1P /SAVE AC TEMPORARILY 1427 1428 /POP EV, AND LOAD A1P IN AC. 1429 010172 4123 LRET3, JMS POP 1430 010173 3176 DCA EV 1431 1432 /LOAD A1P AND RETURN 1433 010174 1035 LRET4, TAD A1P 1434 010175 5576 JMP I EV 1435 1436 /EVALUATE SUBROUTINE 1437 1438 010176 0000 EV, 0 1439 010177 4114 JMS ATOM /CHECK IF IT IS AN ATOM 1440 010200 7650 SNA CLA 1441 010201 5225 JMP EV1 /HAD AN ATOM 1442 010202 4451 JMS I PCKUSER /SEE IF IT IS A USER-DEFINED 1443 /FUNCTION. 1444 010203 5174 JMP LRET4 /SYSTEM FUNCTION 1445 010204 4104 JMS NUMBER /HAD USER-DEFINED FUNCTION. 1446 /SEE IF IT IS A NUMBER. 1447 010205 7640 SZA CLA 1448 010206 5174 JMP LRET4 /IT WAS A NUMBER 1449 010207 1020 TAD L20 1450 010210 4471 JMS I PLOOKUP 1451 010211 7420 SNL 1452 010212 4460 JMS I PERR /VALUE OF THIS VARIABLE 1453 /IS NOT DEFINED. 1454 010213 5576 JMP I EV /RETURN 1455 010214 1367 PROU9, ROU9 1456 010215 3630 PFEXPR, FEXPR 1457 1458 1459 /DISPATCH ROUTINE. CALLED BY EVALQUOTE, WITH 1460 /A POINTER TO THE FIRST S-EXPRESSION IN A1P 1461 /AND A POINTER TO THE SECOND S-EXPRESSION IN A2P. 1462 1463 010216 0000 DISP, 0 1464 010217 1216 TAD DISP 1465 010220 3176 DCA EV /SAVE RETURN ADDRESS. 1466 010221 1037 TAD A2P /POINTER TO SECOND 1467 /S-EXPRESSION 1468 010222 3033 DISP14, DCA L33 1469 010223 7240 CLA CMA 1470 010224 5233 JMP EV2 1471 1472 010225 1035 EV1, TAD A1P 1473 010226 3031 DCA L31 1474 010227 1421 TAD I TEMP1 1475 010230 3035 DCA A1P 1476 010231 1431 TAD I L31 1477 010232 3033 DCA L33 1478 1479 010233 3032 EV2, DCA L32 1480 010234 1035 TAD A1P /POINTER TO 1ST S-EXPRESSION 1481 010235 7450 EV3, SNA 1482 010236 5576 JMP I EV /NIL FUNCTION-RETURN NIL 1483 010237 3035 DCA A1P 1484 010240 4104 JMS NUMBER /SEE IF 1ST ARGUMENT WAS 1485 /A NUMBER 1486 010241 7640 SZA CLA 1487 010242 4460 JMS I PERR /ERROR- A NUMBER IS 1488 /STANDING IN THE PLACE OF 1489 /A FUNCTION 1490 010243 1435 TAD I A1P 1491 010244 3037 DCA A2P 1492 010245 4114 JMS ATOM 1493 010246 7650 SNA CLA 1494 010247 5374 JMP EV4 /NOT AN ATOM 1495 010250 4451 JMS I PCKUSER /SEE IF USER-DEFINED 1496 010251 5307 JMP EV5 /SYSTEM-DEFINED FUNCTION 1497 010252 1022 TAD L22 /USER-DEFINED 1498 010253 4471 JMS I PLOOKUP 1499 010254 7430 SZL 1500 010255 5235 JMP EV3 1501 010256 1215 TAD PFEXPR 1502 010257 3037 DCA A2P 1503 010260 1031 TAD L31 1504 010261 3035 DCA A1P 1505 010262 4461 JMS I PGET 1506 010263 7420 SNL 1507 010264 5614 JMP I PROU9 1508 010265 3031 DCA L31 1509 010266 1025 TAD ALP /GET ASSOCIATION LIST POINTER 1510 010267 3035 DCA A1P 1511 010270 3037 DCA A2P 1512 010271 4151 JMS NUCEL /PUT A1P AND A2P IN A CELL 1513 010272 3037 DCA A2P /SAVE POINTER TO THIS CELL 1514 010273 1033 TAD L33 1515 010274 3035 DCA A1P 1516 010275 4151 JMS NUCEL 1517 010276 3033 DCA L33 1518 010277 1031 TAD L31 1519 010300 3035 DCA A1P 1520 010301 5223 JMP EV1-2 1521 1522 1523 010302 4452 T, JMS I PGETARG 1524 010303 3035 DCA A1P 1525 010304 5177 JMP EV+1 1526 1527 1528 010305 3664 PSYSSUBS,SYSSUBS 1529 010306 0033 K33, 33 1530 010307 1305 EV5, TAD PSYSSUBS 1531 010310 7161 CLL CML CIA 1532 010311 1035 TAD A1P 1533 010312 7630 SZL CLA 1534 010313 5437 JMP I A2P 1535 010314 1176 TAD EV 1536 010315 4133 JMS PUSH /PREPARE FOR RECURSION 1537 010316 1035 TAD A1P 1538 010317 4133 JMS PUSH 1539 010320 4456 JMS I PLIST1 1540 010321 4123 JMS POP 1541 010322 3031 DCA L31 1542 010323 1306 TAD K33 1543 010324 3011 DCA XR11 1544 010325 5336 JMP EV7 1545 010326 1033 EV6, TAD L33 1546 010327 7450 SNA 1547 010330 4460 JMS I PERR /BUILT IN FUNCTION HAS 1548 /TOO FEW ARGUMENTS 1549 010331 3010 DCA XR10 1550 010332 1433 TAD I L33 1551 010333 3033 DCA 33 1552 010334 1410 TAD I XR10 1553 010335 3411 DCA I XR11 1554 010336 1411 EV7, TAD I XR11 1555 010337 7161 CLL CML CIA 1556 010340 1031 TAD L31 1557 010341 7620 SNL CLA 1558 010342 5326 JMP EV6 1559 010343 1033 TAD L33 1560 010344 7640 SZA CLA 1561 010345 4460 JMS I PERR /BUILT-IN FUNCTION HAS 1562 /TOO MANY ARGUMENTS 1563 010346 1431 TAD I L31 1564 010347 3021 DCA TEMP1 /SAVE ADDRESS OF FUNCTION 1565 010350 4421 JMS I TEMP1 /GO TO BUILT-IN FUNCTION 1566 010351 5171 JMP LRET2 /RETURN 1567 010352 1033 EVA4, TAD L33 1568 010353 4133 JMS PUSH 1569 010354 1176 TAD EV 1570 010355 4133 JMS PUSH 1571 010356 2032 ISZ L32 1572 010357 5366 JMP EVA1 1573 010360 4176 JMS EV 1574 010361 3035 DCA A1P 1575 010362 4123 JMS POP 1576 010363 3176 DCA EV 1577 010364 4123 JMS POP 1578 010365 5222 JMP DISP14 1579 010366 4176 EVA1, JMS EV 1580 010367 3035 DCA A1P 1581 010370 4123 JMS POP 1582 010371 3176 DCA EV 1583 010372 4123 JMS POP 1584 010373 5232 JMP EV2-1 1585 010374 1421 EV4, TAD I TEMP1 1586 010375 7161 CLL CML CIA 1587 010376 1043 TAD PSOBJ 1588 010377 7450 SNA 1589 010400 5255 JMP EVA19 1590 010401 1004 TAD K4 1591 010402 7640 SZA CLA 1592 010403 5614 JMP I PEVA4 1593 010404 4242 JMS PUSHA 1594 010405 4456 JMS I PLIST1 1595 010406 4453 JMS I PGETTOP 1596 010407 1421 TAD I TEMP1 1597 010410 3025 DCA ALP 1598 010411 1410 TAD I XR10 1599 010412 3423 DCA I L23 1600 010413 5257 JMP EVA6 1601 010414 0352 PEVA4, EVA4 1602 010415 3600 K3600, 3600 1603 1604 1605 010416 1022 FUNC1, TAD L22 1606 010417 4471 JMS I PLOOKUP 1607 010420 7420 SNL 1608 010421 4460 JMS I PERR /ERROR-THIS FUNCTIONAL 1609 /ARGUMENT IS NO FUNCTION. 1610 010422 7410 SKP 1611 1612 /LIPS FUNCTI ROUTINE. 1613 010423 4452 FUNCTI, JMS I PGETARG 1614 010424 3035 DCA A1P 1615 010425 4114 JMS ATOM 1616 010426 7640 SZA CLA 1617 010427 5216 JMP FUNC1 1618 010430 1435 TAD I A1P 1619 010431 3035 DCA A1P 1620 010432 1025 TAD ALP 1621 010433 3037 DCA A2P 1622 010434 4151 JMS NUCEL 1623 010435 3037 DCA A2P 1624 010436 1215 TAD K3600 1625 010437 3035 DCA A1P 1626 010440 4151 JMS NUCEL 1627 010441 5576 JMP I EV 1628 1629 1630 /PUSHA ROUTINE 1631 010442 0000 PUSHA, 0 1632 010443 1176 TAD EV 1633 010444 4133 JMS PUSH 1634 010445 1025 TAD ALP 1635 010446 4133 JMS PUSH 1636 010447 1037 TAD A2P 1637 010450 4133 JMS PUSH 1638 010451 5642 JMP I PUSHA 1639 1640 1641 /LISP PROG ROUTINE. 1642 010452 1033 PROG, TAD L33 1643 010453 3037 DCA A2P 1644 010454 3033 DCA L33 1645 010455 4242 EVA19, JMS PUSHA 1646 010456 4456 JMS I PLIST1 1647 010457 4453 EVA6, JMS I PGETTOP 1648 010460 1021 TAD TEMP1 1649 010461 3031 DCA L31 1650 010462 1421 TAD I TEMP1 1651 010463 3021 DCA TEMP1 1652 010464 1410 EVA11, TAD I XR10 1653 010465 7450 SNA 1654 010466 5317 JMP EVA8 1655 010467 3010 DCA XR10 1656 010470 1410 TAD I XR10 1657 010471 3035 DCA A1P 1658 010472 1033 TAD L33 1659 010473 7440 SZA 1660 010474 5301 JMP EVA9 1661 010475 1421 TAD I TEMP1 1662 010476 7640 SZA CLA 1663 010477 5305 JMP EVA10 1664 010500 4460 JMS I PERR /ERROR-LAMBDA FORM HAS 1665 /TOO FEW ARGUMENTS. 1666 010501 3011 EVA9, DCA XR11 1667 010502 1433 TAD I L33 1668 010503 3033 DCA L33 1669 010504 1411 TAD I XR11 1670 010505 3037 EVA10, DCA A2P 1671 010506 4151 JMS NUCEL 1672 010507 4503 JMS I PSETM2 1673 010510 1010 TAD XR10 1674 010511 3010 DCA XR10 1675 010512 1025 TAD ALP 1676 010513 3037 DCA A2P 1677 010514 4151 JMS NUCEL 1678 010515 3025 DCA ALP 1679 010516 5264 JMP EVA11 1680 010517 1033 EVA8, TAD L33 1681 010520 7640 SZA CLA 1682 010521 4460 JMS I PERR /LAMBDA FORM AHS TOO 1683 /MANY ARGUMENTS. 1684 010522 1421 TAD I TEMP1 1685 010523 7640 SZA CLA 1686 010524 5331 JMP EVA12 1687 010525 2021 ISZ TEMP1 1688 010526 1421 TAD I TEMP1 1689 010527 3035 DCA A1P 1690 010530 5377 JMP EVA13 1691 010531 1021 EVA12, TAD TEMP1 1692 010532 4133 JMS PUSH 1693 010533 4453 EVA14, JMS I PGETTOP 1694 010534 7420 SNL 1695 010535 5375 JMP EVA15 1696 010536 1421 TAD I TEMP1 1697 010537 3423 DCA I L23 1698 010540 1410 TAD I XR10 1699 010541 3035 DCA A1P 1700 010542 4114 JMS ATOM 1701 010543 7450 SNA 1702 010544 4176 JMS EV 1703 010545 5333 JMP EVA14 1704 1705 1706 /CKPROG ROUTINE 1707 010546 0000 CKPROG, 0 1708 010547 1576 TAD I EV 1709 010550 7041 CIA 1710 010551 1345 TAD CKPROG-1 1711 010552 7640 SZA CLA 1712 010553 4460 JMS I PERR /ERROR-GO,RETURN,OR COND 1713 /WITH UNDEFINED VALUE HAS 1714 /BEEN ENCOUNTERED OUTSIDE OF 1715 /A PROG. 1716 010554 5746 JMP I CKPROG 1717 1718 1719 /LISP GO ROUTINE. 1720 010555 4346 GO, JMS CKPROG 1721 010556 4452 JMS I PGETARG 1722 010557 3037 DCA A2P 1723 010560 1427 TAD I SP 1724 010561 3010 DCA XR10 1725 010562 1410 TAD I XR10 1726 010563 3035 DCA A1P 1727 010564 4461 JMS I PGET 1728 010565 7420 SNL 1729 010566 4460 JMS I PERR /ERROR-GO HAS UNKNOWN 1730 /LABEL 1731 010567 4453 JMS I PGETTOP 1732 010570 1035 TAD A1P 1733 010571 3423 DCA I L23 1734 010572 5333 JMP EVA14 1735 1736 1737 /LISP RETURN ROUTINE 1738 010573 4346 RETURN, JMS CKPROG 1739 010574 4452 JMS I PGETARG 1740 010575 3035 EVA15, DCA A1P 1741 010576 4123 JMS POP 1742 010577 4123 EVA13, JMS POP 1743 010600 4176 EVAL1, JMS EV 1744 010601 3035 EVAL2, DCA A1P 1745 010602 4123 JMS POP 1746 010603 3025 DCA ALP 1747 010604 5172 JMP LRET3 1748 1749 /LISP EVAL ROUTINE 1750 010605 0000 EVAL, 0 1751 010606 1205 TAD EVAL 1752 010607 4133 JMS PUSH 1753 010610 1025 TAD ALP 1754 010611 4133 JMS PUSH 1755 010612 1037 TAD A2P 1756 010613 3025 DCA ALP 1757 010614 5200 JMP EVAL1 1758 1759 1760 /LISP APPLY ROUTINE. 1761 010615 0000 APPLY, 0 1762 010616 1215 TAD APPLY 1763 010617 4133 JMS PUSH 1764 010620 1025 TAD ALP 1765 010621 4133 JMS PUSH 1766 010622 1041 TAD A3P 1767 010623 3025 DCA ALP 1768 010624 4447 JMS I PDISP 1769 010625 5201 JMP EVAL2 1770 1771 1772 /LISP COND ROUTINE 1773 010626 1176 COND, TAD EV 1774 010627 4133 JMS PUSH 1775 010630 1033 TAD L33 1776 010631 4133 JMS PUSH 1777 010632 5236 JMP COND1 1778 010633 4453 COND3, JMS I PGETTOP 1779 010634 1421 TAD I TEMP1 1780 010635 3423 DCA I L23 1781 010636 4453 COND1, JMS I PGETTOP 1782 010637 7420 SNL 1783 010640 5256 JMP COND2 1784 010641 1410 TAD I XR10 1785 010642 3010 DCA XR10 1786 010643 1410 TAD I XR10 1787 010644 3035 DCA A1P 1788 010645 4176 JMS EV 1789 010646 7650 SNA CLA 1790 010647 5233 JMP COND3 1791 010650 4453 JMS I PGETTOP 1792 010651 1410 TAD I XR10 1793 010652 3035 DCA A1P 1794 010653 1435 TAD I A1P 1795 010654 3010 DCA XR10 1796 010655 1410 TAD I XR10 1797 010656 3035 COND2, DCA A1P 1798 010657 4123 JMS POP 1799 010660 4123 JMS POP 1800 010661 3176 DCA EV 1801 010662 7430 SZL 1802 010663 5177 JMP EV+1 1803 010664 4666 JMS I PCKPROG 1804 010665 5576 JMP I EV 1805 010666 0546 PCKPROG,CKPROG 1806 /LISP LIST ROUTINE. 1807 010667 1176 LIST, TAD EV 1808 010670 3272 LIST6, DCA LIST1 1809 010671 7410 SKP 1810 010672 0000 LIST1, 0 1811 010673 1033 TAD L33 1812 010674 2032 ISZ L32 /IF L32 IS -1 RETURN. 1813 010675 7450 SNA /IF L33 IS 0 RETURN 1814 010676 5672 JMP I LIST1 1815 010677 4133 JMS PUSH 1816 010700 4453 LIST2, JMS I PGETTOP 1817 010701 1272 TAD LIST1 1818 010702 3423 DCA I L23 1819 010703 7420 SNL 1820 010704 5317 JMP LIST4 1821 010705 1410 TAD I XR10 1822 010706 3035 DCA A1P 1823 010707 1421 TAD I TEMP1 1824 010710 4133 JMS PUSH 1825 010711 4176 JMS EV 1826 010712 3272 DCA LIST1 1827 010713 5300 JMP LIST2 1828 010714 1033 LIST3, TAD L33 1829 010715 3435 DCA I A1P 1830 010716 1035 TAD A1P 1831 010717 3033 LIST4, DCA L33 1832 010720 1027 LIST5, TAD SP 1833 010721 3035 DCA A1P 1834 010722 4123 JMS POP 1835 010723 3021 DCA TEMP1 1836 010724 1021 TAD TEMP1 1837 010725 7161 CLL CML CIA 1838 010726 7440 SZA 1839 010727 1043 TAD PSOBJ 1840 010730 7670 SNL SNA CLA 1841 010731 5314 JMP LIST3 1842 010732 1033 TAD L33 1843 010733 5421 JMP I TEMP1 1844 1845 1846 1847 1848 /LISP SET ROUTINE. 1849 010734 0000 SET, 0 1850 010735 1037 TAD A2P 1851 010736 3033 DCA L33 1852 010737 1025 TAD ALP /ASSOCIATION LIST POINTER 1853 010740 3037 DCA A2P 1854 010741 4450 JMS I PASSOC 1855 010742 7450 SNA 1856 010743 4460 JMS I PERR /ERROR- FIRST ARGUMENT OF 1857 /SET OR SETQ IS NOT ATOMIC 1858 010744 3021 DCA TEMP1 1859 010745 1033 TAD L33 1860 010746 3421 DCA I TEMP1 1861 010747 1033 TAD L33 1862 010750 5734 JMP I SET /RETURN 1863 1864 1865 /LISP SETQ ROUTINE 1866 010751 1176 SETQ, TAD EV 1867 010752 4133 JMS PUSH 1868 010753 1033 TAD L33 1869 010754 3010 DCA XR10 1870 010755 1433 TAD I L33 1871 010756 3033 DCA L33 1872 010757 1410 TAD I XR10 1873 010760 4133 JMS PUSH 1874 010761 4452 JMS I PGETARG 1875 010762 3035 DCA A1P 1876 010763 4176 JMS EV 1877 010764 3037 DCA A2P 1878 010765 4123 JMS POP 1879 010766 3035 DCA A1P 1880 010767 4334 JMS SET 1881 010770 5171 JMP LRET2 /RETURN 1882 1883 1884 /LISP CDR ROUTINE. 1885 010771 0000 CDR, 0 1886 010772 1035 TAD A1P 1887 010773 7640 SZA CLA 1888 010774 1435 TAD I A1P /GET CDR 1889 010775 5771 JMP I CDR /RETURN. 1890 1891 1892 1893 /LISP STOP ROUTINE. 1894 010776 7402 STOP, HLT 1895 010777 5576 JMP I EV /RETURN TO EVALQUOTE 1896 /WHEN CONTINUE PUSHED. 1897 1898 1899 1900 /LISP QUOTE ROUTINE 1901 011000 4212 QUOTE, JMS GETARG 1902 011001 5576 JMP I EV 1903 1904 1905 /LISP RPLACAR ROUTINE. REPLACE THE CAR PART. 1906 011002 0000 RPLACA, 0 1907 011003 4114 JMS ATOM 1908 011004 7440 SZA 1909 011005 7201 CLA IAC 1910 011006 1037 TAD A2P 1911 011007 3421 DCA I TEMP1 1912 011010 1035 TAD A1P 1913 011011 5602 JMP I RPLACA 1914 1915 1916 /GETARG ROUTINE. 1917 011012 0000 GETARG, 0 1918 011013 7240 CLA CMA /-1 IN AC 1919 011014 1033 TAD L33 1920 011015 3010 DCA XR10 1921 011016 1433 TAD I L33 1922 011017 2010 ISZ XR10 1923 011020 7640 SZA CLA 1924 011021 4460 JMS I PERR /ERROR-WRONG NUMBER OF 1925 /ARGUMENTS IN THIS FUNCTION 1926 011022 1410 TAD I XR10 1927 011023 5612 JMP I GETARG 1928 /LISP EQ ROUTINE. 1929 011024 0000 EQ, 0 1930 011025 4104 JMS NUMBER /SEE IF ARGUMENT IS A NUMBER 1931 011026 7640 SZA CLA 1932 011027 4251 JMS SWAP 1933 011030 4104 JMS NUMBER 1934 011031 7640 SZA CLA 1935 011032 5237 JMP EQ1 1936 011033 1035 TAD A1P 1937 011034 7041 CIA 1938 011035 1037 TAD A2P 1939 011036 5242 JMP EQ2 1940 011037 1435 EQ1, TAD I A1P 1941 011040 7041 CIA 1942 011041 1437 TAD I A2P 1943 011042 7650 EQ2, SNA CLA /SKIP IF NOT EQUAL 1944 011043 1024 TAD PTRUE /POINTER TO "T" 1945 011044 5624 JMP I EQ 1946 1947 1948 1949 /LISP NULL ROUTINE. 1950 011045 0000 NULL, 0 1951 011046 3037 DCA A2P 1952 011047 4224 JMS EQ 1953 011050 5645 JMP I NULL 1954 1955 1956 1957 /SWAP ROUTINE. SWAPS A1P AND A2P. 1958 011051 0000 SWAP, 0 1959 011052 1035 TAD A1P 1960 011053 3011 DCA XR11 1961 011054 1037 TAD A2P 1962 011055 3035 DCA A1P 1963 011056 1011 TAD XR11 1964 011057 3037 DCA A2P 1965 011060 5651 JMP I SWAP 1966 1967 1968 1969 /LISP EQUAL ROUTINE. 1970 011061 0000 EQUAL, 0 1971 011062 1261 TAD EQUAL 1972 011063 4133 JMS PUSH /PREPARE FOR RECURSION 1973 011064 4114 EQUAL2, JMS ATOM 1974 011065 7650 SNA CLA 1975 011066 4251 JMS SWAP 1976 011067 4114 JMS ATOM 1977 011070 7650 SNA CLA 1978 011071 5274 JMP EQUAL1 1979 011072 4224 JMS EQ 1980 011073 5171 JMP LRET2 1981 011074 1435 EQUAL1, TAD I A1P 1982 011075 4133 JMS PUSH 1983 011076 1437 TAD I A2P 1984 011077 4133 JMS PUSH 1985 011100 1411 TAD I XR11 1986 011101 3035 DCA A1P 1987 011102 1421 TAD I TEMP1 1988 011103 3037 DCA A2P 1989 011104 4261 JMS EQUAL 1990 011105 3041 DCA A3P 1991 011106 4123 JMS POP 1992 011107 3035 DCA A1P 1993 011110 4123 JMS POP 1994 011111 3037 DCA A2P 1995 011112 1041 TAD A3P 1996 011113 7640 SZA CLA 1997 011114 5264 JMP EQUAL2 1998 011115 5171 JMP LRET2 1999 2000 2001 /LISP GET ROUTINE. 2002 011116 0000 GET, 0 2003 011117 4451 GET1, JMS I PCKUSER 2004 011120 5716 JMP I GET 2005 011121 1035 TAD A1P 2006 011122 3010 DCA XR10 2007 011123 1435 TAD I A1P 2008 011124 3035 DCA A1P 2009 011125 1410 TAD I XR10 2010 011126 7141 CLL CIA 2011 011127 1037 TAD A2P 2012 011130 7640 SZA CLA 2013 011131 5317 JMP GET1 2014 011132 1035 TAD A1P 2015 011133 3011 DCA XR11 2016 011134 1411 TAD I XR11 2017 011135 5716 JMP I GET 2018 2019 2020 2021 /LISP ASSOC ROUTINE. 2022 011136 0000 ASSOC, 0 2023 011137 7300 ASSOC1, CLA CLL 2024 011140 1037 TAD A2P 2025 011141 7450 SNA 2026 011142 5736 JMP I ASSOC /RETURN 2027 011143 3010 DCA XR10 2028 011144 1437 TAD I A2P 2029 011145 3037 DCA A2P 2030 011146 1410 TAD I XR10 2031 011147 3010 DCA XR10 2032 011150 1410 TAD I XR10 2033 011151 7041 CIA 2034 011152 1035 TAD A1P 2035 011153 7440 SZA 2036 011154 5337 JMP ASSOC1 2037 011155 7140 CLL CMA 2038 011156 1010 TAD XR10 2039 011157 5736 JMP I ASSOC /RETURN 2040 2041 2042 /LOOKUP ROUTINE. 2043 011160 0000 LOOKUP, 0 2044 011161 3023 DCA L23 2045 011162 1025 TAD ALP 2046 011163 3037 DCA A2P 2047 011164 4336 JMS ASSOC /LOOK UP THE 1ST ARG 2048 011165 7420 SNL 2049 011166 5372 JMP LKUP1 2050 011167 3021 DCA TEMP1 2051 011170 1421 TAD I TEMP1 2052 011171 5760 JMP I LOOKUP 2053 011172 1035 LKUP1, TAD A1P 2054 011173 3031 DCA L31 2055 011174 1023 TAD L23 2056 011175 3037 DCA A2P 2057 011176 4316 JMS GET 2058 011177 5760 JMP I LOOKUP 2059 2060 /LISP RPLACDR ROUTINE. REPLACE CDR PART. 2061 011200 0000 RPLACD, 0 2062 011201 1037 TAD A2P 2063 011202 3435 DCA I A1P 2064 011203 1035 TAD A1P 2065 011204 5600 JMP I RPLACD 2066 2067 /LISP DEFLIS ROUTINE. 2068 011205 0000 DEFLIS, 0 2069 011206 1205 TAD DEFLIS 2070 011207 4133 JMS PUSH 2071 011210 1037 TAD A2P 2072 011211 3041 DCA A3P 2073 011212 1035 DEFL2, TAD A1P 2074 011213 3031 DCA L31 2075 011214 4451 JMS I PCKUSER 2076 011215 5457 JMP I PLIST5 2077 011216 4472 JMS I PCAR 2078 011217 3035 DCA A1P 2079 011220 1035 TAD A1P 2080 011221 3037 DCA A2P 2081 011222 4472 JMS I PCAR 2082 011223 3035 DCA A1P 2083 011224 1041 TAD A3P 2084 011225 3421 DCA I TEMP1 2085 011226 4114 JMS ATOM 2086 011227 7650 SNA CLA 2087 011230 4460 JMS I PERR /ERROR-FIRST ELEMENT OF A 2088 /PAIR IN DEFINE OF DEFLIS 2089 /IS NOT A NAME. 2090 011231 4451 JMS I PCKUSER 2091 011232 5261 JMP DEFL4 2092 011233 1435 TAD I A1P 2093 011234 3033 DCA L33 2094 011235 4200 JMS RPLACD 2095 011236 4133 JMS PUSH 2096 011237 1437 TAD I A2P 2097 011240 3037 DCA A2P 2098 011241 1033 TAD L33 2099 011242 3010 DCA XR10 2100 011243 1410 TAD I XR10 2101 011244 7041 CIA 2102 011245 1041 TAD A3P 2103 011246 7640 SZA CLA 2104 011247 5254 JMP DEFL1 2105 011250 1433 TAD I L33 2106 011251 3033 DCA L33 2107 011252 1433 TAD I L33 2108 011253 7410 SKP 2109 011254 1033 DEFL1, TAD L33 2110 011255 3437 DCA I A2P 2111 011256 1431 DEFL3, TAD I L31 2112 011257 3035 DCA A1P 2113 011260 5212 JMP DEFL2 2114 011261 1421 DEFL4, TAD I TEMP1 2115 011262 3035 DCA A1P 2116 011263 4151 JMS NUCEL 2117 011264 4133 JMS PUSH 2118 011265 1426 TAD I POBJST 2119 011266 3037 DCA A2P 2120 011267 4151 JMS NUCEL 2121 011270 3426 DCA I POBJST 2122 011271 5256 JMP DEFL3 2123 2124 2125 2126 /LISP DEFINE ROUTINE. 2127 011272 0000 DEFINE, 0 2128 011273 1022 TAD L22 2129 011274 3037 DCA A2P 2130 011275 4205 JMS DEFLIS 2131 011276 5672 JMP I DEFINE 2132 /THIS SECTION IS FOR C....R ROUTINES 2133 011277 0000 ROU2, 0 2134 011300 2011 ISZ XR11 2135 011301 5311 JMP ROU1 2136 011302 1010 TAD XR10 2137 011303 4501 JMS I PSCR6 2138 011304 7161 ROU3, CLL CML CIA 2139 011305 5677 JMP I ROU2 2140 2141 2142 011306 4073 JMS INRET /ROUTINE TO RETURN WITH 2143 /SINGLE CHARACTER+X AND 2144 /MASK THE TAPE READER. 2145 011307 5710 JMP I .+1 2146 011310 3173 RMASK 2147 2148 2149 011311 7040 ROU1, CMA 2150 011312 3011 DCA XR11 2151 011313 1021 TAD TEMP1 2152 011314 7450 SNA 2153 011315 5677 JMP I ROU2 2154 011316 3010 DCA XR10 2155 011317 1421 TAD I TEMP1 2156 011320 3021 DCA TEMP1 2157 011321 1410 TAD I XR10 2158 011322 3010 DCA XR10 2159 011323 1007 TAD K77 2160 011324 0010 AND XR10 2161 011325 5304 JMP ROU3 2162 011326 0016 K16, 16 2163 011327 0043 KA, 43 /CONSTANT FOR "A" 2164 011330 0045 KC, 45 /CONSTANT FOR "C" 2165 2166 011331 0000 ROU4, 0 2167 011332 4453 JMS I PGETTOP 2168 011333 7040 CMA 2169 011334 1410 TAD I XR10 2170 011335 3021 DCA TEMP1 2171 011336 7001 IAC 2172 011337 3023 DCA L23 2173 011340 3011 DCA XR11 2174 011341 4277 JMS ROU2 2175 011342 1330 TAD KC 2176 011343 7640 SZA CLA 2177 011344 4460 ROU8, JMS I PERR /ERROR-NAME IN POSITION 2178 /OF A FUNCTION WHICH IS 2179 /NOT A FUNCTION. 2180 011345 4277 ROU7, JMS ROU2 2181 011346 1327 TAD KA 2182 011347 7450 SNA 2183 011350 7020 CML 2184 011351 7440 SZA 2185 011352 1003 TAD K3 2186 011353 7440 SZA /SKIP IF D 2187 011354 5361 JMP ROU6 2188 011355 1023 TAD L23 2189 011356 7004 RAL 2190 011357 3023 DCA L23 2191 011360 5345 JMP ROU7 2192 011361 1326 ROU6, TAD K16 /46+16=64="R" 2193 011362 7450 SNA 2194 011363 4277 JMS ROU2 2195 011364 7440 SZA 2196 011365 5344 JMP ROU8 2197 011366 5731 JMP I ROU4 2198 2199 011367 1176 ROU9, TAD EV 2200 011370 4133 JMS PUSH 2201 011371 1031 TAD L31 2202 011372 4133 JMS PUSH 2203 011373 4331 JMS ROU4 2204 011374 4456 JMS I PLIST1 2205 011375 4452 JMS I PGETARG 2206 011376 3035 DCA A1P 2207 011377 4331 JMS ROU4 2208 011400 1023 ROU11, TAD L23 2209 011401 7110 CLL RAR 2210 011402 7440 SZA 2211 011403 5206 JMP ROU10 2212 011404 4123 JMS POP 2213 011405 5172 JMP LRET3 2214 011406 3023 ROU10, DCA L23 2215 011407 7420 SNL 2216 011410 4454 JMS I PCDR 2217 011411 7430 SZL 2218 011412 4275 JMS CAR 2219 011413 3035 DCA A1P 2220 011414 5200 JMP ROU11 2221 011415 0670 PLIST6, LIST6 2222 2223 2224 /PLUS1 SUBROUTINE. 2225 011416 0000 PLUS1, 0 2226 011417 3037 DCA A2P 2227 011420 7001 IAC 2228 011421 3035 DCA A1P 2229 011422 1176 TAD EV 2230 011423 4133 JMS PUSH 2231 011424 4151 JMS NUCEL 2232 011425 4133 JMS PUSH 2233 011426 1216 TAD PLUS1 2234 011427 5615 JMP I PLIST6 2235 2236 011430 0000 PLUS2, 0 2237 011431 7200 CLA 2238 011432 1033 TAD L33 2239 011433 7450 SNA 2240 011434 5170 JMP LRET1 2241 011435 3010 DCA XR10 2242 011436 1433 TAD I L33 2243 011437 3033 DCA L33 2244 011440 1410 TAD I XR10 2245 011441 3035 DCA A1P 2246 011442 4453 JMS I PGETTOP 2247 011443 1421 TAD I TEMP1 2248 011444 5630 JMP I PLUS2 2249 2250 2251 /LISP PLUS ROUTINE. 2252 011445 4216 PLUS, JMS PLUS1 2253 011446 4230 PLUS3, JMS PLUS2 2254 011447 1435 TAD I A1P 2255 011450 3421 DCA I TEMP1 2256 011451 5246 JMP PLUS3 2257 2258 /LISP MINUS ROUTINE. 2259 011452 4216 MINUS, JMS PLUS1 2260 011453 4230 MINUS2, JMS PLUS2 2261 011454 1435 TAD I A1P 2262 011455 7041 CIA 2263 011456 3421 DCA I TEMP1 2264 011457 5253 JMP MINUS2 2265 2266 2267 /LISP LESSP ROUTINE. 2268 011460 0000 LESSP, 0 2269 011461 1437 TAD I A2P 2270 011462 7161 CLL CML CIA 2271 011463 7500 SMA 2272 011464 7100 CLL 2273 011465 3023 DCA L23 2274 011466 1435 TAD I A1P 2275 011467 7510 SPA 2276 011470 7020 CML 2277 011471 1023 TAD L23 2278 011472 7630 SZL CLA 2279 011473 1024 TAD PTRUE 2280 011474 5660 JMP I LESSP 2281 2282 /LISP CAR ROUTINE 2283 011475 0000 CAR, 0 2284 011476 4114 JMS ATOM 2285 011477 7640 SZA CLA 2286 011500 4460 JMS I PERR /ERROR-THE CAR OF AN ATOM 2287 /HAS BEEN TAKEN. 2288 011501 4503 JMS I PSETM2 2289 011502 0421 AND I TEMP1 2290 011503 5675 JMP I CAR 2291 2292 /SCR6 ROUTINE. SCALES AC RIGHT 6 PLACES. 2293 011504 0000 SCR6, 0 2294 011505 7112 CLL RTR 2295 011506 7112 CLL RTR 2296 011507 7112 CLL RTR 2297 011510 7120 STL 2298 011511 0007 AND K77 2299 011512 5704 JMP I SCR6 2300 2301 /LISP EXPR ROUTINE. 2302 011513 0000 EXPR, 0 2303 011514 1435 TAD I A1P /ADDRESS TO JUMP TO. 2304 011515 3313 DCA EXPR 2305 011516 1437 TAD I A2P /GET 2ND ARGUMENT IN AC 2306 011517 5713 JMP I EXPR /JUMP TO THIS ROUTINE. 2307 2308 /GETTOP ROUTINE. PLACES THE TOP ELEMENT OF THE 2309 /STACK IN TEMP1 AND XR10 WITHOUT POPPING 2310 /THE STACK. 2311 011520 0000 GETTOP, 0 2312 011521 7321 CLA CLL CML IAC /AC=1,LINK=1 2313 011522 1027 TAD SP 2314 011523 3023 DCA L23 /STACK POINTER+1 2315 011524 1423 TAD I L23 /ITEM ON TOP OF STACK 2316 011525 3021 DCA TEMP1 2317 011526 1021 TAD TEMP1 2318 011527 7450 SNA 2319 011530 7100 CLL 2320 011531 3010 DCA XR10 2321 011532 5720 JMP I GETTOP 2322 2323 2324 /LISP GENSYM ROUTINE. 2325 011533 0000 GENSYM, 0 2326 011534 1333 TAD GENSYM 2327 011535 3464 DCA I PREAD 2328 011536 3032 DCA L32 2329 011537 3023 DCA L23 2330 011540 1017 TAD CGENSY 2331 011541 0373 AND K17 2332 011542 3021 DCA TEMP1 2333 011543 1017 TAD CGENSY 2334 011544 7006 RTL 2335 011545 0374 AND GEN1 2336 011546 1021 TAD TEMP1 2337 011547 1375 TAD GEN2 2338 011550 3372 DCA GEN3 2339 011551 1017 TAD CGENSY 2340 011552 7012 RTR 2341 011553 0374 AND GEN1 2342 011554 1375 TAD GEN2 2343 011555 3370 DCA GEN4 2344 011556 2017 ISZ CGENSY 2345 011557 1365 TAD GEN5 2346 011560 3010 DCA XR10 2347 011561 3037 DCA A2P 2348 011562 4151 JMS NUCEL 2349 011563 3033 DCA L33 2350 011564 5766 JMP I GEN6 2351 011565 1567 GEN5, GEN7 2352 011566 2742 GEN6, NXTA6 2353 011567 1571 GEN7, GEN4+1 2354 011570 0000 GEN4, 0 2355 011571 0000 0 2356 011572 0000 GEN3, 0 2357 011573 0017 K17, 17 2358 011574 1700 GEN1, 1700 2359 011575 5151 GEN2, 5151 2360 011576 0000 0 2361 011577 0000 0 2362 /GARBAGE COLLECTION ROUTINES. 2363 /IF A GARBAGE COLLECTION IS NECESSARY, 2364 /THIS WILL GO THROUGH AND MARK ALL CELLS 2365 /REACHABLE FROM THE OBJECT LIST,SP, 2366 /A1P,A2P,A3P,ALP,L31,AND L33. IF THE CELL 2367 /HAS THE CDR PART =1 (IMPLIES THIS IS A 2368 /NUMBER), THE SYSTEM WILL CHANGE THE 1 TO A 5. 2369 /OTHERWISE,THIS WILL SET THE RIGHT-MOST 2370 /BIT OF THE CDR PART TO 1. WHEN ALL 2371 /REACHABLE CELLS HAVE BEEN MARKED, THE COLLECTION 2372 /STARTS. ALL CELLS WITH CDR PART 1 WILL BE 2373 /COLLECTED (UNMARKED NUMBERS), AND ALL CELLS 2374 /WITHOUT THE RIGHTMOST BIT OF THE CDR PART 2375 /SET WILL BE COLLECTED. THE OTHER CELLS 2376 /WILL BE UNMARKED. 2377 PAGE 2378 011600 0000 GL1, 0 /POINTER TO THE NEXT CELL 2379 /IN THE OBJECT LIST. 2380 011601 0000 GL2, 0 2381 011602 7774 KM4, -4 2382 011603 1005 GARB4, TAD K5 /CELL IS A NUMBER 2383 /REPLACE THE 1 WITH 5. 2384 011604 3601 DCA I GL2 2385 011605 7340 GARB3, CLA CLL CMA /-1 IN AC 2386 011606 1012 TAD XR12 2387 011607 3201 DCA GL2 2388 011610 1601 TAD I GL2 /MOVE TO NEXT CELL IN 2389 /OBJECT LIST. 2390 011611 7450 SNA 2391 011612 5633 JMP I GMARK 2392 011613 3200 DCA GL1 /POINTER TO NEXT CELL 2393 /IN OBLIST 2394 011614 3601 DCA I GL2 2395 011615 7040 CMA 2396 011616 1201 TAD GL2 2397 011617 3012 DCA XR12 2398 011620 4351 GARB2, JMS GMARKS 2399 011621 7440 SZA 2400 011622 5240 JMP GARB5 2401 011623 1601 GARB6, TAD I GL2 2402 011624 7010 RAR 2403 011625 7420 SNL 2404 011626 5235 JMP GARB7 2405 011627 7104 CLL RAL 2406 011630 3200 DCA GL1 2407 011631 4351 JMS GMARKS 2408 011632 5230 JMP .-2 2409 2410 011633 0000 GMARK, 0 2411 011634 7410 SKP 2412 011635 7004 GARB7, RAL 2413 011636 3200 DCA GL1 2414 011637 5220 JMP GARB2 2415 011640 3412 GARB5, DCA I XR12 2416 011641 1412 TAD I XR12 2417 011642 7640 SZA CLA 2418 011643 5223 JMP GARB6 2419 /PRINT ERROR SYMBOL 2420 011644 1251 GAR4, TAD KCAT /NOW HAVE EITHER SYMBOL 2421 /FOR "@" OR "?" IN AC 2422 011645 4462 JMS I PPRINCC 2423 011646 7402 HLT 2424 011647 5650 JMP I .+1 /REINITIALIZE WHEN CONTINUE 2425 /IS PRESSED. 2426 011650 3006 INIT2+4 2427 011651 0042 KCAT, 42 /CHARACTER FOR "@" 2428 2429 2430 2431 2432 /ROUTINES CALL GARB TO SEE IF FREE SPACE IS 2433 /EXHAUSTED. IF IT IS,GARB INITIATES A 2434 /GARBAGE COLLECT. 2435 011652 0000 GARB, 0 2436 011653 1030 TAD FLIST 2437 011654 7640 SZA CLA 2438 011655 5652 JMP I GARB /STILL ROOM LEFT. RETURN 2439 011656 2006 ISZ GCCNT /INCREMENT GARBAGE 2440 /COLLECTOR COUNT AND 2441 /START GARBAGE COLLECTION. 2442 011657 7000 NOP 2443 011660 1046 TAD PSYMT 2444 011661 3012 DCA XR12 /POINTER TO THE SYSTEM 2445 /ATOMIC SYMBOL TABLE 2446 011662 1266 TAD PL23 2447 011663 3270 DCA GLCNT 2448 011664 1426 TAD I POBJST /POINTER TO THE 2449 /START OF THE OBJECT LIST 2450 /FIRST MARK CELLS POINTED TO BY THE OBJECT LIST 2451 /THEN MARK CELLS POINTED TO BY ALP,SP,L31,L33, 2452 /A1P,A2P,AND A3P. 2453 011665 5274 JMP GARB1 2454 011666 0023 PL23, L23 2455 011667 7737 KMA3P, -A3P /TO SEE IF AT END OF POINTERS. 2456 011670 0000 GLCNT, 0 2457 011671 2270 GARB8, ISZ GLCNT 2458 011672 2270 ISZ GLCNT 2459 011673 1670 TAD I GLCNT 2460 011674 4233 GARB1, JMS GMARK /MARK THE CELLS 2461 011675 1270 TAD GLCNT 2462 011676 1267 TAD KMA3P 2463 011677 7640 SZA CLA 2464 011700 5271 JMP GARB8 2465 /HAVE NOW MARKED ALL THE CELLS. NOW COLLECT AND 2466 /UNMARK. 2467 011701 1045 TAD LLEN 2468 011702 7130 CLL CML RAR /LENGTH/2 2469 011703 3200 DCA GL1 /NEGATIVE COUNT OF NUMBER 2470 /OF CELLS IN FREE LIST 2471 011704 1044 TAD PBEG 2472 011705 3012 DCA XR12 /XR12 POINTS TO THE NEXT 2473 /CELL TO EXAMINE 2474 011706 1012 TAD XR12 2475 011707 3013 DCA XR13 /XR13 POINTS TO THE CURRENT 2476 /CELL. 2477 011710 1412 GAR3, TAD I XR12 2478 011711 3201 DCA GL2 2479 011712 7040 CMA 2480 011713 1412 TAD I XR12 2481 011714 7450 SNA 2482 011715 5342 JMP GARB9 /COLLECT THE CELL 2483 011716 1202 TAD KM4 2484 011717 7640 SZA CLA 2485 011720 5324 JMP GAR1 /SEE IF BIT 11 IS MARKED 2486 011721 2013 ISZ XR13 /REPLACE 5 WITH 1 2487 011722 7001 IAC 2488 011723 5347 JMP GAR2 2489 /CHECK IF BIT 11 IS MARKED,AND IF NOT, 2490 /COLLECT THE CELL. 2491 011724 1201 GAR1, TAD GL2 2492 011725 7010 RAR 2493 011726 7420 SNL 2494 011727 5342 JMP GARB9 /CELL WAS NOT MARKED. COLLECT. 2495 011730 7104 CLL RAL /UNMARK CELL. 2496 011731 3413 DCA I XR13 2497 011732 2013 ISZ XR13 2498 011733 2200 GAR5, ISZ GL1 /INCREMENT COUNT OF CELLS 2499 /STILL TO GO THROUGH. 2500 011734 5310 JMP GAR3 2501 011735 1030 TAD FLIST /DONE COLLECTING. 2502 011736 7640 SZA CLA 2503 011737 5652 JMP I GARB /RETURN 2504 011740 7240 CLA CMA /NO MORE FREE SPACE. 2505 /PRINT "?" AND HALT 2506 011741 5244 JMP GAR4 2507 /COLLECT THE CELL. 2508 011742 7200 GARB9, CLA 2509 011743 1030 TAD FLIST 2510 011744 3413 DCA I XR13 2511 011745 1013 TAD XR13 2512 011746 3030 DCA FLIST 2513 011747 3413 GAR2, DCA I XR13 /ZERO CAR PART 2514 011750 5333 JMP GAR5 2515 2516 011751 0000 GMARKS, 0 2517 011752 1200 TAD GL1 2518 011753 7161 CLL CML CIA 2519 011754 1044 TAD PBEG 2520 011755 7620 SNL CLA 2521 011756 5205 JMP GARB3 /POINTS TO SYSTEM AREA- 2522 /DON'T MARK. 2523 011757 7001 IAC 2524 011760 1200 TAD GL1 2525 011761 3201 DCA GL2 /POINTS TO SECOND WORD 2526 /OF CELL. 2527 011762 7040 CMA 2528 011763 1601 TAD I GL2 /POINTER TO NAME. 2529 011764 7450 SNA 2530 011765 5203 JMP GARB4 /VALUE WAS 1.THIS CELL 2531 /IS A NUMBER. REPLACE BY 5. 2532 011766 1202 TAD KM4 2533 011767 7650 SNA CLA 2534 011770 5205 JMP GARB3 /VALUE WAS 5. CELL 2535 /IS ALREADY MARKED. 2536 011771 1600 TAD I GL1 2537 011772 7010 RAR 2538 011773 7430 SZL 2539 011774 5205 JMP GARB3 /CELL IS ALREADY MARKED 2540 011775 7004 RAL /NOT MARKED-MARK IT. 2541 011776 2600 ISZ I GL1 2542 011777 5751 JMP I GMARKS 2543 /PRINT NAME OF ATOM ROUTINE. 2544 012000 3023 PRINTB, DCA L23 2545 012001 3041 DCA A3P 2546 012002 1023 TAD L23 /POINTER TO ATOM 2547 012003 3021 PRINTD, DCA TEMP1 2548 012004 1421 TAD I TEMP1 2549 012005 2041 ISZ A3P 2550 012006 7440 SZA 2551 012007 2041 ISZ A3P 2552 012010 7440 SZA 2553 012011 5203 JMP PRINTD 2554 012012 2021 ISZ TEMP1 2555 012013 1421 TAD I TEMP1 2556 012014 0232 AND KKM100 /AND WITH 7700 TO GET 2557 /SECOND CHARACTER. 2558 012015 7640 SZA CLA 2559 012016 2041 ISZ A3P 2560 012017 1041 TAD A3P 2561 012020 4362 JMS PROOM /SEE IF THERE IS ROOM 2562 /ON THIS LINE FOR THE 2563 /ATOM 2564 012021 1023 PRINTE, TAD L23 2565 012022 7450 SNA 2566 012023 5317 JMP PRINTF /NIL-SO RETURN 2567 /FROM PRINTING ATOM 2568 012024 3010 DCA XR10 2569 012025 1423 TAD I L23 2570 012026 3023 DCA L23 2571 012027 1410 TAD I XR10 2572 012030 4325 JMS PRINTC /PRINT THE ONE OR TWO 2573 /CHARACTERS IN ACCUMULATOR 2574 012031 5221 JMP PRINTE /GET NEXT PAIR OF CHARACTERS. 2575 2576 012032 7700 KKM100, -100 2577 2578 012033 2033 KLOC, KLOC /TABLE USED IN CONVERTING 2579 /A NUMBER TO 4 CHARACTERS. 2580 012034 1750 K1000, 1750 /THESE 3 LOCATIONS ARE CHANGED 2581 012035 0144 K100, 144 /FOR OCTAL PRINTING 2582 012036 0012 K10, 12 2583 012037 0000 0 /THIS TERMINATES THE TABLE 2584 2585 012040 7160 PRINTA, CLL CMA CML /PRINT ATOM ROUTINE- 2586 /FIRST SEE IF ATOM IS 2587 /A NUMBER. 2588 012041 1421 TAD I TEMP1 /IF IT IS A NUMBER, POINTER 2589 /WILL BE 1. 2590 012042 7440 SZA 2591 012043 5200 JMP PRINTB /NOT A NUMBER. 2592 012044 1435 TAD I A1P /HAD A NUMBER. GET IT. 2593 012045 7510 SPA 2594 PRNTA5, 2595 012046 7061 CML CIA /***THIS IS CHANGED FOR 2596 /***PRINTING WITHOUT SIGN. 2597 012047 3023 DCA L23 /SAVE THE NUMBER. 2598 012050 1233 TAD KLOC /TABLE POINTER 2599 012051 3033 DCA L33 2600 012052 7430 SZL 2601 012053 1273 TAD KMIN /HAD A NEGATIVE NUMBER. 2602 012054 3021 DCA TEMP1 /STORE CHARACTER FOR SIGN 2603 012055 3037 DCA A2P 2604 012056 7420 SNL /SKIP IF NEGATIVE NUMBER. 2605 012057 2037 PRNTA1, ISZ A2P 2606 012060 2033 ISZ L33 2607 012061 1433 TAD I L33 /GET NUMBER YOU ARE 2608 /GOING TO SUBTRACT. 2609 012062 7141 CLL CIA 2610 012063 1023 TAD L23 /ADD OUR NUMBER. 2611 012064 7620 SNL CLA 2612 012065 5257 JMP PRNTA1 /THE SUBTRACTION 2613 /CONSTANT WAS TOO LARGE. 2614 012066 1037 TAD A2P /WE HAVE USED A2P 2615 /TO TELL HOW MANY DIGITS 2616 /WE WILL HAVE TO PRINT. 2617 012067 7041 CIA 2618 012070 1005 TAD K5 2619 012071 4362 JMS PROOM /SEE IF THERE IS ROOM 2620 /ON THE CURRENT LINE 2621 /TO PRINT THE NUMBER. 2622 012072 5304 JMP PRNTA2 2623 2624 012073 0017 KMIN, 17 /CHARATER FOR "-" 2625 012074 0021 K21, 21 /(CHARACTER FOR 0)-1 2626 012075 7161 PRNTA3, CLL CML CIA 2627 012076 1023 TAD L23 2628 012077 7420 SNL 2629 012100 3023 DCA L23 2630 012101 7620 SNL CLA 2631 012102 5310 JMP PRNTA4 2632 012103 2033 ISZ L33 2633 012104 1021 PRNTA2, TAD TEMP1 2634 012105 4325 JMS PRINTC /PRINT THE SIGN 2635 012106 1274 TAD K21 2636 012107 3021 DCA TEMP1 2637 012110 2021 PRNTA4, ISZ TEMP1 2638 012111 1433 TAD I L33 2639 012112 7440 SZA 2640 012113 5275 JMP PRNTA3 2641 012114 1023 TAD L23 2642 012115 1021 TAD TEMP1 2643 012116 4325 JMS PRINTC 2644 2645 2646 /RETURN FROM PRINT ROUTINE 2647 012117 1035 PRINTF, TAD A1P 2648 012120 5772 JMP I PRINT 2649 2650 2651 012121 7775 KM3, -3 2652 012122 7751 KM27, -27 2653 012123 0236 K236, 236 2654 012124 3217 POUTCH, OUTSUB 2655 2656 /PRINTC ROUTINE. DECODES THE CHARACTER 2657 /IN THE RIGHT-HAND 6 BITS OF AC, 2658 /AND PRINTS IT. DECODES THE CHARACTER 2659 /IN THE LEFT-HAND 6 BITS OF AC, 2660 /AND PRINTS IT. IGNORES ZEORES. 2661 2662 012125 0000 PRINTC, 0 2663 012126 7450 SNA 2664 012127 5725 JMP I PRINTC /RETURN IF ZERO. 2665 012130 3123 DCA POP /SAVE TEMPORARILY 2666 012131 1123 TAD POP 2667 012132 0007 AND K77 2668 012133 3021 DCA TEMP1 2669 012134 1021 TAD TEMP1 /NOW CONVERT THE CHARACTER 2670 /TO ASCII FROM THE INTERNAL 2671 /CODE. 2672 012135 1321 TAD KM3 2673 012136 7440 SZA /SKIP IF 3 (I.E. IF 2674 /IT IS A LINE FEED) 2675 012137 1321 TAD KM3 2676 012140 7650 SNA CLA /SKIP IF IT IS NOT 2677 /A CARRIAGE RETURN OR 2678 /LINE FEED. 2679 012141 1322 TAD KM27 2680 012142 1021 TAD TEMP1 /ADD CHARACTER 2681 012143 1323 TAD K236 /NOW HAVE ASCII CHARACTER 2682 012144 4724 JMS I POUTCH /GO TO THE OUTPUT ROUTINE 2683 012145 7200 CLA 2684 012146 1123 TAD POP 2685 012147 4501 JMS I PSCR6 /NOW HAVE 2ND CHARACTER 2686 /IN RIGHT-HAND 6 BITS. 2687 012150 5326 JMP PRINTC+1 2688 2689 /TERPRI ROUTINE. PRINTS A CARRIAGE RETURN 2690 /AND A LINE FEED. 2691 012151 0000 TERPRI, 0 2692 012152 1232 TAD KKM100 2693 012153 3016 DCA LINCNT /REINITIALIZE THE LINE COUNT 2694 012154 1357 TAD K306 2695 012155 4325 JMS PRINTC /PRINT CARRIAGE RETURN 2696 /AND LINE FEED. 2697 012156 5751 JMP I TERPRI 2698 2699 012157 0306 K306, 306 /INTERNAL CODE FOR CARRIAGE 2700 /RETURN AND LINE FEED. 2701 2702 /ROUTINE TO PRINT A SINGLE CHARACTER WHOSE 2703 /INTERNAL REPRESENTATION IS IN X. 2704 2705 012160 4462 JMS I PPRINCC 2706 012161 5171 JMP LRET2 2707 2708 /ROUTINE TO SEE IF THERE IS ROOM ON THE 2709 /CURRENT LINE FOR THE PRINTING WHICH IS 2710 /NECESSARY. ENTER WITH THE NUMBER OF 2711 /CHARACTERS NECESSARY TO PRINT. 2712 2713 012162 0000 PROOM, 0 2714 012163 1016 TAD LINCNT 2715 012164 3016 DCA LINCNT /LINCNT IS MODIFIED 2716 /BY THE CONTENTS OF 2717 /THE AC ON ENTRY TO PROOM 2718 012165 1016 TAD LINCNT 2719 012166 7710 SPA CLA /SKIP IF NOT ENOUGH 2720 /ROOM ON CURRENT LINE. 2721 012167 5762 JMP I PROOM /RETURN 2722 012170 4351 JMS TERPRI /GO TO A NEW LINE. 2723 012171 7410 SKP 2724 /LISP PRINT ROUTINE. 2725 /WILL PRINT THE S-EXPRESSION POINTED TO 2726 /BY A1P. 2727 2728 012172 0000 PRINT, 0 2729 012173 4114 JMS ATOM /SEE IF IT IS AN ATOM 2730 012174 7640 SZA CLA 2731 012175 5240 JMP PRINTA /IT WAS AN ATOM 2732 012176 1372 TAD PRINT /NOT AN ATOM. PREPARE 2733 /FOR RECURSION. 2734 012177 4133 JMS PUSH 2735 012200 1035 TAD A1P 2736 012201 4133 JMS PUSH /HAVE NOW SAVED 2737 /RETURN AND POINTER 2738 /TO S-EXPRESSION. 2739 012202 1206 TAD KLP 2740 012203 4211 JMS PRINCC /PRINT A LEFT PARENTHESIS 2741 012204 1035 TAD A1P 2742 012205 5231 JMP PRINT1 2743 2744 012206 0012 KLP, 12 /INTERNAL CODE FOR LEFT 2745 /PARENTHESIS 2746 012207 0013 KRP, 13 /INTERNAL CODE FOR RIGHT 2747 /PARENTHESIS 2748 012210 0020 KPER, 20 /INTERNAL CODE FOR PERIOD. 2749 2750 /PRINCC ROUTINE. WILL PRINT A CHARACTER AND 2751 /INCREMENT COUNT. 2752 012211 0000 PRINCC, 0 2753 012212 2016 ISZ LINCNT 2754 012213 5222 JMP PRINC1 /NOT AT END OF LINE 2755 012214 3023 DCA L23 /AT END OF A LINE. 2756 /SAVE THE CHARACTER 2757 /TEMPORARILY. 2758 012215 4467 JMS I PTERPRI /PRINT A C.R. AND L.F. 2759 012216 1023 TAD L23 /RESTORE CHARACTER 2760 012217 7450 SNA 2761 012220 5611 JMP I PRINCC /HAD A BLANK AT END OF 2762 /LINE. DO NOT PRINT IT. 2763 012221 2016 ISZ LINCNT /INCREMENT LINE COUNT 2764 012222 7450 PRINC1, SNA 2765 012223 1002 TAD K2 /HAD A BLANK- CHANGE TO 2766 /THE OTHER CODE FOR BLANK 2767 012224 4626 JMS I PPRIN /PRINT THE CHARACTER 2768 012225 5611 JMP I PRINCC /RETURN 2769 2770 012226 2125 PPRIN, PRINTC 2771 2772 2773 012227 4463 PRINT4, JMS I PPRINT /CALL PRINT AGAIN. 2774 /HAD ATOM IN A LIST. 2775 012230 4123 JMS POP 2776 2777 012231 4243 PRINT1, JMS PRTERM /PRINT THE NEXT TERM 2778 012232 7650 SNA CLA /SKIP IF NOT ATOM. 2779 012233 5227 JMP PRINT4 /HAD ATOM 2780 012234 4463 PRINT5, JMS I PPRINT /CALL PRINT AGAIN 2781 012235 4123 JMS POP 2782 012236 4243 JMS PRTERM 2783 012237 7650 SNA CLA 2784 012240 5227 JMP PRINT4 /HAD ATOM 2785 012241 4211 JMS PRINCC /PRINT THE CHARACTER 2786 012242 5234 JMP PRINT5 2787 2788 012243 0000 PRTERM, 0 2789 012244 7450 SNA 2790 012245 5264 JMP PRINT3 /AT END OF A SUBEXPRESSION, 2791 /SO PRINT A RIGHT PARENTHESIS 2792 012246 3035 DCA A1P 2793 012247 4114 JMS ATOM 2794 012250 7640 SZA CLA 2795 012251 5260 JMP PRINT2 /HAD AN ATOM-PRINT 2796 /A PERIOD. 2797 012252 1435 TAD I A1P /NOT AN ATOM 2798 012253 4133 JMS PUSH 2799 012254 1421 TAD I TEMP1 2800 012255 3035 DCA A1P 2801 012256 4114 JMS ATOM 2802 012257 5643 JMP I PRTERM /RETURN 2803 2804 012260 1210 PRINT2, TAD KPER /PRINT A PERIOD 2805 012261 4211 JMS PRINCC 2806 012262 4463 JMS I PPRINT /CALL PRINT ROUTINE AGAIN 2807 012263 7200 CLA 2808 012264 1207 PRINT3, TAD KRP /PRINT A RIGHT PARENTHESIS 2809 012265 4211 JMS PRINCC 2810 012266 5170 JMP LRET1 /POP AND RETURN 2811 /FETCHC WILL USE THE BASIC INPUT ROUTINE 2812 /TO READ A CHARACTER. THEN IT WILL 2813 /CONVERT THE CHARACTER TO THE SPECIAL 2814 /SIX-BIT INTERNAL CHARACTER CODE. 2815 2816 /FOR ASCII CHARACTERS WITH A CODE OF LESS 2817 /THAN 236, THE INTERNAL CODE IS FOUND 2818 /BY SUBTRACTING 207. 2819 2820 /FOR ASCII CHARACTERS WITH A CODE OF 2821 /GREATER THAN OR EQUAL TO 236, THE INTERNAL 2822 /CODE IS FOUND BY SUBTRACTING 236. 2823 2824 2825 /THIS SUBROUTINE RETURNS TO THE LOCATION 2826 /AFTER THE CALL IF LEADER-TRAILER WAS FOUND 2827 /AND RETURNS TO THE SECOND LOCATION AFTER 2828 /THE CALL FOR ANY OTHER CHARACTER. 2829 /ON RETURN, THE CHARACTER WILL BE BOTH 2830 /IN THE ACCUMULATOR AND IN THE LOCATION 2831 /CHAR. 2832 2833 2834 /CONSTANTS USED. 2835 012267 3115 PCHMODE,CHMODE /POINTER TO ROUTINE TO 2836 /CHECK THE MODE WITH THE 2837 /PARAMETER AND SKIP IF 2838 /THE APPROPRIATE BITS ARE 2839 /NOT SET. 2840 012270 3217 POUTSUB,OUTSUB /POINTER TO THE BASIC OUTPUT 2841 /ROUTINE. 2842 012271 0027 K27, 27 2843 2844 2845 2846 012272 0141 K141, 141 2847 012273 0177 K177, 177 2848 012274 7601 KM177, -177 2849 2850 2851 012275 1014 FETCH2, TAD CHAR /HAD ASCII CODE. CONVERT 2852 /TO INTERNAL FORM. 2853 012276 1274 TAD KM177 2854 012277 7450 SNA 2855 012300 5317 JMP FETCH4 /IGNORE RUBOUTS. 2856 012301 1272 TAD K141 2857 012302 7510 SPA /SKIP IF CHARACTER 2858 /WAS >=236. 2859 012303 1271 TAD K27 /CHARACTER WAS <236 2860 012304 2312 FETCH1, ISZ FETCHC /THE NORMAL RETURN IS 2861 /TWO LOCATIONS AFTER 2862 /THE CALL. THE LOCATION 2863 /AFTER THE CALL IS THE 2864 /RETURN FOR LEADER TRAILER 2865 /OR HEADER TAPE. 2866 012305 7410 SKP 2867 012306 2324 CNGTTY, RDASCII /THIS LOCATION IS 2868 /USED AS A TRANSFER 2869 /POINTER TO EITHER THE 2870 /CODE FOR ASCII OR THE 2871 /CODE FOR CCITT2.IT IS 2872 /INITIALLY SET FOR ASCII. 2873 012307 3014 DCA CHAR /SAVE THE CODED CHARACTER 2874 /IN CHAR. 2875 012310 1014 TAD CHAR /RETURN WITH IT ALSO 2876 /IN THE AC. 2877 012311 5712 JMP I FETCHC /RETURN 2878 2879 2880 012312 0000 FETCHC, 0 /THIS IS THE SUBROUTINE 2881 /ENTRY POINT. 2882 012313 7200 CLA 2883 012314 1014 TAD CHAR /IF CHAR IS NON-ZERO, 2884 012315 7440 SZA /THE PREVIOUS CHARACTER 2885 /READ HAS NOT YET BEEN 2886 /USED. RETURN IT. 2887 012316 5304 JMP FETCH1 /RETURN CHAR. 2888 2889 012317 4500 FETCH4, JMS I PINSUB /GO TO THE BASIC INPUT ROUTINE 2890 012320 0273 AND K177 /MASK OFF HIGH-ORDER BIT. 2891 012321 7440 SZA 2892 012322 5706 JMP I CNGTTY /GO TO EITHER ASCII OR 2893 /CCITT2 SECTION. 2894 012323 4306 JMS CNGTTY /CHANGE POINTER TO POINT TO 2895 /ASCII SECTION. HAD LEADER-TRAILER 2896 /OR HEADER TAPE. 2897 012324 3014 RDASCII,DCA CHAR /SAVE MASKED CHARACTER 2898 012325 5275 JMP FETCH2 /ASCII 2899 2900 /LISP TIMES ROUTINE 2901 /ACCEPTS AN INFINITE NUMBER OF ARGUMENTS. 2902 2903 012326 7201 TIMES, CLA IAC /SET PRODUCT TO 1 INITIALLY 2904 012327 4750 JMS I PPLUS1 /SET UP CELLS FOR RETURN 2905 012330 7200 TLOOP, CLA 2906 012331 1033 TAD L33 2907 012332 7450 SNA 2908 012333 5170 JMP LRET1 /HAD NIL POINTER. ALL OF THE 2909 /TERMS OF THE PRODUCT HAVE 2910 /BEEN USED. 2911 /RETURN. 2912 012334 3010 DCA XR10 2913 012335 1433 TAD I L33 2914 012336 3033 DCA L33 /POINT TO NEXT ARGUMENT. 2915 012337 1410 TAD I XR10 /GET ADDRESS OF ARGUMENT. 2916 012340 3035 DCA A1P 2917 012341 4453 JMS I PGETTOP 2918 012342 1421 TAD I TEMP1 /GET PREVIOUSLY SAVE PRODUCT. 2919 012343 3037 DCA A2P /SAVE PREVIOUS VALUE 2920 012344 1435 TAD I A1P /GET CURRENT ARGUMENT 2921 012345 4351 JMS MULT /GET PRODUCT 2922 012346 3421 DCA I TEMP1 /SAVE RESULT AS NEW PRODUCT 2923 012347 5330 JMP TLOOP 2924 012350 1416 PPLUS1, PLUS1 2925 012351 0000 MULT, 0 2926 012352 3035 DCA A1P 2927 012353 1370 TAD KM14 2928 012354 3312 DCA FETCHC 2929 012355 7104 MULTL, CLL RAL 2930 012356 3041 DCA A3P /TEMPORARY RESULT 2931 012357 1035 TAD A1P 2932 012360 7104 CLL RAL 2933 012361 3035 DCA A1P 2934 012362 7430 SZL 2935 012363 1037 TAD A2P /BIT WAS 1, SO ADD. 2936 012364 1041 TAD A3P 2937 012365 2312 ISZ FETCHC 2938 012366 5355 JMP MULTL /LOOP NOT DONE. 2939 012367 5751 JMP I MULT /RETURN 2940 012370 7764 KM14, -14 2941 2942 /LISP EXIT ROUTINE. RETURNS TO PS/8 2943 /MONITOR AT 7600. 2944 012371 6203 EXIT, CDF CIF 0 2945 012372 5773 JMP I .+1 2946 012373 7600 7600 /LOCATION OF MONITOR. 2947 2948 /IOPEN ROUTINE. 2949 /HAS THREE ARGUMENTS. 2950 012374 0000 IOPEN, 0 2951 012375 6203 CDF CIF 0 2952 012376 4777 JMS I .+1 2953 012377 1200 IOPENR 2954 2955 /GET A CHARACTER FROM THE OPEN INPUT 2956 /FILE ROUTINE. RETURNS WITH THE 2957 /CHARACTER IN THE ACCUMULATOR. 2958 012400 0000 GCHAR, 0 2959 012401 6203 CDF CIF 0 2960 012402 4604 JMS I PGTCHAR 2961 012403 5473 JMP I INRET /RETURN. 2962 012404 1260 PGTCHAR,GTCHAR 2963 2964 /WRITE A CHARACTER FROM THE AC TO THE 2965 /OPEN OUTPUT FILE ROUTINE. RETURNS 2966 /WITH THE ACCUMULATOR UNCHANGED. 2967 012405 0000 PCHAR, 0 2968 012406 6203 CDF CIF 0 2969 012407 4611 JMS I PPTCHAR 2970 012410 5605 JMP I PCHAR 2971 012411 1471 PPTCHAR,PTCHAR /POINTER TO THE ROUTINE. 2972 2973 /OOPEN ROUTINE. 2974 /HAS THREE ARGUMENTS. 2975 012412 0000 OOPEN, 0 2976 012413 6203 CDF CIF 0 2977 012414 4615 JMS I .+1 2978 012415 1400 OOPENR 2979 2980 /ICLOSE ROUTINE. 2981 /HAS NO ARGUMENTS. 2982 012416 0000 ICLOSE, 0 2983 012417 6203 CDF CIF 0 2984 012420 4621 JMS I .+1 2985 012421 1600 ICLOSR /POINTER TO ICLOSE ROUTINE 2986 2987 /OCLOSE ROUTINE. 2988 /HAS NO ARGUMENTS. 2989 012422 0000 OCLOSE, 0 2990 012423 6203 CDF CIF 0 2991 012424 4625 JMS I .+1 2992 012425 1612 OCLOSR /POINTER TO OCLOSE ROUTINE 2993 2994 012426 7760 KM20, -20 2995 2996 012427 0000 0 /UNUSED****************** 2997 2998 /THE RDTST ROUTINE WILL USE THE FETCHC 2999 /ROUTINE TO READ A CHARACTER. IT WILL RETURN 3000 /TO THE LOCATION AFTER THE CALL IF A 3001 /DELIMITER IS FOUND, AND WILL RETURN TO TWO 3002 /LOCATIONS AFTER THE CALL OTHERWISE. 3003 3004 /IF NO DELIMITER WAS FOUND, RDTST RETURNS 3005 /WITH THE CHARACTER IN THE ACCUMULATOR. 3006 /A ZERO IMPLIES THAT A QUOTE WAS FOUND. 3007 3008 /IF A DELIMITER WAS FOUND, THE ACCUMULATOR 3009 /WILL BE ZERO, AND A3P WILL POINT 3010 /TO THE ROUTINE FOR THE DELIMITER FOUND. 3011 3012 3013 012430 0000 RDTST, 0 3014 012431 4466 JMS I PFETCHC /FETCH A CHARACTER 3015 012432 4460 JMS I PERR /ERROR- LEADER-TRAILER 3016 /CANNOT OCCUR IN A 3017 /LISP EXPRESSION. 3018 /NOW CHECK TO SEE IF THE CHARACTER IS A DELIMITER 3019 012433 1226 TAD KM20 3020 012434 7450 SNA 3021 012435 5246 JMP RDTST2 /HAD A PERIOD 3022 012436 1005 TAD K5 3023 012437 7450 SNA 3024 012440 5245 JMP RDTST1 /HAD A CLOSING PARENTHESIS 3025 012441 7001 IAC 3026 012442 7440 SZA 3027 012443 5253 JMP RDTST5 3028 012444 7001 IAC /HAD AN OPENING PARENTHESIS 3029 012445 7001 RDTST1, IAC /HAD CLOSING PARENTHESIS 3030 012446 7001 RDTST2, IAC /HAD PERIOD 3031 012447 1252 RDTST3, TAD PREAD6 /HAD INTERNAL CODE OF 10 3032 /OR LESS. 3033 012450 3041 DCA A3P /SAVE POINTER TO APPROPRIATE 3034 /JUMP INSTRUCTION. 3035 012451 5630 JMP I RDTST /RETURN 3036 3037 012452 2465 PREAD6, READ6 /POINTER TO FIRST OF JUMPS. 3038 3039 012453 7001 RDTST5, IAC 3040 012454 7450 SNA 3041 012455 5261 JMP RDTST6 /HAD QUOTE 3042 012456 7710 SPA CLA 3043 012457 5247 JMP RDTST3 /HAD INTERNAL CODE OF 3044 /10 OR LESS, E.G. CARRIAGE 3045 /RETURN OR LINE FEED OR BLANK. 3046 012460 1014 TAD CHAR /NO DELIMITER. PUT CHARACTER 3047 /IN ACCUMULATOR 3048 012461 2230 RDTST6, ISZ RDTST /SKIP DELIMITER RETURN 3049 012462 5630 JMP I RDTST /RETURN 3050 /READ WILL READ IN AN S-EXPRESSION. 3051 /IT IS A FUNCTION OF NO ARGUMENTS. 3052 /ALL IDENTIFIERS READ FOR THE FIRST TIME 3053 /ARE PUT ON THE OBLIST. IDENTIFIERS MAY 3054 /CONSIST OF ANY NUMBER OF CHARACTERS 3055 /AND ANY CHARACTER EXCEPT LEFT PARENTHESIS, 3056 /RIGHT PARENTHESIS,DOT,SPACE,CARRIAGE 3057 /RETURN,LINE-FEED, BLANK, AND APOSTROPHE. 3058 /HOWEVER, THESE CHARACTERS CAN BE 3059 /"QUOTED" BY PRECEDING THEM WITH ' 3060 /THEN, THEY MAY BE A CHARACTER OF A NAME. 3061 /A NAME MUST START WITH A LETTER. AN 3062 /OBJECT STARTING WITH A DIGIT OR 3063 /A PLUS SIGN OR A MINUS SIGN IS REGARDED 3064 /AS A NUMBER (EXCEPT WHEN PRECEDED BY ' ). 3065 3066 3067 012463 3014 READ2, DCA CHAR /COME HERE WHEN A 3068 /DELIMITER IS FOUND. 3069 012464 5441 JMP I A3P /RDTST PLACED A JUMP 3070 /TO THE APPROPRIATE 3071 /DELIMITER ROUTINE IN 3072 /A3P. 3073 /NOW GO TO THIS ROUTINE. 3074 3075 3076 012465 5313 READ6, JMP READ1 /DELIMITER WAS A C.R. 3077 /OR L.F. OR SPACE 3078 012466 5272 JMP READ7 /DELIMITER WAS PERIOD. 3079 012467 5300 JMP READ9 /DELIMITER WAS RIGHT 3080 /PARENTHESIS 3081 012470 1310 TAD READ /DELIMITER WAS RIGHT 3082 /PARENTHESIS. 3083 012471 5275 JMP READ8 3084 3085 012472 4310 READ7, JMS READ /HAD PERIOD. 3086 012473 3033 READ5, DCA L33 3087 012474 4310 JMS READ 3088 012475 4133 READ8, JMS PUSH /HAD (, SO PUSH 3089 /PREVIOUS VALUE OF READ, 3090 /AND GO READ AGAIN. 3091 012476 5273 JMP READ5 3092 012477 2475 PREAD8, READ8 3093 012500 1310 READ9, TAD READ /HAD ')' 3094 012501 7041 CIA 3095 012502 1277 TAD PREAD8 3096 012503 7440 SZA /SKIP IF CLOSING PARENTHESIS 3097 /RIGHT AFTER OPENING 3098 /PARENTHESIS. 3099 012504 4460 JMS I PERR /ERROR-CLOSING PARENTHESIS 3100 /CANNOT OCCUR HERE. 3101 012505 5457 JMP I PLIST5 3102 3103 012506 4012 K4012, 4012 3104 012507 3744 K3744, 3744 3105 3106 3107 3108 012510 0000 READ, 0 3109 012511 7240 CLA CMA 3110 012512 3021 DCA TEMP1 /-1 IN TEMP1 3111 /-1 INDICATES THAT THE NUMBER 3112 /DOES NOT NEED TO BE COMPLEMENTED. 3113 /IF A MINUS SIGN IS FOUND, 3114 /THIS IS CHANGED TO ZERO. 3115 012513 4230 READ1, JMS RDTST /GET A CHARACTER,AND SEE 3116 /IF IT IS A DELIMITER. 3117 012514 5263 JMP READ2 /HAD A DELIMITER 3118 /SEE IF IT WAS A NUMBER 3119 012515 1307 TAD K3744 3120 012516 7500 SMA 3121 012517 1306 TAD K4012 3122 012520 7510 SPA 3123 012521 5360 JMP RDEXP /NOT A NUMBER. 3124 3125 /HAD A DIGIT OR PLUS OR MINUS, SO KEEP PICKING 3126 /UP DIGITS TILL NUMBER IS COMPLETE. NO CHECK 3127 /IS MADE FOR OVERFLOW OR UNDERFLOW. 3128 012522 3037 RDNUM, DCA A2P 3129 012523 3014 DCA CHAR /ZERO CHAR SO NEXT CHARACTER 3130 /CAN BE READ. 3131 012524 4466 JMS I PFETCHC /READ NEXT CHARACTER 3132 012525 4460 JMS I PERR /ERROR- LEADER TRAILER 3133 /AFTER A NUMBER HAS BEEN FOUND. 3134 /NOW SEE IF THIS IS ALSO A DIGIT. 3135 012526 1307 TAD K3744 3136 012527 7500 SMA 3137 012530 1306 TAD K4012 3138 012531 7510 SPA 3139 012532 5342 JMP READD /AT END OF NUMBER 3140 012533 3035 DCA A1P /HAD ANOTHER DIGIT 3141 /MULTIPLY PREVIOUS NUMBER BY 10 (OR 8 FOR OCTAL) 3142 012534 1037 TAD A2P 3143 012535 7106 CLL RTL 3144 RDNUM1, 3145 012536 1037 TAD A2P /THIS IS CHANGED TO A NOP 3146 /FOR OCTAL READING. 3147 012537 7104 CLL RAL /NOW HAVE 10 (OR 8) 3148 /TIMES THE PREVIOUS NUMBER 3149 012540 1035 TAD A1P /NOW ADD THIS DIGIT 3150 012541 5322 JMP RDNUM 3151 3152 012542 7201 READD, CLA IAC /HAVE COMPLETED THE NUMBER 3153 012543 3035 DCA A1P 3154 012544 1037 TAD A2P 3155 012545 2021 ISZ TEMP1 /SKIP IF NO MINUS SIGN 3156 012546 7041 CIA /HAD A MINUS SIGN. 3157 012547 3037 DCA A2P 3158 012550 4151 JMS NUCEL /BOTTOM HALF IS 1 IF 3159 /CELL IS A NUMBER. 3160 /TOP HALF CONTAINS THE 3161 /ACTUAL NUMBER. 3162 012551 5710 JMP I READ /RETURN WITH AC POINTING 3163 /TO THE CELL CONTAINING THE 3164 /NUMBER. 3165 3166 012552 1014 RDEXP1, TAD CHAR /HAD A PLUS SIGN OR 3167 /A MINUS SIGN TO 3168 /GET HERE. 3169 012553 3032 DCA L32 3170 012554 3014 DCA CHAR 3171 012555 4230 JMS RDTST /READ THE NEXT CHARACTER 3172 012556 5367 JMP RDEXP2 /HAD A DELIMITER-A PLUS 3173 / BY ITSELF IS A VALID 3174 /NAME. 3175 012557 5313 JMP READ1 /NO DELIMITER, SO IT MUST 3176 /BE A NUMBER, SO IGNORE 3177 /THE PLUS OR MINUS SIGN. 3178 3179 3180 012560 1003 RDEXP, TAD K3 /SEE IF IT WAS A 3181 /MINUS SIGN. 3182 012561 7450 SNA 3183 012562 2021 ISZ TEMP1 /HAD A MINUS SIGN. 3184 /THEN SKIP THE NEXT 3185 /INSTRUCTION. 3186 012563 1002 TAD K2 /SEE IF IT WAS A 3187 /PLUS SIGN. 3188 012564 7650 SNA CLA 3189 012565 5352 JMP RDEXP1 /HAD A PLUS SIGN OR 3190 /A MINUS SIGN. 3191 012566 4465 JMS I PRDPCK /READ AND PACK THE TWO 3192 /NEXT CHARACTERS. 3193 /IF A DELIMITER IS 3194 /FOUND AFTER ONLY ONE 3195 /CHARACTER, L32 3196 /WILL ONLY CONTAIN THIS 3197 /ONE CHARATER. OTHERWISE 3198 /IT WILL CONTAIN BOTH CHARS. 3199 012567 1426 RDEXP2, TAD I POBJST /POINTER TO THE BEGINNING 3200 /OF THE OBJECT LIST 3201 012570 3033 DCA L33 3202 012571 4773 JMS I PGTATOM 3203 012572 5376 JMP RDEXP3 3204 3205 012573 2634 PGTATOM, GTATOM 3206 3207 012574 4465 READN6, JMS I PRDPCK /READ NEXT 2 CHARACTERS. 3208 012575 1423 TAD I L23 3209 3210 012576 3023 RDEXP3, DCA L23 /POINTER TO ATOM 3211 012577 1032 TAD L32 /USER CHARACTERS 3212 012600 7650 SNA CLA 3213 012601 5217 JMP READ3 /END OF USER CHARACTERS 3214 3215 012602 1023 READ4, TAD L23 3216 012603 7450 SNA 3217 012604 5213 JMP READN5 3218 012605 3010 DCA XR10 3219 012606 1410 TAD I XR10 3220 012607 7041 CIA 3221 012610 1032 TAD L32 /SEE IF OUR CHARACTERS 3222 /MATCH THOSE IN THE 3223 /CURRENT ATOM. 3224 012611 7650 SNA CLA 3225 012612 5615 JMP I PREADN6 /YES, THEY MATCH. GET 3226 /MORE OF ATOM AND COMPARE 3227 /AGAIN. 3228 3229 012613 4257 READN5, JMS NXTATOM /NO MATCH. GET POINTER 3230 /TO NEXT OBJECT, AND SEE 3231 /IF IT MATCHES. 3232 012614 5202 JMP READ4 3233 3234 012615 2574 PREADN6, READN6 3235 3236 012616 4257 READN7, JMS NXTATOM 3237 012617 1023 READ3, TAD L23 3238 012620 7640 SZA CLA 3239 012621 5216 JMP READN7 3240 012622 4234 JMS GTATOM /HAD NIL 3241 012623 7041 CIA 3242 012624 1232 TAD READN8 /ADD POINTER TO "NIL" 3243 012625 7650 SNA CLA 3244 012626 5633 JMP I READN9 3245 012627 7040 CMA 3246 012630 1010 TAD XR10 3247 012631 5633 JMP I READN9 3248 3249 012632 3400 READN8, NILN /POINTER TO "NIL" 3250 012633 2551 READN9, RDEXP1-1 3251 3252 012634 0000 GTATOM, 0 /SUBROUTINE TO GO DOWN 3253 /A LIST TILL IT FINDS AN 3254 /ATOM. 3255 012635 7450 SNA 3256 012636 1033 TAD L33 3257 012637 7410 SKP 3258 012640 7004 RAL 3259 012641 3010 DCA XR10 3260 012642 1410 TAD I XR10 3261 012643 7010 RAR 3262 012644 7420 SNL 3263 012645 5240 JMP .-5 /NOT AN ATOM. 3264 012646 7104 CLL RAL /CHOP OFF ATOM MARK. 3265 012647 5634 JMP I GTATOM 3266 3267 012650 0000 CKUSER, 0 /SEE IF C(A1P)>=OBJ 3268 /IF SO, SKIP NEXT 3269 /INSTRUCTION. 3270 012651 1035 TAD A1P 3271 012652 7160 CLL CMA CML 3272 012653 1042 TAD POBJ 3273 012654 7630 SZL CLA 3274 012655 2250 ISZ CKUSER 3275 012656 5650 JMP I CKUSER 3276 3277 /NXTATOM ROUTINE. GOES DOWN A LIST AND GETS 3278 /THE NEXT ATOM. 3279 012657 0000 NXTATOM,0 3280 012660 1033 TAD L33 3281 012661 3035 DCA A1P 3282 012662 4250 NXTA1, JMS CKUSER 3283 012663 5326 JMP NXTA5 /C (L33) = OBJ 3285 012665 7450 SNA 3286 012666 1043 TAD PSOBJ /HAD NIL- GO THROUGH 3287 /SYSTEM NAMES. 3288 012667 3035 DCA A1P 3289 012670 4234 NXTA2, JMS GTATOM 3290 012671 3041 DCA A3P /SAVE POINTER TO 3291 /ATOM POINTED TO BY L33 3292 012672 1035 TAD A1P 3293 012673 4234 JMS GTATOM 3294 012674 3037 NXTA3, DCA A2P /SAVE POINTER TO ATOM 3295 /NAME. 3296 012675 1041 TAD A3P 3297 012676 7041 CIA 3298 012677 1023 TAD L23 3299 012700 7640 SZA CLA 3300 012701 5307 JMP NXTA4 3301 012702 1035 TAD A1P 3302 012703 3033 DCA L33 /SAVE POINTER TO NEW 3303 /ATOM 3304 012704 1037 TAD A2P 3305 012705 3023 DCA L23 /SAVE POINTER TO NEW 3306 /ATOM NAME. 3307 012706 5657 JMP I NXTATOM /RETURN. 3308 3309 012707 1037 NXTA4, TAD A2P 3310 012710 7450 SNA 3311 012711 5262 JMP NXTA1 3312 012712 3011 DCA XR11 /HAVE TO RETRACE STEPS 3313 012713 1041 TAD A3P 3314 012714 3010 DCA XR10 3315 012715 1410 TAD I XR10 3316 012716 7041 CIA 3317 012717 1411 TAD I XR11 3318 012720 7640 SZA CLA 3319 012721 5262 JMP NXTA1 3320 012722 1441 TAD I A3P 3321 012723 3041 DCA A3P 3322 012724 1437 TAD I A2P 3323 012725 5274 JMP NXTA3 3324 3325 012726 2035 NXTA5, ISZ A1P 3326 012727 2035 ISZ A1P 3327 012730 4250 JMS CKUSER 3328 012731 5270 JMP NXTA2 /STILL ON THE SYSTEM 3329 /OBJECT LIST. 3330 /COULD NOT FIND THE NAME ON THE OBJECT LIST, 3331 /SO PUT IT ON. 3332 012732 4234 JMS GTATOM 3333 012733 3010 DCA XR10 3334 012734 3037 DCA A2P 3335 012735 4151 JMS NUCEL /CELL POINTING TO THE 3336 /NEW OBJECT 3337 012736 3033 DCA L33 3338 012737 1426 TAD I POBJST 3339 012740 3037 DCA A2P 3340 012741 4151 JMS NUCEL 3341 012742 3426 NXTA6, DCA I POBJST /ADD THIS TO THE OBJECT LIST 3342 012743 1033 TAD L33 3343 012744 7001 IAC 3344 012745 3035 DCA A1P 3345 012746 7001 IAC 3346 012747 1030 NEWAT1, TAD FLIST 3347 012750 3435 DCA I A1P 3348 012751 1010 TAD XR10 3349 012752 7041 CIA 3350 012753 1023 TAD L23 3351 012754 7650 SNA CLA 3352 012755 5367 JMP NEWAT3 3353 012756 1010 TAD XR10 3354 012757 3021 DCA TEMP1 3355 012760 1410 TAD I XR10 3356 012761 3035 DCA A1P 3357 012762 1421 TAD I TEMP1 3358 012763 3010 DCA XR10 3359 012764 4151 NEWAT2, JMS NUCEL 3360 012765 7200 CLA 3361 012766 5347 JMP NEWAT1 3362 012767 1032 NEWAT3, TAD L32 /HAVE NEW PACKED CHARACTERS 3363 012770 7450 SNA 3364 012771 5375 JMP NEWAT4 /DONE WITH THIS OBJECT 3365 012772 3035 DCA A1P 3366 012773 4465 JMS I PRDPCK 3367 012774 5364 JMP NEWAT2 3368 /COME HERE WHEN THE NEW OBJECT HAS BEEN 3369 /COMPLETELY READ IN AND ADDED TO THE 3370 /OBJECT LIST. 3371 012775 3435 NEWAT4, DCA I A1P /PUT NIL AT 3372 /LAST CELL POINTER. 3373 012776 1033 TAD L33 /POINTER TO THE LIST. 3374 012777 5633 JMP I READN9 /RETURN. 3375 PAGE 3376 3377 /STARTING AT INIT, THE WHOLE SYSTEM IS 3378 /CLEARED. THE OBLIST IS EMPTIED AND 3379 /THE GENSYM COUNT IS ZEROED. 3380 3381 013000 5263 INIT, JMP CLEAR 3382 3383 /STARTING AT INIT1, THE SYSTEM IS 3384 /CLEARED, BUT THE SYSTEM WILL KEEP 3385 /OBLIST AND ALL PROPERTIES OF 3386 /THE OBJECTS. 3387 3388 013001 6046 INIT1, TLS /THIS IS TO SET FLAG 3389 013002 1002 INIT2, TAD K2 3390 013003 6014 CHNGMD, RFC /CLEAR HIGH SPEED 3391 /READER FLAG 3392 013004 3354 DCA MODE /SET THE MODE 3393 013005 3014 DCA CHAR /INITIALIZE CHARACTER BUFFER 3394 /THIS LOOP ZEROES THE CDR PART OF 3395 /THE PERMANENT ATOMS WHICH ARE AT THE 3396 /END OF NAMES. 3397 013006 1046 TAD PSYMT 3398 013007 3012 DCA XR12 3399 013010 3412 DCA I XR12 3400 013011 1412 TAD I XR12 3401 013012 7640 SZA CLA 3402 013013 5210 JMP .-3 3403 013014 7200 INIT3, CLA 3404 013015 3025 DCA ALP /CLEAR ASSOCIATION LIST 3405 /POINTER 3406 013016 3027 DCA SP /CLEAR STACK POINTER 3407 013017 3035 DCA A1P /CLEAR POINTER TO 3408 /FIRST ARGUMENT 3409 013020 3037 DCA A2P /CLEAR POINTER TO 3410 /SECOND ARGUMENT 3411 013021 3041 DCA A3P /CLEAR POINTER TO 3412 /THIRD ARGUMENT 3413 013022 3031 DCA L31 3414 013023 3033 DCA L33 3415 013024 4467 JMS I PTERPRI /PRINT CARRIAGE RETURN 3416 /AND LINE FEED. 3417 013025 4466 JMS I PFETCHC /READ A CHARACTER 3418 013026 5225 JMP .-1 /IGNORE LEADER 3419 013027 7201 CLA IAC 3420 013030 3334 DCA MODE1 3421 013031 4464 JMS I PREAD /READ IN THE FIRST S-EXPRESSION 3422 013032 3035 DCA A1P /SAVE POINTER TO THE S-EXPRESSION 3423 013033 4104 JMS NUMBER /SEE IF THE S-EXPRESSION 3424 /WAS A NUMBER 3425 013034 7650 SNA CLA /SKIP IF IT WAS A NUMBER. 3426 013035 5244 JMP NONUMB 3427 013036 1435 TAD I A1P /YES, IT WAS A NUMBER 3428 013037 5203 JMP CHNGMD /CHANGE THE MODE, 3429 /AND RESTART EVALQUOTE 3430 3431 3432 /SETM2 SETS THE ACCUMULATOR TO 7776 (-2) 3433 3434 013040 0000 SETM2, 0 3435 013041 7340 CLA CLL CMA 3436 013042 7004 RAL 3437 013043 5640 JMP I SETM2 3438 3439 /WE HAVE FOUND THE FIRST S-EXPRESSION AND IT 3440 /WAS NOT A NUMBER. NOW GET THE SECOND 3441 /S-EXPRESSION. 3442 013044 1035 NONUMB, TAD A1P 3443 013045 4303 JMS PRINTS /PRINT THE S-EXPRESSION IF 3444 /MODE BIT 1 WAS SELECTED. 3445 013046 4133 JMS PUSH /PUSH DOWN POINTER TO FIRST 3446 /S-EXPRESSION 3447 013047 4464 JMS I PREAD /READ IN THE SECOND S-EXPRESSION 3448 013050 4303 JMS PRINTS /PRINT THE SECOND S-EXPRESSION 3449 /IF MODE BIT 1 WAS SELECTED. 3450 013051 2334 ISZ MODE1 3451 013052 3037 DCA A2P /SAVE POINTER TO SECOND 3452 /S-EXPRESSION 3453 013053 4453 JMS I PGETTOP 3454 013054 1021 TAD TEMP1 /GETTOP PLACES THE VALUE 3455 /WHICH WAS AT THE TOP 3456 /OF THE STACK INTO TEMP1, 3457 /WITHOUT POPPING STACK. 3458 013055 3035 DCA A1P /A1P NOW POINTS TO 1ST 3459 /S-EXPRESSION 3460 013056 1037 TAD A2P 3461 013057 4133 JMS PUSH /PUSH POINTER TO SECOND 3462 /S-EXPRESSION 3463 013060 4447 JMS I PDISP /GO TO THE APPROPRIATE ROUTINE 3464 /I.E.,EVALUATE THE EXPRESSIONS. 3465 013061 4303 JMS PRINTS /PRINT THE RESULT IF THE 3466 /PROPER MODE BIT WAS SELECTED. 3467 013062 5214 JMP INIT3 /GET THE NEXT EVALQUOTE 3468 /PAIR. 3469 3470 3471 /INITIALIZE THE WHOLE SYSTEM 3472 3473 013063 1042 CLEAR, TAD POBJ 3474 013064 3426 DCA I POBJST /INITIALIZE THE OBJECT LIST 3475 013065 3017 DCA CGENSY /CLEAR THE GENSYM COUNT 3476 013066 1044 TAD PBEG 3477 013067 3010 DCA XR10 /POINTER TO FIRST CELL OF 3478 /LIST SPACE 3479 013070 1045 TAD LLEN 3480 013071 7130 CLL CML RAR /HAVE NUMBER OF CELLS 3481 013072 3021 DCA TEMP1 /SET UP LOOP COUNTER 3482 /NOW LINK TOGETHER THE LIST SPACE 3483 013073 3410 DCA I XR10 3484 013074 3410 DCA I XR10 3485 013075 7040 CMA 3486 013076 1010 TAD XR10 3487 013077 2021 ISZ TEMP1 3488 013100 5273 JMP .-5 /NOT DONE YET 3489 013101 3030 DCA FLIST /ADDRESS OF LAST CELL 3490 013102 5201 JMP INIT1 3491 3492 /SUBROUTINE TO PRINT AN S-EXPRESSION IF 3493 /THIS IS SPECIFIED BY THE MODE 3494 013103 0000 PRINTS, 0 3495 013104 4315 JMS CHMODE /CHECK THE MODE 3496 013105 3134 MODE1 3497 013106 5314 JMP PRINSR /DO NOT PRINT THE S-EXPRESSION 3498 013107 3035 DCA A1P 3499 013110 7420 SNL 3500 013111 4467 JMS I PTERPRI /PRINT A CARRIAGE RETURN 3501 /AND LINE FEED 3502 013112 4462 JMS I PPRINCC /PRINT A CHARACTER 3503 013113 4463 JMS I PPRINT /PRINT THE S-EXPRESSION 3504 013114 5703 PRINSR, JMP I PRINTS 3505 3506 /SUBROUTINE TO CHECK TO SEE IF THE MODE 3507 /HAS THE BITS SPECIFIED BY THE ARGUMENT 3508 /SELECTED. IF SO, SKIPS 3509 /THE NEXT LOCATION. 3510 3511 013115 0000 CHMODE, 0 3512 013116 3114 DCA ATOM /SAVE AC TEMPORARILY 3513 013117 1715 TAD I CHMODE /GET ARGUMENT 3514 013120 3104 DCA NUMBER 3515 013121 1354 TAD MODE 3516 013122 0504 AND I NUMBER 3517 013123 2315 ISZ CHMODE 3518 013124 7640 SZA CLA 3519 013125 2315 ISZ CHMODE 3520 013126 1334 TAD MODE1 3521 013127 7010 RAR 3522 013130 7200 CLA 3523 013131 1114 TAD ATOM /RESTORE AC. 3524 013132 5715 JMP I CHMODE 3525 3526 3527 013133 3662 PPSTOP, PSTOP 3528 3529 3530 /PRINT AN ERROR MESSAGE AND RESTART 3531 3532 MODE1, 3533 013134 0000 ERR, 0 3534 013135 0001 0001 /THIS CLEARS THE AC. 3535 013136 4467 JMS I PTERPRI /PRINT A CARRIAGE RETURN 3536 /AND LINE FEED. 3537 013137 1333 TAD PPSTOP 3538 013140 4346 JMS PNTERR /PRINT "STOP" 3539 013141 1060 TAD PERR 3540 013142 4346 JMS PNTERR /PRINT ADDRESS CALLED FROM 3541 013143 1031 TAD L31 3542 013144 4346 JMS PNTERR /PRINT THE REST OF THE 3543 /CURRENT S-EXPRESSION. 3544 013145 5202 JMP INIT2 3545 3546 3547 /PRINT THE LIST OR NUMBER POINTED TO BY AC. 3548 013146 0000 PNTERR, 0 3549 013147 3035 DCA A1P 3550 013150 4463 JMS I PPRINT /LISP PRINT ROUTINE 3551 013151 7200 CLA 3552 013152 4462 JMS I PPRINCC 3553 013153 5746 JMP I PNTERR 3554 3555 013154 0000 MODE, 0 /MODE WORD. 3556 3557 /BASIC INPUT ROUTINE 3558 013155 0000 INSUB, 0 3559 013156 1355 TAD INSUB 3560 013157 3073 DCA INRET 3561 013160 4315 JMS CHMODE /SEE IF LOW-SPEED READER 3562 013161 0004 K4 3563 013162 5074 JMP TTYIN /LOW-SPEED READER 3564 013163 6011 PTRIN, RSF /HIGH-SPEED READER 3565 013164 5363 JMP .-1 3566 013165 6016 RFC RRB /READ CHARACTER 3567 013166 5473 JMP I INRET 3568 013167 0000 0 3569 /ROUTINE TO RETURN SWITCH REGISTER +FIRST 3570 /ARGUMENT MASKED BY SECOND ARGUMENT 3571 013170 7604 LAS 3572 013171 7410 SKP 3573 013172 3037 DCA A2P 3574 013173 1437 RMASK, TAD I A2P /GET MASK 3575 013174 0441 AND I A3P /LOGICAL AND OF 1ST 3576 /AND 2ND ARGUMENTS 3577 013175 3037 DCA A2P 3578 013176 7001 IAC 3579 013177 3035 DCA A1P 3580 013200 4151 JMS NUCEL /PUT RESULT IN A CELL 3581 /IT IS A NUMBER. 3582 013201 5171 JMP LRET2 /RETURN 3583 3584 013202 3021 DCA TEMP1 3585 013203 1441 TAD I A3P 3586 013204 3421 DCA I TEMP1 3587 013205 5171 JMP LRET2 3588 3589 013206 3616 PPNIL, PNIL /POINTER TO POINTER TO 3590 /NIL. 3591 3592 /THE FOLLOWING ROUTINE PUTS A1P +1 IN TEMP1 IF 3593 /A1P IS NON-ZERO. IF A1P IS ZERO, PUTS POINTER 3594 /TO "NIL" IN TEMP1. 3595 013207 0000 A1PPL1, 0 /A1P PLUS ONE ROUTINE 3596 013210 7200 CLA 3597 013211 1035 TAD A1P 3598 013212 7450 SNA 3599 013213 1206 TAD PPNIL 3600 013214 7001 IAC 3601 013215 3021 DCA TEMP1 3602 013216 5607 JMP I A1PPL1 3603 3604 /BASIC OUTPUT ROUTINE 3605 013217 0000 OUTSUB, 0 3606 013220 6041 TSF 3607 013221 5220 JMP .-1 /WAIT TILL TELETYPE FREE 3608 013222 6046 TLS /TYPE CHARACTER IN AC. 3609 013223 5617 JMP I OUTSUB /RETURN 3610 3611 /RDPCK WILL READ IN 2 CHARACTERS AND PACK THEM 3612 /IN LOCATION L32. 3613 3614 013224 0000 RDPCK, 0 3615 013225 3032 DCA L32 /CLEAR L32 3616 013226 4242 JMS GETC /GET A CHARACTER 3617 013227 3032 DCA L32 3618 013230 3014 DCA CHAR /CLEAR CHARACTER BUFFER. 3619 013231 4242 JMS GETC /GET A CHARACTER 3620 013232 7106 CLL RTL 3621 013233 7106 CLL RTL 3622 013234 7106 CLL RTL 3623 013235 1032 TAD L32 /ADD PREVIOUS CHARACTER 3624 /TO THIS CHARACTER. GET 3625 /SECOND CHARACTER IN 3626 /LEFT-HAND 6 BITS AND 3627 /FIRST CHARACTER IN RIGHT- 3628 /HAND 6 BITS. 3629 013236 3032 DCA L32 3630 013237 3014 DCA CHAR /CLEAR CHARACTER BUFFER 3631 013240 5624 JMP I RDPCK /RETURN. 3632 3633 013241 2430 PRDTST, RDTST /POINTER TO RDTEST ROUTINE 3634 3635 /GETC WILL FETCH A CHARACTER. IF IT IS 3636 /A QUOTE, IT WILL DIRECTLY FETCH THE 3637 /NEXT CHARACTER WITHOUT CLASSIFYING IT. 3638 /IF A DELIMITER IS FOUND, RETURN 3639 /WILL BE TO ROUTINE WHICH CALLED RDPCK. 3640 3641 013242 0000 GETC, 0 3642 013243 4641 JMS I PRDTST /READ A CHARACTER AND 3643 /SEE IF IT IS A DELIMITER 3644 013244 5624 JMP I RDPCK /HAD A DELIMITER 3645 013245 7440 SZA 3646 013246 5642 JMP I GETC /NOT A QUOTE 3647 013247 3014 DCA CHAR /WAS QUOTE. CLEAR CHARACTER 3648 /BUFFER. 3649 013250 4466 JMS I PFETCHC /GET A CHARACTER 3650 /WITHOUT TESTING TO 3651 /SEE IF IT IS A DELIMITER 3652 013251 4460 JMS I PERR /ERROR-LEADER TRAILER 3653 /HAS BEEN FOUND AFTER QUOTE 3654 013252 5642 JMP I GETC /RETURN 3655 3656 /APVAL FUNCTION 3657 013253 4466 APVAL, JMS I PFETCHC /GET A CHARACTER 3658 013254 7000 NOP /DON'T CARE IF IT 3659 /IS LEADER-TRAILER. 3660 013255 7650 SNA CLA 3661 013256 1024 TAD PTRUE 3662 013257 5576 JMP I EV 3663 3664 /ZEXPR ROUTINE. JUMPS TO FIELD 0 ADDRESS 3665 /SPECIFIED IN 1ST ARGUMENT. 3666 013260 0000 ZEXPR, 0 3667 013261 6202 CIF 0 3668 013262 5663 JMP I .+1 3669 013263 1675 ZEXPR0 3670 /NOW COME THE SYSTEM NAMES. THEY ARE IN 3671 /THE FORM OF A LIST. THE FIRST SECTION HAS 3672 /THE CDR POINTER NIL. 3673 3674 013264 0000 0 3675 013265 0000 SYMT, 0 3676 013266 0000 0 3677 013267 0056 NL, 56 /"L" 3678 013270 0000 0 3679 013271 0073 NY, 73 /"Y" 3680 013272 0000 0 3681 013273 0060 NN, 60 /"N" 3682 013274 0000 0 3683 013275 0045 NC, 45 /"C" 3684 013276 0000 0 3685 013277 5761 NOM, 5761 /"OM" 3686 013300 0000 0 3687 013301 0064 NR, 64 /"R" 3688 013302 0000 0 3689 013303 4765 NSE, 4765 /"SE" 3690 013304 0000 0 3691 013305 4660 NND, 4660 /"ND" 3692 013306 0000 0 3693 013307 6560 NNS, 6560 /"NS" 3694 013310 0000 0 3695 013311 4760 NNE, 4760 /"NE" 3696 013312 0000 0 3697 013313 6553 NIS, 6553 /"IS" 3698 013314 0000 0 3699 013315 6347 NEQ, 6347 /"EQ" 3700 013316 0000 0 3701 013317 5643 NAL, 5643 /"AL" 3702 013320 0000 0 3703 013321 6462 NPR, 6462 /"PR" 3704 013322 0000 0 3705 013323 5164 NRG, 5164 /"RG" 3706 013324 0000 0 3707 013325 5366 NTI, 5366 /"TI" 3708 013326 0000 0 3709 013327 5773 NYM, 5773 /"YM" 3710 013330 0000 0 3711 013331 0066 NT, 66 /"T" 3712 013332 0000 0 3713 013333 6151 NGO, 6151 /"GO" 3714 013334 0000 0 3715 013335 4346 NDA, 4346 /"DA" 3716 013336 0000 0 3717 013337 0062 NP, 62 /"P" 3718 013340 0000 0 3719 013341 6665 NST, 6665 /"ST" 3720 013342 0000 0 3721 013343 0065 NS, 65 /"S" 3722 013344 0000 0 3723 013345 5656 NLL, 5656 /"LL" 3724 013346 0000 0 3725 013347 6447 NER, 6447 /"ER" 3726 013350 0000 0 3727 013351 6567 NUS, 6567 /"US" 3728 013352 0000 0 3729 013353 5161 NOG, 5161 /"OG" 3730 013354 0000 0 3731 013355 0047 NE, 47 /"E" 3732 013356 0000 0 3733 013357 4643 NAD, 4643 /"AD" 3734 013360 0000 0 3735 013361 6064 NRN, 6064 /"RN" 3736 013362 0000 0 3737 013363 4345 NCA, 4345 /"CA" 3738 013364 0000 0 3739 013365 4645 NCD, 4645 /"CD" 3740 013366 0000 0 3741 013367 6366 NTQ, 6366 /"TQ" 3742 013370 0000 0 3743 013371 6261 N1OP, 6261 /"OP" 3744 013372 0000 0 3745 013373 5364 NRI, 5364 /"RI" 3746 013374 0000 0 3747 013375 6653 NIT, 6653 /"IT" 3748 013376 0000 0 3749 013377 0000 0 3750 /THIS IS STILL THE SYSTEM NAME TABLE. 3751 /THESE NAMES DO NOT HAVE THEIR 3752 /CDR PART NULL. 3753 013400 3266 NILN, NL-1 3754 013401 5360 NNIL, 5360 /"NI" 3755 013402 3404 NPLY-1 3756 013403 6243 NAPPLY, 6243 /"AP" 3757 013404 3270 NY-1 3758 013405 5662 NPLY, 5662 /"PL" 3759 013406 3374 NIT-1 3760 013407 7247 NEXIT, 7247 /"EX" 3761 013410 3412 NMES-1 3762 013411 5366 NTIMES, 5366 /"TI" 3763 013412 3342 NS-1 3764 013413 4757 NMES, 4757 /"ME" 3765 013414 3416 NVAL-1 3766 013415 6243 NAPVAL, 6243 /"AP" 3767 013416 3266 NL-1 3768 013417 4370 NVAL, 4370 /"VA" 3769 013420 3422 NSOC-1 3770 013421 6543 NASSOC, 6543 /"AS" 3771 013422 3274 NC-1 3772 013423 6165 NSOC, 6165 /"SO" 3773 013424 3276 NOM-1 3774 013425 6643 NATOM, 6643 /"AT" 3775 013426 3300 NR-1 3776 013427 4345 NCAR, 4345 /"CA" 3777 013430 3300 NR-1 3778 013431 4645 NCDR, 4645 /"CD" 3779 013432 3304 NND-1 3780 013433 6145 NCOND, 6145 /"CO" 3781 013434 3306 NNS-1 3782 013435 6145 NCONS, 6145 /"CO" 3783 013436 3440 NFINE-1 3784 013437 4746 NDEFINE,4746 /"DE" 3785 013440 3310 NNE-1 3786 013441 5350 NFINE, 5350 /"FI" 3787 013442 3444 NFLIS-1 3788 013443 4746 NDEFLIS,4746 /"DE" 3789 013444 3312 NIS-1 3790 013445 5650 NFLIS, 5650 /"FL" 3791 013446 3450 NUAL-1 3792 013447 6347 NEQUAL, 6347 /"EQ" 3793 013450 3266 NL-1 3794 013451 4367 NUAL, 4367 /"UA" 3795 013452 3316 NAL-1 3796 013453 7047 NEVAL, 7047 /"EV" 3797 013454 3320 NPR-1 3798 013455 7247 NEXPR, 7247 /"EX" 3799 013456 3462 NXPR-1 3800 013457 4750 NFEXPR, 4750 /"FE" 3801 013460 3462 NXPR-1 3802 013461 4774 NZEXPR, 4774 /"ZE" 3803 013462 3300 NR-1 3804 013463 6272 NXPR, 6272 /"XP" 3805 013464 3466 NNARG-1 3806 013465 6750 NFUNARG,6750 /"FU" 3807 013466 3322 NRG-1 3808 013467 4360 NNARG, 4360 /"NA" 3809 013470 3472 NNCTI-1 3810 013471 6750 NFUNCTI,6750 /"FU" 3811 013472 3324 NTI-1 3812 013473 4560 NNCTI, 4560 /"NC" 3813 013474 3476 NNSYM-1 3814 013475 4751 NGENSYM,4751 /"GE" 3815 013476 3326 NYM-1 3816 013477 6560 NNSYM, 6560 /"NS" 3817 013500 3330 NT-1 3818 013501 4751 NGET, 4751 /"GE" 3819 013502 3504 NMBDA-1 3820 013503 4356 NLAMBDA,4356 /"LA" 3821 013504 3334 NDA-1 3822 013505 4457 NMBDA, 4457 /"MB" 3823 013506 3510 NSSP-1 3824 013507 4756 NLESSP, 4756 /"LE" 3825 013510 3336 NP-1 3826 013511 6565 NSSP, 6565 /"SS" 3827 013512 3340 NST-1 3828 013513 5356 NLIST, 5356 /"LI" 3829 013514 3516 NNUS-1 3830 013515 5357 NMINUS, 5357 /"MI" 3831 013516 3342 NS-1 3832 013517 6760 NNUS, 6760 /"NU" 3833 013520 3344 NLL-1 3834 013521 6760 NNULL, 6760 /"NU" 3835 013522 3524 NMBER-1 3836 013523 6760 NNUMBER,6760 /"NU" 3837 013524 3346 NER-1 3838 013525 4457 NMBER, 4457 /"MB" 3839 013526 3512 NLIST-1 3840 013527 4461 NOBLIST,4461 /"OB" 3841 013530 3534 NPEN-1 3842 013531 6153 NIOPEN, 6153 /"IO" 3843 013532 3534 NPEN-1 3844 013533 6161 NOOPEN, 6161 /"OO" 3845 013534 3272 NN-1 3846 013535 4762 NPEN, 4762 /"PE" 3847 013536 3542 NLOSE-1 3848 013537 4553 NICLOSE,4553 /"IC" 3849 013540 3542 NLOSE-1 3850 013541 4561 NOCLOSE,4561 /"OC" 3851 013542 3302 NSE-1 3852 013543 6156 NLOSE, 6156 /"LO" 3853 013544 3546 NEAR-1 3854 013545 5645 NCLEAR, 5645 /"CL" 3855 013546 3300 NR-1 3856 013547 4347 NEAR, 4347 /"EA" 3857 013550 3350 NUS-1 3858 013551 5662 NPLUS, 5662 /"PL" 3859 013552 3554 NINT-1 3860 013553 6462 NPRINT, 6462 /"PR" 3861 013554 3330 NT-1 3862 013555 6053 NINT, 6053 /"IN" 3863 013556 3352 NOG-1 3864 013557 6462 NPROG, 6462 /"PR" 3865 013560 3562 NOTE-1 3866 013561 6763 NQUOTE, 6763 /"QU" 3867 013562 3354 NE-1 3868 013563 6661 NOTE, 6661 /"OT" 3869 013564 3356 NAD-1 3870 013565 4764 NREAD, 4764 /"RE" 3871 013566 3570 NTURN-1 3872 013567 4764 NRETURN,4764 /"RE" 3873 013570 3360 NRN-1 3874 013571 6766 NTURN, 6766 /"TU" 3875 013572 3574 NLACA-1 3876 013573 6264 NRPLACA,6264 /"RP" 3877 013574 3362 NCA-1 3878 013575 4356 NLACA, 4356 /"LA" 3879 013576 3600 NLACD-1 3880 013577 6264 N1RPLACD,6264 /"RP" 3881 013600 3364 NCD-1 3882 013601 4356 NLACD, 4356 /"LA" 3883 013602 3330 NT-1 3884 013603 4765 NSET, 4765 /"SE" 3885 013604 3366 NTQ-1 3886 013605 4765 NSETQ, 4765 /"SE" 3887 013606 3370 N1OP-1 3888 013607 6665 NSTOP, 6665 /"ST" 3889 013610 3612 NRPRI-1 3890 013611 4766 NTERPRI,4766 /"TE" 3891 013612 3372 NRI-1 3892 013613 6264 NRPRI, 6264 /"RP" 3893 /NOW COMES THE SYSTEM OBJECT LIST. 3894 /THE FIRST CELL POINTS TO THE ADDRESS OF 3895 /THE ROUTINE, AND THE SECOND CELL POINTS 3896 /TO THE NAME OF THE ROUTINE. 3897 3898 3899 /THESE FIRST ONES ARE NOT SUBROUTINES 3900 3901 SOBJ, 3902 013614 0000 LAMBDA, 0 /THIS HAS NO ADDRESS 3903 013615 3503 NLAMBDA 3904 013616 0000 PNIL, 0 3905 013617 3401 NNIL 3906 013620 0000 FUNARG, 0 3907 013621 3465 NFUNARG 3908 013622 0302 TRUE, T 3909 013623 3331 NT 3910 013624 3253 PAPVAL, APVAL 3911 013625 3415 NAPVAL 3912 013626 0626 COND 3913 013627 3433 NCOND 3914 013630 0000 FEXPR, 0 3915 013631 3457 NFEXPR 3916 013632 0423 FUNCTI 3917 013633 3471 NFUNCTI 3918 013634 0555 GO 3919 013635 3333 NGO 3920 013636 3063 CLEAR 3921 013637 3545 NCLEAR 3922 013640 0667 LIST 3923 013641 3513 NLIST 3924 013642 1452 MINUS 3925 013643 3515 NMINUS 3926 013644 1445 PLUS 3927 013645 3551 NPLUS 3928 013646 0452 PROG 3929 013647 3557 NPROG 3930 013650 1000 QUOTE 3931 013651 3561 NQUOTE 3932 013652 0573 RETURN 3933 013653 3567 NRETURN 3934 013654 2371 EXIT 3935 013655 3407 NEXIT 3936 013656 2326 TIMES 3937 013657 3411 NTIMES 3938 013660 0751 SETQ 3939 013661 3605 NSETQ 3940 3941 3942 /THE FOLLOWING ARE SUBROUTINES WITH 3943 /NO ARGUMENTS. 3944 PSTOP, 3945 013662 0776 B0ARG, STOP 3946 013663 3607 NSTOP 3947 013664 1533 SYSSUBS,GENSYM 3948 013665 3475 NGENSYM 3949 013666 2510 READ 3950 013667 3565 NREAD 3951 013670 2416 ICLOSE 3952 013671 3537 NICLOSE 3953 013672 2422 OCLOSE 3954 013673 3541 NOCLOSE 3955 013674 2151 TERPRI 3956 013675 3611 NTERPRI 3957 3958 3959 3960 /THE FOLLOWING HAVE 1 ARGUMENT 3961 3962 013676 0114 B1ARG, ATOM 3963 013677 3425 NATOM 3964 013700 1475 CAR 3965 013701 3427 NCAR 3966 013702 0771 CDR 3967 013703 3431 NCDR 3968 013704 1272 DEFINE 3969 013705 3437 NDEFINE 3970 013706 1045 NULL 3971 013707 3521 NNULL 3972 013710 0104 NUMBER 3973 013711 3523 NNUMBER 3974 013712 2172 PRINT 3975 013713 3553 NPRINT 3976 3977 3978 3979 /THE FOLLOWING HAVE 2 ARGUMENTS 3980 3981 013714 1136 B2ARG, ASSOC 3982 013715 3421 NASSOC 3983 013716 0151 CONS 3984 013717 3435 NCONS 3985 013720 1205 DEFLIS 3986 013721 3443 NDEFLIS 3987 013722 1024 EQ 3988 013723 3315 NEQ 3989 013724 1061 EQUAL 3990 013725 3447 NEQUAL 3991 013726 0605 EVAL 3992 013727 3453 NEVAL 3993 013730 1116 GET 3994 013731 3501 NGET 3995 013732 1460 LESSP 3996 013733 3507 NLESSP 3997 013734 1002 RPLACA 3998 013735 3573 NRPLACA 3999 013736 1200 RPLACD 4000 013737 3577 N1RPLACD 4001 013740 0734 SET 4002 013741 3603 NSET 4003 4004 4005 4006 /THE FOLLOWING HAVE 3 ARGUMENTS 4007 4008 013742 0615 B3ARG, APPLY 4009 013743 3403 NAPPLY 4010 013744 2374 IOPEN 4011 013745 3531 NIOPEN 4012 013746 2412 OOPEN 4013 013747 3533 NOOPEN 4014 013750 1513 EXPR 4015 013751 3455 NEXPR 4016 013752 3260 ZEXPR 4017 013753 3461 NZEXPR 4018 4019 4020 /THIS IS THE OBJECT LIST 4021 013754 0000 OBJ, 0 4022 013755 3756 .+1 4023 013756 3760 .+2 4024 013757 3527 NOBLIST 4025 013760 3762 .+2 4026 013761 3624 PAPVAL 4027 013762 0000 0 4028 013763 3764 OBJST 4029 013764 3754 OBJST, OBJ /POINTER TO THE OBJECT LIST 4030 4031 4032 013765 0000 LBEG, 0 /BEGINNING OF THE LIST 4033 /SPACE -1 4034 4035 /THE LIST SPACE GETS CHAINED TOGETHER BY CLEAR. 4036 4037 $ A1P 0035 A1PPL1 3207 A2P 0037 A3P 0041 ADDWCA 2200 unreferenced ALP 0025 ALTM 0316 APPLY 0615 APVAL 3253 ARG1N 1161 ARG22 1170 ARG2N 1167 ASDEV1 1217 ASDEV2 1220 ASERR 1255 ASPAG 1221 ASR 7415 unreferenced ASSOC 1136 ASSOC1 1137 ATOM 0114 B0ARG 3662 unreferenced B1ARG 3676 B2ARG 3714 B3ARG 3742 BPOINT 0270 BRET 0212 unreferenced BTTY 0200 CAM 7621 CAR 1475 CDR 0771 CGENSY 0017 CHAR 0014 CHMODE 3115 CHNGMD 3003 CKPROG 0546 CKUSER 2650 CLEAR 3063 CNGLO2 1717 unreferenced CNGLO3 1724 unreferenced CNGLOC 1703 unreferenced CNGLOZ 1706 CNGPT 1645 CNGTTY 2306 CNTC 0405 CNTR 0374 CNTRC 0407 CNTRR 0376 CNTRU 0323 CNTU 0310 COND 0626 COND1 0636 COND2 0656 COND3 0633 CONS 0151 COUBUF 1631 COUREC 1632 CPAGE 2306 unreferenced CPAGE1 2324 CPOINT 0267 CRET 0314 CRRET 0210 DEFINE 1272 DEFL1 1254 DEFL2 1212 DEFL3 1256 DEFL4 1261 DEFLIS 1205 DFEXIT 1551 DISP 0216 DISP14 0222 DVI 7407 ECHO 0271 ECHO1 0306 EQ 1024 EQ1 1037 EQ2 1042 EQUAL 1061 EQUAL1 1074 EQUAL2 1064 ERR 3134 ERROR1 0161 ERROR2 1330 EV 0176 EV1 0225 EV2 0233 EV3 0235 EV4 0374 EV5 0307 EV6 0326 EV7 0336 EVA1 0366 EVA10 0505 EVA11 0464 EVA12 0531 EVA13 0577 EVA14 0533 EVA15 0575 EVA19 0455 EVA4 0352 EVA6 0457 EVA8 0517 EVA9 0501 EVAL 0605 EVAL1 0600 EVAL2 0601 EXIT 2371 EXPR 1513 F1RET 0133 FETCH1 2304 FETCH2 2275 FETCH4 2317 FETCHC 2312 FEX 2122 FEXPR 3630 FI200 1271 unreferenced FI7200 1310 FI7400 0151 FICHCT 1335 FIGET 1305 FIN10 1337 FINBUF 1272 FINPTR 0130 FINREC 1273 FINTMP 1336 FINXX 1316 FITHRD 1325 FLIST 0030 FLUCNT 1233 FLUNAM 1232 FNXTCH 1262 unreferenced FO7177 1564 FOCCNT 1643 FOCHAR 1475 FOCHCT 1567 FOCNAM 1642 unreferenced FOJMP 1503 FOLOOP 1501 FOOCNT 1445 FOONAM 1444 FOPOLD 1570 FOSETP 1554 FOUBUF 1506 FOUCH1 1547 FOUCH2 1544 FOUCH3 1522 unreferenced FOUJMP 1517 FOUPTR 1571 FOUREC 1507 FOUTMP 1566 FUNARG 3620 unreferenced FUNC1 0416 FUNCTI 0423 GAR1 1724 GAR2 1747 GAR3 1710 GAR4 1644 GAR5 1733 GARB 1652 GARB1 1674 GARB2 1620 GARB3 1605 GARB4 1603 GARB5 1640 GARB6 1623 GARB7 1635 GARB8 1671 GARB9 1742 GCCNT 0006 GCHAR 2400 GEN1 1574 GEN2 1575 GEN3 1572 GEN4 1570 GEN5 1565 GEN6 1566 GEN7 1567 GENSYM 1533 GET 1116 GET1 1117 GETARG 1012 GETC 3242 GETCO2 1731 unreferenced GETCO3 1733 unreferenced GETCON 1710 GETEXT 1104 GETFLN 1040 GETNAM 1000 GETTOP 1520 GL1 1600 GL2 1601 GLCNT 1670 GMARK 1633 GMARKS 1751 GO 0555 GTATOM 2634 GTCHAR 1260 ICLOSE 2416 ICLOSR 1600 IHNDLR 0126 INBUFL 6200 INDBUF 7200 INDEV1 0105 INDEV2 0106 INFIL1 0107 INIT 3000 INIT1 3001 INIT2 3002 INIT3 3014 INRET 0073 INSUB 3155 IOPEN 2374 IOPENR 1200 K10 2036 K100 2035 K1000 2034 K141 2272 K150 0372 K16 1326 K17 1573 K177 2273 K1INSU 1341 K2 0002 K21 2074 K212 0625 K215 0312 K22 0624 K232 1657 K236 2123 K27 2271 K3 0003 K306 2157 K33 0306 K334 0371 K36 0155 K3600 0415 K3744 2507 K4 0004 K4012 2506 K5 0005 K55 0176 K6546 0175 K77 0007 K7700A 0150 KA 1327 KC 1330 KCAT 1651 KFOCCN 1572 KFOUBU 1660 KFOURE 1661 KGCHAR 1342 KKM100 2032 KLLS 6356 KLOC 2033 KLP 2206 KLSF 6351 KM12 0365 KM14 2370 KM177 2274 KM20 2426 KM215 0623 KM27 2122 KM3 2121 KM377 0370 KM4 1602 KM6 0154 KMA3P 1667 KMIN 2073 KMLAST 0266 KN3 0147 KOUERR 1662 KOUTCH 0144 KP17 0366 KP212 0313 unreferenced KP3 0367 KP3600 0153 KP377 1343 KP45 0373 KP77 0152 KPCHAR 1466 KPER 2210 KPL3 0622 KPOUTC 1467 KPTTYI 1610 KRP 2207 L20 0020 L22 0022 L23 0023 L31 0031 L32 0032 L33 0033 LAMBDA 3614 unreferenced LASTL 5577 LBEG 3765 LEND 7577 LESSP 1460 LFTEAX 2026 unreferenced LFTSHC 2043 LFTSHX 2000 unreferenced LINCNT 0016 LIST 0667 LIST1 0672 LIST2 0700 LIST3 0714 LIST4 0717 LIST5 0720 LIST6 0670 LKUP1 1172 LLEN 0045 LOOKUP 1160 LPTLS8 0626 LPTOUT 0600 LRET1 0170 LRET2 0171 LRET3 0172 LRET4 0174 LSR 7417 MINUS 1452 MINUS2 1453 MODE 3154 MODE1 3134 MOVARG 1663 MQA 7501 MQL 7421 MULT 2351 MULTL 2355 MUY 7405 N1OP 3371 N1RPLA 3577 NAD 3357 NAL 3317 NAPPLY 3403 NAPVAL 3415 NASSOC 3421 NATOM 3425 NC 3275 NCA 3363 NCAR 3427 NCD 3365 NCDR 3431 NCLEAR 3545 NCOND 3433 NCONS 3435 NCTR 0157 NDA 3335 NDEFIN 3437 NDEFLI 3443 NE 3355 NEAR 3547 NEQ 3315 NEQUAL 3447 NER 3347 NEVAL 3453 NEWAT1 2747 NEWAT2 2764 NEWAT3 2767 NEWAT4 2775 NEXIT 3407 NEXPR 3455 NFEXPR 3457 NFINE 3441 NFLIS 3445 NFUNAR 3465 NFUNCT 3471 NGENSY 3475 NGET 3501 NGO 3333 NICLOS 3537 NIL 0000 unreferenced NIL1 0001 unreferenced NILN 3400 NINT 3555 NIOPEN 3531 NIS 3313 NIT 3375 NL 3267 NLACA 3575 NLACD 3601 NLAMBD 3503 NLESSP 3507 NLIST 3513 NLL 3345 NLOSE 3543 NMBDA 3505 NMBER 3525 NMES 3413 NMI 7411 unreferenced NMINUS 3515 NMLOOP 1132 NN 3273 NNARG 3467 NNCTI 3473 NND 3305 NNE 3311 NNIL 3401 NNS 3307 NNSYM 3477 NNULL 3521 NNUMBE 3523 NNUS 3517 NOBLIS 3527 NOCLOS 3541 NOG 3353 NOM 3277 NONUMB 3044 NOOPEN 3533 NOSHIF 2016 NOTE 3563 NP 3337 NPEN 3535 NPLUS 3551 NPLY 3405 NPR 3321 NPRINT 3553 NPROG 3557 NQUOTE 3561 NR 3301 NREAD 3565 NRETUR 3567 NRG 3323 NRI 3373 NRN 3361 NRPLAC 3573 NRPRI 3613 NS 3343 NSE 3303 NSET 3603 NSETQ 3605 NSOC 3423 NSSP 3511 NST 3341 NSTOP 3607 NT 3331 NTERPR 3611 NTI 3325 NTIMES 3411 NTQ 3367 NTURN 3571 NUAL 3451 NUCEL 0151 NULL 1045 NUMB 0103 NUMB1 0104 NUMBER 0104 NUS 3351 NVAL 3417 NXPR 3463 NXTA1 2662 NXTA2 2670 NXTA3 2674 NXTA4 2707 NXTA5 2726 NXTA6 2742 NXTATO 2657 NY 3271 NYM 3327 NZEXPR 3461 OBJ 3754 OBJST 3764 OCLOSE 2422 OCLOSR 1612 OHNDLR 0127 OOPEN 2412 OOPENR 1400 OREAEX 1755 unreferenced ORET 1455 ORX 1745 unreferenced OSDEV1 1430 OSDEV2 1431 OSPAG 1432 OSPEC 1461 OUBUF 5600 OUDBUF 6600 OUDEV1 0113 OUDEV2 0114 OUERR 1464 OUERR1 0164 OUFIL1 0115 OUTSUB 3217 P1ERR 0124 P1FOCH 0146 P1LPTO 0145 P1OUTS 0171 P1PINS 1340 P7600 2235 PA1P 0100 PA1PPL 0070 PA2P 0101 PA3P 0102 PAPVAL 3624 PASSOC 0050 PB1ARG 0034 unreferenced PB2ARG 0036 unreferenced PB3ARG 0040 unreferenced PBEG 0044 PCAR 0072 PCDR 0054 PCHAR 2405 PCHMOD 2267 unreferenced PCKPRO 0666 PCKUSE 0051 PCLF 6662 PCNTRC 0265 PDISP 0047 PERR 0060 PEVA4 0414 PFETCH 0066 PFEXPR 0215 PFILN1 0131 PFILN2 0132 PFOCHA 1654 PGARB 0055 PGET 0061 PGETAR 0052 PGETNA 0125 PGETTO 0053 PGTATO 2573 PGTCHA 2404 PINDBU 1254 PINSUB 0100 PL23 1666 PLIST1 0056 PLIST5 0057 PLIST6 1415 PLOOKU 0071 PLPT 1716 PLPTOU 1553 unreferenced PLRET2 0040 PLUS 1445 PLUS1 1416 PLUS2 1430 PLUS3 1446 PMODE 0362 PNAME 0123 PNAME1 0160 PNIL 3616 PNTERR 3146 POBJ 0042 POBJST 0026 POP 0123 POSDEV 1655 POUDBU 1470 POUERR 1656 POUTCH 2124 POUTSU 2270 unreferenced PPINNA 0121 PPINSU 1611 PPLUS1 2350 PPNIL 3206 PPOUTC 0172 PPOUTN 0122 PPRIN 2226 PPRINC 0062 PPRINT 0063 PPSTOP 3133 PPTCHA 2411 PQUOTI 0034 PRDPCK 0065 PRDTST 3241 PREAD 0064 PREAD6 2452 PREAD8 2477 PREADN 2615 PRINC1 2222 PRINCC 2211 PRINSR 3114 PRINT 2172 PRINT1 2231 PRINT2 2260 PRINT3 2264 PRINT4 2227 PRINT5 2234 PRINTA 2040 PRINTB 2000 PRINTC 2125 PRINTD 2003 PRINTE 2021 PRINTF 2117 PRINTS 3103 PRLPT 1713 unreferenced PRNTA1 2057 PRNTA2 2104 PRNTA3 2075 PRNTA4 2110 PRNTA5 2046 PROG 0452 PROOM 2162 PROU9 0214 PRTERM 2243 PSCR6 0101 PSETM2 0103 PSKF 6661 PSOBJ 0043 PSTB 6664 PSTOP 3662 PSYMT 0046 PSYSSU 0305 PTARG1 0173 PTARG2 0174 PTCHAR 1471 PTERPR 0067 PTFLAG 0417 PTRIN 3163 unreferenced PTRUE 0024 PTSTRI 0416 PUSH 0133 PUSHA 0442 QUOTE 1000 QUOTIE 0015 RDASCI 2324 RDEXP 2560 RDEXP1 2552 RDEXP2 2567 RDEXP3 2576 RDNUM 2522 RDNUM1 2536 RDPCK 3224 RDTST 2430 RDTST1 2445 RDTST2 2446 RDTST3 2447 RDTST5 2453 RDTST6 2461 READ 2510 READ1 2513 READ2 2463 READ3 2617 READ4 2602 READ5 2473 READ6 2465 READ7 2472 READ8 2475 READ9 2500 READD 2542 READN5 2613 READN6 2574 READN7 2616 READN8 2632 READN9 2633 REMDVI 2102 REMEAE 2076 unreferenced REMEXT 2137 unreferenced REMX 2054 unreferenced RETURN 0573 RIGEAS 2045 RIGHTS 2020 RIGSHC 2051 RLOCA 0142 RLOOP 0220 RMASK 3173 ROU1 1311 ROU10 1406 ROU11 1400 ROU2 1277 ROU3 1304 ROU4 1331 ROU6 1361 ROU7 1345 ROU8 1344 ROU9 1367 RPLACA 1002 RPLACD 1200 RUBOUT 0326 RVAL 0143 SAVEXT 1125 SAVNAM 1172 SCA 7441 unreferenced SCL 7641 unreferenced SCR6 1504 SET 0734 SETDA 2267 SETDEC 2237 unreferenced SETM2 3040 SETOA 2301 SETOCT 2253 unreferenced SETQ 0751 SHL 7413 SOBJ 3614 SP 0027 STANSA 2231 STOP 0776 STUTX 2211 unreferenced STUX 2222 SWAP 1051 SWP 7521 SYMT 3265 SYSSUB 3664 T 0302 TBUF 5400 TCHAR 0621 TEMOUT 1565 TEMP 0364 TEMP1 0021 TEMPAD 0036 TEMPAX 2053 TERPRI 2151 TFLAG 0264 TIMEAE 2112 unreferenced TIMES 2326 TIMEXT 2125 unreferenced TLOOP 2330 TMCHAR 0363 TMNAM 0156 TMSTR 0361 TREAD 0214 TRUE 3622 TSLOOP 0351 TSTRIN 0344 TTYIN 0074 XORX 1735 unreferenced XR10 0010 XR11 0011 XR12 0012 XR13 0013 ZA1P 0035 ZA2P 0037 ZA3P 0041 ZEXPR 3260 ZEXPR0 1675 ZRET2 0042 ZVRET2 0044