1 /**** FOCAL 5/69 **** 2 3 /EXPUNGE / VRS Unimplemented 4 /PROCESSOR INSTRUCTIONS 5 FIXMRI AND=0000 6 FIXMRI TAD=1000 7 FIXMRI ISZ=2000 8 FIXMRI DCA=3000 9 FIXMRI JMS=4000 10 FIXMRI JMP=5000 11 /FLOATING POINT INSTRUCTIONS 12 FIXMRI FPW=0000 13 FIXMRI FAD=1000 14 FIXMRI FSB=2000 15 FIXMRI FMY=3000 16 FIXMRI FDV=4000 17 FIXMRI FGT=5000 18 FIXMRI FPT=6000 19 20 FNR=7000 21 FEXT=0 22 FENT=JMS I 7 23 NOP=7000 24 CLA=7200 25 CLL=7100 26 CMA=7040 27 RAL=7004 28 CML=7020 29 RAR=7010 30 RTR=7012 31 RTL=7006 32 IAC=7001 33 SMA=7500 34 SZA=7440 35 SPA=7510 36 SNA=7450 37 SNL=7420 38 SZL=7430 39 SKP=7410 40 CIA=7041 41 ION=6001 42 IOF=6002 43 KSF=6031 44 KRB=6036 45 TSF=6041 46 TCF=6042 47 TPC=6044 48 TLS=6046 49 RSF=6011 50 RRB=6012 51 RFC=6014 52 FIXTAB 53 54 / * FOCAL * - BY RICK MERRILL - FOR THE FAMILY OF 8. 55 /REVISED BY EDWARD TAFT 5/69 56 57 /MISCELLANEOUS ITEMS 58 *1 59 00001 5402 JMP I .+1 /INTERRUPT PROCESSOR ENTRY 60 00002 2603 INTRPT 61 00003 7477 MINUSA, -301 /CONSTANT 62 00004 0000 FNEGSW, 0 /USED FOR CALCULATING SIGNS 63 00005 0013 P13, 13 /CONSTANT 64 00006 0100 C100, 100 /CONSTANT 65 00007 6600 FPNT /ADDRESS OF FLOATING POINT INTERPRETER. 66 67 /AUTO-INDEX REGISTERS 68 69 00010 0000 AXIN, 0 /STORAGE INDEX 70 00011 0000 XRT, 0 /EXTRA XR 71 00012 0000 XRT2, 0 /EXTRA XR 72 00013 0000 PDLXR, 0 /PUSHDOWN LIST INDEX REGISTER. 73 00014 3377 FLTXR, IOBUF-1 /XR15 FOR FLOATING POINT 74 00015 0200 C200, 200 /CONSTANT 75 00016 0000 XRT3, 0 /USED BY PUSHDOWN LIST CONTROLS 76 77 78 TEXTP=. /TEXT POINTERS 79 00017 3430 AXOUT, FRSTX /OUTPUT INDEX 80 00020 0000 XCT, 0 /UNPACK SWITCH 81 00021 0000 GTEM, 0 /UNPACK STORAGE 82 83 /NUMBERS 84 85 00022 0256 PER, 256 /PERIOD 86 00023 7701 M77, -77 /RIGHT MASK 87 00024 7600 P7600, 7600 /GROUP MASK 88 00025 7760 M20, -20 /CONSTANT 89 00026 0177 P177, 177 /STEP MASK 90 00027 5577 BOTTOM, DBCONV-1/END OF TEXT BUFFER 91 FLOAT= JMS I . /FLOAT C(AC) SUBROUTINE 92 00030 7332 XFLOAT 93 00031 0017 P17, 17 /BCD MASK 94 00032 0277 P277, 277 /"?" 95 00033 0240 C240, 240 /SPACE 96 00034 7776 M2, -2 /CONSTANT 97 00035 0002 P2, 2 /CONSTANT 98 00036 0260 C260, 260 /ASCII FOR ZERO 99 00037 0000 HINBUF, 0 /HIGH SPEED INPUT BUFFER 100 101 FLOP=. /FLOATING OPERAND STORAGE 102 00040 0000 FLOP0, 0 103 00041 0000 FLOP1, 0 104 00042 0000 FLOP2, 0 105 00043 0000 FLOP3, 0 106 FLAC=. /FLOATING POINT ACCUMULATOR 107 00044 0000 FLAC0, 0 108 00045 0000 FLAC1, 0 109 00046 0000 FLAC2, 0 110 00047 0000 FLAC3, 0 111 NEGATE= JMS I . /NEGATE FLAC ROUTINE 112 00050 6676 NEGAC 113 00051 0010 TOTDIG, 10 /TOTAL DIGITS IN OUTPUT FIELD 114 FIX= JMS I . /FIX FLAC ROUTINE 115 00052 7311 XFIX 116 00053 0000 TABCTR, 0 /CARRIAGE INDEX 117 118 /CONSTANTS 119 120 121 LIST6=. /INPUT LIST FOR "SFOUND". 122 00054 0337 P337, 337 /LEFT ARR 123 00055 0214 214 /F.F. 124 00056 0207 207 /BELL 125 00057 0212 CLF, 212 /L.F. 126 LIST3=. /EXCRETION LIST 127 00060 0215 CCR, 215 /LIST BRANCHER. 128 00061 0000 0 /SEARCH CHARACTER (VARIABLE) 129 130 M100=. 131 00062 7700 P7700, 7700 /LEFT MASK 132 00063 7540 M240, -240 /SPACE TEST 133 00064 7522 MPER, -256 /PERIOD TEST 134 00065 7563 MCR, -215 /C.R. TEST 135 MFLT=. /3-WORD FLOATING POINT 136 00066 7775 M3, -3 137 00067 7773 M5, -5 /PAREN TEST 138 00070 7767 M11, -11 /PAREN TEST 139 00071 0077 P77, 77 /RIGHT MASK 140 141 00072 6170 FOUTPUT,BDCONV /FLOATING OUTPUT 142 00073 5600 FINPUT, DBCONV /FLOATING INPUT 143 00074 2527 COMBUF, COMEIN /COMMAND BUFFER`START 144 00075 3420 CFRS, FRST /ADDRESS OF DUMMY LINE. 145 00076 3432 END, BUFBEG /FIRST LOCATION USED. 146 00077 3432 ENDT, BUFBEG /START OF STORAGE AREA ** 147 RETURN= JMP I . /FUNCTION RETURN 148 00100 2056 EFUN3I, EFUN3 149 150 /NEW INSTRUCTIONS: 151 152 PUSHJ=JMS I . /RECURSIVE SUBROUTINE CALL 153 00101 0523 XPUSHJ 154 POPA=TAD I PDLXR/RESTORE AC 155 POPJ=JMP I . /SUBROUTINE RETURN 156 00102 1556 XPOPJ 157 PUSHA=JMS I . /SAVE AC 158 00103 0501 XPUSHA 159 PUSHF=JMS I . /SAVE GROUP OF DATA 160 00104 0532 PD2 161 POPF=JMS I . /RESTORE GROUP 162 00105 0550 PD3 163 GETC=JMS I . /UNPACK A CHARACTER 164 00106 2315 UTRA 165 PACKC=JMS I . /PACK A CHARACTER 166 00107 3023 PACBUF 167 SORTJ=JMS I . /SORT AND BRANCH ON AC OR CHAR 168 00110 1333 SORTB 169 SORTC=JMS I . /SORT CHAR 170 00111 0733 XSORTC 171 PRINTC=JMS I . /PRINT AC OR CHAR 172 00112 2477 OUT 173 READC=JMS I . /READ ASR-33 INTO CHAR AND PRINT IT 174 00113 2463 CHIN 175 PRNTLN=JMS I . /PRINT C(LINENO) 176 00114 6151 XPRNTLN 177 GETLN=JMS I . /UNPACK AND FORM A LINENUMBER 178 00115 0312 XGETLN 179 FINDLN=JMS I . /SEARCH FOR A GIVEN LINE 180 00116 2265 XFIND 181 ENDLN=JMS I . /INSERT LINE POINTERS 182 00117 2417 XENDLN 183 RTL6=JMS I . /ROTATE LEFT SIX 184 00120 0305 XRTL6 185 SPNOR=JMS I . /IGNORE SPACES AND LEADING ZEROS 186 00121 1524 XSPNOR 187 TESTN=JMS I . /PERIOD; OTHER; NUMBER 188 00122 1533 XTESTN 189 TSTLPR=JMS I . /SKIP IF 5 0 249 00202 3145 DCA PC /FOR COMMAND MODE 250 00203 3151 DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?). 251 00204 1226 TAD COMBOT /PROTECT COMMAND BUFFER. 252 00205 3013 DCA PDLXR /NO PATCH TEST. 253 00206 2152 ISZ DMPSW /INIT UNPACK AND TRACE SWITCH. 254 00207 3061 DCA LIST3+1 /CLEAR SEARCH CHARACTER FOR INPUT. 255 00210 1054 TAD P337 /ANNOUNCE PRESENCE 256 00211 4512 PRINTC /BY TYPING THE LEAD-IN CHARACTER 257 00212 1074 IBAR, TAD COMBUF /INITIALIZE COMMAND BUFFER 258 00213 3010 DCA AXIN /FOR UNPACKING. 259 00214 3136 DCA XCTIN 260 00215 1074 TAD COMBUF /RUBOUT PROTECTION 261 00216 3153 DCA PACKST 262 00217 4513 IGNOR, READC /READ COMMAND STRING 263 00220 4510 SORTJ 264 00221 0053 LIST6-1 265 00222 0510 INLIST-LIST6 266 00223 4507 PACKC /SAVE STRING CHARACTER. 267 00224 5217 JMP IGNOR 268 ///// 269 00225 4000 P4000, 4000 /LINE NUMBER TEST 270 00226 2612 COMBOT, COMOUT+12 /END OF COMMAND BUFFER,LESS PROTECTION COUNT. 271 00227 1575 CFRSX, FLTZER /POINTER FOR PC=COMMAND OR INPUT 272 ///// 273 /COMMAND/INPUT PROCESSOR 274 275 00230 4507 IRETN, PACKC /START TO PACK C.R. 276 00231 4507 PACKC /FINISH C.R. 277 00232 1074 TAD COMBUF /INITIALIZE "TEXTP" 278 00233 3017 GONE, DCA AXOUT /SETUP CURRENT LINE 279 00234 3020 DCA XCT 280 00235 4506 GETC /READ FIRST CHARACTER. 281 00236 1027 TAD BOTTOM /INIT PUSH-DOWN-LIST 282 00237 3013 DCA PDLXR 283 00240 4521 SPNOR /IGNORE LEADING BLANKS 284 00241 4522 TESTN /DOES THE LINE BEGIN WITH 1-9? 285 00242 4526 ERROR4 /ILLEGAL GROUP ZERO USAGE 286 00243 5274 JMP INPUTX /NO 287 00244 6002 IOF /YES,STOP INPUT MOMENTARILY. 288 00245 2151 ISZ DEBGSW /DISABLE TRACE FOR REPACKING 289 00246 4515 GETLN /READ THIS LINE NUMBER 290 00247 1141 TAD NAGSW 291 00250 1225 TAD P4000 /TEST FOR SINGLE LINE 292 00251 7640 SZA CLA 293 00252 4526 ERROR3 /ILLEGAL LINE NUMBER ON INPUT 294 00253 1134 TAD BUFR /SET POINTERS 295 00254 3010 DCA AXIN 296 00255 3136 DCA XCTIN 297 00256 1143 TAD LINENO /SAVE LINE # 298 00257 3410 DCA I AXIN /(X-MEM) 299 00260 4521 SPNOR /IGNORE SPACES AFTER LINE NUMBER 300 00261 7410 SKP 301 00262 4506 GETC /READ 1ST AFTER LINENO TERMINATOR. 302 00263 4507 PACKC /SAVE TEXT AND RESTORE DATA FIELD 303 00264 1142 TAD CHAR /TEST FOR END OF INPUT STRING 304 00265 1065 TAD MCR 305 00266 7640 SZA CLA 306 00267 5262 JMP .-5 307 00270 4501 PUSHJ /REMOVE OLD LINE, IF ANY. 308 00271 2111 DELETE 309 00272 4517 ENDLN /INSERT NEW LINE 310 00273 5177 JMP START 311 ///// 312 00274 4501 INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND. 313 00275 0616 PROC 314 00276 1545 TAD I PC /CHECK NEXT LINE (X-MEM) 315 00277 7450 SNA /END OF PROGRAM? 316 00300 5177 JMP START /YES 317 00301 3145 DCA PC /SAVE NEW LINE NO. 318 00302 1145 TAD PC /START NEW LINE 319 00303 7001 IAC 320 00304 5233 JMP GONE /PROCESS OTHER COMMANDS 321 /TEXT LINE BUFFER FORMAT* 322 /#1 : POINTER OR ZERO IN LAST 323 /#2 : LINENO 324 /#3 - #N+1 : TEXT 325 /#N : C.R. 326 327 00305 0000 XRTL6, 0 /ROTATE AC LEFT 6 328 00306 7106 CLL RTL 329 00307 7006 RTL 330 00310 7006 RTL 331 00311 5705 JMP I XRTL6 332 / 333 /PROCESS A LINE NUMBER - "GETLN" 334 00312 0000 XGETLN, 0 335 00313 4521 SPNOR 336 00314 1225 TAD P4000 /INITIALIZE TO SINGLE LINE 337 00315 3141 DCA NAGSW 338 00316 4511 SORTC /TEST FOR A SIGN 339 00317 6114 SNLIST-1 340 00320 5370 JMP EVLN /EVALUATE IN FLOATING POINT 341 00321 4766 JMS I INPINT /FIXED POINT: GET GROUP 342 00322 4522 TESTN 343 00323 4506 GETC /GO PAST . IF THERE 344 00324 4356 JMS GEG /GET 1ST STEP DIGIT 345 00325 7106 CLL RTL /MULTIPLY BY TEN 346 00326 1127 TAD SORTCN 347 00327 7004 RAL 348 00330 4356 JMS GEG /GET 2ND STEP DIGIT 349 00331 1143 TAD LINENO /COMBINE 350 00332 7450 GEXIT, SNA 351 00333 3141 DCA NAGSW /MUST BE GROUP 352 00334 3143 DCA LINENO /SAVE STEP NUMBER 353 00335 1164 TAD DECNUM /GROUP 354 00336 7450 SNA 355 00337 5347 JMP GTESTA /GROUP 0: MUST BE "ALL" 356 00340 4520 RTL6 /CONSTRUCT LINE NUMBER 357 00341 7004 RAL 358 00342 1143 TAD LINENO 359 00343 3143 DCA LINENO 360 00344 1164 TAD DECNUM /TEST FOR LEGAL GROUP 361 00345 0367 AND C7760 362 00346 5351 JMP .+3 363 00347 2141 GTESTA, ISZ NAGSW /SET TO "ALL" 364 00350 1143 TAD LINENO /MAKE SURE LINE # IS ZERO 365 00351 7650 SNA CLA 366 00352 4522 TESTN /OK, TEST FOR EXTRA DIGITS 367 00353 5361 JMP LNERR /DOUBLE ., ILLEGAL G. 0, OR G.>15 368 00354 5712 JMP I XGETLN /OK 369 00355 5361 JMP LNERR /TOO MANY DIGITS 370 371 00356 0000 GEG, 0 /GET A STEP DIGIT 372 00357 3143 DCA LINENO 373 00360 4522 TESTN 374 00361 4526 LNERR, ERROR /DOUBLE PERIODS 375 00362 5331 JMP GEXIT-1 /NO DIGIT 376 00363 4506 GETC /DIGIT, PASS IT 377 00364 1127 TAD SORTCN /EXIT WITH VALUE 378 00365 5756 JMP I GEG 379 ///// 380 00366 6010 INPINT, DECINT 381 00367 7760 C7760, 7760 382 ///// 383 /EVALUATE A LINE NUMBER IN FLOATING POINT 384 00370 4501 EVLN, PUSHJ /GET VALUE 385 00371 1601 EVAL 386 00372 4452 FIX /GET GROUP # 387 00373 4503 PUSHA 388 00374 1045 TAD FLAC1 389 00375 7640 SZA CLA 390 00376 5361 JMP LNERR /TOO BIG 391 00377 4407 FENT /GET STEP # 392 00400 7000 FNR 393 00401 2560 FSB I FLARGP /THIS GIVES -(FRACTIONAL PART) 394 00402 3614 FMY I F10P 395 00403 3614 FMY I F10P 396 00404 2615 FSB I FP10P /KILL ANY ROUNDOFF ERROR 397 00405 0000 FEXT 398 00406 4450 NEGATE 399 00407 1413 POPA /RESTORE GROUP 400 00410 3164 DCA DECNUM 401 00411 4452 FIX 402 00412 5613 JMP I .+1 403 00413 0332 GEXIT 404 ///// 405 00414 5770 F10P, FLTEN 406 00415 5773 FP10P, FLPTEN 407 408 /RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 15.99 409 410 /NAGSW: 411 /GROUP=0000 412 /LINE=4000 413 /ALL=0001 414 /RECURSIVE OPERATE, EXECUTE, OR CALL 415 416 00416 4515 DO, GETLN /EXECUTE ONE LINE, A GROUP,OR ALL 417 00417 1145 TAD PC /SAVE ADDRESS 418 00420 4503 PUSHA /OF CURRENT LINE 419 00421 4504 PUSHF /SAVE REST OF THIS LINE 420 00422 0017 TEXTP /ADDRESS OF TEXT POINTERS 421 00423 4504 DGRP, PUSHF /SAVE NAGSW; CHAR; AND LINENO. 422 00424 0141 NAGSW 423 00425 1141 TAD NAGSW /CHECK DATA FROM GETLN. 424 00426 7710 SPA CLA /SKIP IF GROUP OR ALL 425 00427 5254 JMP DOONE /DO ONE LINE 426 00430 4516 FINDLN /INIT FOR GROUP AND SET THISLN 427 00431 5273 JMP TGRP2 428 00432 4501 DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC. 429 00433 0613 PROCESS-2 430 00434 4505 POPF /RESTORE THE DATA 431 00435 0141 NAGSW 432 00436 1545 TAD I PC /CHECK FOR END OF TEXT (X-MEM) 433 00437 7450 SNA 434 00440 5262 JMP DCONT /ALL DONE 435 00441 7001 IAC 436 00442 3154 DCA PT1 /SAVE POINTER TO LINENO 437 00443 1141 TAD NAGSW /CHECK FOR GROUP 438 00444 7740 SMA SZA CLA 439 00445 5251 JMP .+4 /DO ALL 440 00446 1554 TAD I PT1 /TEST GROUP (X-MEM) 441 00447 4524 TSTGRP 442 00450 5262 JMP DCONT /NOT IN GROUP 443 00451 1554 TAD I PT1 /READ NEXT LINE NO. (X-MEM) 444 00452 3143 DCA LINENO 445 00453 5223 JMP DGRP /CONTINUE THE SUBROUTINE 446 ///// 447 00454 4516 DOONE, FINDLN /FIND THE LINE 448 00455 4526 ERROR2 /NO SUCH LINE NUMBER 449 00456 4501 PUSHJ /EXECUTE IT 450 00457 0615 PROCESS 451 00460 4505 POPF /RESTORE CHAR 452 00461 0141 NAGSW 453 00462 4505 DCONT, POPF /RESTORE TEXT POINTERS 454 00463 0017 TEXTP 455 00464 1413 POPA /RESTORE ADDRESS OF CURRENT LINE. 456 00465 3145 DCA PC 457 00466 4565 TSTERM /GO TO TERMINATOR 458 00467 5266 JMP .-1 459 00470 5672 JMP I .+2 /END OF DO, CONTINUE PROCESSING 460 00471 5216 JMP DO /COMMA, DO ANOTHER 461 00472 0616 PROC 462 463 00473 1146 TGRP2, TAD THISLN /TEST FOR GOOD GROUP NUMBER. 464 00474 3011 DCA XRT 465 00475 1411 TAD I XRT 466 00476 4524 TSTGRP 467 00477 4526 ERROR2 /NO SUCH GROUP NUMBER 468 00500 5232 JMP DGRP1 469 /PUSHDOWN LIST CONTROLS 470 / 471 00501 0000 XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA" 472 00502 3332 DCA PD2 /SAVE AC 473 00503 7040 CMA /BACK UP POINTER 474 00504 4310 JMS PCHK /CHECK CORE USAGE 475 00505 1332 TAD PD2 476 00506 3416 DCA I XRT3 /SAVE 477 00507 5701 JMP I XPUSHA 478 ///// 479 00510 0000 PCHK, 0 480 00511 1013 TAD PDLXR /INC IN AC 481 00512 3013 DCA PDLXR 482 00513 1013 TAD PDLXR 483 00514 3016 DCA XRT3 /DUPLICATE POINTER 484 00515 1013 TAD PDLXR 485 00516 7141 CLL CIA 486 00517 1155 TAD LASTV 487 00520 7630 SZL CLA 488 00521 4526 ERROR /STORAGE FILLED BY PUSHDOWN LIST 489 00522 5710 JMP I PCHK 490 ///// 491 00523 0000 XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ" 492 00524 7201 CLA IAC 493 00525 1323 TAD XPUSHJ /SAVE RETURN 494 00526 4301 JMS XPUSHA /(PUSHA) 495 00527 1723 TAD I XPUSHJ /TO NEW ROUTINE 496 00530 3323 DCA XPUSHJ 497 00531 5723 JMP I XPUSHJ 498 ///// 499 00532 0000 PD2, 0 /SAVE A FLOATING PT NUMBER - "PUSHF" 500 00533 7240 CLA CMA /COMPUTE ADDRESS 501 00534 1732 TAD I PD2 502 00535 3011 DCA XRT 503 00536 2332 ISZ PD2 504 00537 1066 TAD M3 /BACKUP THREE 505 00540 4310 JMS PCHK 506 00541 1411 TAD I XRT /SAVE 3 WORDS 507 00542 3416 DCA I XRT3 508 00543 1411 TAD I XRT 509 00544 3416 DCA I XRT3 510 00545 1411 TAD I XRT 511 00546 3416 DCA I XRT3 512 00547 5732 JMP I PD2 513 514 00550 0000 PD3, 0 /RESTORE A FLOATING PT # - "POPF" 515 00551 7240 CLA CMA 516 00552 1750 TAD I PD3 517 00553 2350 ISZ PD3 518 00554 3011 DCA XRT 519 00555 1413 TAD I PDLXR 520 00556 3411 DCA I XRT 521 00557 1413 TAD I PDLXR 522 00560 3411 DCA I XRT 523 00561 1413 TAD I PDLXR 524 00562 3411 DCA I XRT 525 00563 5750 JMP I PD3 526 / 527 /INPUT CONTROL CHARACTERS 528 00564 0212 INLIST, IBAR /B.A.=RESTART 529 00565 0223 IGNOR+4 /F.F. 530 00566 0223 IGNOR+4 /BELL 531 00567 0217 IGNOR /L.F.=IGNORED 532 00570 0230 IRETN /C.R.=TERMINATE INPUT 533 / 534 /LIST OF FUNCTION ADDRESSES 535 00571 2053 FNTABF, XABS /ABSOLUTE VALUE 536 00572 7535 FSGN /SIGN PART 537 00573 1156 XINT /INTEGER PART 538 00574 1145 XDYS /FDIS- DISPLAY Y AND INTENSIFY 539 00575 7351 FRAN /RANDOM NUMBER 540 00576 1153 XDXS /SET X-COORDINATE FOR DISPLAY 541 00577 2414 XADC /READ ANALOG-DIGITAL CONVERTER 542 00600 2735 ERROR5 /ATN THESE ROUTINES NOT IN PACKAGE 543 00601 2735 ERROR5 /EXP 544 00602 2735 ERROR5 /LOG 545 00603 2735 ERROR5 /SIN 546 00604 2735 ERROR5 /COS 547 00605 7462 FSQT /SQUARE ROOT 548 00606 2735 ERROR5 /NEW- USER-DEFINED FUNCTION 549 / 550 00607 7472 MF, -306 /USED BY TESTC 551 /PRIMARY CONTROL AND TRANSFER 552 553 00610 4515 GOTO, GETLN /READ THE LINE NUMBER REQUESTED 554 00611 4516 FINDLN /LOCATE IT AND RESET TEXTP 555 00612 4526 ERROR2 /NOT THERE OR A TIGHT LOOP. 556 00613 1146 TAD THISLN /SET PC 557 00614 3145 DCA PC 558 00615 4506 PROCESS,GETC /TEST FOR END OF LINE 559 00616 4511 PROC, SORTC /FIRST CHARACTER READY = USE PROC 560 00617 0057 CCR-1 561 00620 5502 PC1, POPJ /EXIT "PROCESS" 562 00621 4511 SORTC /IGNORE SPACE ; , 563 00622 1140 GLIST-1 564 00623 5215 JMP PROCESS 565 00624 1142 TAD CHAR /SAVE COMMAND CHARACTER 566 00625 4503 PUSHA 567 00626 4506 GETC /GO TO TERMINATOR 568 00627 4511 SORTC 569 00630 2002 TERMS-4 570 00631 7410 SKP 571 00632 5226 JMP .-4 572 00633 4521 SPNOR 573 00634 1413 POPA 574 00635 4510 SORTJ /GO DO COMMAND 575 00636 0755 COMLST-1 576 00637 0206 COMGO-COMLST 577 00640 4526 ERROR2 /ILLEGAL COMMAND 578 ///// 579 580 COMMENTS=PC1 /ALSO IS CONTINUE 581 582 /OUTPUT COMMAND TEXT 583 584 00641 4711 WRITE, JMS I WTXS /SAVE CHAR AND TEXT POINTERS 585 00642 4515 GETLN /SET LINENO 586 00643 2151 ISZ DEBGSW /DISABLE TRACE 587 00644 4516 FINDLN /SEARCH FOR LINE NUMBER 588 00645 5274 JMP WTESTG /NOT THERE OR GROUP 589 00646 1143 TAD LINENO 590 00647 7640 SZA CLA 591 00650 4514 PRNTLN /PRINT LINE NUMBER AND A SPACE. 592 00651 4506 GETC 593 00652 4512 PRINTC /PRINT TEXT OF A LINE. 594 00653 1142 TAD CHAR 595 00654 1065 TAD MCR 596 00655 7640 SZA CLA /SKIP IF END OF LINE 597 00656 5251 JMP .-5 598 00657 1546 TAD I THISLN /TEST FOR END OF TEXT (X-MEM) 599 00660 7450 WTEST2, SNA 600 00661 5303 JMP WEXIT /WRITE FINISHED 601 00662 7001 IAC 602 00663 3154 DCA PT1 /SAVE POINTER TO LINENO OF`NEXT (X-MEM) 603 00664 1141 TAD NAGSW 604 00665 7700 SMA CLA 605 00666 1554 TAD I PT1 /(X-MEM) 606 00667 4524 TSTGRP /TRY NEXT LINENO FOR GROUP. 607 00670 5276 JMP WX 608 00671 1554 WALL, TAD I PT1 /SET LINENO (X-MEM) 609 00672 3143 DCA LINENO 610 00673 5244 JMP WRITE+3 611 /// 612 00674 1146 WTESTG, TAD THISLN /INIT GROUP PRINTOUT 613 00675 5260 JMP WTEST2 614 ///// 615 00676 1141 WX, TAD NAGSW 616 00677 7750 SPA SNA CLA /SKIP IF ALL 617 00700 5303 JMP WEXIT 618 00701 4512 PRINTC /PRINT C.R. AGAIN 619 00702 5271 JMP WALL 620 ///// 621 00703 4712 WEXIT, JMS I WTXR /RESTORE CURRENT LINE 622 00704 3151 DCA DEBGSW /RESTORE TRACE 623 00705 4565 TSTERM 624 00706 5305 JMP .-1 625 00707 5216 JMP PROC /END OF WRITE 626 00710 5241 JMP WRITE /COMMA, MORE TO WRITE 627 ///// 628 00711 2435 WTXS, TXTSAV 629 00712 2443 WTXR, TXTRES 630 631 00713 0000 XTESTC, 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC" 632 00714 4521 SPNOR /IGNORE SPACES 633 00715 4511 SORTC /TEST THE VARIABLE TERMINATORS 634 00716 2005 TERMS-1 635 00717 5713 JMP I XTESTC /YES - SORTCN IS SET 636 00720 2313 ISZ XTESTC 637 00721 4522 TESTN 638 00722 5713 JMP I XTESTC /. (PART OF NUMBER) 639 00723 7410 SKP /OTHER 640 00724 5713 JMP I XTESTC /NUMBER 641 00725 1142 TAD CHAR /TEST FOR "F" 642 00726 1207 TAD MF 643 00727 7640 SZA CLA 644 00730 2313 ISZ XTESTC /NO 645 00731 2313 ISZ XTESTC /RETURNS: 646 00732 5713 JMP I XTESTC /TERMINATOR;NUMBER;FUNCTION;OTHER 647 ///// 648 00733 0000 XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORTC" 649 00734 1733 TAD I XSORTC 650 00735 3012 DCA XRT2 /1ST ARG IS LIST-1 651 00736 1412 TAD I XRT2 652 00737 7510 SPA /LIST IS ENDED BY A NEGATIVE NUMBER 653 00740 5352 JMP SEXC /2AND EXIT = NOT IN LIST 654 00741 7041 CIA 655 00742 1142 TAD CHAR 656 00743 7640 SZA CLA /COMPARE 657 00744 5336 JMP .-6 658 00745 1733 TAD I XSORTC /COMPUTE INCREMENT : 0 - N 659 00746 7040 CMA 660 00747 1012 TAD XRT2 661 00750 3127 DCA SORTCN 662 00751 7410 SKP /1ST EXIT = YES 663 00752 2333 SEXC, ISZ XSORTC 664 00753 2333 ISZ XSORTC 665 00754 7300 CLA CLL 666 00755 5733 JMP I XSORTC 667 668 /COMMAND DECODING LIST 669 00756 0323 COMLST, 323 /SET 670 00757 0306 306 /FOR 671 00760 0311 311 /IF 672 00761 0304 304 /DO 673 00762 0307 307 /GOTO 674 00763 0303 303 /COMMENT OR CONTINUE 675 00764 0301 301 /ASK 676 00765 0324 324 /TYPE 677 00766 0314 314 /LIBRARY 678 00767 0305 305 /ERASE 679 00770 0327 327 /WRITE 680 00771 0315 315 /MODIFY 681 00772 0321 321 /QUIT 682 00773 0322 322 /RETURN 683 00774 0317 317 /OPTION 684 00775 0310 310 /HELLO 685 /CONDITIONAL TRANSFER PROCESS 686 / IF (EXP) A,B,C 687 00776 4511 IF, SORTC /LOOK FOR L-PAR 688 00777 1022 PLPR-1 689 01000 7410 SKP 690 01001 4526 ERROR /NO ( AFTER IF 691 01002 4501 PUSHJ /EVALUATE EXPRESSION 692 01003 1600 EVAL-1 693 01004 4506 GETC /PASS ) 694 01005 1045 TAD FLAC1 /TEST FOR -,0,+ 695 01006 7710 SPA CLA 696 01007 5622 JMP I PGOTO /NEGATIVE, USE 1ST REF 697 01010 4565 TSTERM /0 OR POS, GET TO NEXT 698 01011 5210 JMP .-1 699 01012 5703 JMP I PRCP /; OR CR, CONTINUE SAME LINE 700 01013 1045 TAD FLAC1 /COMMA, SEE IF 0 OR POS 701 01014 7650 SNA CLA 702 01015 5622 JMP I PGOTO /ZERO, USE 2ND REF 703 01016 4565 TSTERM /POSITIVE, GET TO NEXT 704 01017 5216 JMP .-1 705 01020 5703 JMP I PRCP /; OR CR 706 01021 5622 JMP I PGOTO /COMMA, USE 3RD REF 707 01022 0610 PGOTO, GOTO 708 01023 0250 PLPR, 250 709 /ASSIGNMENT AND LOOP CONTROL 710 SET=. 711 01024 4501 FOR, PUSHJ /GET POINTER TO VAR. 712 01025 1404 GETARG 713 01026 4521 SPNOR 714 01027 4511 SORTC /SEARCH FOR = 715 01030 2024 TERMS+17-1 716 01031 7410 SKP 717 01032 4526 ERROR /LEFT OF = IN ERROR: "FOR" OR "SET" 718 01033 1154 TAD PT1 /SAVE VARIABLE POINTER 719 01034 3332 DCA PT2 720 01035 4501 PUSHJ /EVALUATE INITIAL EXPRESSION 721 01036 1600 EVAL-1 722 01037 4407 FENT /SAVE INITIAL VALUE 723 01040 6732 FPT I PT2 724 01041 0000 FEXT 725 01042 4565 TSTERM /CHECK TERMINATOR 726 01043 4526 ERROR /PROBABLY EXCESS R-PAR 727 01044 5703 JMP I PRCP /; OR CR: THIS IS A SET; CONTINUE 728 01045 1332 TAD PT2 /COMMA, SAVE LOOP VAR POINTER 729 01046 4503 PUSHA 730 01047 4501 PUSHJ /EVALUATE SECOND EXPRESSION 731 01050 1601 EVAL 732 01051 4565 TSTERM /CHECK TERMINATOR 733 01052 4526 ERROR /EXCESS R-PAR OR BAD TERMINATOR 734 01053 5317 JMP ONEINC /; OR CR, THAT'S ALL (INC=1) 735 01054 4504 PUSHF /COMMA, SAVE INCREMENT 736 01055 2034 FLARG 737 01056 4501 PUSHJ /EVALUATE FINAL EXPRESSION 738 01057 1601 EVAL 739 01060 4504 SFINAL, PUSHF /SAVE FINAL VALUE 740 01061 2034 FLARG 741 01062 4724 JMS I FTXS /SAVE CHAR AND TEXT POINTERS 742 01063 4430 FLOAT /FLOAT A ZERO TO START 743 01064 4407 FCONT, FENT /COMPARE LOOP VAR TO FINAL 744 01065 1732 FAD I PT2 /LOOP VAR 745 01066 6732 FPT I PT2 746 01067 2560 FSB I FLARGP /FINAL 747 01070 0000 FEXT 748 01071 1013 TAD PDLXR /CHECK SIGN OF INCREMENT 749 01072 1322 TAD PINC 750 01073 3332 DCA PT2 751 01074 1732 TAD I PT2 752 01075 7710 SPA CLA 753 01076 4450 NEGATE /BACKWARD COUNTING 754 01077 1045 TAD FLAC1 755 01100 7740 SMA SZA CLA 756 01101 5326 JMP FEND /LIMIT REACHED OR EXCEEDED 757 758 01102 4501 PUSHJ /NOT YET, DO OBJECT STATEMENTS 759 01103 0616 PRCP, PROC 760 01104 4725 JMS I FTXR /RESET TO BEGINNING OF OBJ. STMT. 761 01105 4505 POPF /RESTORE LIMIT 762 01106 2034 FLARG 763 01107 4505 POPF /RESTORE INC 764 01110 0044 FLAC 765 01111 1413 POPA /RESTORE LOOP VAR POINTER 766 01112 3332 DCA PT2 767 01113 1323 TAD M13 /PUSH DOWN ALL OF ABOVE 768 01114 1013 TAD PDLXR 769 01115 3013 DCA PDLXR 770 01116 5264 JMP FCONT 771 ///// 772 01117 4504 ONEINC, PUSHF /NO INCREMENT GIVEN, SET TO 1 773 01120 1573 FLTONE 774 01121 5260 JMP SFINAL 775 ///// 776 01122 0011 PINC, 11 777 01123 7765 M13, -13 778 01124 2435 FTXS, TXTSAV 779 01125 2443 FTXR, TXTRES 780 01126 1005 FEND, TAD P13 /END OF LOOP 781 01127 1013 TAD PDLXR /REMOVE VALUES!FROM PUSHDOWN LIST 782 01130 3013 DCA PDLXR 783 01131 5502 POPJ 784 01132 0000 PT2, 0 785 ///// 786 /ASK/TYPE SPECIAL CHARACTERS 787 01133 0246 ALIST, 246 /& 788 01134 0245 245 /% 789 01135 0242 242 /" 790 01136 0241 241 /! 791 01137 0243 243 /# 792 01140 0244 244 /$ 793 01141 0240 GLIST, 240 /SPACE 794 01142 0254 TLIST, 254 /, 795 01143 0273 273 /; 796 01144 0215 215 /C.R. 797 /SET Y AND INTENSIFY THE POINT 798 01145 4452 XDYS, FIX 799 01146 6063 6063 /DYL 800 01147 7200 CLA 801 01150 1361 TAD X0 802 01151 6053 6053 /DXL DIX 803 01152 7410 SKP 804 / 805 /SET X 806 01153 4452 XDXS, FIX 807 01154 3361 DCA X0 /(DXL) 808 01155 5500 RETURN 809 / 810 /TAKE THE INTEGER PART 811 01156 4452 XINT, FIX 812 01157 7200 CLA 813 01160 5500 RETURN 814 01161 0000 X0, 0 815 ///// 816 01162 1252 TLIST3, TASK4 /" 817 01163 1210 TASK /C.R. - AUTOMATIC QUOTE MATCH 818 /COMMAND POINTERS 819 01164 1024 COMGO, SET 820 01165 1024 FOR 821 01166 0776 IF 822 01167 0416 DO 823 01170 0610 GOTO 824 01171 0620 COMMENTS 825 01172 1206 ASK 826 01173 1207 TYPE 827 01174 2735 LIBRARY 828 01175 2226 ERASE 829 01176 0641 WRITE 830 01177 1273 MODIFY 831 01200 0177 START 832 01201 1554 RETRN 833 01202 6446 OPTION 834 01203 3274 HELLO 835 ///// 836 01204 3040 PACLS2, PQUES 837 01205 3065 RUB1 838 /INPUT-OUTPUT STATEMENTS 839 840 01206 7240 ASK, CLA CMA /REMEMBER WHICH CALL. 841 01207 3131 TYPE, DCA ATSW 842 01210 3151 TASK, DCA DEBGSW /RE-ENABLE THE TRACE 843 01211 4510 SORTJ /SPECIAL CHARACTER? 844 01212 1132 ALIST-1 845 01213 0426 ATLIST-ALIST 846 01214 2131 ISZ ATSW /TEST QUOTE SWITCH 847 01215 5227 JMP TYPE2 848 01216 4501 PUSHJ /DO ASK; SETUP PT1 849 01217 1404 GETARG 850 01220 4636 JMS I TTXTS /PROTECT TEXT 851 01221 1233 TAD COL /TYPE COLON 852 01222 4512 TASKCL, PRINTC /(CLA) TO SUPPRESS ":" 853 01223 4626 JMS I INTERP /CALL INPUT CONVERSION ROUTINE 854 01224 4637 JMS I TTXTR /RESTORE TEXT 855 01225 5206 JMP ASK /CONTINUE PROCESSING 856 01226 3306 INTERP, INTASK 857 //// 858 01227 4501 TYPE2, PUSHJ /DO TYPE 859 01230 1601 EVAL 860 01231 4565 TSTERM 861 01232 4526 ERROR /BAD TERMINATOR IN "TYPE" 862 01233 0272 COL, 272 863 01234 4640 JMS I OUTS /PRINT 864 01235 5207 JMP TYPE 865 ///// 866 01236 2435 TTXTS, TXTSAV 867 01237 2443 TTXTR, TXTRES 868 01240 3365 OUTS, OUTPT 869 870 01241 2151 TQUOT, ISZ DEBGSW /DISABLE TRACE 871 01242 4506 GETC /TYPE LITERALS 872 01243 4510 SORTJ 873 01244 1404 TLIST2-1 874 01245 7555 TLIST3-TLIST2 875 01246 4512 PRINTC 876 01247 5242 JMP TQUOT+1 877 ////// 878 01250 1060 TCRLF, TAD CCR /SLASH=CR,LF. 879 01251 4512 PRINTC 880 01252 4506 TASK4, GETC /MOVE TO NEXT CHARACTER 881 01253 5210 JMP TASK 882 //// 883 01254 1060 TCRLF2, TAD CCR /SPLAT=CR 884 01255 4537 JMS I OUTDEV 885 01256 1015 TAD C200 /DELAY FOR C.R. 886 01257 5251 JMP TCRLF+1 887 888 /IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW" 889 / #0: DISABLE AND RETURN ALL"?" ' S. 890 /IF DMPSW = 0: TRACE ON, IF ENABLED 891 / #0: TRACE OFF 892 /IF BOTH = 0 : PRINT TRACE. 893 894 895 01260 4506 TINTR, GETC /PASS PERCENT SIGN 896 01261 4672 JMS I INTG /READ FORMAT CONTROL: "%7.3" 897 01262 1164 TAD DECNUM /INTEGER PART (TOTAL DIGITS) 898 01263 3051 DCA TOTDIG 899 01264 4522 TESTN /GET PAST . IF ANY 900 01265 4506 GETC 901 01266 4672 JMS I INTG /RIGHT-HAND PART (DECIMAL PLACES) 902 01267 1164 TAD DECNUM 903 01270 3133 DCA DECP 904 01271 5210 JMP TASK 905 01272 6010 INTG, DECINT 906 /SEARCH ROUTINES 907 908 01273 4515 MODIFY, GETLN /READ LINE NO. 909 01274 4516 FINDLN /LOOK IT UP NOW. 910 01275 4526 ERROR2 /NOT THERE = BAD COMMAND UNLESS ZERO. 911 01276 1134 TAD BUFR /SET POINTERS 912 01277 3010 DCA AXIN /FOR INPUT 913 01300 3136 DCA XCTIN 914 01301 1143 TAD LINENO /COPY THE SAME LINE NUMBER. 915 01302 7450 SNA /CHECK FOR ALL 916 01303 5275 JMP MODIFY+2 /ERROR IN ARG 917 01304 3410 DCA I AXIN /(X-MEM) 918 01305 1010 TAD AXIN /SAVE START OF NEW LINE 919 01306 3153 DCA PACKST 920 01307 4540 SCONT, JMS I INDEV /READ THE TELETYPE INPUT SILENTLY. 921 01310 3061 DCA LIST3+1 /SAVE SEARCH CHARACTER 922 01311 2151 ISZ DEBGSW /NO BREAKS. 923 01312 4506 SCHAR, GETC /TYPE+TEST-F.F. 924 01313 4512 PRINTC 925 01314 4510 SORTJ /LOOK FOR MATCH 926 01315 0057 LIST3-1 927 01316 1322 LISTGO-LIST3 928 01317 4507 PACKC /SAVE NEW LINE. 929 01320 5312 JMP SCHAR 930 ///// 931 01321 1134 SBAR, TAD BUFR /RESTART-B.A. 932 01322 7001 IAC 933 01323 3010 DCA AXIN /SET POINTERS 934 01324 3136 DCA XCTIN 935 01325 4513 SFOUND, READC /READ FROM KEYBOARD 936 01326 4510 SORTJ /TEST 937 01327 0053 LIST6-1 938 01330 1322 SRNLST-LIST6 939 01331 4507 SGOT, PACKC /PACK CHAR. 940 01332 5325 JMP SFOUND /MORE 941 942 01333 0000 SORTB, 0 /SORT AND BRANCH ROUTINE. - "SORTJ" 943 01334 7450 SNA 944 01335 1142 TAD CHAR /ASSUME CHAR IF AC=0 945 01336 7041 CIA 946 01337 3157 DCA T2 /SAVE SORT ITEM 947 01340 1733 TAD I SORTB /FIRST ARG IS LIST LESS ONE 948 01341 2333 ISZ SORTB /2AND IS INTRA-LIST LENGTH 949 01342 3012 DCA XRT2 950 01343 1412 TAD I XRT2 951 01344 7510 SPA /**LISTS ENDED BY NEGATIVE NUMBERS** 952 01345 5357 JMP SEX /READ EXIT 953 01346 1157 TAD T2 /FIND ADDRESS 954 01347 7640 SZA CLA 955 01350 5343 JMP .-5 956 01351 1012 TAD XRT2 /MATCH FOUND. 957 01352 1733 TAD I SORTB 958 01353 3333 DCA SORTB /SETUP RETURN 959 01354 1733 TAD I SORTB 960 01355 3333 DCA SORTB 961 01356 7410 SKP 962 01357 2333 SEX, ISZ SORTB /MATCH NOT FOUND. 963 01360 7300 CLA CLL 964 01361 5733 JMP I SORTB /RETURN TO CALLING SEQUENCE. 965 966 01362 4501 TAB, PUSHJ /TABULATE TO A PARTICULAR COLUMN 967 01363 1600 EVAL-1 968 01364 4452 FIX /GET COLUMN NUMBER 969 01365 7141 CLL CIA 970 01366 7001 IAC 971 01367 1053 TAD TABCTR 972 01370 7630 SZL CLA 973 01371 5210 JMP TASK /ALREADY THERE OR PAST IT 974 01372 1033 TAD C240 975 01373 4512 PRINTC 976 01374 1046 TAD FLAC2 /TEST AGAIN 977 01375 5365 JMP TAB+3 978 SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE 979 01376 1321 SBAR /B.A. = RESTART 980 01377 1312 SCHAR /F.F. = CONTINUE 981 01400 1307 SCONT /BELL = CHANGE SEARCH CHARACTER 982 01401 1310 SCONT+1 /L.F. = FINISH THE LINE AS BEFORE. 983 ///// 984 01402 0263 LISTGO, INPUTX-11 /C.R. - END THE MODIFIED LINE HERE 985 01403 1331 SGOT /FOUND SEARCH CHARACTER 986 /FIND OR ENTER A VARIABLE IN THE LIST. 987 988 01404 4525 GETARG, TESTC /FIRST LETTER OF ARG 989 01405 0242 TLIST2, 0242 /" 990 01406 0215 0215 /C.R. - FUNCTION OR NUMBER IS NOT AN ARG. 991 01407 4526 ERROR4 /BAD ARGUEMENT IN 'FOR' 'SET', OR 'ASK' 992 01410 7240 CLA CMA /"GETARG" CAN CREATE NEW VAR. 993 01411 4503 GETVAR, PUSHA /"GETVAR" WILL NOT 994 01412 3136 DCA XCTIN /PACK INTO ADD. 995 01413 4507 PACKC 996 01414 4506 GETC /SECOND LETTER 997 01415 4511 SORTC /TERMINATOR? 998 01416 2005 TERMS-1 999 01417 5222 JMP .+3 /YES 1000 01420 1142 TAD CHAR /NO 1001 01421 0071 AND P77 /SAVE 2AND LETTER OF NAME 1002 01422 1135 TAD ADD 1003 01423 4503 PUSHA 1004 01424 4511 SORTC /IGNORE THE REST 1005 01425 2005 TERMS-1 1006 01426 5231 JMP .+3 1007 01427 4506 GETC 1008 01430 5224 JMP .-4 1009 01431 4523 TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN 1010 01432 5243 JMP GS1 /NOT SUBSCRIPTED BY L-PAR. 1011 01433 1130 TAD LASTOP /SAVE LAST OPERATION 1012 01434 4503 PUSHA 1013 01435 4501 PUSHJ /MOVE PAST L-PAR AND 1014 01436 1600 EVAL-1 /EVALUATE THE SUBSCRIPT. 1015 01437 4506 GETC /MOVE PAST R-PAR 1016 01440 1413 POPA 1017 01441 3130 DCA LASTOP /RECALL LAST OPERATION 1018 01442 4452 FIX 1019 01443 3324 GS1, DCA SUBS /SAVE SUBSCRIPT 1020 01444 1413 POPA 1021 01445 3135 DCA ADD /RESTORE NAME 1022 01446 1134 TAD STARTV /SEARCH FOR VARIABLE 1023 01447 3154 GS3, DCA PT1 1024 01450 1154 TAD PT1 1025 01451 3011 DCA XRT 1026 01452 1154 TAD PT1 1027 01453 7041 CIA 1028 01454 1155 TAD LASTV /TEST FOR END OF LIST 1029 01455 7750 SPA SNA CLA 1030 01456 5267 JMP GS2 /END SEARCH 1031 01457 1554 TAD I PT1 /GET TABLE ENTRY 1032 01460 7041 CIA 1033 01461 1135 TAD ADD 1034 01462 7650 SNA CLA 1035 01463 5312 JMP GFND1 /FOUND XX 1036 1037 01464 1154 GS4, TAD PT1 /TRY NEXT ONE 1038 01465 1144 TAD GINC 1039 01466 5247 JMP GS3 1040 01467 2413 GS2, ISZ I PDLXR /VAR. NOT FOUND, CAN I MAKE ONE? 1041 01470 4526 ERROR /UNDEFINED VAR. USED IN EXPRESSION 1042 01471 1155 TAD LASTV /OK, ADD THE VARIABLE 1043 01472 1005 TAD P13 /TEST STORAGE LIMITS 1044 01473 7141 CIA CLL 1045 01474 1013 TAD PDLXR 1046 01475 7620 SNL CLA 1047 01476 4526 ERROR3 1048 01477 1155 TAD LASTV /UPDATE THE LIST. 1049 01500 1144 TAD GINC 1050 01501 3155 DCA LASTV 1051 01502 1135 TAD ADD /SAVE NAME 1052 01503 3554 DCA I PT1 1053 01504 1324 TAD SUBS /SAVE SUBSCRIPT 1054 01505 3411 DCA I XRT 1055 01506 3411 DCA I XRT /INITIALIZE VAR. TO ZERO 1056 01507 3411 DCA I XRT 1057 01510 3411 DCA I XRT 1058 01511 5320 JMP GS5 /EXIT 1059 ///// 1060 01512 1411 GFND1, TAD I XRT /FOUND NAME, TEST SUBSCRIPT 1061 01513 7041 CIA 1062 01514 1324 TAD SUBS 1063 01515 7640 SZA CLA 1064 01516 5264 JMP GS4 /WRONG SUBSCRIPT 1065 01517 2013 ISZ PDLXR 1066 01520 2154 GS5, ISZ PT1 /SET POINTER TO DATA 1067 01521 2154 ISZ PT1 1068 01522 5502 POPJ 1069 //// 1070 01523 1575 P0, FLTZER 1071 1072 /IGNORE LEADING SPACES - "SPNOR" 1073 1074 SUBS=. 1075 01524 0000 XSPNOR, 0 1076 01525 1142 TAD CHAR 1077 01526 1063 TAD M240 1078 01527 7640 SZA CLA 1079 01530 5724 JMP I XSPNOR 1080 01531 4506 GETC 1081 01532 5325 JMP XSPNOR+1 1082 ///// 1083 /SEE IF NEXT CHARACTER IS A NUMBER 1084 01533 0000 XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN" 1085 01534 1142 TAD CHAR 1086 01535 1064 TAD MPER /TEST FOR . 1087 01536 7440 SZA 1088 01537 2333 ISZ XTESTN /NOT A . 1089 01540 1352 TAD NTST1 /COMPARE TO "9" 1090 01541 7500 SMA 1091 01542 5350 JMP NTEXIT /TOO LARGE 1092 01543 1353 TAD NTST2 /COMPARE TO "0" 1093 01544 7510 SPA 1094 01545 5350 JMP NTEXIT /TOO SMALL 1095 01546 3127 DCA SORTCN /FOUND DIGIT, SAVE IT 1096 01547 2333 ISZ XTESTN 1097 01550 7300 NTEXIT, CLA CLL 1098 01551 5733 JMP I XTESTN 1099 ///// 1100 01552 7764 NTST1, 256-272 1101 01553 0012 NTST2, 272-260 1102 /EXIT FROM A "DO" SUBROUTINE 1103 1104 1105 01554 1323 RETRN, TAD P0 /(PC) => 0 1106 01555 3145 DCA PC 1107 01556 1413 XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ" 1108 01557 3157 DCA T2 1109 01560 5557 JMP I T2 1110 1111 1112 /ASK-TYPE CONTROL CHARACTER TABLE 1113 01561 1362 ATLIST, TAB /& - TABULATION DELIMITER 1114 01562 1260 TINTR /% - FORMAT DELIMITER 1115 01563 1241 TQUOT /" - LITERAL DELIMITER 1116 01564 1250 TCRLF /! - CARRIAGE RETURN AND LINE FEED 1117 01565 1254 TCRLF2 /# - CARRIAGE RETURN ONLY 1118 01566 3125 TDUMP /$/- DUMP THE SYMBOL TABLE CONTENTS 1119 01567 1252 TASK4 /SP- TERMINATOR FOR NAMES 1120 01570 1252 TASK4 /, - TERMINATOR FOR EXPRESSIONS 1121 01571 0615 PROCESS /; - TERMINATOR FOR COMMANDS 1122 01572 0620 PC1 /C.R. - TERMINATOR FOR STRINGS 1123 ///// 1124 01573 0001 FLTONE, 0001 1125 01574 2000 2000 1126 01575 0000 FLTZER, 0000 1127 01576 0000 0000 1128 01577 0000 0000 1129 /EVALUATE AN EXPRESSION WHICH 1130 /TERMINATES WITH AN R-PAR,; OR C.R. AND 1131 /LEAVE THE RESULT IN FLAC AND IN FLARG. 1132 1133 1134 1135 1136 01600 4506 GETC /MOVE PAST EXTRA CHARACTER 1137 01601 3130 EVAL, DCA LASTOP /EVAUATION CONTROLLER (CHECKPOINT ?) 1138 01602 4525 TESTC /TEST CHARACTER AND IGNORE SPACES 1139 01603 5215 JMP ETERM1 /TERMIOATION 1140 01604 5332 JMP ENUM /NUMBER 1141 01605 5342 JMP EFUN /FUNCTION 1142 01606 4501 PUSHJ /LETTER OF VARIABLE 1143 01607 1411 GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1. 1144 01610 4525 OPNEXT, TESTC /PT1=>ARG 1145 01611 5236 JMP ETERMN /T 1146 01612 0212 ECHOLST,0212 /N-ERROR IN FORMAT 1147 01613 0377 0377 /F 1148 01614 4526 ERROR4 /L - MISSING OPERATOR 1149 ///// 1150 01615 4504 ETERM1, PUSHF /INITIALIZE RESULT TO ZERO. 1151 01616 1575 FLTZER 1152 01617 4505 POPF 1153 01620 2034 FLARG 1154 01621 1160 TAD FLARGP /SET PT1. 1155 01622 3154 DCA PT1 1156 01623 1034 TAD M2 /TEST FOR UNARY OPERATIONS 1157 01624 1127 TAD SORTCN 1158 01625 7450 SNA 1159 01626 5241 JMP ETERM /CREATE DUMMY FOR UNARY MINUS 1160 01627 7001 IAC 1161 01630 7650 SNA CLA 1162 01631 5323 JMP ARGNXT /IGNORE UNARY PLUS 1163 01632 1127 TAD SORTCN /TEST FOR NULL PARENS. 1164 01633 1070 TAD M11 1165 01634 7710 SPA CLA 1166 01635 5353 JMP ELPAR /MIGHT BE AN L-PAR. 1167 01636 4523 ETERMN, TSTLPR 1168 01637 7410 SKP 1169 01640 4526 ERROR4 /OPERATOR MISSING BEFORE PAREN 1170 01641 1127 ETERM, TAD SORTCN /SET FROM "TESTC"-"SORTC" 1171 01642 3147 DCA THISOP 1172 01643 1147 TAD THISOP 1173 01644 1070 TAD M11 1174 01645 7700 SMA CLA /END? 1175 01646 3147 DCA THISOP /"THISOP" EQUIV. TO END OF EXP. 1176 1177 01647 7201 ETERM2, CLA IAC /COMPARE PRIORITIES 1178 01650 0147 AND THISOP /PRIORITIES ARE: (^),(*/),(+-),PUT 1179 01651 1147 TAD THISOP 1180 01652 7041 CIA 1181 01653 3274 DCA FLOPR 1182 01654 7001 IAC 1183 01655 0130 AND LASTOP 1184 01656 1130 TAD LASTOP 1185 01657 1274 TAD FLOPR 1186 01660 7710 SPA CLA 1187 01661 5310 JMP EPAR /CONTINUE 1188 01662 1130 TAD LASTOP /FIND OPERATION FROM TABLE 1189 01663 1331 TAD OPTABL 1190 01664 3274 DCA FLOPR 1191 01665 1674 TAD I FLOPR 1192 01666 3274 DCA FLOPR 1193 01667 1130 TAD LASTOP 1194 01670 7640 SZA CLA /TEST FOR END OF DATA INTO FLOATING AC. 1195 01671 4505 POPF /GET LAST DATA 1196 01672 0044 FLAC 1197 01673 4407 FENT 1198 01674 0000 FLOPR, 00 /(FLOPR I PT1) +-*/^ 1199 01675 6560 FPT I FLARGP /SAVE RESULT 1200 01676 0000 FEXT 1201 01677 1160 TAD FLARGP 1202 01700 3154 DCA PT1 1203 01701 1147 TAD THISOP 1204 01702 1130 TAD LASTOP /=0? 1205 01703 7650 SNA CLA 1206 01704 5502 POPJ /EXIT "EVAL" 1207 01705 1413 POPA /GET PRIOR OP 1208 01706 3130 DCA LASTOP 1209 01707 5247 JMP ETERM2 /COMPARE THIS OP 1210 ///// 1211 01710 4523 EPAR, TSTLPR /TEST FOR SUB-EXPRESSION 1212 01711 7410 SKP 1213 01712 5355 JMP EPAR2 /GO EVALUATE EXPRESSION 1214 01713 1130 TAD LASTOP /CONTINUE READING THE EXPRESSION 1215 01714 4503 PUSHA /SAVE "LASTOP". 1216 01715 1154 TAD PT1 1217 01716 3320 DCA .+2 1218 01717 4504 PUSHF /SAVE LAST ARGUMENT 1219 01720 0000 00 1220 01721 1147 TAD THISOP /MORE TO COME 1221 01722 3130 DCA LASTOP 1222 01723 4506 ARGNXT, GETC /READ 1ST CHAR OF AN ARG. 1223 01724 4525 TESTC /DO SPECIAL CHECK 1224 01725 5353 JMP ELPAR /COULD BE LEFT PAREN 1225 01726 5332 JMP ENUM /N 1226 01727 5342 JMP EFUN /F 1227 01730 5206 JMP OPNEXT-2 /L 1228 01731 2026 OPTABL, OPTABS 1229 ///// 1230 1231 01732 4504 ENUM, PUSHF /TO PROCESS A NUMBER,SAVE AC 1232 01733 0044 FLAC 1233 01734 1160 TAD FLARGP /SET POINTER AS FOR A VARIABLE. 1234 01735 3154 DCA PT1 1235 01736 4473 JMS I FINPUT /READ TEXT NUMBER => (PT1) 1236 01737 4505 POPF /RESTORE THE AC 1237 01740 0044 FLAC 1238 01741 5210 JMP OPNEXT /CONTINUE 1239 ///// 1240 01742 3274 EFUN, DCA FLOPR /SET CODE 1241 01743 4506 GETC /READ FUNCTION NAME.(1,2,OR 3 LETTERS) 1242 01744 4511 SORTC /LOOK FOR TERMINATION CHARACTER. 1243 01745 2005 TERMS-1 1244 01746 5364 JMP EFUN2 /YES 1245 01747 1274 TAD FLOPR /NO 1246 01750 7104 CLL RAL /MISH-MASH HASH CODE 1247 01751 1142 TAD CHAR 1248 01752 5342 JMP EFUN 1249 01753 4523 ELPAR, TSTLPR 1250 01754 4526 ERROR4 /DOUBLE OPERATORS 1251 01755 1127 EPAR2, TAD SORTCN /LEFT PARENS FOUND. 1252 01756 4503 PUSHA 1253 01757 1130 TAD LASTOP /SAVE DATA 1254 01760 4503 PUSHA 1255 01761 4501 PUSHJ /EVALUATE THE EXPRESSION 1256 01762 1600 EVAL-1 1257 01763 5500 JMP I EFUN3I 1258 /// 1259 01764 1127 EFUN2, TAD SORTCN /SAVE 'SORTCN','LASTOP',AND FUNC CODE 1260 01765 4503 PUSHA 1261 01766 1130 TAD LASTOP 1262 01767 4503 PUSHA 1263 01770 1274 TAD FLOPR /SAVE FUNCTION CODE. 1264 01771 4503 PUSHA 1265 01772 4523 TSTLPR 1266 01773 4526 ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT 1267 01774 4501 PUSHJ /YES 1268 01775 1600 EVAL-1 1269 01776 1413 POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I. 1270 01777 4510 SORTJ 1271 02000 2207 FNTABL-1 1272 02001 6361 FNTABF-FNTABL 1273 02002 4526 ERROR2 /ILLEGAL FUNCTION NAME. 1274 ///// 1275 1276 02003 0241 241 /! 1277 02004 0242 242 /" 1278 02005 0256 256 /. -FOR INPUT NUMBERS 1279 TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR' 1280 02006 0240 240 /SPACE 0 1281 02007 0253 253 /+ 1 1282 02010 0255 255 /- 2 1283 02011 0257 257 // 3 1284 02012 0252 252 /* 4 1285 02013 0336 336 /UP ARR 5 1286 02014 0250 250 /( 6 L-PARS 1287 02015 0333 333 /[ 7 1288 02016 0274 274 /< 10 1289 02017 0251 251 /) 11 R-PARS 1290 02020 0335 335 /] 12 1291 02021 0276 276 /> 13 1292 02022 0254 254 /, 14 1293 02023 0273 273 /; 15 1294 02024 0215 215 /C.R. 16 1295 02025 0275 275 /= TO END GETARG FROM 'SET' 1296 02026 5554 OPTABS, FGT I PT1 1297 02027 1554 FAD I PT1 1298 02030 2554 FSB I PT1 1299 02031 4554 FDV I PT1 1300 02032 3554 FMY I PT1 1301 02033 0554 FPW I PT1 1302 ///// 1303 02034 0000 FLARG, 0 /DATA TEMPORARY STORAGE 1304 02035 0000 0 1305 02036 0000 0 1306 ///// 1307 /FOCAL TEXT FOR "HELLO" COMMAND 1308 02037 7056 HPT, 7056 /[T %] 8.4; 1309 02040 6473 6473 1310 02041 1740 1740 /OPTION K,T,I,E,:,S; 1311 02042 1354 1354 1312 02043 2454 2454 1313 02044 1154 1154 1314 02045 0554 0554 1315 02046 7254 7254 1316 02047 2373 2373 1317 02050 0540 0540 /ERASE ALL 1318 02051 0177 0177 1319 02052 1500 1500 1320 ///// 1321 /ABSOLUTE VALUE FUNCTION 1322 02053 1045 XABS, TAD FLAC1 1323 02054 7710 SPA CLA 1324 02055 4450 NEGATE 1325 /CONTINUATION OF FUNCTION CALLS. 1326 1327 02056 1413 EFUN3, POPA /RESTORE LAST OPERATION 1328 02057 3130 DCA LASTOP 1329 02060 4407 FENT 1330 02061 7000 FNR /NORMALIZE FUNCTION RETURN 1331 02062 6234 FPT FLARG 1332 02063 0000 FEXT 1333 02064 1160 TAD FLARGP /SET POINTER 1334 02065 3154 DCA PT1 1335 02066 1413 POPA /GET LAST PAREN CODE. 1336 02067 7041 CIA /CHECK FOR PAREN MATCH. 1337 02070 1066 TAD M3 1338 02071 1127 TAD SORTCN /(STILL SET FROM THE LAST "EVAL") 1339 02072 7640 SZA CLA /SKIP IF MATCH 1340 02073 4526 ERROR4 /PAREN ERROR 1341 02074 4506 GETC /MOVE PAST R-PAR, AND RETURN TO OPNEX. 1342 02075 5676 JMP I .+1 /FUNCTION RETURN IS OK 1343 02076 1610 OPNEXT 1344 //// 1345 1346 02077 0000 LPRTST, 0 /SKIP IF LEFT PAREN. - 'TSTLPR' 1347 02100 1127 TAD SORTCN 1348 02101 1070 TAD M11 1349 02102 7700 SMA CLA 1350 02103 5677 JMP I LPRTST 1351 02104 1127 TAD SORTCN 1352 02105 1067 TAD M5 1353 02106 7740 SMA SZA CLA 1354 02107 2277 ISZ LPRTST 1355 02110 5677 JMP I LPRTST 1356 1357 /THE DELETE A LINE ROUTINE 1358 1359 02111 4516 DELETE, FINDLN /SETS "THISLN" AND "LASTLN". 1360 02112 5502 POPJ /ALREADY GONE 1361 02113 2151 ISZ DEBGSW /DISABLE TRACE 1362 02114 4506 GETC /MEASURE LENGTH 1363 02115 1142 TAD CHAR 1364 02116 1065 TAD MCR 1365 02117 7640 SZA CLA 1366 02120 5314 JMP .-4 1367 02121 1017 TAD AXOUT /SAVE LAST ADDRESS 1368 02122 7040 CMA 1369 02123 1146 TAD THISLN 1370 02124 3132 DCA CNTR /LENGTH < 0 1371 02125 1546 TAD I THISLN /DISCONNECT 1372 02126 3550 DCA I LASTLN 1373 02127 1075 TAD CFRS /START LIST AT TOP 1374 02130 3157 DOK, DCA T2 /EXAMINATION ADDRESS 1375 02131 1557 TAD I T2 /GET THE NEXT ADDR. 1376 02132 7450 SNA /TEST FOR END 1377 02133 5346 JMP DONE /YES-WRAP UP ALL. 1378 02134 3156 DCA T1 /SAVE NEXT ADDRESS. 1379 02135 1146 TAD THISLN /COMPARE LINE POSITIONS 1380 02136 7141 CIA CLL 1381 02137 1156 TAD T1 1382 02140 7630 SZL CLA /SKIP IF THISLN > X 1383 02141 1132 TAD CNTR /CHANGE (X) TO ACCOUNT FOR 1384 02142 1156 TAD T1 /GARBAGE COLLECTION. 1385 02143 3557 DCA I T2 1386 02144 1156 TAD T1 /GET NEXT 1387 02145 5330 JMP DOK 1388 ///// 1389 /GARBAGE COLLECTION 1390 1391 02146 7040 DONE, CMA /BACKUP L FOR XR 1392 02147 1146 TAD THISLN 1393 02150 3011 DCA XRT 1394 02151 1132 TAD CNTR /SETUP END OF HOSE 1395 02152 7040 CMA 1396 02153 1146 TAD THISLN 1397 02154 3012 DCA XRT2 1398 02155 1132 TAD CNTR /CORRECT END OF BUFFER POINTER. 1399 02156 1134 TAD BUFR 1400 02157 3134 DCA BUFR 1401 02160 1010 TAD AXIN /COMPUTE COUNT 1402 02161 7040 CMA 1403 02162 1012 TAD XRT2 1404 02163 3156 DCA T1 1405 02164 1010 TAD AXIN 1406 02165 1132 TAD CNTR 1407 02166 3010 DCA AXIN 1408 02167 1412 TAD I XRT2 /SIPHON LOWER PART. 1409 02170 3411 DCA I XRT 1410 02171 2156 ISZ T1 1411 02172 5367 JMP .-3 1412 02173 5311 JMP DELETE /RESET 'LASTLN','THISLN', AND DATA`FIELD. 1413 ///// 1414 /OPTION TABLE 1415 02174 6457 OPTTBL, OPTK /SWITCH TO KEYBOARD INPUT 1416 02175 6453 OPTR /READER INPUT 1417 02176 3237 OPTT /TTY OUTPUT 1418 02177 3234 OPTP /PUNCH OUTPUT 1419 02200 3303 OPTI /INTERPRETIVE/NUMERIC I/O 1420 02201 3302 OPTC /SINGLE CHARACTER I/O 1421 02202 3244 OPTCOL /PRINT ":" AT "ASK" 1422 02203 3243 OPTX /SUPPRESS ":" 1423 02204 3252 OPTE /ECHO KEYBOARD INPUT 1424 02205 3253 OPTN /NO ECHO 1425 02206 3256 OPTS /SET VARIABLE TERMINATOR 1426 02207 3271 OPTM /START DISK MONITOR 1427 1428 FNTABL=. 1429 02210 2533 2533 /ABS 1430 02211 2650 2650 /SGN 1431 02212 2636 2636 /ITR 1432 02213 2565 2565 /DIS 1433 02214 2630 2630 /RAN 1434 02215 2623 2623 /DXS 1435 02216 2517 2517 /ADC 1436 02217 2572 2572 /ATN 1437 02220 2624 2624 /EXP 1438 02221 2625 2625 /LOG 1439 02222 2654 2654 /SIN /LIST OF CODED FUNCTION NAMES 1440 02223 2575 2575 /COS 1441 02224 2702 2702 /SQT 1442 02225 2631 2631 /NEW 1443 /ERASE SINGLE LINES, GROUPS, OR VARIABLES 1444 02226 1142 ERASE, TAD CHAR /SEE IF "ALL" 1445 02227 1003 TAD MINUSA 1446 02230 7640 SZA CLA 1447 02231 5240 JMP ERVX 1448 02232 1077 TAD ENDT /YES, ERASE ALL TEXT 1449 02233 3134 DCA BUFR 1450 02234 3475 DCA I CFRS 1451 02235 1134 ERV, TAD STARTV /ERASE VARIABLES 1452 02236 3155 DCA LASTV 1453 02237 5177 JMP START /PROGRAM EXECUTION ENDS 1454 ///// 1455 02240 4515 ERVX, GETLN /GET LINE NUMBER 1456 02241 1143 TAD LINENO /SEE OF ZERO OR NONE 1457 02242 7640 SZA CLA 1458 02243 5250 JMP ERL /NO, ERASE LINES 1459 02244 1134 TAD STARTV /YES, ERASE VARIABLES 1460 02245 3155 DCA LASTV 1461 02246 5647 JMP I .+1 /CONTINUE PROCESSING 1462 02247 0616 PROC 1463 ///// 1464 02250 1134 ERL, TAD BUFR /ERASE LINES 1465 02251 3010 DCA AXIN 1466 02252 4501 ERG, PUSHJ /EXTRACT ONE LINE 1467 02253 2111 DELETE 1468 02254 2146 ISZ THISLN 1469 02255 1141 TAD NAGSW 1470 02256 7700 SMA CLA 1471 02257 1546 TAD I THISLN 1472 02260 4524 TSTGRP /IF GROUP, SEE IF END OF GROUP 1473 02261 5235 JMP ERV /YES 1474 02262 1546 TAD I THISLN /NO, CONTINUE ERASING GROUP 1475 02263 3143 DCA LINENO 1476 02264 5252 JMP ERG 1477 /ROUTINE CALLED VIA "FINDLN": 1478 1479 /SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ] 1480 /1ST RETURN IF NOT FOUND, 1481 /2AND IF FOUND. 1482 /"THISLN" = FOUND LINE OR NEXT LARGER. 1483 /"LASTLN" = LESSER AND/OR LAST. 1484 /"TEXTP" IS SET 1485 1486 02265 0000 XFIND, 0 1487 02266 1075 TAD CFRS /INITIALIZE POINTERS TO FIRST LINE 1488 02267 3150 DCA LASTLN 1489 02270 1075 TAD CFRS 1490 02271 3146 FINDN, DCA THISLN /SAVE THIS ONE 1491 02272 1146 TAD THISLN 1492 02273 3012 DCA XRT2 1493 02274 1143 TAD LINENO 1494 02275 7041 CIA 1495 02276 1412 TAD I XRT2 /LINENO=0 WILL ALSO BE FOUND 1496 02277 7450 SNA 1497 02300 2265 ISZ XFIND /FOUND IT (2ND EXIT) 1498 02301 7700 SMA CLA 1499 02302 5310 JMP FEND3 /PAST IT. 1500 02303 1146 TAD THISLN /MOVE POINTERS 1501 02304 3150 DCA LASTLN 1502 02305 1546 TAD I THISLN 1503 02306 7440 SZA /SKIP IF END OF TEST 1504 02307 5271 JMP FINDN 1505 02310 1146 FEND3, TAD THISLN 1506 02311 7001 IAC 1507 02312 3017 DCA AXOUT /SET "TEXTP". 1508 02313 3020 DCA XCT 1509 02314 5665 JMP I XFIND 1510 1511 02315 0000 UTRA, 0 /UNPACK CHARACTER. - "GETC" 1512 02316 4351 JMS GET1 1513 02317 7710 UTE, SPA CLA /NORM & EXTEND 1514 02320 1006 TAD C100 /300-337 & 340-376 1515 02321 1377 TAD M137 /240-276 & 200-236 1516 02322 1142 TAD CHAR 1517 02323 7450 SNA 1518 02324 5337 JMP UTX /"?" FOUND 1519 02325 1054 TAD P337 1520 02326 3142 UTQ, DCA CHAR 1521 02327 1151 TAD DEBGSW 1522 02330 1152 TAD DMPSW 1523 02331 7650 SNA CLA /PRINT ONLY IF BOTH ARE ZERO. 1524 02332 4512 PRINTC 1525 02333 5715 JMP I UTRA 1526 ////// 1527 02334 4351 EXTR, JMS GET1 1528 02335 7040 CMA 1529 02336 5317 JMP UTE 1530 /// 1531 02337 1151 UTX, TAD DEBGSW /TEST FOR TRACE-ENABLED 1532 02340 7640 SZA CLA 1533 02341 5347 JMP .+6 1534 02342 1152 TAD DMPSW /FLIP THE TRACE FLOP 1535 02343 7650 SNA CLA 1536 02344 7001 IAC 1537 02345 3152 DCA DMPSW 1538 02346 5316 JMP UTRA+1 /GET NEXT CHARACTER INSTEAD. 1539 02347 1032 TAD P277 /TRACE DISABLED = RETURN "?" 1540 02350 5326 JMP UTQ 1541 1542 02351 0000 GET1, 0 /UNPACK 6-BITS 1543 02352 2020 ISZ XCT /STARTS=0 1544 02353 5366 JMP GET3 1545 02354 1021 TAD GTEM 1546 02355 0071 GEND, AND P77 1547 02356 3142 DCA CHAR /SAVE 1548 02357 1142 TAD CHAR 1549 02360 1023 TAD M77 1550 02361 7650 SNA CLA 1551 02362 5334 JMP EXTR /EXTENDED 1552 02363 1142 TAD CHAR 1553 02364 1376 TAD M40 1554 02365 5751 JMP I GET1 1555 ///// 1556 1557 02366 1417 GET3, TAD I AXOUT /(X-MEM) 1558 02367 3021 DCA GTEM 1559 02370 7040 CMA 1560 02371 3020 DCA XCT 1561 02372 1021 TAD GTEM 1562 02373 4520 RTL6 1563 02374 7004 RAL 1564 02375 5355 JMP GEND 1565 02376 7740 M40, -40 1566 02377 7641 M137, -137 1567 ///// 1568 /OPTION LIST 1569 02400 0313 OPTLST, "K 1570 02401 0322 "R 1571 02402 0324 "T 1572 02403 0320 "P 1573 02404 0311 "I 1574 02405 0303 "C 1575 02406 0272 ": 1576 02407 0330 "X 1577 02410 0305 "E 1578 02411 0316 "N 1579 02412 0323 "S 1580 02413 0315 "M 1581 ///// 1582 /ANALOG-DIGITAL CONVERSION 1583 02414 6004 XADC, 6004 1584 02415 3045 DCA FLAC1 /ARG MUST BE 0 1585 02416 5500 RETURN 1586 1587 02417 0000 XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" 1588 02420 1550 TAD I LASTLN /SAVE OLD POINTER 1589 02421 3534 DCA I BUFR 1590 02422 1134 TAD BUFR /POINT TO NEW LAST LINE 1591 02423 3550 DCA I LASTLN 1592 02424 1135 TAD ADD /CHECK FOR EXTRA INFO 1593 02425 7440 SZA 1594 02426 3410 DCA I AXIN 1595 02427 1010 TAD AXIN /COMPUTE NEW`END OF BUFFER 1596 02430 7001 IAC 1597 02431 3134 DCA BUFR 1598 02432 1134 TAD STARTV /RESET VARIABLE LIST 1599 02433 3155 DCA LASTV 1600 02434 5617 JMP I XENDLN 1601 ///// 1602 02435 0000 TXTSAV, 0 /SAVE CHAR AND TEXT POINTERS 1603 02436 4504 PUSHF 1604 02437 0017 TEXTP 1605 02440 1142 TAD CHAR 1606 02441 4503 PUSHA 1607 02442 5635 JMP I TXTSAV 1608 / 1609 02443 0000 TXTRES, 0 /RESTORE SAME 1610 02444 1413 POPA 1611 02445 3142 DCA CHAR 1612 02446 4505 POPF 1613 02447 0017 TEXTP 1614 02450 5643 JMP I TXTRES 1615 ///// 1616 02451 0000 GRPTST, 0 /AC VS LINENO - "TSTGRP" 1617 02452 0024 AND P7600 1618 02453 7041 CIA 1619 02454 3157 DCA T2 1620 02455 1143 TAD LINENO 1621 02456 0024 AND P7600 1622 02457 1157 TAD T2 1623 02460 7650 SNA CLA 1624 02461 2251 ISZ GRPTST 1625 02462 5651 JMP I GRPTST 1626 /I-O SUBROUTINES 1627 1628 VAL=. 1629 02463 0000 CHIN, 0 /READ IN A CHARACTER SUBR. - "READC" 1630 02464 4540 JMS I INDEV 1631 02465 3142 DCA CHAR 1632 02466 4511 SORTC /LINEFEED OR RUBOUT? 1633 02467 1611 ECHOLST-1 1634 02470 5663 JMP I CHIN /YES 1635 02471 4512 ECHO, PRINTC 1636 02472 1142 TAD CHAR /SEE IF 200 (L/T) 1637 02473 1024 TAD P7600 1638 02474 7640 SZA CLA 1639 02475 5663 JMP I CHIN /NO, EXIT 1640 02476 5264 JMP CHIN+1 /YES, GET ANOTHER 1641 ///// 1642 02477 0000 OUT, 0 /OUTPUT A CHARACTER - "PRINTC" 1643 02500 7450 SNA /USE (AC) OR (CHAR) 1644 02501 1142 TAD CHAR 1645 02502 1065 TAD MCR 1646 02503 7450 SNA 1647 02504 5310 JMP OUTCR 1648 02505 1060 TAD CCR 1649 02506 4537 JMS I OUTDEV 1650 02507 5677 OUTX, JMP I OUT 1651 ///// 1652 02510 1060 OUTCR, TAD CCR 1653 02511 4537 JMS I OUTDEV 1654 02512 1057 TAD CLF 1655 02513 5306 JMP OUTX-1 1656 ///// 1657 /TEST FOR A COMMA, SEMICOLON, OR CR - "TSTERM" 1658 /RETURNS: OTHER, ; OR CR, COMMA 1659 /GETS NEXT CHARACTER AFTER COMMA OR OTHER 1660 02514 0000 XTSTER, 0 1661 02515 4511 SORTC /LOOK FOR ,;CR 1662 02516 1141 TLIST-1 1663 02517 7410 SKP 1664 02520 5326 JMP .+6 /OTHER, GO PAST IT 1665 02521 1127 TAD SORTCN /FOUND ONE, SEE WHAT IT IS 1666 02522 2314 ISZ XTSTER 1667 02523 7640 SZA CLA 1668 02524 5714 JMP I XTSTER /; OR CR: 2ND EXIT 1669 02525 2314 ISZ XTSTER /COMMA, 3RD EXIT 1670 02526 4506 GETC 1671 02527 5714 JMP I XTSTER 1672 ///// 1673 1674 COMEIN=.-1 /COMMAND-INPUT BUFFER LIVES HERE. 1675 1676 COMOUT=2600 1677 *COMOUT 1678 1679 /INTERRUPT PROCESSOR. 1680 1681 02600 0000 SAVAC, 0 /CONTENTS OF AC 1682 02601 0000 SAVLK, 0 /CONTENTS OF LINK 1683 02602 7575 MBREAK, -203 /CONTROL-C 1684 02603 3200 INTRPT, DCA SAVAC /SAVE WORKING DATA 1685 02604 7010 RAR 1686 02605 3201 DCA SAVLK 1687 02606 6031 KSF /CHECK FOR KEYBOARD FIRST 1688 02607 5225 JMP TINT 1689 02610 6036 KRB /READ BUFFER AND CLEAR FLAG TO FETCH NEXT 1690 02611 0026 AND P177 /IGNORE PARITY BIT 1691 02612 1015 TAD C200 1692 02613 3306 DCA SIN 1693 02614 1306 TAD SIN 1694 02615 1202 TAD MBREAK /MANUAL STOP? 1695 02616 7650 SNA CLA 1696 02617 5345 JMP RECOVR 1697 02620 1264 TAD INBUF /ANY SPACE? 1698 02621 7640 SZA CLA 1699 02622 4526 ERROR2 /WILL WAIT FOR OUTPUT BUFFER 1700 02623 1306 TAD SIN 1701 02624 3264 DCA INBUF /SAVE INPUT 1702 02625 6041 TINT, TSF 1703 02626 5244 JMP EXIT 1704 02627 6042 TCF 1705 02630 3260 DCA TELSW /TURN OFF THE IN-PROGRESS FLAG. 1706 02631 1663 TAD I OPTRI 1707 02632 7450 SNA 1708 02633 5244 JMP EXIT /DONE 1709 02634 6044 TPC /TYPE NEXT. 1710 02635 3260 DCA TELSW /CLEAR AC AND TURN ON THE FLAG. 1711 02636 3663 DCA I OPTRI /ZERO OUT THE DATA AREA 1712 02637 1263 TAD OPTRI 1713 02640 7001 IAC 1714 02641 0031 AND P17 1715 02642 1261 TAD OPTR0 1716 02643 3263 DCA OPTRI 1717 02644 6244 EXIT, 6244 /RESTORE MEMORY FIELD 1718 02645 6101 6101 /SMP 1719 02646 7000 NOP /(HLT)-IF YOU HAVE MEMORY PARITY 1720 02647 6011 RSF /TEST H.S. READER FLAG 1721 02650 5253 JMP .+3 1722 02651 6012 RRB /READ BUFFER AND CLEAR FLAG 1723 02652 3037 DCA HINBUF /SAVE CHARACTER 1724 02653 1201 TAD SAVLK 1725 02654 7104 RAL CLL 1726 02655 1200 TAD SAVAC 1727 02656 6001 ION 1728 02657 5400 EXITJ, JMP I 0 1729 1730 02660 0001 TELSW, 1 /INPUT SWITCH 1731 02661 3400 OPTR0, IOBUF /OUTPUT POINTERS 1732 02662 3400 OPTRO, IOBUF /VARS 1733 02663 3400 OPTRI, IOBUF 1734 02664 0000 INBUF, 0 /KEYBOARD BUFFER. 1735 ///// 1736 02665 0000 XI33, 0 /VIA (INDEV) 1737 02666 1264 TAD INBUF /ANY INPUT? 1738 02667 7550 SPA SNA 1739 02670 5266 JMP .-2 /NO = WAIT 1740 02671 3275 DCA XOUTL 1741 02672 3264 DCA INBUF /CLEAR INPUT BUFFER 1742 02673 1275 TAD XOUTL 1743 02674 5665 JMP I XI33 1744 ///// 1745 02675 0000 XOUTL, 0 /VIA (OUTDEV) 1746 02676 3265 DCA XI33 /SAVE CURRENT CHARACTER. 1747 02677 1265 TAD XI33 /IS IT A CR? 1748 02700 1065 TAD MCR 1749 02701 7650 SNA CLA 1750 02702 3053 DCA TABCTR /YES, RESET CARRIAGE INDEX 1751 02703 1265 TAD XI33 1752 02704 4732 JMS I SKPNP /SKIP IF A NON-PRINTING CHARACTER 1753 02705 2053 ISZ TABCTR /PRINTING: INCREMENT INDEX 1754 02706 0000 SIN, 0 1755 02707 6001 ION /BE SURE INTERRUPT IS ON. 1756 02710 1662 TAD I OPTRO /ANY ROOM? 1757 02711 7640 SZA CLA /A CHARACTER IS NON-ZERO 1758 02712 5310 JMP .-2 /NO = WAIT. 1759 02713 1260 TAD TELSW /IN PROGRESS? 1760 02714 7640 SZA CLA 1761 02715 5322 JMP .+5 1762 02716 1265 TAD XI33 /NO 1763 02717 6046 TLS /TYPE CHARACTER. 1764 02720 3260 DCA TELSW /SET IN-PROGRESS FLAG. 1765 02721 5675 JMP I XOUTL /RETURN 1766 02722 1265 TAD XI33 /SEND DATA 1767 02723 3662 DCA I OPTRO 1768 02724 1262 TAD OPTRO /SET POINTERS 1769 02725 7001 IAC 1770 02726 0031 AND P17 1771 02727 1261 TAD OPTR0 1772 02730 3262 DCA OPTRO 1773 02731 5675 JMP I XOUTL 1774 /////// 1775 02732 3014 SKPNP, SKIPNP 1776 ERROR2=ERROR 1777 ERROR3=ERROR 1778 ERROR4=ERROR 1779 02733 3225 WAITP, OWAIT 1780 02734 3203 OPTDOP, OPTTDO 1781 02735 3336 ERROR5, DCA .+1 /ERROR CALLED FROM A TABLE 1782 02736 0000 ERR2, 0 /LIMIT EXCEEDED 1783 02737 7240 CLA CMA /COMPUTE CALLING ADDRESS (ALSO "SPACE") 1784 02740 1336 TAD ERR2 /AND USE IT AS ERROR NUMBER. 1785 02741 3143 DCA LINENO /SAVE ERROR CODE. 1786 02742 4733 JMS I WAITP /WAIT FOR OUTPUT TO FINISH 1787 02743 6002 IOF /DISABLE INTERRUPT FOR INITIALIZATIONS 1788 02744 5347 JMP .+3 1789 02745 1015 RECOVR, TAD C200 1790 02746 3143 DCA LINENO /SAVE ERROR NUMBER 1791 02747 2260 ISZ TELSW /TURN ON IN-PROGRESS SWITCH 1792 02750 1025 TAD M20 /SETUP INIT COUNT 1793 02751 3132 DCA CNTR 1794 02752 7040 CMA 1795 02753 1261 TAD OPTR0 1796 02754 3011 DCA XRT /INIT I/O BUFFERS. 1797 02755 3411 DCA I XRT 1798 02756 2132 ISZ CNTR 1799 02757 5355 JMP .-2 1800 02760 3264 DCA INBUF /INIT KEY-BUFR. 1801 02761 1261 TAD OPTR0 /INIT TTY POINTERS. 1802 02762 3263 DCA OPTRI 1803 02763 1261 TAD OPTR0 1804 02764 3262 DCA OPTRO 1805 02765 4734 JMS I OPTDOP /SET TO TTY OUTPUT 1806 02766 1161 TAD PTCH /RESET "READC" 1807 02767 3113 DCA 113 /IF AN ERROR OCCURS. 1808 02770 7040 CMA /PREPARE A STOP BIT FOR TTY 1809 02771 6046 TLS /AND RAISE FLAG 1810 02772 7200 CLA 1811 02773 1060 TAD CCR /PRINT A CR 1812 02774 4512 PRINTC 1813 02775 1032 TAD P277 /MAKE A ? 1814 02776 4512 PRINTC /AND TURN ON THE INTERRUPT 1815 02777 4514 PRNTLN /PRINT ERROR NUMBER AND, 1816 03000 2145 ISZ PC 1817 03001 1545 TAD I PC /UNLESS IT IS ZERO, (X-MEM) 1818 03002 7450 SNA 1819 03003 5211 JMP .+6 1820 03004 3143 DCA LINENO 1821 03005 1062 TAD P7700 1822 03006 4512 PRINTC 1823 03007 4512 PRINTC /PRINT SPACE AGAIN AND 1824 03010 4514 PRNTLN /PRINT LINE OF ERROR. 1825 03011 1060 TAD CCR 1826 03012 4512 PRINTC 1827 03013 5177 JMP START /INTERRUPT WILL BE RE-ENABLED SOON. 1828 ///// 1829 /SKIP IF (AC) IS A NON-PRINTING CHARACTER 1830 03014 0000 SKIPNP, 0 1831 03015 4520 RTL6 /PRINTING CHARACTERS ARE 240-337 1832 03016 7710 SPA CLA 1833 03017 7020 CML 1834 03020 7420 SNL 1835 03021 2214 ISZ SKIPNP 1836 03022 5614 JMP I SKIPNP 1837 ///// 1838 /PACK A CHARACTER INTO THE BUFFER - "PACKC" 1839 03023 0000 PACBUF, 0 1840 03024 4510 SORTJ /LOOK FOR ? OR RUBOUT 1841 03025 3055 PACLST-1 1842 03026 6126 PACLS2-PACLST 1843 03027 1142 TAD CHAR 1844 03030 4214 JMS SKIPNP /PRINTING CHARACTER? 1845 03031 5234 JMP .+3 /YES 1846 03032 1071 TAD P77 /NO, PACK 77 FIRST 1847 03033 4242 JMS PCK1 1848 03034 1142 TAD CHAR /PACK 6-BIT CHARACTER 1849 03035 0071 AND P77 1850 03036 4242 JMS PCK1 1851 03037 5623 JMP I PACBUF 1852 ///// 1853 03040 1054 PQUES, TAD P337 /USE 337 FOR ? 1854 03041 5235 JMP .-4 1855 ///// 1856 /PACK ONE 6-BIT WORD 1857 03042 0000 PCK1, 0 1858 03043 2136 ISZ XCTIN 1859 03044 5260 JMP ROT /PACK LEFT HALF 1860 03045 1135 TAD ADD /PACK RIGHT HALF AND STORE 1861 03046 3410 DCA I AXIN 1862 03047 1013 TAD PDLXR /CHECK FOR SPACE 1863 03050 7141 CLL CIA 1864 03051 1005 TAD P13 1865 03052 1010 TAD AXIN 1866 03053 7630 SZL CLA 1867 03054 4526 ERROR /BUFFER OR STORAGE OVERFLOW 1868 03055 5642 JMP I PCK1 1869 ///// 1870 03056 0277 PACLST, 277 /? 1871 03057 0377 377 /RUBOUT 1872 ///// 1873 03060 4520 ROT, RTL6 /SAVE LEFT HALF 1874 03061 3135 DCA ADD 1875 03062 7040 CMA 1876 03063 3136 DCA XCTIN 1877 03064 5642 JMP I PCK1 1878 /RUBOUT ONE CHARACTER 1879 03065 1010 RUB1, TAD AXIN /SAVE POINTER 1880 03066 3242 DCA PCK1 1881 03067 1136 TAD XCTIN /CHARACTER IN ADD? 1882 03070 7640 SZA CLA 1883 03071 5277 JMP RUB2 /YES 1884 03072 1010 TAD AXIN /NO, BEGINNING OF BUFFER? 1885 03073 7041 CIA 1886 03074 1153 TAD PACKST 1887 03075 7700 SMA CLA 1888 03076 5322 JMP PKZERO /YES, IGNORE 1889 03077 1324 RUB2, TAD SPLAT /ECHO A BACKSLASH 1890 03100 4512 PRINTC 1891 03101 2136 ISZ XCTIN 1892 03102 5310 JMP RUB3 /BACKUP STORAGE 1893 03103 1642 TAD I PCK1 /KILL ADD AND CHECK FOR 77 1894 03104 0071 AND P77 /IN 2ND HALF OF LAST STORED WORD 1895 03105 1023 TAD M77 1896 03106 7640 SZA CLA 1897 03107 5322 JMP PKZERO /NO, DONE 1898 03110 1642 RUB3, TAD I PCK1 /KILL 2ND HALF OF LAST STORED WORD 1899 03111 0062 AND P7700 1900 03112 3135 DCA ADD 1901 03113 7040 CMA /BACKUP POINTER 1902 03114 1010 TAD AXIN 1903 03115 3010 DCA AXIN 1904 03116 1135 TAD ADD /TEST FOR 77 IN ADD 1905 03117 1006 TAD C100 1906 03120 7640 SZA CLA 1907 03121 7040 CMA 1908 03122 3136 PKZERO, DCA XCTIN 1909 03123 5623 JMP I PACBUF 1910 03124 0334 SPLAT, 334 1911 /DUMP THE SYMBOL TABLE CONTENTS 1912 03125 4504 TDUMP, PUSHF /SAVE TEXT POINTERS 1913 03126 0017 TEXTP 1914 03127 7040 CMA 1915 03130 1134 TAD STARTV /START VARIABLE LIST 1916 03131 3014 TDLOOP, DCA FLTXR 1917 03132 1014 TAD FLTXR /TEST FOR END OF LIST 1918 03133 7040 CMA 1919 03134 1155 TAD LASTV 1920 03135 7650 SNA CLA 1921 03136 5370 JMP TDEND /END FOUND 1922 03137 1375 TAD TDTEXT /NO, SET UP POINTERS 1923 03140 3017 DCA AXOUT 1924 03141 3020 DCA XCT 1925 03142 1414 TAD I FLTXR /2 LETTERS OF VAR. NAME 1926 03143 3376 DCA TDTEXT+1 1927 03144 4501 PUSHJ /PRINT NAME AND "(" 1928 03145 1241 TQUOT 1929 03146 1414 TAD I FLTXR /GET AND PRINT SUBSCRIPT 1930 03147 4774 JMS I TDOUTP 1931 03150 4501 PUSHJ /PRINT ")=" 1932 03151 1241 TQUOT 1933 03152 1005 TAD P13 /SPACE TO 11TH COLUMN 1934 03153 3046 DCA FLAC2 1935 03154 4501 PUSHJ 1936 03155 1374 TAB+12 1937 03156 2014 ISZ FLTXR 1938 03157 4407 FENT /PICK UP VALUE 1939 03160 5414 FGT I FLTXR /(DOES NOT AUTOINDEX) 1940 03161 0000 FEXT 1941 03162 4472 JMS I FOUTPUT /PRINT VALUE 1942 03163 1060 TAD CCR /AND A C.R. 1943 03164 4512 PRINTC 1944 03165 1014 TAD FLTXR /INCREMENT FOR NEXT VAR. 1945 03166 1035 TAD P2 1946 03167 5331 JMP TDLOOP 1947 03170 4505 TDEND, POPF /RESTORE TEXT POINTERS 1948 03171 0017 TEXTP 1949 03172 5773 JMP I .+1 1950 03173 1252 TASK4 1951 03174 6100 TDOUTP, SIGOUT 1952 03175 3175 TDTEXT, . /THE FOLLOWING IS FOCAL TEXT 1953 03176 0000 0 /VAR. NAME GOES HERE 1954 03177 5077 5077 /"(" AND C.R. 1955 03200 1551 1551 /")=" AND C.R. 1956 03201 7577 7577 1957 03202 1500 1500 1958 /OPTION ROUTINES 1959 / 1960 /ROUTINE TO SET UP OUTPUT 1961 03203 0000 OPTTDO, 0 1962 03204 1220 TAD CTSF 1963 03205 3621 DCA I OPTTL /TSF 1964 03206 1621 TAD I OPTTL 1965 03207 7001 IAC 1966 03210 3622 DCA I OPTTL+1 /TCF 1967 03211 1622 TAD I OPTTL+1 1968 03212 1035 TAD P2 1969 03213 3623 DCA I OPTTL+2 /TPC 1970 03214 1623 TAD I OPTTL+2 1971 03215 1035 TAD P2 1972 03216 3624 DCA I OPTTL+3 /TLS 1973 03217 5603 JMP I OPTTDO 1974 03220 6041 CTSF, TSF 1975 03221 2625 OPTTL, TINT 1976 03222 2627 TINT+2 1977 03223 2634 TINT+7 1978 03224 2717 SIN+11 1979 ///// 1980 /ROUTINE TO WAIT UNTIL OUTPUT FINISHES 1981 03225 0000 OWAIT, 0 1982 03226 6001 ION /(SWAP) - FOR 2-USER 1983 03227 1633 TAD I TSWP /LOOK AT TELSW 1984 03230 7640 SZA CLA 1985 03231 5226 JMP .-3 1986 03232 5625 JMP I OWAIT 1987 03233 2660 TSWP, TELSW 1988 ///// 1989 03234 4225 OPTP, JMS OWAIT /SET UP FOR PUNCH OUTPUT 1990 03235 1025 TAD M20 /CONVERT TO PSF, ETC. 1991 03236 7410 SKP 1992 03237 4225 OPTT, JMS OWAIT /SET UP FOR TTY OUTPUT 1993 03240 4203 JMS OPTTDO 1994 03241 5642 OPTXIT, JMP I .+1 /EXIT OPTIONS 1995 03242 6461 OPTRET 1996 1997 03243 1250 OPTX, TAD OPTC1 /SUPPRESS ":" ON ASK 1998 03244 1247 OPTCOL, TAD CPRINT /RESTORE ":" 1999 03245 3651 DCA I COLP 2000 03246 5241 JMP OPTXIT 2001 03247 4512 CPRINT, PRINTC 2002 03250 2466 OPTC1, CLA-PRINTC 2003 03251 1222 COLP, TASKCL 2004 ///// 2005 03252 1247 OPTE, TAD CPRINT /SET UP FOR KEYBOARD ECHO 2006 03253 3655 OPTN, DCA I ECHP /SUPPRESS ECHO 2007 03254 5241 JMP OPTXIT 2008 03255 2471 ECHP, ECHO 2009 ///// 2010 03256 4506 OPTS, GETC /SET UP USER TERMINATOR FOR "ASK" 2011 03257 4511 SORTC 2012 03260 2003 TERMS-3 2013 03261 7410 SKP 2014 03262 5256 JMP .-4 2015 03263 4501 PUSHJ /GET CHARACTER 2016 03264 1601 EVAL 2017 03265 4452 FIX 2018 03266 3670 DCA I USERTP 2019 03267 5241 JMP OPTXIT 2020 03270 6002 USERTP, USERT 2021 ///// 2022 03271 4225 OPTM, JMS OWAIT /EXIT TO DISK MONITOR 2023 03272 6002 IOF 2024 03273 5424 JMP I P7600 2025 ///// 2026 /THIS IS THE INITIALIZATION COMMAND 2027 03274 1301 HELLO, TAD HP 2028 03275 3017 DCA AXOUT 2029 03276 3020 DCA XCT 2030 03277 4501 PUSHJ /START BY SETTING FORMAT 2031 03300 1260 TINTR 2032 ///// 2033 03301 2036 HP, HPT-1 /FOCAL TEXT "%8.4;O K,T,I,E,:,S;E A" 2034 / I/O MODE OPTIONS 2035 03302 7240 OPTC, CLA CMA 2036 03303 3305 OPTI, DCA IOSW 2037 03304 5241 JMP OPTXIT 2038 ///// 2039 03305 0000 IOSW, 0 2040 / I/O MODE: "I" = 0000 = INTERPRETIVE INPUT, NUMERIC OUTPUT 2041 / "C" = 7777 = SINGLE CHARACTER I/O 2042 ///// 2043 /"ASK" MASTER ROUTINE 2044 03306 0000 INTASK, 0 2045 03307 1154 TAD PT1 /SAVE VAR. POINTER 2046 03310 3225 DCA OWAIT 2047 03311 1305 TAD IOSW /WHAT MODE OF INPUT? 2048 03312 7650 SNA CLA 2049 03313 5323 JMP STRING /INTERPRETIVE 2050 03314 4513 READC /SINGLE CHARACTER 2051 03315 1142 TAD CHAR /CONVERT CHARACTER CODE TO FLOATING 2052 03316 4430 FLOAT /POINT NUMBER 2053 03317 4407 ASKEND, FENT /SAVE VALUE 2054 03320 6625 FPT I OWAIT 2055 03321 0000 FEXT 2056 03322 5706 JMP I INTASK 2057 /INTERPRETIVE BUFFERED INPUT 2058 03323 1013 STRING, TAD PDLXR /SAVE PUSHDOWN LIST POINTER 2059 03324 3203 DCA OPTTDO 2060 03325 1364 TAD BUFTOP /PROTECT TOP OF ASKBUF 2061 03326 3013 DCA PDLXR 2062 03327 2151 ISZ DEBGSW /DISABLE TRACE 2063 03330 1363 INBARR, TAD BUFBOT /INITIALIZE ASKBUF 2064 03331 3010 DCA AXIN 2065 03332 3136 DCA XCTIN 2066 03333 1363 TAD BUFBOT 2067 03334 3153 DCA PACKST 2068 03335 4513 READC /IGNORE SPACES 2069 03336 4511 SORTC 2070 03337 0032 C240-1 2071 03340 5335 JMP .-3 2072 03341 4510 SORTJ /SEARCH FOR TERMINATOR 2073 03342 5775 ASKLST-1 2074 03343 0774 ASKLS2-ASKLST 2075 03344 4507 PACKC /PACK INTO BUFFER 2076 03345 4513 INGT, READC 2077 03346 5341 JMP .-5 2078 /TERMINATOR FOUND, PROCESS INPUT 2079 03347 1060 INTERM, TAD CCR /PACK A C.R. 2080 03350 3142 DCA CHAR 2081 03351 4507 PACKC 2082 03352 4507 PACKC 2083 03353 1203 TAD OPTTDO /RESTORE PDLXR 2084 03354 3013 DCA PDLXR 2085 03355 1363 TAD BUFBOT /INITIALIZE UNPACKING 2086 03356 3017 DCA AXOUT 2087 03357 3020 DCA XCT 2088 03360 4501 PUSHJ /EVALUATE EXPRESSION 2089 03361 1600 EVAL-1 2090 03362 5317 JMP ASKEND 2091 ///// 2092 03363 7550 BUFBOT, ASKBUF /BOTTOM OF BUFFER 2093 03364 7612 BUFTOP, ASKBUF!177+13 /TOP+12 OF BUFFER 2094 ///// 2095 /"TYPE" OUTPUT 2096 03365 0000 OUTPT, 0 2097 03366 1305 TAD IOSW /WHAT KIND OF OUTPUT 2098 03367 7640 SZA CLA 2099 03370 5373 JMP COUTPT /SINGLE CHARACTER 2100 03371 4472 JMS I FOUTPUT /NUMERIC OUTPUT, PRINT VALUE 2101 03372 5765 JMP I OUTPT 2102 ///// 2103 03373 4452 COUTPT, FIX /GET CODE FOR CHARACTER 2104 03374 7450 SNA /MODULO 256 2105 03375 7130 CLL CML RAR /TO ALLOW ZERO CODE TO BE PRINTED 2106 03376 4537 JMS I OUTDEV 2107 03377 5765 JMP I OUTPT 2108 /NOTE: "TDUMP" PRINTS ONLY IN NUMERIC MODE 2109 IOBUF=3400 2110 / 2111 *IOBUF+20 2112 03420 0000 FRST, 0 /TEXT POINTER 2113 03421 0000 0000 /DUMMY LINE NO 2114 03422 0355 0355 / C- 2115 03423 0617 0617 / FO 2116 03424 0301 0301 / CA 2117 03425 1454 1454 / L, 2118 03426 4040 4040 2119 03427 6557 6557 / 5/ 2120 03430 6671 FRSTX, 6671 / 69 2121 03431 7715 7715 2122 BUFBEG=. 2123 ///// 2124 LIBRARY=ERROR5 /COMMAND NOT AVAILABLE 2125 /PAUSE / VRS Unimplemented 2126 /FOCAL INITIALIZATION ROUTINE 2127 *START-1 2128 00176 3432 BEGIN 2129 *BUFBEG 2130 03432 7300 BEGIN, CLA CLL 2131 03433 1377 TAD (RECOVR+1 /RESTORE RESTART 2132 03434 3176 DCA START-1 2133 03435 6002 IOF /CLEAR FLAGS TO PREVENT INTERRUPT 2134 03436 6022 6022 /PCF 2135 03437 6032 6032 /KCC 2136 03440 6203 6203 /CDF CIF 00 2137 03441 6402 6402 /CLEAR PT08'S 2138 03442 6412 6412 2139 03443 6422 6422 2140 03444 6432 6432 2141 03445 6442 6442 2142 03446 6452 6452 2143 03447 6462 6462 2144 03450 6472 6472 2145 03451 6764 6764 /CLEAR DECTAPE 2146 03452 6772 6772 2147 03453 7200 CLA 2148 03454 6046 TLS /START LOW SPEED OUTPUT 2149 03455 3414 DCA I FLTXR /CLEAR OUTPUT BUFFER 2150 03456 2376 ISZ (-20 2151 03457 5255 JMP .-2 2152 03460 1027 TAD BOTTOM /INITIALIZE PUSHDOWN LIST 2153 03461 3013 DCA PDLXR 2154 03462 6001 ION 2155 03463 4512 PRINTC /CHAR IS A C.R 2156 03464 4512 PRINTC 2157 03465 4512 PRINTC 2158 03466 4501 PUSHJ /TYPE FOCAL HEADING 2159 03467 0641 WRITE 2160 03470 5671 JMP I .+1 2161 03471 2232 ERV-3 /ERASE ALL 2162 2163 03576 7760 *5600 /***** FLOAT -- FOR FOCAL 5/69 ***** 03577 2746 2164 /DECIMAL TO BINARY CONVERSION 2/10/69 2165 05600 0000 DBCONV, 0 2166 05601 4430 FLOAT /FLOAT A ZERO 2167 05602 3364 DCA DECEXP /INITIALIZE 2168 05603 7040 CMA 2169 05604 3260 DCA PSWIT 2170 05605 1363 TAD C43 /35(10) 2171 05606 3044 DCA FLAC0 2172 05607 4755 JMS I SGNTST /SIGN OF MANTISSA 2173 05610 3365 DCA INSIGN 2174 05611 5215 JMP NEWDIG+1 2175 05612 2260 PERIOD, ISZ PSWIT /. FOUND, SEE IF FIRST 2176 05613 4526 ERROR /DOUBLE PERIODS 2177 05614 4506 NEWDIG, GETC /LOOK FOR A DIGIT 2178 05615 4522 TESTN 2179 05616 5212 JMP PERIOD /. FOUND 2180 05617 5250 JMP NOTDIG /NOT FOUND 2181 05620 1260 TAD PSWIT /DECREMENT DECIMAL EXPONENT 2182 05621 7700 SMA CLA /IF AFTER . 2183 05622 7040 CMA 2184 05623 1364 TAD DECEXP 2185 05624 3364 DCA DECEXP 2186 05625 4342 JMS MULT10 /MULTIPLY FLAC BY 10 2187 05626 1127 TAD SORTCN /ADD NEW DIGIT 2188 05627 3043 DCA FLOP3 2189 05630 3042 DCA FLOP2 2190 05631 3041 DCA FLOP1 2191 05632 4313 JMS TRPLAD 2192 05633 1162 OVCHEK, TAD REMAIN /CHECK FOR OVERFLOW 2193 05634 7640 SZA CLA 2194 05635 5241 JMP .+4 2195 05636 1045 TAD FLAC1 2196 05637 7700 SMA CLA 2197 05640 5214 JMP NEWDIG /NO OVERFLOW 2198 05641 1361 TAD IOVRL /OVERFLOW, ROTATE RIGHT 2199 05642 3760 DCA I IRARAC /SET UP RETURN TO OVCHEK 2200 05643 1162 TAD REMAIN /ROTATE REMAIN 2201 05644 7110 CLL RAR 2202 05645 3162 DCA REMAIN 2203 05646 1045 TAD FLAC1 2204 05647 5762 JMP I ROTRAC /ROTATE REST OF FLAC 2205 2206 05650 4511 NOTDIG, SORTC /TEST FOR LETTER E 2207 05651 6145 C305-1 2208 05652 5301 JMP EINPUT /FOUND E 2209 05653 2365 DBTERM, ISZ INSIGN /END OF INPUT, AFFIX SIGN 2210 05654 4450 NEGATE 2211 05655 1366 TAD CFNR /SET UP TO NORMALIZE 2212 05656 3260 DBLOOP, DCA .+2 2213 05657 4407 FENT 2214 05660 7000 PSWIT, FNR /OR FMY BY 10 OR .10 2215 05661 6554 FPT I PT1 /SAVE RESULT 2216 05662 0000 FEXT 2217 05663 1364 TAD DECEXP /CHECK DECIMAL EXPONENT 2218 05664 7450 SNA 2219 05665 5600 JMP I DBCONV /DONE 2220 05666 7500 SMA 2221 05667 5273 JMP .+4 2222 05670 7001 IAC /NEGATIVE, SET UP TO FMY BY .10 2223 05671 3364 DCA DECEXP 2224 05672 5277 JMP .+5 2225 05673 7240 CLA CMA /POSITIVE, SET UP TO FMY BY 10 2226 05674 1364 TAD DECEXP 2227 05675 3364 DCA DECEXP 2228 05676 1066 TAD M3 2229 05677 1367 TAD FLINST /INSTRUCTION FMY FLTEN OR FLPTEN 2230 05700 5256 JMP DBLOOP 2231 05701 4506 EINPUT, GETC /FOUND "E" 2232 05702 4755 JMS I SGNTST /TEST FOR SIGN 2233 05703 3040 DCA FLOP0 2234 05704 4757 JMS I DECIN1 /INPUT A DECIMAL INTEGER 2235 05705 1164 TAD DECNUM 2236 05706 2040 ISZ FLOP0 /CHECK SIGN 2237 05707 7041 CIA 2238 05710 1364 TAD DECEXP 2239 05711 3364 DCA DECEXP 2240 05712 5253 JMP DBTERM 2241 /ADD FLOP TO FLAC TRIPLE PRECISION WITH OVERFLOW 2242 05713 0000 TRPLAD, 0 2243 05714 7300 CLA CLL 2244 05715 1043 TAD FLOP3 2245 05716 1047 TAD FLAC3 2246 05717 3047 DCA FLAC3 2247 05720 7004 RAL 2248 05721 1042 TAD FLOP2 2249 05722 1046 TAD FLAC2 2250 05723 3046 DCA FLAC2 2251 05724 7004 RAL 2252 05725 1041 TAD FLOP1 2253 05726 1045 TAD FLAC1 2254 05727 3045 DCA FLAC1 2255 05730 7004 RAL 2256 05731 1162 TAD REMAIN 2257 05732 3162 DCA REMAIN 2258 05733 5713 JMP I TRPLAD 2259 /MULTIPLY FLAC BY 2 2260 05734 0000 MULT2, 0 2261 05735 4756 JMS I MULT2I 2262 05736 1162 TAD REMAIN 2263 05737 7004 RAL 2264 05740 3162 DCA REMAIN 2265 05741 5734 JMP I MULT2 2266 /MULTIPLY FLAC BY 10 2267 05742 0000 MULT10, 0 2268 05743 4504 PUSHF /FLAC=>FLOP 2269 05744 0045 FLAC1 2270 05745 4505 POPF 2271 05746 0041 FLOP1 2272 05747 3162 DCA REMAIN /CLEAR OVERFLOW 2273 05750 4334 JMS MULT2 /FLAC*10 = (FLAC*2*2+FLAC)*2 2274 05751 4334 JMS MULT2 2275 05752 4313 JMS TRPLAD 2276 05753 4334 JMS MULT2 2277 05754 5742 JMP I MULT10 2278 05755 6030 SGNTST, TSTSGN 2279 05756 7037 MULT2I, RALAC 2280 05757 6010 DECIN1, DECINT 2281 05760 7251 IRARAC, RARAC 2282 05761 5633 IOVRL, OVCHEK 2283 05762 7256 ROTRAC, RARAC+5 2284 05763 0043 C43, 43 2285 05764 0000 DECEXP, 0 /IMPLICIT DECIMAL EXPONENT 2286 05765 0000 INSIGN, 0 /SIGN OF MANTISSA 2287 05766 7000 CFNR, FNR 2288 05767 3373 FLINST, FMY .+4 2289 05770 0004 FLTEN, 0004 /10(10) FLOATING 2290 05771 2400 2400 2291 05772 0000 0000 2292 05773 7775 FLPTEN, 7775 /.10(10) FLOATING 2293 05774 3146 3146 2294 05775 3147 3147 2295 REMAIN=TEMP1 2296 /CHARACTER LIST FOR "ASK" 2297 05776 0215 ASKLST, 215 /CR 2298 05777 0214 214 /FF 2299 06000 0337 337 /BA 2300 06001 0254 254 /COMMA 2301 06002 0000 USERT, 0 /USER-SELECTED CHARACTER 2302 06003 0212 212 /LF 2303 /POWER OF 10 TABLE 2304 06004 6030 INTABL, -1750 /1000 2305 06005 7634 -144 /100 2306 06006 7766 -12 /10 2307 06007 7777 -1 /1 2308 /INPUT A DECIMAL INTEGER <2048 2309 06010 0000 DECINT, 0 2310 06011 3164 DCA DECNUM 2311 06012 4522 TESTN /GET A DIGIT 2312 06013 7000 NOP 2313 06014 5610 JMP I DECINT /NONE FOUND 2314 06015 4506 GETC 2315 06016 1164 TAD DECNUM /MULTIPLY PREV. # BY 10 2316 06017 7106 CLL RTL 2317 06020 7530 SPA SZL 2318 06021 5226 JMP .+5 /OVERFLOW (>2047) 2319 06022 1164 TAD DECNUM 2320 06023 7004 RAL 2321 06024 1127 TAD SORTCN /ADD NEW DIGIT 2322 06025 7530 SPA SZL 2323 06026 4526 ERROR 2324 06027 5211 JMP DECINT+1 2325 DECNUM=TEMP3 2326 /TEST FOR A SIGN 2327 06030 0000 TSTSGN, 0 2328 06031 4521 SPNOR 2329 06032 3127 DCA SORTCN 2330 06033 4511 SORTC /LOOK FOR + OR - 2331 06034 6114 SNLIST-1 2332 06035 4506 GETC /SIGN FOUND 2333 06036 4521 SPNOR /NOT FOUND 2334 06037 7240 CLA CMA 2335 06040 1127 TAD SORTCN /SORTCN: 0=+, 1=- 2336 06041 5630 JMP I TSTSGN /AC: 7777=+, 0=- 2337 DIGIT=TEMP2 2338 /PRINT A 2-4 DIGIT UNSIGNED DECIMAL INTEGER 2339 /FIRST 2 LEADING ZEROES NOT PRINTED 2340 06042 0000 INTOUT, 0 2341 06043 3164 DCA DECNUM 2342 06044 1314 TAD INTPTR /POWER OF 10 POINTER 2343 06045 3260 DCA INTSUB 2344 06046 3210 DCA DECINT /DECINT=0 MEANS SKIP 0 OUTPUT 2345 06047 4255 JMS INTDO /1ST DIGIT (1000S) 2346 06050 4255 JMS INTDO /2ND DIGIT (100S) 2347 06051 2210 ISZ DECINT /DECINT>0 MEANS PRINT 0S 2348 06052 4255 JMS INTDO /3RD DIGIT (10S) 2349 06053 4255 JMS INTDO /4TH DIGIT (UNITS) 2350 06054 5642 JMP I INTOUT 2351 06055 0000 INTDO, 0 2352 06056 3163 DCA DIGIT /INITIALIZE 2353 06057 1164 TAD DECNUM 2354 06060 1204 INTSUB, TAD INTABL /SUBTRACT A POWER OF 10 2355 06061 7510 SPA 2356 06062 5267 JMP INTNEG 2357 06063 3164 DCA DECNUM /POSITIVE RESULT 2358 06064 2163 ISZ DIGIT /NONZERO DIGIT, SO IGNORE NO 2359 06065 2210 ISZ DECINT /FURTHER ZEROES 2360 06066 5257 JMP INTSUB-1 2361 06067 7300 INTNEG, CLA CLL /NEGATIVE RESULT 2362 06070 2260 ISZ INTSUB /SET UP NEXT POWER OF 10 2363 06071 1210 TAD DECINT /IS IT A LEADING 0? 2364 06072 7650 SNA CLA 2365 06073 5655 JMP I INTDO /YES, SKIP IT 2366 06074 1163 TAD DIGIT /NO, PRINT DIGIT 2367 06075 1036 TAD C260 2368 06076 4512 PRINTC 2369 06077 5655 JMP I INTDO 2370 /OUTPUT A SIGNED INTEGER IN AC 2371 06100 0000 SIGOUT, 0 2372 06101 3164 DCA DECNUM /SAVE NUMBER 2373 06102 1164 TAD DECNUM 2374 06103 7710 SPA CLA 2375 06104 1035 TAD P2 /MAKE A - 2376 06105 1315 TAD C253 /MAKE A + 2377 06106 4512 PRINTC 2378 06107 1164 TAD DECNUM /OUTPUT ABSOLUTE VALUE 2379 06110 7510 SPA 2380 06111 7041 CIA 2381 06112 4242 JMS INTOUT /OUTPUT THE NUMBER 2382 06113 5700 JMP I SIGOUT 2383 06114 1204 INTPTR, TAD INTABL 2384 SNLIST=. /FOR SIGN TESTING 2385 06115 0253 C253, 253 /+ 2386 06116 0255 255 /- 2387 /E FORMAT OUTPUT ROUTINE 2388 06117 7200 XXX, CLA /CONVERT TO E FORMAT ON OVERFLOW 2389 06120 1051 TAD TOTDIG 2390 06121 7410 SKP 2391 06122 1133 FLOUT, TAD DECP /E FORMAT (%0) FLOATING OUTPUT 2392 06123 7041 CIA 2393 06124 7450 SNA 2394 06125 1347 TAD MDIG /6 DIGITS IF 0 GIVEN 2395 06126 3164 DCA DECNUM /DIGIT COUNTER 2396 06127 1022 TAD PER /PERIOD 2397 06130 4512 PRINTC 2398 06131 1412 FLDIG, TAD I XRT2 /NEXT DIGIT 2399 06132 2157 ISZ T2 /OUT OF SIG DIGITS? 2400 06133 5336 JMP .+3 /NO, PRINT DIGIT 2401 06134 7240 CLA CMA /YES, RESET POINTER AND PRINT 0 2402 06135 3157 DCA T2 2403 06136 4750 JMS I OUTP 2404 06137 7410 SKP /FIELD NOW FILLED, PRINT EXPONENT 2405 06140 5331 JMP FLDIG 2406 /B-D CONV EXPONENT OUTPUT 2407 06141 1346 TAD C305 /PRINT LETTER E 2408 06142 4512 PRINTC 2409 06143 1156 TAD T1 /OUTPUT THE EXPONENT 2410 06144 4300 JMS SIGOUT 2411 06145 5770 BDEND, JMP I BDCONV /DONE 2412 06146 0305 C305, 305 /E 2413 06147 7772 MDIG, -DIGITS 2414 06150 6437 OUTP, OUTA 2415 /PRINT A LINE NUMBER - "PRNTLN" 2416 06151 0000 XPRNTL, 0 2417 06152 1143 TAD LINENO 2418 06153 4520 RTL6 2419 06154 0071 AND P77 2420 06155 4242 JMS INTOUT /2-DIGIT PART NUMBER 2421 06156 1022 TAD PER 2422 06157 4512 PRINTC /DECIMAL POINT 2423 06160 1143 TAD LINENO 2424 06161 0026 AND P177 /2-DIGIT STEP NUMBER 2425 06162 4242 JMS INTOUT 2426 06163 1033 TAD C240 /SPACE 2427 06164 3142 DCA CHAR 2428 06165 4512 PRINTC 2429 06166 5751 JMP I XPRNTL 2430 2431 06167 0015 NEGSGN, 255-240 2432 /BINARY TO DECIMAL CONVERSION AND OUTPUT 2433 06170 0000 BDCONV, 0 2434 06171 1045 TAD FLAC1 /CHECK SIGN 2435 06172 7700 SMA CLA 2436 06173 5376 JMP .+3 2437 06174 4450 NEGATE /NEGATIVE, TAKE ABSOLUTE VALUE 2438 06175 1367 TAD NEGSGN /MAKE A - 2439 06176 1033 TAD C240 /MAKE A SPACE 2440 06177 4512 PRINTC 2441 06200 7240 CLA CMA /DECREMENT BINARY EXPONENT 2442 06201 1044 TAD FLAC0 2443 06202 3044 DCA FLAC0 2444 06203 3156 BDSCAL, DCA T1 /INITIALIZE DECIMAL EXPONENT 2445 06204 1044 TAD FLAC0 /START SCALING: -4= EXPONENT 2535 06332 1051 TAD TOTDIG 2536 06333 7510 SPA 2537 06334 5362 JMP FPRNT-2 /NO ROUNDING NEEDED 2538 06335 1226 TAD MDIGIT /ROUND TO DECP+EXP PLACES 2539 06336 7500 SMA 2540 06337 7200 CLA 2541 06340 1227 R6, TAD RND2 /START ROUNDING 2542 06341 3004 DCA FNEGSW /PLACES TO ROUND TO 2543 06342 1235 TAD BUFST /ROUNDING START ADDRESS 2544 06343 1004 TAD FNEGSW /SET UP ROUND COUNT 2545 06344 3040 DCA FLOP0 2546 06345 1004 TAD FNEGSW 2547 06346 7041 CIA 2548 06347 3004 DCA FNEGSW /START ROUNDING PROCESS BY 2549 06350 1631 TAD I TENPT /ADDING 4 TO FIRST DIGIT 2550 06351 2440 RET, ISZ I FLOP0 /INCREMENT CURRENT DIGIT 2551 06352 1440 TAD I FLOP0 2552 06353 1230 TAD M12 2553 06354 7710 SPA CLA /DIGIT>9? 2554 06355 5364 JMP FPRNT /NO, END ROUNDING 2555 06356 3440 DCA I FLOP0 /YES, SET DIGIT TO 0 AND CARRY 2556 06357 2004 ISZ FNEGSW /BEGINNING OF BUFFER? 2557 06360 5240 JMP DECR /NO DECREMENT BUFFER ADDRESS 2558 06361 2440 ISZ I FLOP0 /YES, FAKE CARRY FROM FIRST DIGIT 2559 06362 2156 ISZ T1 2560 06363 7200 CLA 2561 2562 06364 1051 FPRNT, TAD TOTDIG /SET UP FIELD SIZES 2563 06365 7450 SNA 2564 06366 5636 JMP I FLOUTP /E FORMAT OUTPUT 2565 06367 7041 CIA 2566 06370 3164 DCA DECNUM /NUMBER OF PLACES TO PRINT 2567 06371 1164 TAD DECNUM 2568 06372 1156 TAD T1 2569 06373 7540 SMA SZA 2570 06374 5637 JMP I XXXP /TOO BIG, PRINT E FORMAT 2571 06375 1133 TAD DECP /OK, TEST DECIMAL PLACES 2572 06376 7500 SMA 2573 06377 7200 CLA /ADJUST DECIMAL POINT 2574 06400 7041 CIA 2575 06401 1156 TAD T1 2576 06402 7141 CLL CIA 2577 06403 3004 DCA FNEGSW /NUMBER OF INTEGER PLACES 2578 06404 7430 SZL 2579 06405 5222 JMP IN+4 /NO INTEGER PLACES 2580 /START PRINTING 2581 06406 1156 BACK, TAD T1 2582 06407 1004 TAD FNEGSW 2583 06410 7650 SNA CLA 2584 06411 5225 JMP DIG /PRINT A DIGIT 2585 06412 1004 TAD FNEGSW 2586 06413 7001 IAC 2587 06414 7710 SPA CLA /PRINT 0 IF ONE INTEGER PLACE LEFT 2588 06415 1025 TAD M20 /OTHERWISE A SPACE 2589 06416 4237 IN, JMS OUTA /PRINT A CHARACTER 2590 06417 5645 JMP I BDENDP /FIELD FILLED, EXIT 2591 06420 2004 ISZ FNEGSW 2592 06421 5206 JMP BACK /CONTINUE 2593 06422 1022 TAD PER /DECIMAL POINT 2594 06423 4512 PRINTC 2595 06424 5206 JMP BACK 2596 06425 7040 DIG, CMA 2597 06426 1156 TAD T1 /DECREMENT DECIMAL EXPONENT 2598 06427 3156 DCA T1 2599 06430 2157 ISZ T2 /CHECK SIG DIGIT COUNT 2600 06431 5235 JMP .+4 /SOME LEFT 2601 06432 7040 CMA /ALL USED UP 2602 06433 3157 DCA T2 2603 06434 5216 JMP IN /PRINT A 0 2604 06435 1412 TAD I XRT2 /PRINT A SIG DIGIT 2605 06436 5216 JMP IN 2606 /DIGIT PRINT ROUTINE FOR BDCONV 2607 06437 0000 OUTA, 0 2608 06440 1036 TAD C260 /CONVERT TO ASCII 2609 06441 4512 PRINTC 2610 06442 2164 ISZ DECNUM /FIELD FILLED? 2611 06443 2237 ISZ OUTA /NO, GO TO SECOND RETURN 2612 06444 5637 JMP I OUTA 2613 06445 6145 BDENDP, BDEND 2614 / "OPTION" PROCESSOR 2615 06446 4521 OPTION, SPNOR /GET OPTION LETTER 2616 06447 4510 SORTJ 2617 06450 2377 OPTLST-1 2618 06451 7574 OPTTBL-OPTLST 2619 06452 4526 ERROR /ILLEGAL OPTION NAME 2620 ///// 2621 06453 7240 OPTR, CLA CMA /SWAP INPUT TO HIGH SPEED READER 2622 06454 3037 DCA HINBUF 2623 06455 6014 RFC /START READER 2624 06456 1317 TAD RESTR /POINT TO "HREAD" 2625 06457 1161 OPTK, TAD PTCH /SWAP TO KEYBOARD IF CALLED HERE 2626 06460 3113 DCA 113 2627 ///// 2628 06461 4565 OPTRET, TSTERM /MOVE TO ,;CR 2629 06462 5261 JMP .-1 2630 06463 5665 JMP I .+2 /END OF OPTIONS 2631 06464 5246 JMP OPTION /CONTINUE PROCESSING OPTIONS 2632 06465 0616 PROC 2633 ///// 2634 /HIGH SPEED INPUT ROUTINE 2635 06466 0000 HREAD, 0 2636 06467 1067 TAD M5 2637 06470 3156 DCA T1 2638 06471 3157 DCA T2 2639 06472 6001 HREAD2, ION /(SWAP) - FOR 2-USER 2640 06473 1037 TAD HINBUF /WAIT FOR INPUT 2641 06474 7700 SMA CLA 2642 06475 5306 JMP HSGO+1 2643 06476 2157 ISZ T2 2644 06477 5272 JMP HREAD2 2645 06500 2156 ISZ T1 2646 06501 5272 JMP HREAD2 2647 06502 1161 TAD PTCH /ALL DONE READING TAPE 2648 06503 3113 DCA 113 /SWAP TO KEYBOARD INPUT 2649 06504 1054 TAD P337 /RETURN A B.A. TO KILL UNENDED LINE OR GARBAGE 2650 /CHARACTER 2651 06505 5315 HSGO, JMP RESTR-2 2652 06506 7040 CMA 2653 06507 3037 DCA HINBUF /SET TO READ NEXT 2654 06510 6016 RRB RFC 2655 06511 0026 AND P177 /IGNORE PARITY AND BLANK 2656 06512 7450 SNA 2657 06513 5267 JMP HREAD+1 2658 06514 1015 TAD C200 2659 06515 3142 DCA CHAR 2660 06516 5666 JMP I HREAD 2661 ///// 2662 06517 4003 RESTR, HREAD-CHIN 2663 2664 PAGE 2665 /FLOATING POINT PACKAGE 2666 /ARITHMETIC INTERPRETER 2667 06600 0000 FPNT, 0 2668 06601 7300 CLA CLL 2669 06602 1600 TAD I FPNT /FLOATING INSTRUCTION 2670 06603 7450 SNA 2671 06604 5600 JMP I FPNT /FEXT 2672 06605 0015 AND C200 /GET PAGE BIT 2673 06606 7640 SZA CLA 2674 06607 1200 TAD FPNT /CURRENT PAGE 2675 06610 0024 AND P7600 2676 06611 3231 DCA FLADDR /START ADDRESS OF ADDRESSED PAGE 2677 06612 1600 TAD I FPNT /GET ADDRESS BITS 2678 06613 0026 AND P177 2679 06614 1231 TAD FLADDR 2680 06615 3231 DCA FLADDR /FULL 12-BIT ADDRESS 2681 06616 1600 TAD I FPNT 2682 06617 2200 ISZ FPNT 2683 06620 7106 CLL RTL /OP BITS =>AC9-11 2684 06621 7006 RTL /INDIRECT BIT =>LINK 2685 06622 0031 AND P17 2686 06623 1236 TAD DRECTR /SET UP OP POINTER 2687 06624 3235 DCA DIRECT 2688 06625 1631 TAD I FLADDR /INDIRECT? 2689 06626 7430 SZL 2690 06627 3231 DCA FLADDR /YES 2691 06630 4504 PUSHF /NO, GET OPERAND 2692 06631 0000 FLADDR, 0 2693 06632 4505 POPF 2694 06633 0040 FLOP 2695 06634 3043 DCA FLOP3 /CLEAR LOW ORDER OPERAND 2696 06635 5637 DIRECT, JMP I .+2 /OP DIRECT INSTRUCTION 2697 06636 5637 DRECTR, JMP I .+1 /OP TABLE 2698 06637 7406 FLPOW 2699 06640 6720 FLADD 2700 06641 6717 FLSUB 2701 06642 7077 FLMUL 2702 06643 7171 FLDIV 2703 06644 6647 FLGET 2704 06645 6653 FLPUT 2705 06646 6762 FLNOR 2706 2707 06647 4504 FLGET, PUSHF /OP 5: GET FLAC FROM STORAGE 2708 06650 0040 FLOP 2709 06651 1254 TAD .+3 /SET UP POINTER TO FLAC 2710 06652 5256 JMP .+4 2711 06653 4504 FLPUT, PUSHF /OP 6: PUT FLAC IN STORAGE 2712 06654 0044 FLAC 2713 06655 1231 TAD FLADDR /SET UP POINTER TO STORAGE 2714 06656 3260 DCA .+2 2715 06657 4505 POPF 2716 06660 0000 0 /ADDRESS OF STORAGE LOCATION 2717 06661 5201 JMP FPNT+1 2718 06662 0000 NEGOP, 0 /ROUTINE TO NEGATE FLOP 2719 06663 1042 TAD FLOP2 2720 06664 7141 CLL CIA 2721 06665 3042 DCA FLOP2 2722 06666 7024 CML RAL 2723 06667 1041 TAD FLOP1 2724 06670 7041 CIA 2725 06671 3041 DCA FLOP1 2726 06672 1004 TAD FNEGSW /FNEGSW IS COMPLEMENTED WHEN 2727 06673 7140 CLL CMA /FLOP OR FLAC IS NEGATED 2728 06674 3004 DCA FNEGSW 2729 06675 5662 JMP I NEGOP 2730 06676 0000 NEGAC, 0 /ROUTINE TO NEGATE FLAC - "NEGATE" 2731 06677 7300 CLA CLL /TRIPLE PRECISION 2732 06700 1047 TAD FLAC3 2733 06701 7041 CIA 2734 06702 3047 DCA FLAC3 2735 06703 7024 CML RAL 2736 06704 1046 TAD FLAC2 2737 06705 7041 CIA 2738 06706 3046 DCA FLAC2 2739 06707 7024 CML RAL 2740 06710 1045 TAD FLAC1 2741 06711 7041 CIA 2742 06712 3045 DCA FLAC1 2743 06713 1004 TAD FNEGSW 2744 06714 7140 CLL CMA 2745 06715 3004 DCA FNEGSW 2746 06716 5676 JMP I NEGAC 2747 /ARITHMETIC OPERATIONS 2748 /BOTH FLAC AND FLOP MUST BE NORMALIZED FOR 2749 /+-*/^ (FAD,FSU,FMY,FDV,FXP) 2750 06717 4262 FLSUB, JMS NEGOP /OP 2: SUBTRACT OP (NEGATE AND ADD) 2751 06720 1045 FLADD, TAD FLAC1 /OP 1: ADD OP 2752 06721 7650 SNA CLA 2753 06722 5247 JMP FLGET /RESULT=OPERAND IF FLAC=0 2754 06723 1041 TAD FLOP1 2755 06724 7650 SNA CLA 2756 06725 5201 JMP FPNT+1 /RESULT=FLAC IF FLOP=0 2757 06726 1040 TAD FLOP0 /COMPARE EXPONENTS 2758 06727 7041 CIA 2759 06730 1044 TAD FLAC0 2760 06731 7450 SNA 2761 06732 5357 JMP CMBINE /EQUAL, GO ADD TOGETHER 2762 06733 7500 SMA /NOT EQUAL, NEED SHIFTING 2763 06734 5346 JMP SHFLOP /FLAC>FLOP, SHIFT FLOP 2764 06735 1365 TAD P27 /FLAC