1 /**** FOCAL 5/69 **** 2 /E.A.TAFT - REVISION OF FOCALW 8/68 /EAT/ 25-JUL-72 3 4 5 6 7 8 /ASSEMBLY INSTRUCTIONS FOR DECUS VERSION: 9 10 /INPUT FILES: 11 / FOCAL.569 FOCAL LANGUAGE PROCESSOR 12 / FLOAT.569 FLOATING POINT PACKAGE 13 / EXTEND.569 EXTENDED FUNCTION PACKAGE 14 / 2USER.569 2-USER OVERLAY 15 16 /ASSEMBLY USING PAL10 V.141 17 / .R PAL10 18 / *FOCAL.BIN_FOCAL.569,FLOAT.569 19 / *EXTEND.BIN_EXTEND.569 20 / *2USER.BIN_2USER.569 21 / *^C 22 / .R PIP 23 / *FOCAL.BIN/B_FOCCAL.BIN,EXTEND.BIN,2USER.BIN 24 / *PTP:/I_FOCAL.BIN 25 26 /WHEN READ-IN ON A PDP-8, THE LOADER WILL STOP 3 TIMES. THE FIRST 27 / SECTION CONTAINS THE BASIC PROCESSOR AND FLOATING POINT PACKAGE. 28 / THE SECOND SECTION CONTAINS THE EXTENDED FUNCTIONS. THE LAST 29 / SECTION CONTAINS THE 2-USER OVERLAY (REQUIRES 2 TERMINALS AND 8K). 30 EXPUNGE 31 /PROCESSOR INSTRUCTIONS 32 FIXMRI AND=0000 33 FIXMRI TAD=1000 34 FIXMRI ISZ=2000 35 FIXMRI DCA=3000 36 FIXMRI JMS=4000 37 FIXMRI JMP=5000 38 /FLOATING POINT INSTRUCTIONS 39 FIXMRI FPW=0000 40 FIXMRI FAD=1000 41 FIXMRI FSB=2000 42 FIXMRI FMY=3000 43 FIXMRI FDV=4000 44 FIXMRI FGT=5000 45 FIXMRI FPT=6000 46 47 FNR=7000 48 FEXT=0 49 FENT=JMS I 7 50 NOP=7000 51 CLA=7200 52 CLL=7100 53 CMA=7040 54 RAL=7004 55 CML=7020 56 RAR=7010 57 RTR=7012 58 RTL=7006 59 IAC=7001 60 SMA=7500 61 SZA=7440 62 SPA=7510 63 SNA=7450 64 SNL=7420 65 SZL=7430 66 SKP=7410 67 CIA=7041 68 ION=6001 69 IOF=6002 70 KSF=6031 71 KRB=6036 72 TSF=6041 73 TCF=6042 74 TPC=6044 75 TLS=6046 76 RSF=6011 77 RRB=6012 78 RFC=6014 79 FIXTAB 80 81 / * FOCAL * - BY RICK MERRILL - FOR THE FAMILY OF 8. 82 /REVISED BY EDWARD TAFT 5/69 83 84 /MISCELLANEOUS ITEMS 85 *1 86 000001 5402 JMP I .+1 /INTERRUPT PROCESSOR ENTRY 87 000002 2603 INTRPT 88 000003 7477 MINUSA, -301 /CONSTANT 89 000004 0000 FNEGSW, 0 /USED FOR CALCULATING SIGNS 90 000005 0013 P13, 13 /CONSTANT 91 000006 0100 C100, 100 /CONSTANT 92 000007 6600 FPNT /ADDRESS OF FLOATING POINT INTERPRETER. 93 94 /AUTO-INDEX REGISTERS 95 96 000010 0000 AXIN, 0 /STORAGE INDEX 97 000011 0000 XRT, 0 /EXTRA XR 98 000012 0000 XRT2, 0 /EXTRA XR 99 000013 0000 PDLXR, 0 /PUSHDOWN LIST INDEX REGISTER. 100 000014 3377 FLTXR, IOBUF-1 /XR15 FOR FLOATING POINT 101 000015 0200 C200, 200 /CONSTANT 102 000016 0000 XRT3, 0 /USED BY PUSHDOWN LIST CONTROLS 103 104 105 TEXTP=. /TEXT POINTERS 106 000017 3430 AXOUT, FRSTX /OUTPUT INDEX 107 000020 0000 XCT, 0 /UNPACK SWITCH 108 000021 0000 GTEM, 0 /UNPACK STORAGE 109 110 /NUMBERS 111 112 000022 0256 PER, 256 /PERIOD 113 000023 7701 M77, -77 /RIGHT MASK 114 000024 7600 P7600, 7600 /GROUP MASK 115 000025 7760 M20, -20 /CONSTANT 116 000026 0177 P177, 177 /STEP MASK 117 000027 5577 BOTTOM, DBCONV-1/END OF TEXT BUFFER 118 FLOAT= JMS I . /FLOAT C(AC) SUBROUTINE 119 000030 7332 XFLOAT 120 000031 0017 P17, 17 /BCD MASK 121 000032 0277 P277, 277 /"?" 122 000033 0240 C240, 240 /SPACE 123 000034 7776 M2, -2 /CONSTANT 124 000035 0002 P2, 2 /CONSTANT 125 000036 0260 C260, 260 /ASCII FOR ZERO 126 000037 0000 HINBUF, 0 /HIGH SPEED INPUT BUFFER 127 128 FLOP=. /FLOATING OPERAND STORAGE 129 000040 0000 FLOP0, 0 130 000041 0000 FLOP1, 0 131 000042 0000 FLOP2, 0 132 000043 0000 FLOP3, 0 133 FLAC=. /FLOATING POINT ACCUMULATOR 134 000044 0000 FLAC0, 0 135 000045 0000 FLAC1, 0 136 000046 0000 FLAC2, 0 137 000047 0000 FLAC3, 0 138 NEGATE= JMS I . /NEGATE FLAC ROUTINE 139 000050 6676 NEGAC 140 000051 0010 TOTDIG, 10 /TOTAL DIGITS IN OUTPUT FIELD 141 FIX= JMS I . /FIX FLAC ROUTINE 142 000052 7311 XFIX 143 000053 0000 TABCTR, 0 /CARRIAGE INDEX 144 145 /CONSTANTS 146 147 148 LIST6=. /INPUT LIST FOR "SFOUND". 149 000054 0337 P337, 337 /LEFT ARR 150 000055 0214 214 /F.F. 151 000056 0207 207 /BELL 152 000057 0212 CLF, 212 /L.F. 153 LIST3=. /EXCRETION LIST 154 000060 0215 CCR, 215 /LIST BRANCHER. 155 000061 0000 0 /SEARCH CHARACTER (VARIABLE) 156 157 M100=. 158 000062 7700 P7700, 7700 /LEFT MASK 159 000063 7540 M240, -240 /SPACE TEST 160 000064 7522 MPER, -256 /PERIOD TEST 161 000065 7563 MCR, -215 /C.R. TEST 162 MFLT=. /3-WORD FLOATING POINT 163 000066 7775 M3, -3 164 000067 7773 M5, -5 /PAREN TEST 165 000070 7767 M11, -11 /PAREN TEST 166 000071 0077 P77, 77 /RIGHT MASK 167 168 000072 6170 FOUTPUT,BDCONV /FLOATING OUTPUT 169 000073 5600 FINPUT, DBCONV /FLOATING INPUT 170 000074 2527 COMBUF, COMEIN /COMMAND BUFFER`START 171 000075 3420 CFRS, FRST /ADDRESS OF DUMMY LINE. 172 000076 3432 END, BUFBEG /FIRST LOCATION USED. 173 000077 3432 ENDT, BUFBEG /START OF STORAGE AREA ** 174 RETURN= JMP I . /FUNCTION RETURN 175 000100 2056 EFUN3I, EFUN3 176 177 /NEW INSTRUCTIONS: 178 179 PUSHJ=JMS I . /RECURSIVE SUBROUTINE CALL 180 000101 0523 XPUSHJ 181 POPA=TAD I PDLXR/RESTORE AC 182 POPJ=JMP I . /SUBROUTINE RETURN 183 000102 1556 XPOPJ 184 PUSHA=JMS I . /SAVE AC 185 000103 0501 XPUSHA 186 PUSHF=JMS I . /SAVE GROUP OF DATA 187 000104 0532 PD2 188 POPF=JMS I . /RESTORE GROUP 189 000105 0550 PD3 190 GETC=JMS I . /UNPACK A CHARACTER 191 000106 2315 UTRA 192 PACKC=JMS I . /PACK A CHARACTER 193 000107 3023 PACBUF 194 SORTJ=JMS I . /SORT AND BRANCH ON AC OR CHAR 195 000110 1333 SORTB 196 SORTC=JMS I . /SORT CHAR 197 000111 0733 XSORTC 198 PRINTC=JMS I . /PRINT AC OR CHAR 199 000112 2477 OUT 200 READC=JMS I . /READ ASR-33 INTO CHAR AND PRINT IT 201 000113 2463 CHIN 202 PRNTLN=JMS I . /PRINT C(LINENO) 203 000114 6151 XPRNTLN 204 GETLN=JMS I . /UNPACK AND FORM A LINENUMBER 205 000115 0312 XGETLN 206 FINDLN=JMS I . /SEARCH FOR A GIVEN LINE 207 000116 2265 XFIND 208 ENDLN=JMS I . /INSERT LINE POINTERS 209 000117 2417 XENDLN 210 RTL6=JMS I . /ROTATE LEFT SIX 211 000120 0305 XRTL6 212 SPNOR=JMS I . /IGNORE SPACES AND LEADING ZEROS 213 000121 1524 XSPNOR 214 TESTN=JMS I . /PERIOD; OTHER; NUMBER 215 000122 1533 XTESTN 216 TSTLPR=JMS I . /SKIP IF 5 0 275 000202 3145 DCA PC /FOR COMMAND MODE 276 000203 3151 DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?). 277 000204 1226 TAD COMBOT /PROTECT COMMAND BUFFER. 278 000205 3013 DCA PDLXR /NO PATCH TEST. 279 000206 2152 ISZ DMPSW /INIT UNPACK AND TRACE SWITCH. 280 000207 3061 DCA LIST3+1 /CLEAR SEARCH CHARACTER FOR INPUT. 281 000210 1054 TAD P337 /ANNOUNCE PRESENCE 282 000211 4512 PRINTC /BY TYPING THE LEAD-IN CHARACTER 283 000212 1074 IBAR, TAD COMBUF /INITIALIZE COMMAND BUFFER 284 000213 3010 DCA AXIN /FOR UNPACKING. 285 000214 3136 DCA XCTIN 286 000215 1074 TAD COMBUF /RUBOUT PROTECTION 287 000216 3153 DCA PACKST 288 000217 4513 IGNOR, READC /READ COMMAND STRING 289 000220 4510 SORTJ 290 000221 0053 LIST6-1 291 000222 0510 INLIST-LIST6 292 000223 4507 PACKC /SAVE STRING CHARACTER. 293 000224 5217 JMP IGNOR 294 ///// 295 000225 4000 P4000, 4000 /LINE NUMBER TEST 296 000226 2612 COMBOT, COMOUT+12 /END OF COMMAND BUFFER,LESS PROTECTION COUNT. 297 000227 1575 CFRSX, FLTZER /POINTER FOR PC=COMMAND OR INPUT 298 ///// 299 /COMMAND/INPUT PROCESSOR 300 301 000230 4507 IRETN, PACKC /START TO PACK C.R. 302 000231 4507 PACKC /FINISH C.R. 303 000232 1074 TAD COMBUF /INITIALIZE "TEXTP" 304 000233 3017 GONE, DCA AXOUT /SETUP CURRENT LINE 305 000234 3020 DCA XCT 306 000235 4506 GETC /READ FIRST CHARACTER. 307 000236 1027 TAD BOTTOM /INIT PUSH-DOWN-LIST 308 000237 3013 DCA PDLXR 309 000240 4521 SPNOR /IGNORE LEADING BLANKS 310 000241 4522 TESTN /DOES THE LINE BEGIN WITH 1-9? 311 000242 4526 ERROR4 /ILLEGAL GROUP ZERO USAGE 312 000243 5274 JMP INPUTX /NO 313 000244 6002 IOF /YES,STOP INPUT MOMENTARILY. 314 000245 2151 ISZ DEBGSW /DISABLE TRACE FOR REPACKING 315 000246 4515 GETLN /READ THIS LINE NUMBER 316 000247 1141 TAD NAGSW 317 000250 1225 TAD P4000 /TEST FOR SINGLE LINE 318 000251 7640 SZA CLA 319 000252 4526 ERROR3 /ILLEGAL LINE NUMBER ON INPUT 320 000253 1134 TAD BUFR /SET POINTERS 321 000254 3010 DCA AXIN 322 000255 3136 DCA XCTIN 323 000256 1143 TAD LINENO /SAVE LINE # 324 000257 3410 DCA I AXIN /(X-MEM) 325 000260 4521 SPNOR /IGNORE SPACES AFTER LINE NUMBER 326 000261 7410 SKP 327 000262 4506 GETC /READ 1ST AFTER LINENO TERMINATOR. 328 000263 4507 PACKC /SAVE TEXT AND RESTORE DATA FIELD 329 000264 1142 TAD CHAR /TEST FOR END OF INPUT STRING 330 000265 1065 TAD MCR 331 000266 7640 SZA CLA 332 000267 5262 JMP .-5 333 000270 4501 PUSHJ /REMOVE OLD LINE, IF ANY. 334 000271 2111 DELETE 335 000272 4517 ENDLN /INSERT NEW LINE 336 000273 5177 JMP START 337 ///// 338 000274 4501 INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND. 339 000275 0616 PROC 340 000276 1545 TAD I PC /CHECK NEXT LINE (X-MEM) 341 000277 7450 SNA /END OF PROGRAM? 342 000300 5177 JMP START /YES 343 000301 3145 DCA PC /SAVE NEW LINE NO. 344 000302 1145 TAD PC /START NEW LINE 345 000303 7001 IAC 346 000304 5233 JMP GONE /PROCESS OTHER COMMANDS 347 /TEXT LINE BUFFER FORMAT* 348 /#1 : POINTER OR ZERO IN LAST 349 /#2 : LINENO 350 /#3 - #N+1 : TEXT 351 /#N : C.R. 352 353 000305 0000 XRTL6, 0 /ROTATE AC LEFT 6 354 000306 7106 CLL RTL 355 000307 7006 RTL 356 000310 7006 RTL 357 000311 5705 JMP I XRTL6 358 / 359 /PROCESS A LINE NUMBER - "GETLN" 360 000312 0000 XGETLN, 0 361 000313 4521 SPNOR 362 000314 1225 TAD P4000 /INITIALIZE TO SINGLE LINE 363 000315 3141 DCA NAGSW 364 000316 4511 SORTC /TEST FOR A SIGN 365 000317 6114 SNLIST-1 366 000320 5370 JMP EVLN /EVALUATE IN FLOATING POINT 367 000321 4766 JMS I INPINT /FIXED POINT: GET GROUP 368 000322 4522 TESTN 369 000323 4506 GETC /GO PAST . IF THERE 370 000324 4356 JMS GEG /GET 1ST STEP DIGIT 371 000325 7106 CLL RTL /MULTIPLY BY TEN 372 000326 1127 TAD SORTCN 373 000327 7004 RAL 374 000330 4356 JMS GEG /GET 2ND STEP DIGIT 375 000331 1143 TAD LINENO /COMBINE 376 000332 7450 GEXIT, SNA 377 000333 3141 DCA NAGSW /MUST BE GROUP 378 000334 3143 DCA LINENO /SAVE STEP NUMBER 379 000335 1164 TAD DECNUM /GROUP 380 000336 7450 SNA 381 000337 5347 JMP GTESTA /GROUP 0: MUST BE "ALL" 382 000340 4520 RTL6 /CONSTRUCT LINE NUMBER 383 000341 7004 RAL 384 000342 1143 TAD LINENO 385 000343 3143 DCA LINENO 386 000344 1164 TAD DECNUM /TEST FOR LEGAL GROUP 387 000345 0367 AND C7760 388 000346 5351 JMP .+3 389 000347 2141 GTESTA, ISZ NAGSW /SET TO "ALL" 390 000350 1143 TAD LINENO /MAKE SURE LINE # IS ZERO 391 000351 7650 SNA CLA 392 000352 4522 TESTN /OK, TEST FOR EXTRA DIGITS 393 000353 5361 JMP LNERR /DOUBLE ., ILLEGAL G. 0, OR G.>15 394 000354 5712 JMP I XGETLN /OK 395 000355 5361 JMP LNERR /TOO MANY DIGITS 396 397 000356 0000 GEG, 0 /GET A STEP DIGIT 398 000357 3143 DCA LINENO 399 000360 4522 TESTN 400 000361 4526 LNERR, ERROR /DOUBLE PERIODS 401 000362 5331 JMP GEXIT-1 /NO DIGIT 402 000363 4506 GETC /DIGIT, PASS IT 403 000364 1127 TAD SORTCN /EXIT WITH VALUE 404 000365 5756 JMP I GEG 405 ///// 406 000366 6010 INPINT, DECINT 407 000367 7760 C7760, 7760 408 ///// 409 /EVALUATE A LINE NUMBER IN FLOATING POINT 410 000370 4501 EVLN, PUSHJ /GET VALUE 411 000371 1601 EVAL 412 000372 4452 FIX /GET GROUP # 413 000373 4503 PUSHA 414 000374 1045 TAD FLAC1 415 000375 7640 SZA CLA 416 000376 5361 JMP LNERR /TOO BIG 417 000377 4407 FENT /GET STEP # 418 000400 7000 FNR 419 000401 2560 FSB I FLARGP /THIS GIVES -(FRACTIONAL PART) 420 000402 3614 FMY I F10P 421 000403 3614 FMY I F10P 422 000404 2615 FSB I FP10P /KILL ANY ROUNDOFF ERROR 423 000405 0000 FEXT 424 000406 4450 NEGATE 425 000407 1413 POPA /RESTORE GROUP 426 000410 3164 DCA DECNUM 427 000411 4452 FIX 428 000412 5613 JMP I .+1 429 000413 0332 GEXIT 430 ///// 431 000414 5770 F10P, FLTEN 432 000415 5773 FP10P, FLPTEN 433 434 /RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 15.99 435 436 /NAGSW: 437 /GROUP=0000 438 /LINE=4000 439 /ALL=0001 440 /RECURSIVE OPERATE, EXECUTE, OR CALL 441 442 000416 4515 DO, GETLN /EXECUTE ONE LINE, A GROUP,OR ALL 443 000417 1145 TAD PC /SAVE ADDRESS 444 000420 4503 PUSHA /OF CURRENT LINE 445 000421 4504 PUSHF /SAVE REST OF THIS LINE 446 000422 0017 TEXTP /ADDRESS OF TEXT POINTERS 447 000423 4504 DGRP, PUSHF /SAVE NAGSW; CHAR; AND LINENO. 448 000424 0141 NAGSW 449 000425 1141 TAD NAGSW /CHECK DATA FROM GETLN. 450 000426 7710 SPA CLA /SKIP IF GROUP OR ALL 451 000427 5254 JMP DOONE /DO ONE LINE 452 000430 4516 FINDLN /INIT FOR GROUP AND SET THISLN 453 000431 5273 JMP TGRP2 454 000432 4501 DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC. 455 000433 0613 PROCESS-2 456 000434 4505 POPF /RESTORE THE DATA 457 000435 0141 NAGSW 458 000436 1545 TAD I PC /CHECK FOR END OF TEXT (X-MEM) 459 000437 7450 SNA 460 000440 5262 JMP DCONT /ALL DONE 461 000441 7001 IAC 462 000442 3154 DCA PT1 /SAVE POINTER TO LINENO 463 000443 1141 TAD NAGSW /CHECK FOR GROUP 464 000444 7740 SMA SZA CLA 465 000445 5251 JMP .+4 /DO ALL 466 000446 1554 TAD I PT1 /TEST GROUP (X-MEM) 467 000447 4524 TSTGRP 468 000450 5262 JMP DCONT /NOT IN GROUP 469 000451 1554 TAD I PT1 /READ NEXT LINE NO. (X-MEM) 470 000452 3143 DCA LINENO 471 000453 5223 JMP DGRP /CONTINUE THE SUBROUTINE 472 ///// 473 000454 4516 DOONE, FINDLN /FIND THE LINE 474 000455 4526 ERROR2 /NO SUCH LINE NUMBER 475 000456 4501 PUSHJ /EXECUTE IT 476 000457 0615 PROCESS 477 000460 4505 POPF /RESTORE CHAR 478 000461 0141 NAGSW 479 000462 4505 DCONT, POPF /RESTORE TEXT POINTERS 480 000463 0017 TEXTP 481 000464 1413 POPA /RESTORE ADDRESS OF CURRENT LINE. 482 000465 3145 DCA PC 483 000466 4565 TSTERM /GO TO TERMINATOR 484 000467 5266 JMP .-1 485 000470 5672 JMP I .+2 /END OF DO, CONTINUE PROCESSING 486 000471 5216 JMP DO /COMMA, DO ANOTHER 487 000472 0616 PROC 488 489 000473 1146 TGRP2, TAD THISLN /TEST FOR GOOD GROUP NUMBER. 490 000474 3011 DCA XRT 491 000475 1411 TAD I XRT 492 000476 4524 TSTGRP 493 000477 4526 ERROR2 /NO SUCH GROUP NUMBER 494 000500 5232 JMP DGRP1 495 /PUSHDOWN LIST CONTROLS 496 / 497 000501 0000 XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA" 498 000502 3332 DCA PD2 /SAVE AC 499 000503 7040 CMA /BACK UP POINTER 500 000504 4310 JMS PCHK /CHECK CORE USAGE 501 000505 1332 TAD PD2 502 000506 3416 DCA I XRT3 /SAVE 503 000507 5701 JMP I XPUSHA 504 ///// 505 000510 0000 PCHK, 0 506 000511 1013 TAD PDLXR /INC IN AC 507 000512 3013 DCA PDLXR 508 000513 1013 TAD PDLXR 509 000514 3016 DCA XRT3 /DUPLICATE POINTER 510 000515 1013 TAD PDLXR 511 000516 7141 CLL CIA 512 000517 1155 TAD LASTV 513 000520 7630 SZL CLA 514 000521 4526 ERROR /STORAGE FILLED BY PUSHDOWN LIST 515 000522 5710 JMP I PCHK 516 ///// 517 000523 0000 XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ" 518 000524 7201 CLA IAC 519 000525 1323 TAD XPUSHJ /SAVE RETURN 520 000526 4301 JMS XPUSHA /(PUSHA) 521 000527 1723 TAD I XPUSHJ /TO NEW ROUTINE 522 000530 3323 DCA XPUSHJ 523 000531 5723 JMP I XPUSHJ 524 ///// 525 000532 0000 PD2, 0 /SAVE A FLOATING PT NUMBER - "PUSHF" 526 000533 7240 CLA CMA /COMPUTE ADDRESS 527 000534 1732 TAD I PD2 528 000535 3011 DCA XRT 529 000536 2332 ISZ PD2 530 000537 1066 TAD M3 /BACKUP THREE 531 000540 4310 JMS PCHK 532 000541 1411 TAD I XRT /SAVE 3 WORDS 533 000542 3416 DCA I XRT3 534 000543 1411 TAD I XRT 535 000544 3416 DCA I XRT3 536 000545 1411 TAD I XRT 537 000546 3416 DCA I XRT3 538 000547 5732 JMP I PD2 539 540 000550 0000 PD3, 0 /RESTORE A FLOATING PT # - "POPF" 541 000551 7240 CLA CMA 542 000552 1750 TAD I PD3 543 000553 2350 ISZ PD3 544 000554 3011 DCA XRT 545 000555 1413 TAD I PDLXR 546 000556 3411 DCA I XRT 547 000557 1413 TAD I PDLXR 548 000560 3411 DCA I XRT 549 000561 1413 TAD I PDLXR 550 000562 3411 DCA I XRT 551 000563 5750 JMP I PD3 552 / 553 /INPUT CONTROL CHARACTERS 554 000564 0212 INLIST, IBAR /B.A.=RESTART 555 000565 0223 IGNOR+4 /F.F. 556 000566 0223 IGNOR+4 /BELL 557 000567 0217 IGNOR /L.F.=IGNORED 558 000570 0230 IRETN /C.R.=TERMINATE INPUT 559 / 560 /LIST OF FUNCTION ADDRESSES 561 000571 2053 FNTABF, XABS /ABSOLUTE VALUE 562 000572 7535 FSGN /SIGN PART 563 000573 1156 XINT /INTEGER PART 564 000574 1145 XDYS /FDIS- DISPLAY Y AND INTENSIFY 565 000575 7351 FRAN /RANDOM NUMBER 566 000576 1153 XDXS /SET X-COORDINATE FOR DISPLAY 567 000577 2414 XADC /READ ANALOG-DIGITAL CONVERTER 568 000600 2735 ERROR5 /ATN THESE ROUTINES NOT IN PACKAGE 569 000601 2735 ERROR5 /EXP 570 000602 2735 ERROR5 /LOG 571 000603 2735 ERROR5 /SIN 572 000604 2735 ERROR5 /COS 573 000605 7462 FSQT /SQUARE ROOT 574 000606 2735 ERROR5 /NEW- USER-DEFINED FUNCTION 575 / 576 000607 7472 MF, -306 /USED BY TESTC 577 /PRIMARY CONTROL AND TRANSFER 578 579 000610 4515 GOTO, GETLN /READ THE LINE NUMBER REQUESTED 580 000611 4516 FINDLN /LOCATE IT AND RESET TEXTP 581 000612 4526 ERROR2 /NOT THERE OR A TIGHT LOOP. 582 000613 1146 TAD THISLN /SET PC 583 000614 3145 DCA PC 584 000615 4506 PROCESS,GETC /TEST FOR END OF LINE 585 000616 4511 PROC, SORTC /FIRST CHARACTER READY = USE PROC 586 000617 0057 CCR-1 587 000620 5502 PC1, POPJ /EXIT "PROCESS" 588 000621 4511 SORTC /IGNORE SPACE ; , 589 000622 1140 GLIST-1 590 000623 5215 JMP PROCESS 591 000624 1142 TAD CHAR /SAVE COMMAND CHARACTER 592 000625 4503 PUSHA 593 000626 4506 GETC /GO TO TERMINATOR 594 000627 4511 SORTC 595 000630 2002 TERMS-4 596 000631 7410 SKP 597 000632 5226 JMP .-4 598 000633 4521 SPNOR 599 000634 1413 POPA 600 000635 4510 SORTJ /GO DO COMMAND 601 000636 0755 COMLST-1 602 000637 0206 COMGO-COMLST 603 000640 4526 ERROR2 /ILLEGAL COMMAND 604 ///// 605 606 COMMENTS=PC1 /ALSO IS CONTINUE 607 608 /OUTPUT COMMAND TEXT 609 610 000641 4711 WRITE, JMS I WTXS /SAVE CHAR AND TEXT POINTERS 611 000642 4515 GETLN /SET LINENO 612 000643 2151 ISZ DEBGSW /DISABLE TRACE 613 000644 4516 FINDLN /SEARCH FOR LINE NUMBER 614 000645 5274 JMP WTESTG /NOT THERE OR GROUP 615 000646 1143 TAD LINENO 616 000647 7640 SZA CLA 617 000650 4514 PRNTLN /PRINT LINE NUMBER AND A SPACE. 618 000651 4506 GETC 619 000652 4512 PRINTC /PRINT TEXT OF A LINE. 620 000653 1142 TAD CHAR 621 000654 1065 TAD MCR 622 000655 7640 SZA CLA /SKIP IF END OF LINE 623 000656 5251 JMP .-5 624 000657 1546 TAD I THISLN /TEST FOR END OF TEXT (X-MEM) 625 000660 7450 WTEST2, SNA 626 000661 5303 JMP WEXIT /WRITE FINISHED 627 000662 7001 IAC 628 000663 3154 DCA PT1 /SAVE POINTER TO LINENO OF`NEXT (X-MEM) 629 000664 1141 TAD NAGSW 630 000665 7700 SMA CLA 631 000666 1554 TAD I PT1 /(X-MEM) 632 000667 4524 TSTGRP /TRY NEXT LINENO FOR GROUP. 633 000670 5276 JMP WX 634 000671 1554 WALL, TAD I PT1 /SET LINENO (X-MEM) 635 000672 3143 DCA LINENO 636 000673 5244 JMP WRITE+3 637 /// 638 000674 1146 WTESTG, TAD THISLN /INIT GROUP PRINTOUT 639 000675 5260 JMP WTEST2 640 ///// 641 000676 1141 WX, TAD NAGSW 642 000677 7750 SPA SNA CLA /SKIP IF ALL 643 000700 5303 JMP WEXIT 644 000701 4512 PRINTC /PRINT C.R. AGAIN 645 000702 5271 JMP WALL 646 ///// 647 000703 4712 WEXIT, JMS I WTXR /RESTORE CURRENT LINE 648 000704 3151 DCA DEBGSW /RESTORE TRACE 649 000705 4565 TSTERM 650 000706 5305 JMP .-1 651 000707 5216 JMP PROC /END OF WRITE 652 000710 5241 JMP WRITE /COMMA, MORE TO WRITE 653 ///// 654 000711 2435 WTXS, TXTSAV 655 000712 2443 WTXR, TXTRES 656 657 000713 0000 XTESTC, 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC" 658 000714 4521 SPNOR /IGNORE SPACES 659 000715 4511 SORTC /TEST THE VARIABLE TERMINATORS 660 000716 2005 TERMS-1 661 000717 5713 JMP I XTESTC /YES - SORTCN IS SET 662 000720 2313 ISZ XTESTC 663 000721 4522 TESTN 664 000722 5713 JMP I XTESTC /. (PART OF NUMBER) 665 000723 7410 SKP /OTHER 666 000724 5713 JMP I XTESTC /NUMBER 667 000725 1142 TAD CHAR /TEST FOR "F" 668 000726 1207 TAD MF 669 000727 7640 SZA CLA 670 000730 2313 ISZ XTESTC /NO 671 000731 2313 ISZ XTESTC /RETURNS: 672 000732 5713 JMP I XTESTC /TERMINATOR;NUMBER;FUNCTION;OTHER 673 ///// 674 000733 0000 XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORTC" 675 000734 1733 TAD I XSORTC 676 000735 3012 DCA XRT2 /1ST ARG IS LIST-1 677 000736 1412 TAD I XRT2 678 000737 7510 SPA /LIST IS ENDED BY A NEGATIVE NUMBER 679 000740 5352 JMP SEXC /2AND EXIT = NOT IN LIST 680 000741 7041 CIA 681 000742 1142 TAD CHAR 682 000743 7640 SZA CLA /COMPARE 683 000744 5336 JMP .-6 684 000745 1733 TAD I XSORTC /COMPUTE INCREMENT : 0 - N 685 000746 7040 CMA 686 000747 1012 TAD XRT2 687 000750 3127 DCA SORTCN 688 000751 7410 SKP /1ST EXIT = YES 689 000752 2333 SEXC, ISZ XSORTC 690 000753 2333 ISZ XSORTC 691 000754 7300 CLA CLL 692 000755 5733 JMP I XSORTC 693 694 /COMMAND DECODING LIST 695 000756 0323 COMLST, 323 /SET 696 000757 0306 306 /FOR 697 000760 0311 311 /IF 698 000761 0304 304 /DO 699 000762 0307 307 /GOTO 700 000763 0303 303 /COMMENT OR CONTINUE 701 000764 0301 301 /ASK 702 000765 0324 324 /TYPE 703 000766 0314 314 /LIBRARY 704 000767 0305 305 /ERASE 705 000770 0327 327 /WRITE 706 000771 0315 315 /MODIFY 707 000772 0321 321 /QUIT 708 000773 0322 322 /RETURN 709 000774 0317 317 /OPTION 710 000775 0310 310 /HELLO 711 /CONDITIONAL TRANSFER PROCESS 712 / IF (EXP) A,B,C 713 000776 4511 IF, SORTC /LOOK FOR L-PAR 714 000777 1022 PLPR-1 715 001000 7410 SKP 716 001001 4526 ERROR /NO ( AFTER IF 717 001002 4501 PUSHJ /EVALUATE EXPRESSION 718 001003 1600 EVAL-1 719 001004 4506 GETC /PASS ) 720 001005 1045 TAD FLAC1 /TEST FOR -,0,+ 721 001006 7710 SPA CLA 722 001007 5622 JMP I PGOTO /NEGATIVE, USE 1ST REF 723 001010 4565 TSTERM /0 OR POS, GET TO NEXT 724 001011 5210 JMP .-1 725 001012 5703 JMP I PRCP /; OR CR, CONTINUE SAME LINE 726 001013 1045 TAD FLAC1 /COMMA, SEE IF 0 OR POS 727 001014 7650 SNA CLA 728 001015 5622 JMP I PGOTO /ZERO, USE 2ND REF 729 001016 4565 TSTERM /POSITIVE, GET TO NEXT 730 001017 5216 JMP .-1 731 001020 5703 JMP I PRCP /; OR CR 732 001021 5622 JMP I PGOTO /COMMA, USE 3RD REF 733 001022 0610 PGOTO, GOTO 734 001023 0250 PLPR, 250 735 /ASSIGNMENT AND LOOP CONTROL 736 SET=. 737 001024 4501 FOR, PUSHJ /GET POINTER TO VAR. 738 001025 1404 GETARG 739 001026 4521 SPNOR 740 001027 4511 SORTC /SEARCH FOR = 741 001030 2024 TERMS+17-1 742 001031 7410 SKP 743 001032 4526 ERROR /LEFT OF = IN ERROR: "FOR" OR "SET" 744 001033 1154 TAD PT1 /SAVE VARIABLE POINTER 745 001034 3332 DCA PT2 746 001035 4501 PUSHJ /EVALUATE INITIAL EXPRESSION 747 001036 1600 EVAL-1 748 001037 4407 FENT /SAVE INITIAL VALUE 749 001040 6732 FPT I PT2 750 001041 0000 FEXT 751 001042 4565 TSTERM /CHECK TERMINATOR 752 001043 4526 ERROR /PROBABLY EXCESS R-PAR 753 001044 5703 JMP I PRCP /; OR CR: THIS IS A SET; CONTINUE 754 001045 1332 TAD PT2 /COMMA, SAVE LOOP VAR POINTER 755 001046 4503 PUSHA 756 001047 4501 PUSHJ /EVALUATE SECOND EXPRESSION 757 001050 1601 EVAL 758 001051 4565 TSTERM /CHECK TERMINATOR 759 001052 4526 ERROR /EXCESS R-PAR OR BAD TERMINATOR 760 001053 5317 JMP ONEINC /; OR CR, THAT'S ALL (INC=1) 761 001054 4504 PUSHF /COMMA, SAVE INCREMENT 762 001055 2034 FLARG 763 001056 4501 PUSHJ /EVALUATE FINAL EXPRESSION 764 001057 1601 EVAL 765 001060 4504 SFINAL, PUSHF /SAVE FINAL VALUE 766 001061 2034 FLARG 767 001062 4724 JMS I FTXS /SAVE CHAR AND TEXT POINTERS 768 001063 4430 FLOAT /FLOAT A ZERO TO START 769 001064 4407 FCONT, FENT /COMPARE LOOP VAR TO FINAL 770 001065 1732 FAD I PT2 /LOOP VAR 771 001066 6732 FPT I PT2 772 001067 2560 FSB I FLARGP /FINAL 773 001070 0000 FEXT 774 001071 1013 TAD PDLXR /CHECK SIGN OF INCREMENT 775 001072 1322 TAD PINC 776 001073 3332 DCA PT2 777 001074 1732 TAD I PT2 778 001075 7710 SPA CLA 779 001076 4450 NEGATE /BACKWARD COUNTING 780 001077 1045 TAD FLAC1 781 001100 7740 SMA SZA CLA 782 001101 5326 JMP FEND /LIMIT REACHED OR EXCEEDED 783 784 001102 4501 PUSHJ /NOT YET, DO OBJECT STATEMENTS 785 001103 0616 PRCP, PROC 786 001104 4725 JMS I FTXR /RESET TO BEGINNING OF OBJ. STMT. 787 001105 4505 POPF /RESTORE LIMIT 788 001106 2034 FLARG 789 001107 4505 POPF /RESTORE INC 790 001110 0044 FLAC 791 001111 1413 POPA /RESTORE LOOP VAR POINTER 792 001112 3332 DCA PT2 793 001113 1323 TAD M13 /PUSH DOWN ALL OF ABOVE 794 001114 1013 TAD PDLXR 795 001115 3013 DCA PDLXR 796 001116 5264 JMP FCONT 797 ///// 798 001117 4504 ONEINC, PUSHF /NO INCREMENT GIVEN, SET TO 1 799 001120 1573 FLTONE 800 001121 5260 JMP SFINAL 801 ///// 802 001122 0011 PINC, 11 803 001123 7765 M13, -13 804 001124 2435 FTXS, TXTSAV 805 001125 2443 FTXR, TXTRES 806 001126 1005 FEND, TAD P13 /END OF LOOP 807 001127 1013 TAD PDLXR /REMOVE VALUES!FROM PUSHDOWN LIST 808 001130 3013 DCA PDLXR 809 001131 5502 POPJ 810 001132 0000 PT2, 0 811 ///// 812 /ASK/TYPE SPECIAL CHARACTERS 813 001133 0246 ALIST, 246 /& 814 001134 0245 245 /% 815 001135 0242 242 /" 816 001136 0241 241 /! 817 001137 0243 243 /# 818 001140 0244 244 /$ 819 001141 0240 GLIST, 240 /SPACE 820 001142 0254 TLIST, 254 /, 821 001143 0273 273 /; 822 001144 0215 215 /C.R. 823 /SET Y AND INTENSIFY THE POINT 824 001145 4452 XDYS, FIX 825 001146 6063 6063 /DYL 826 001147 7200 CLA 827 001150 1361 TAD X0 828 001151 6053 6053 /DXL DIX 829 001152 7410 SKP 830 / 831 /SET X 832 001153 4452 XDXS, FIX 833 001154 3361 DCA X0 /(DXL) 834 001155 5500 RETURN 835 / 836 /TAKE THE INTEGER PART 837 001156 4452 XINT, FIX 838 001157 7200 CLA 839 001160 5500 RETURN 840 001161 0000 X0, 0 841 ///// 842 001162 1252 TLIST3, TASK4 /" 843 001163 1210 TASK /C.R. - AUTOMATIC QUOTE MATCH 844 /COMMAND POINTERS 845 001164 1024 COMGO, SET 846 001165 1024 FOR 847 001166 0776 IF 848 001167 0416 DO 849 001170 0610 GOTO 850 001171 0620 COMMENTS 851 001172 1206 ASK 852 001173 1207 TYPE 853 001174 2735 LIBRARY 854 001175 2226 ERASE 855 001176 0641 WRITE 856 001177 1273 MODIFY 857 001200 0177 START 858 001201 1554 RETRN 859 001202 6446 OPTION 860 001203 3274 HELLO 861 ///// 862 001204 3040 PACLS2, PQUES 863 001205 3065 RUB1 864 /INPUT-OUTPUT STATEMENTS 865 866 001206 7240 ASK, CLA CMA /REMEMBER WHICH CALL. 867 001207 3131 TYPE, DCA ATSW 868 001210 3151 TASK, DCA DEBGSW /RE-ENABLE THE TRACE 869 001211 4510 SORTJ /SPECIAL CHARACTER? 870 001212 1132 ALIST-1 871 001213 0426 ATLIST-ALIST 872 001214 2131 ISZ ATSW /TEST QUOTE SWITCH 873 001215 5227 JMP TYPE2 874 001216 4501 PUSHJ /DO ASK; SETUP PT1 875 001217 1404 GETARG 876 001220 4636 JMS I TTXTS /PROTECT TEXT 877 001221 1233 TAD COL /TYPE COLON 878 001222 4512 TASKCL, PRINTC /(CLA) TO SUPPRESS ":" 879 001223 4626 JMS I INTERP /CALL INPUT CONVERSION ROUTINE 880 001224 4637 JMS I TTXTR /RESTORE TEXT 881 001225 5206 JMP ASK /CONTINUE PROCESSING 882 001226 3306 INTERP, INTASK 883 //// 884 001227 4501 TYPE2, PUSHJ /DO TYPE 885 001230 1601 EVAL 886 001231 4565 TSTERM 887 001232 4526 ERROR /BAD TERMINATOR IN "TYPE" 888 001233 0272 COL, 272 889 001234 4640 JMS I OUTS /PRINT 890 001235 5207 JMP TYPE 891 ///// 892 001236 2435 TTXTS, TXTSAV 893 001237 2443 TTXTR, TXTRES 894 001240 3365 OUTS, OUTPT 895 896 001241 2151 TQUOT, ISZ DEBGSW /DISABLE TRACE 897 001242 4506 GETC /TYPE LITERALS 898 001243 4510 SORTJ 899 001244 1404 TLIST2-1 900 001245 7555 TLIST3-TLIST2 901 001246 4512 PRINTC 902 001247 5242 JMP TQUOT+1 903 ////// 904 001250 1060 TCRLF, TAD CCR /SLASH=CR,LF. 905 001251 4512 PRINTC 906 001252 4506 TASK4, GETC /MOVE TO NEXT CHARACTER 907 001253 5210 JMP TASK 908 //// 909 001254 1060 TCRLF2, TAD CCR /SPLAT=CR 910 001255 4537 JMS I OUTDEV 911 001256 1015 TAD C200 /DELAY FOR C.R. 912 001257 5251 JMP TCRLF+1 913 914 /IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW" 915 / #0: DISABLE AND RETURN ALL"?" ' S. 916 /IF DMPSW = 0: TRACE ON, IF ENABLED 917 / #0: TRACE OFF 918 /IF BOTH = 0 : PRINT TRACE. 919 920 921 001260 4506 TINTR, GETC /PASS PERCENT SIGN 922 001261 4672 JMS I INTG /READ FORMAT CONTROL: "%7.3" 923 001262 1164 TAD DECNUM /INTEGER PART (TOTAL DIGITS) 924 001263 3051 DCA TOTDIG 925 001264 4522 TESTN /GET PAST . IF ANY 926 001265 4506 GETC 927 001266 4672 JMS I INTG /RIGHT-HAND PART (DECIMAL PLACES) 928 001267 1164 TAD DECNUM 929 001270 3133 DCA DECP 930 001271 5210 JMP TASK 931 001272 6010 INTG, DECINT 932 /SEARCH ROUTINES 933 934 001273 4515 MODIFY, GETLN /READ LINE NO. 935 001274 4516 FINDLN /LOOK IT UP NOW. 936 001275 4526 ERROR2 /NOT THERE = BAD COMMAND UNLESS ZERO. 937 001276 1134 TAD BUFR /SET POINTERS 938 001277 3010 DCA AXIN /FOR INPUT 939 001300 3136 DCA XCTIN 940 001301 1143 TAD LINENO /COPY THE SAME LINE NUMBER. 941 001302 7450 SNA /CHECK FOR ALL 942 001303 5275 JMP MODIFY+2 /ERROR IN ARG 943 001304 3410 DCA I AXIN /(X-MEM) 944 001305 1010 TAD AXIN /SAVE START OF NEW LINE 945 001306 3153 DCA PACKST 946 001307 4540 SCONT, JMS I INDEV /READ THE TELETYPE INPUT SILENTLY. 947 001310 3061 DCA LIST3+1 /SAVE SEARCH CHARACTER 948 001311 2151 ISZ DEBGSW /NO BREAKS. 949 001312 4506 SCHAR, GETC /TYPE+TEST-F.F. 950 001313 4512 PRINTC 951 001314 4510 SORTJ /LOOK FOR MATCH 952 001315 0057 LIST3-1 953 001316 1322 LISTGO-LIST3 954 001317 4507 PACKC /SAVE NEW LINE. 955 001320 5312 JMP SCHAR 956 ///// 957 001321 1134 SBAR, TAD BUFR /RESTART-B.A. 958 001322 7001 IAC 959 001323 3010 DCA AXIN /SET POINTERS 960 001324 3136 DCA XCTIN 961 001325 4513 SFOUND, READC /READ FROM KEYBOARD 962 001326 4510 SORTJ /TEST 963 001327 0053 LIST6-1 964 001330 1322 SRNLST-LIST6 965 001331 4507 SGOT, PACKC /PACK CHAR. 966 001332 5325 JMP SFOUND /MORE 967 968 001333 0000 SORTB, 0 /SORT AND BRANCH ROUTINE. - "SORTJ" 969 001334 7450 SNA 970 001335 1142 TAD CHAR /ASSUME CHAR IF AC=0 971 001336 7041 CIA 972 001337 3157 DCA T2 /SAVE SORT ITEM 973 001340 1733 TAD I SORTB /FIRST ARG IS LIST LESS ONE 974 001341 2333 ISZ SORTB /2AND IS INTRA-LIST LENGTH 975 001342 3012 DCA XRT2 976 001343 1412 TAD I XRT2 977 001344 7510 SPA /**LISTS ENDED BY NEGATIVE NUMBERS** 978 001345 5357 JMP SEX /READ EXIT 979 001346 1157 TAD T2 /FIND ADDRESS 980 001347 7640 SZA CLA 981 001350 5343 JMP .-5 982 001351 1012 TAD XRT2 /MATCH FOUND. 983 001352 1733 TAD I SORTB 984 001353 3333 DCA SORTB /SETUP RETURN 985 001354 1733 TAD I SORTB 986 001355 3333 DCA SORTB 987 001356 7410 SKP 988 001357 2333 SEX, ISZ SORTB /MATCH NOT FOUND. 989 001360 7300 CLA CLL 990 001361 5733 JMP I SORTB /RETURN TO CALLING SEQUENCE. 991 992 001362 4501 TAB, PUSHJ /TABULATE TO A PARTICULAR COLUMN 993 001363 1600 EVAL-1 994 001364 4452 FIX /GET COLUMN NUMBER 995 001365 7141 CLL CIA 996 001366 7001 IAC 997 001367 1053 TAD TABCTR 998 001370 7630 SZL CLA 999 001371 5210 JMP TASK /ALREADY THERE OR PAST IT 1000 001372 1033 TAD C240 1001 001373 4512 PRINTC 1002 001374 1046 TAD FLAC2 /TEST AGAIN 1003 001375 5365 JMP TAB+3 1004 SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE 1005 001376 1321 SBAR /B.A. = RESTART 1006 001377 1312 SCHAR /F.F. = CONTINUE 1007 001400 1307 SCONT /BELL = CHANGE SEARCH CHARACTER 1008 001401 1310 SCONT+1 /L.F. = FINISH THE LINE AS BEFORE. 1009 ///// 1010 001402 0263 LISTGO, INPUTX-11 /C.R. - END THE MODIFIED LINE HERE 1011 001403 1331 SGOT /FOUND SEARCH CHARACTER 1012 /FIND OR ENTER A VARIABLE IN THE LIST. 1013 1014 001404 4525 GETARG, TESTC /FIRST LETTER OF ARG 1015 001405 0242 TLIST2, 0242 /" 1016 001406 0215 0215 /C.R. - FUNCTION OR NUMBER IS NOT AN ARG. 1017 001407 4526 ERROR4 /BAD ARGUEMENT IN 'FOR' 'SET', OR 'ASK' 1018 001410 7240 CLA CMA /"GETARG" CAN CREATE NEW VAR. 1019 001411 4503 GETVAR, PUSHA /"GETVAR" WILL NOT 1020 001412 3136 DCA XCTIN /PACK INTO ADD. 1021 001413 4507 PACKC 1022 001414 4506 GETC /SECOND LETTER 1023 001415 4511 SORTC /TERMINATOR? 1024 001416 2005 TERMS-1 1025 001417 5222 JMP .+3 /YES 1026 001420 1142 TAD CHAR /NO 1027 001421 0071 AND P77 /SAVE 2AND LETTER OF NAME 1028 001422 1135 TAD ADD 1029 001423 4503 PUSHA 1030 001424 4511 SORTC /IGNORE THE REST 1031 001425 2005 TERMS-1 1032 001426 5231 JMP .+3 1033 001427 4506 GETC 1034 001430 5224 JMP .-4 1035 001431 4523 TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN 1036 001432 5243 JMP GS1 /NOT SUBSCRIPTED BY L-PAR. 1037 001433 1130 TAD LASTOP /SAVE LAST OPERATION 1038 001434 4503 PUSHA 1039 001435 4501 PUSHJ /MOVE PAST L-PAR AND 1040 001436 1600 EVAL-1 /EVALUATE THE SUBSCRIPT. 1041 001437 4506 GETC /MOVE PAST R-PAR 1042 001440 1413 POPA 1043 001441 3130 DCA LASTOP /RECALL LAST OPERATION 1044 001442 4452 FIX 1045 001443 3324 GS1, DCA SUBS /SAVE SUBSCRIPT 1046 001444 1413 POPA 1047 001445 3135 DCA ADD /RESTORE NAME 1048 001446 1134 TAD STARTV /SEARCH FOR VARIABLE 1049 001447 3154 GS3, DCA PT1 1050 001450 1154 TAD PT1 1051 001451 3011 DCA XRT 1052 001452 1154 TAD PT1 1053 001453 7041 CIA 1054 001454 1155 TAD LASTV /TEST FOR END OF LIST 1055 001455 7750 SPA SNA CLA 1056 001456 5267 JMP GS2 /END SEARCH 1057 001457 1554 TAD I PT1 /GET TABLE ENTRY 1058 001460 7041 CIA 1059 001461 1135 TAD ADD 1060 001462 7650 SNA CLA 1061 001463 5312 JMP GFND1 /FOUND XX 1062 1063 001464 1154 GS4, TAD PT1 /TRY NEXT ONE 1064 001465 1144 TAD GINC 1065 001466 5247 JMP GS3 1066 001467 2413 GS2, ISZ I PDLXR /VAR. NOT FOUND, CAN I MAKE ONE? 1067 001470 4526 ERROR /UNDEFINED VAR. USED IN EXPRESSION 1068 001471 1155 TAD LASTV /OK, ADD THE VARIABLE 1069 001472 1005 TAD P13 /TEST STORAGE LIMITS 1070 001473 7141 CIA CLL 1071 001474 1013 TAD PDLXR 1072 001475 7620 SNL CLA 1073 001476 4526 ERROR3 1074 001477 1155 TAD LASTV /UPDATE THE LIST. 1075 001500 1144 TAD GINC 1076 001501 3155 DCA LASTV 1077 001502 1135 TAD ADD /SAVE NAME 1078 001503 3554 DCA I PT1 1079 001504 1324 TAD SUBS /SAVE SUBSCRIPT 1080 001505 3411 DCA I XRT 1081 001506 3411 DCA I XRT /INITIALIZE VAR. TO ZERO 1082 001507 3411 DCA I XRT 1083 001510 3411 DCA I XRT 1084 001511 5320 JMP GS5 /EXIT 1085 ///// 1086 001512 1411 GFND1, TAD I XRT /FOUND NAME, TEST SUBSCRIPT 1087 001513 7041 CIA 1088 001514 1324 TAD SUBS 1089 001515 7640 SZA CLA 1090 001516 5264 JMP GS4 /WRONG SUBSCRIPT 1091 001517 2013 ISZ PDLXR 1092 001520 2154 GS5, ISZ PT1 /SET POINTER TO DATA 1093 001521 2154 ISZ PT1 1094 001522 5502 POPJ 1095 //// 1096 001523 1575 P0, FLTZER 1097 1098 /IGNORE LEADING SPACES - "SPNOR" 1099 1100 SUBS=. 1101 001524 0000 XSPNOR, 0 1102 001525 1142 TAD CHAR 1103 001526 1063 TAD M240 1104 001527 7640 SZA CLA 1105 001530 5724 JMP I XSPNOR 1106 001531 4506 GETC 1107 001532 5325 JMP XSPNOR+1 1108 ///// 1109 /SEE IF NEXT CHARACTER IS A NUMBER 1110 001533 0000 XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN" 1111 001534 1142 TAD CHAR 1112 001535 1064 TAD MPER /TEST FOR . 1113 001536 7440 SZA 1114 001537 2333 ISZ XTESTN /NOT A . 1115 001540 1352 TAD NTST1 /COMPARE TO "9" 1116 001541 7500 SMA 1117 001542 5350 JMP NTEXIT /TOO LARGE 1118 001543 1353 TAD NTST2 /COMPARE TO "0" 1119 001544 7510 SPA 1120 001545 5350 JMP NTEXIT /TOO SMALL 1121 001546 3127 DCA SORTCN /FOUND DIGIT, SAVE IT 1122 001547 2333 ISZ XTESTN 1123 001550 7300 NTEXIT, CLA CLL 1124 001551 5733 JMP I XTESTN 1125 ///// 1126 001552 7764 NTST1, 256-272 1127 001553 0012 NTST2, 272-260 1128 /EXIT FROM A "DO" SUBROUTINE 1129 1130 1131 001554 1323 RETRN, TAD P0 /(PC) => 0 1132 001555 3145 DCA PC 1133 001556 1413 XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ" 1134 001557 3157 DCA T2 1135 001560 5557 JMP I T2 1136 1137 1138 /ASK-TYPE CONTROL CHARACTER TABLE 1139 001561 1362 ATLIST, TAB /& - TABULATION DELIMITER 1140 001562 1260 TINTR /% - FORMAT DELIMITER 1141 001563 1241 TQUOT /" - LITERAL DELIMITER 1142 001564 1250 TCRLF /! - CARRIAGE RETURN AND LINE FEED 1143 001565 1254 TCRLF2 /# - CARRIAGE RETURN ONLY 1144 001566 3125 TDUMP /$/- DUMP THE SYMBOL TABLE CONTENTS 1145 001567 1252 TASK4 /SP- TERMINATOR FOR NAMES 1146 001570 1252 TASK4 /, - TERMINATOR FOR EXPRESSIONS 1147 001571 0615 PROCESS /; - TERMINATOR FOR COMMANDS 1148 001572 0620 PC1 /C.R. - TERMINATOR FOR STRINGS 1149 ///// 1150 001573 0001 FLTONE, 0001 1151 001574 2000 2000 1152 001575 0000 FLTZER, 0000 1153 001576 0000 0000 1154 001577 0000 0000 1155 /EVALUATE AN EXPRESSION WHICH 1156 /TERMINATES WITH AN R-PAR,; OR C.R. AND 1157 /LEAVE THE RESULT IN FLAC AND IN FLARG. 1158 1159 1160 1161 1162 001600 4506 GETC /MOVE PAST EXTRA CHARACTER 1163 001601 3130 EVAL, DCA LASTOP /EVAUATION CONTROLLER (CHECKPOINT ?) 1164 001602 4525 TESTC /TEST CHARACTER AND IGNORE SPACES 1165 001603 5215 JMP ETERM1 /TERMIOATION 1166 001604 5332 JMP ENUM /NUMBER 1167 001605 5342 JMP EFUN /FUNCTION 1168 001606 4501 PUSHJ /LETTER OF VARIABLE 1169 001607 1411 GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1. 1170 001610 4525 OPNEXT, TESTC /PT1=>ARG 1171 001611 5236 JMP ETERMN /T 1172 001612 0212 ECHOLST,0212 /N-ERROR IN FORMAT 1173 001613 0377 0377 /F 1174 001614 4526 ERROR4 /L - MISSING OPERATOR 1175 ///// 1176 001615 4504 ETERM1, PUSHF /INITIALIZE RESULT TO ZERO. 1177 001616 1575 FLTZER 1178 001617 4505 POPF 1179 001620 2034 FLARG 1180 001621 1160 TAD FLARGP /SET PT1. 1181 001622 3154 DCA PT1 1182 001623 1034 TAD M2 /TEST FOR UNARY OPERATIONS 1183 001624 1127 TAD SORTCN 1184 001625 7450 SNA 1185 001626 5241 JMP ETERM /CREATE DUMMY FOR UNARY MINUS 1186 001627 7001 IAC 1187 001630 7650 SNA CLA 1188 001631 5323 JMP ARGNXT /IGNORE UNARY PLUS 1189 001632 1127 TAD SORTCN /TEST FOR NULL PARENS. 1190 001633 1070 TAD M11 1191 001634 7710 SPA CLA 1192 001635 5353 JMP ELPAR /MIGHT BE AN L-PAR. 1193 001636 4523 ETERMN, TSTLPR 1194 001637 7410 SKP 1195 001640 4526 ERROR4 /OPERATOR MISSING BEFORE PAREN 1196 001641 1127 ETERM, TAD SORTCN /SET FROM "TESTC"-"SORTC" 1197 001642 3147 DCA THISOP 1198 001643 1147 TAD THISOP 1199 001644 1070 TAD M11 1200 001645 7700 SMA CLA /END? 1201 001646 3147 DCA THISOP /"THISOP" EQUIV. TO END OF EXP. 1202 1203 001647 7201 ETERM2, CLA IAC /COMPARE PRIORITIES 1204 001650 0147 AND THISOP /PRIORITIES ARE: (^),(*/),(+-),PUT 1205 001651 1147 TAD THISOP 1206 001652 7041 CIA 1207 001653 3274 DCA FLOPR 1208 001654 7001 IAC 1209 001655 0130 AND LASTOP 1210 001656 1130 TAD LASTOP 1211 001657 1274 TAD FLOPR 1212 001660 7710 SPA CLA 1213 001661 5310 JMP EPAR /CONTINUE 1214 001662 1130 TAD LASTOP /FIND OPERATION FROM TABLE 1215 001663 1331 TAD OPTABL 1216 001664 3274 DCA FLOPR 1217 001665 1674 TAD I FLOPR 1218 001666 3274 DCA FLOPR 1219 001667 1130 TAD LASTOP 1220 001670 7640 SZA CLA /TEST FOR END OF DATA INTO FLOATING AC. 1221 001671 4505 POPF /GET LAST DATA 1222 001672 0044 FLAC 1223 001673 4407 FENT 1224 001674 0000 FLOPR, 00 /(FLOPR I PT1) +-*/^ 1225 001675 6560 FPT I FLARGP /SAVE RESULT 1226 001676 0000 FEXT 1227 001677 1160 TAD FLARGP 1228 001700 3154 DCA PT1 1229 001701 1147 TAD THISOP 1230 001702 1130 TAD LASTOP /=0? 1231 001703 7650 SNA CLA 1232 001704 5502 POPJ /EXIT "EVAL" 1233 001705 1413 POPA /GET PRIOR OP 1234 001706 3130 DCA LASTOP 1235 001707 5247 JMP ETERM2 /COMPARE THIS OP 1236 ///// 1237 001710 4523 EPAR, TSTLPR /TEST FOR SUB-EXPRESSION 1238 001711 7410 SKP 1239 001712 5355 JMP EPAR2 /GO EVALUATE EXPRESSION 1240 001713 1130 TAD LASTOP /CONTINUE READING THE EXPRESSION 1241 001714 4503 PUSHA /SAVE "LASTOP". 1242 001715 1154 TAD PT1 1243 001716 3320 DCA .+2 1244 001717 4504 PUSHF /SAVE LAST ARGUMENT 1245 001720 0000 00 1246 001721 1147 TAD THISOP /MORE TO COME 1247 001722 3130 DCA LASTOP 1248 001723 4506 ARGNXT, GETC /READ 1ST CHAR OF AN ARG. 1249 001724 4525 TESTC /DO SPECIAL CHECK 1250 001725 5353 JMP ELPAR /COULD BE LEFT PAREN 1251 001726 5332 JMP ENUM /N 1252 001727 5342 JMP EFUN /F 1253 001730 5206 JMP OPNEXT-2 /L 1254 001731 2026 OPTABL, OPTABS 1255 ///// 1256 1257 001732 4504 ENUM, PUSHF /TO PROCESS A NUMBER,SAVE AC 1258 001733 0044 FLAC 1259 001734 1160 TAD FLARGP /SET POINTER AS FOR A VARIABLE. 1260 001735 3154 DCA PT1 1261 001736 4473 JMS I FINPUT /READ TEXT NUMBER => (PT1) 1262 001737 4505 POPF /RESTORE THE AC 1263 001740 0044 FLAC 1264 001741 5210 JMP OPNEXT /CONTINUE 1265 ///// 1266 001742 3274 EFUN, DCA FLOPR /SET CODE 1267 001743 4506 GETC /READ FUNCTION NAME.(1,2,OR 3 LETTERS) 1268 001744 4511 SORTC /LOOK FOR TERMINATION CHARACTER. 1269 001745 2005 TERMS-1 1270 001746 5364 JMP EFUN2 /YES 1271 001747 1274 TAD FLOPR /NO 1272 001750 7104 CLL RAL /MISH-MASH HASH CODE 1273 001751 1142 TAD CHAR 1274 001752 5342 JMP EFUN 1275 001753 4523 ELPAR, TSTLPR 1276 001754 4526 ERROR4 /DOUBLE OPERATORS 1277 001755 1127 EPAR2, TAD SORTCN /LEFT PARENS FOUND. 1278 001756 4503 PUSHA 1279 001757 1130 TAD LASTOP /SAVE DATA 1280 001760 4503 PUSHA 1281 001761 4501 PUSHJ /EVALUATE THE EXPRESSION 1282 001762 1600 EVAL-1 1283 001763 5500 JMP I EFUN3I 1284 /// 1285 001764 1127 EFUN2, TAD SORTCN /SAVE 'SORTCN','LASTOP',AND FUNC CODE 1286 001765 4503 PUSHA 1287 001766 1130 TAD LASTOP 1288 001767 4503 PUSHA 1289 001770 1274 TAD FLOPR /SAVE FUNCTION CODE. 1290 001771 4503 PUSHA 1291 001772 4523 TSTLPR 1292 001773 4526 ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT 1293 001774 4501 PUSHJ /YES 1294 001775 1600 EVAL-1 1295 001776 1413 POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I. 1296 001777 4510 SORTJ 1297 002000 2207 FNTABL-1 1298 002001 6361 FNTABF-FNTABL 1299 002002 4526 ERROR2 /ILLEGAL FUNCTION NAME. 1300 ///// 1301 1302 002003 0241 241 /! 1303 002004 0242 242 /" 1304 002005 0256 256 /. -FOR INPUT NUMBERS 1305 TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR' 1306 002006 0240 240 /SPACE 0 1307 002007 0253 253 /+ 1 1308 002010 0255 255 /- 2 1309 002011 0257 257 // 3 1310 002012 0252 252 /* 4 1311 002013 0336 336 /UP ARR 5 1312 002014 0250 250 /( 6 L-PARS 1313 002015 0333 333 /[ 7 1314 002016 0274 274 /< 10 1315 002017 0251 251 /) 11 R-PARS 1316 002020 0335 335 /] 12 1317 002021 0276 276 /> 13 1318 002022 0254 254 /, 14 1319 002023 0273 273 /; 15 1320 002024 0215 215 /C.R. 16 1321 002025 0275 275 /= TO END GETARG FROM 'SET' 1322 002026 5554 OPTABS, FGT I PT1 1323 002027 1554 FAD I PT1 1324 002030 2554 FSB I PT1 1325 002031 4554 FDV I PT1 1326 002032 3554 FMY I PT1 1327 002033 0554 FPW I PT1 1328 ///// 1329 002034 0000 FLARG, 0 /DATA TEMPORARY STORAGE 1330 002035 0000 0 1331 002036 0000 0 1332 ///// 1333 /FOCAL TEXT FOR "HELLO" COMMAND 1334 002037 7056 HPT, 7056 /[T %] 8.4; 1335 002040 6473 6473 1336 002041 1740 1740 /OPTION K,T,I,E,:,S; 1337 002042 1354 1354 1338 002043 2454 2454 1339 002044 1154 1154 1340 002045 0554 0554 1341 002046 7254 7254 1342 002047 2373 2373 1343 002050 0540 0540 /ERASE ALL 1344 002051 0177 0177 1345 002052 1500 1500 1346 ///// 1347 /ABSOLUTE VALUE FUNCTION 1348 002053 1045 XABS, TAD FLAC1 1349 002054 7710 SPA CLA 1350 002055 4450 NEGATE 1351 /CONTINUATION OF FUNCTION CALLS. 1352 1353 002056 1413 EFUN3, POPA /RESTORE LAST OPERATION 1354 002057 3130 DCA LASTOP 1355 002060 4407 FENT 1356 002061 7000 FNR /NORMALIZE FUNCTION RETURN 1357 002062 6234 FPT FLARG 1358 002063 0000 FEXT 1359 002064 1160 TAD FLARGP /SET POINTER 1360 002065 3154 DCA PT1 1361 002066 1413 POPA /GET LAST PAREN CODE. 1362 002067 7041 CIA /CHECK FOR PAREN MATCH. 1363 002070 1066 TAD M3 1364 002071 1127 TAD SORTCN /(STILL SET FROM THE LAST "EVAL") 1365 002072 7640 SZA CLA /SKIP IF MATCH 1366 002073 4526 ERROR4 /PAREN ERROR 1367 002074 4506 GETC /MOVE PAST R-PAR, AND RETURN TO OPNEX. 1368 002075 5676 JMP I .+1 /FUNCTION RETURN IS OK 1369 002076 1610 OPNEXT 1370 //// 1371 1372 002077 0000 LPRTST, 0 /SKIP IF LEFT PAREN. - 'TSTLPR' 1373 002100 1127 TAD SORTCN 1374 002101 1070 TAD M11 1375 002102 7700 SMA CLA 1376 002103 5677 JMP I LPRTST 1377 002104 1127 TAD SORTCN 1378 002105 1067 TAD M5 1379 002106 7740 SMA SZA CLA 1380 002107 2277 ISZ LPRTST 1381 002110 5677 JMP I LPRTST 1382 1383 /THE DELETE A LINE ROUTINE 1384 1385 002111 4516 DELETE, FINDLN /SETS "THISLN" AND "LASTLN". 1386 002112 5502 POPJ /ALREADY GONE 1387 002113 2151 ISZ DEBGSW /DISABLE TRACE 1388 002114 4506 GETC /MEASURE LENGTH 1389 002115 1142 TAD CHAR 1390 002116 1065 TAD MCR 1391 002117 7640 SZA CLA 1392 002120 5314 JMP .-4 1393 002121 1017 TAD AXOUT /SAVE LAST ADDRESS 1394 002122 7040 CMA 1395 002123 1146 TAD THISLN 1396 002124 3132 DCA CNTR /LENGTH < 0 1397 002125 1546 TAD I THISLN /DISCONNECT 1398 002126 3550 DCA I LASTLN 1399 002127 1075 TAD CFRS /START LIST AT TOP 1400 002130 3157 DOK, DCA T2 /EXAMINATION ADDRESS 1401 002131 1557 TAD I T2 /GET THE NEXT ADDR. 1402 002132 7450 SNA /TEST FOR END 1403 002133 5346 JMP DONE /YES-WRAP UP ALL. 1404 002134 3156 DCA T1 /SAVE NEXT ADDRESS. 1405 002135 1146 TAD THISLN /COMPARE LINE POSITIONS 1406 002136 7141 CIA CLL 1407 002137 1156 TAD T1 1408 002140 7630 SZL CLA /SKIP IF THISLN > X 1409 002141 1132 TAD CNTR /CHANGE (X) TO ACCOUNT FOR 1410 002142 1156 TAD T1 /GARBAGE COLLECTION. 1411 002143 3557 DCA I T2 1412 002144 1156 TAD T1 /GET NEXT 1413 002145 5330 JMP DOK 1414 ///// 1415 /GARBAGE COLLECTION 1416 1417 002146 7040 DONE, CMA /BACKUP L FOR XR 1418 002147 1146 TAD THISLN 1419 002150 3011 DCA XRT 1420 002151 1132 TAD CNTR /SETUP END OF HOSE 1421 002152 7040 CMA 1422 002153 1146 TAD THISLN 1423 002154 3012 DCA XRT2 1424 002155 1132 TAD CNTR /CORRECT END OF BUFFER POINTER. 1425 002156 1134 TAD BUFR 1426 002157 3134 DCA BUFR 1427 002160 1010 TAD AXIN /COMPUTE COUNT 1428 002161 7040 CMA 1429 002162 1012 TAD XRT2 1430 002163 3156 DCA T1 1431 002164 1010 TAD AXIN 1432 002165 1132 TAD CNTR 1433 002166 3010 DCA AXIN 1434 002167 1412 TAD I XRT2 /SIPHON LOWER PART. 1435 002170 3411 DCA I XRT 1436 002171 2156 ISZ T1 1437 002172 5367 JMP .-3 1438 002173 5311 JMP DELETE /RESET 'LASTLN','THISLN', AND DATA`FIELD. 1439 ///// 1440 /OPTION TABLE 1441 002174 6457 OPTTBL, OPTK /SWITCH TO KEYBOARD INPUT 1442 002175 6453 OPTR /READER INPUT 1443 002176 3237 OPTT /TTY OUTPUT 1444 002177 3234 OPTP /PUNCH OUTPUT 1445 002200 3303 OPTI /INTERPRETIVE/NUMERIC I/O 1446 002201 3302 OPTC /SINGLE CHARACTER I/O 1447 002202 3244 OPTCOL /PRINT ":" AT "ASK" 1448 002203 3243 OPTX /SUPPRESS ":" 1449 002204 3252 OPTE /ECHO KEYBOARD INPUT 1450 002205 3253 OPTN /NO ECHO 1451 002206 3256 OPTS /SET VARIABLE TERMINATOR 1452 002207 3271 OPTM /START DISK MONITOR 1453 1454 FNTABL=. 1455 002210 2533 2533 /ABS 1456 002211 2650 2650 /SGN 1457 002212 2636 2636 /ITR 1458 002213 2565 2565 /DIS 1459 002214 2630 2630 /RAN 1460 002215 2623 2623 /DXS 1461 002216 2517 2517 /ADC 1462 002217 2572 2572 /ATN 1463 002220 2624 2624 /EXP 1464 002221 2625 2625 /LOG 1465 002222 2654 2654 /SIN /LIST OF CODED FUNCTION NAMES 1466 002223 2575 2575 /COS 1467 002224 2702 2702 /SQT 1468 002225 2631 2631 /NEW 1469 /ERASE SINGLE LINES, GROUPS, OR VARIABLES 1470 002226 1142 ERASE, TAD CHAR /SEE IF "ALL" 1471 002227 1003 TAD MINUSA 1472 002230 7640 SZA CLA 1473 002231 5240 JMP ERVX 1474 002232 1077 TAD ENDT /YES, ERASE ALL TEXT 1475 002233 3134 DCA BUFR 1476 002234 3475 DCA I CFRS 1477 002235 1134 ERV, TAD STARTV /ERASE VARIABLES 1478 002236 3155 DCA LASTV 1479 002237 5177 JMP START /PROGRAM EXECUTION ENDS 1480 ///// 1481 002240 4515 ERVX, GETLN /GET LINE NUMBER 1482 002241 1143 TAD LINENO /SEE OF ZERO OR NONE 1483 002242 7640 SZA CLA 1484 002243 5250 JMP ERL /NO, ERASE LINES 1485 002244 1134 TAD STARTV /YES, ERASE VARIABLES 1486 002245 3155 DCA LASTV 1487 002246 5647 JMP I .+1 /CONTINUE PROCESSING 1488 002247 0616 PROC 1489 ///// 1490 002250 1134 ERL, TAD BUFR /ERASE LINES 1491 002251 3010 DCA AXIN 1492 002252 4501 ERG, PUSHJ /EXTRACT ONE LINE 1493 002253 2111 DELETE 1494 002254 2146 ISZ THISLN 1495 002255 1141 TAD NAGSW 1496 002256 7700 SMA CLA 1497 002257 1546 TAD I THISLN 1498 002260 4524 TSTGRP /IF GROUP, SEE IF END OF GROUP 1499 002261 5235 JMP ERV /YES 1500 002262 1546 TAD I THISLN /NO, CONTINUE ERASING GROUP 1501 002263 3143 DCA LINENO 1502 002264 5252 JMP ERG 1503 /ROUTINE CALLED VIA "FINDLN": 1504 1505 /SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ] 1506 /1ST RETURN IF NOT FOUND, 1507 /2AND IF FOUND. 1508 /"THISLN" = FOUND LINE OR NEXT LARGER. 1509 /"LASTLN" = LESSER AND/OR LAST. 1510 /"TEXTP" IS SET 1511 1512 002265 0000 XFIND, 0 1513 002266 1075 TAD CFRS /INITIALIZE POINTERS TO FIRST LINE 1514 002267 3150 DCA LASTLN 1515 002270 1075 TAD CFRS 1516 002271 3146 FINDN, DCA THISLN /SAVE THIS ONE 1517 002272 1146 TAD THISLN 1518 002273 3012 DCA XRT2 1519 002274 1143 TAD LINENO 1520 002275 7041 CIA 1521 002276 1412 TAD I XRT2 /LINENO=0 WILL ALSO BE FOUND 1522 002277 7450 SNA 1523 002300 2265 ISZ XFIND /FOUND IT (2ND EXIT) 1524 002301 7700 SMA CLA 1525 002302 5310 JMP FEND3 /PAST IT. 1526 002303 1146 TAD THISLN /MOVE POINTERS 1527 002304 3150 DCA LASTLN 1528 002305 1546 TAD I THISLN 1529 002306 7440 SZA /SKIP IF END OF TEST 1530 002307 5271 JMP FINDN 1531 002310 1146 FEND3, TAD THISLN 1532 002311 7001 IAC 1533 002312 3017 DCA AXOUT /SET "TEXTP". 1534 002313 3020 DCA XCT 1535 002314 5665 JMP I XFIND 1536 1537 002315 0000 UTRA, 0 /UNPACK CHARACTER. - "GETC" 1538 002316 4351 JMS GET1 1539 002317 7710 UTE, SPA CLA /NORM & EXTEND 1540 002320 1006 TAD C100 /300-337 & 340-376 1541 002321 1377 TAD M137 /240-276 & 200-236 1542 002322 1142 TAD CHAR 1543 002323 7450 SNA 1544 002324 5337 JMP UTX /"?" FOUND 1545 002325 1054 TAD P337 1546 002326 3142 UTQ, DCA CHAR 1547 002327 1151 TAD DEBGSW 1548 002330 1152 TAD DMPSW 1549 002331 7650 SNA CLA /PRINT ONLY IF BOTH ARE ZERO. 1550 002332 4512 PRINTC 1551 002333 5715 JMP I UTRA 1552 ////// 1553 002334 4351 EXTR, JMS GET1 1554 002335 7040 CMA 1555 002336 5317 JMP UTE 1556 /// 1557 002337 1151 UTX, TAD DEBGSW /TEST FOR TRACE-ENABLED 1558 002340 7640 SZA CLA 1559 002341 5347 JMP .+6 1560 002342 1152 TAD DMPSW /FLIP THE TRACE FLOP 1561 002343 7650 SNA CLA 1562 002344 7001 IAC 1563 002345 3152 DCA DMPSW 1564 002346 5316 JMP UTRA+1 /GET NEXT CHARACTER INSTEAD. 1565 002347 1032 TAD P277 /TRACE DISABLED = RETURN "?" 1566 002350 5326 JMP UTQ 1567 1568 002351 0000 GET1, 0 /UNPACK 6-BITS 1569 002352 2020 ISZ XCT /STARTS=0 1570 002353 5366 JMP GET3 1571 002354 1021 TAD GTEM 1572 002355 0071 GEND, AND P77 1573 002356 3142 DCA CHAR /SAVE 1574 002357 1142 TAD CHAR 1575 002360 1023 TAD M77 1576 002361 7650 SNA CLA 1577 002362 5334 JMP EXTR /EXTENDED 1578 002363 1142 TAD CHAR 1579 002364 1376 TAD M40 1580 002365 5751 JMP I GET1 1581 ///// 1582 1583 002366 1417 GET3, TAD I AXOUT /(X-MEM) 1584 002367 3021 DCA GTEM 1585 002370 7040 CMA 1586 002371 3020 DCA XCT 1587 002372 1021 TAD GTEM 1588 002373 4520 RTL6 1589 002374 7004 RAL 1590 002375 5355 JMP GEND 1591 002376 7740 M40, -40 1592 002377 7641 M137, -137 1593 ///// 1594 /OPTION LIST 1595 002400 0313 OPTLST, "K 1596 002401 0322 "R 1597 002402 0324 "T 1598 002403 0320 "P 1599 002404 0311 "I 1600 002405 0303 "C 1601 002406 0272 ": 1602 002407 0330 "X 1603 002410 0305 "E 1604 002411 0316 "N 1605 002412 0323 "S 1606 002413 0315 "M 1607 ///// 1608 /ANALOG-DIGITAL CONVERSION 1609 002414 6004 XADC, 6004 1610 002415 3045 DCA FLAC1 /ARG MUST BE 0 1611 002416 5500 RETURN 1612 1613 002417 0000 XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" 1614 002420 1550 TAD I LASTLN /SAVE OLD POINTER 1615 002421 3534 DCA I BUFR 1616 002422 1134 TAD BUFR /POINT TO NEW LAST LINE 1617 002423 3550 DCA I LASTLN 1618 002424 1135 TAD ADD /CHECK FOR EXTRA INFO 1619 002425 7440 SZA 1620 002426 3410 DCA I AXIN 1621 002427 1010 TAD AXIN /COMPUTE NEW`END OF BUFFER 1622 002430 7001 IAC 1623 002431 3134 DCA BUFR 1624 002432 1134 TAD STARTV /RESET VARIABLE LIST 1625 002433 3155 DCA LASTV 1626 002434 5617 JMP I XENDLN 1627 ///// 1628 002435 0000 TXTSAV, 0 /SAVE CHAR AND TEXT POINTERS 1629 002436 4504 PUSHF 1630 002437 0017 TEXTP 1631 002440 1142 TAD CHAR 1632 002441 4503 PUSHA 1633 002442 5635 JMP I TXTSAV 1634 / 1635 002443 0000 TXTRES, 0 /RESTORE SAME 1636 002444 1413 POPA 1637 002445 3142 DCA CHAR 1638 002446 4505 POPF 1639 002447 0017 TEXTP 1640 002450 5643 JMP I TXTRES 1641 ///// 1642 002451 0000 GRPTST, 0 /AC VS LINENO - "TSTGRP" 1643 002452 0024 AND P7600 1644 002453 7041 CIA 1645 002454 3157 DCA T2 1646 002455 1143 TAD LINENO 1647 002456 0024 AND P7600 1648 002457 1157 TAD T2 1649 002460 7650 SNA CLA 1650 002461 2251 ISZ GRPTST 1651 002462 5651 JMP I GRPTST 1652 /I-O SUBROUTINES 1653 1654 VAL=. 1655 002463 0000 CHIN, 0 /READ IN A CHARACTER SUBR. - "READC" 1656 002464 4540 JMS I INDEV 1657 002465 3142 DCA CHAR 1658 002466 4511 SORTC /LINEFEED OR RUBOUT? 1659 002467 1611 ECHOLST-1 1660 002470 5663 JMP I CHIN /YES 1661 002471 4512 ECHO, PRINTC 1662 002472 1142 TAD CHAR /SEE IF 200 (L/T) 1663 002473 1024 TAD P7600 1664 002474 7640 SZA CLA 1665 002475 5663 JMP I CHIN /NO, EXIT 1666 002476 5264 JMP CHIN+1 /YES, GET ANOTHER 1667 ///// 1668 002477 0000 OUT, 0 /OUTPUT A CHARACTER - "PRINTC" 1669 002500 7450 SNA /USE (AC) OR (CHAR) 1670 002501 1142 TAD CHAR 1671 002502 1065 TAD MCR 1672 002503 7450 SNA 1673 002504 5310 JMP OUTCR 1674 002505 1060 TAD CCR 1675 002506 4537 JMS I OUTDEV 1676 002507 5677 OUTX, JMP I OUT 1677 ///// 1678 002510 1060 OUTCR, TAD CCR 1679 002511 4537 JMS I OUTDEV 1680 002512 1057 TAD CLF 1681 002513 5306 JMP OUTX-1 1682 ///// 1683 /TEST FOR A COMMA, SEMICOLON, OR CR - "TSTERM" 1684 /RETURNS: OTHER, ; OR CR, COMMA 1685 /GETS NEXT CHARACTER AFTER COMMA OR OTHER 1686 002514 0000 XTSTER, 0 1687 002515 4511 SORTC /LOOK FOR ,;CR 1688 002516 1141 TLIST-1 1689 002517 7410 SKP 1690 002520 5326 JMP .+6 /OTHER, GO PAST IT 1691 002521 1127 TAD SORTCN /FOUND ONE, SEE WHAT IT IS 1692 002522 2314 ISZ XTSTER 1693 002523 7640 SZA CLA 1694 002524 5714 JMP I XTSTER /; OR CR: 2ND EXIT 1695 002525 2314 ISZ XTSTER /COMMA, 3RD EXIT 1696 002526 4506 GETC 1697 002527 5714 JMP I XTSTER 1698 ///// 1699 1700 COMEIN=.-1 /COMMAND-INPUT BUFFER LIVES HERE. 1701 1702 COMOUT=2600 1703 *COMOUT 1704 1705 /INTERRUPT PROCESSOR. 1706 1707 002600 0000 SAVAC, 0 /CONTENTS OF AC 1708 002601 0000 SAVLK, 0 /CONTENTS OF LINK 1709 002602 7575 MBREAK, -203 /CONTROL-C 1710 002603 3200 INTRPT, DCA SAVAC /SAVE WORKING DATA 1711 002604 7010 RAR 1712 002605 3201 DCA SAVLK 1713 002606 6031 KSF /CHECK FOR KEYBOARD FIRST 1714 002607 5225 JMP TINT 1715 002610 6036 KRB /READ BUFFER AND CLEAR FLAG TO FETCH NEXT 1716 002611 0026 AND P177 /IGNORE PARITY BIT 1717 002612 1015 TAD C200 1718 002613 3306 DCA SIN 1719 002614 1306 TAD SIN 1720 002615 1202 TAD MBREAK /MANUAL STOP? 1721 002616 7650 SNA CLA 1722 002617 5345 JMP RECOVR 1723 002620 1264 TAD INBUF /ANY SPACE? 1724 002621 7640 SZA CLA 1725 002622 4526 ERROR2 /WILL WAIT FOR OUTPUT BUFFER 1726 002623 1306 TAD SIN 1727 002624 3264 DCA INBUF /SAVE INPUT 1728 002625 6041 TINT, TSF 1729 002626 5244 JMP EXIT 1730 002627 6042 TCF 1731 002630 3260 DCA TELSW /TURN OFF THE IN-PROGRESS FLAG. 1732 002631 1663 TAD I OPTRI 1733 002632 7450 SNA 1734 002633 5244 JMP EXIT /DONE 1735 002634 6044 TPC /TYPE NEXT. 1736 002635 3260 DCA TELSW /CLEAR AC AND TURN ON THE FLAG. 1737 002636 3663 DCA I OPTRI /ZERO OUT THE DATA AREA 1738 002637 1263 TAD OPTRI 1739 002640 7001 IAC 1740 002641 0031 AND P17 1741 002642 1261 TAD OPTR0 1742 002643 3263 DCA OPTRI 1743 002644 6244 EXIT, 6244 /RESTORE MEMORY FIELD 1744 002645 6101 6101 /SMP 1745 002646 7000 NOP /(HLT)-IF YOU HAVE MEMORY PARITY 1746 002647 6011 RSF /TEST H.S. READER FLAG 1747 002650 5253 JMP .+3 1748 002651 6012 RRB /READ BUFFER AND CLEAR FLAG 1749 002652 3037 DCA HINBUF /SAVE CHARACTER 1750 002653 1201 TAD SAVLK 1751 002654 7104 RAL CLL 1752 002655 1200 TAD SAVAC 1753 002656 6001 ION 1754 002657 5400 EXITJ, JMP I 0 1755 1756 002660 0001 TELSW, 1 /INPUT SWITCH 1757 002661 3400 OPTR0, IOBUF /OUTPUT POINTERS 1758 002662 3400 OPTRO, IOBUF /VARS 1759 002663 3400 OPTRI, IOBUF 1760 002664 0000 INBUF, 0 /KEYBOARD BUFFER. 1761 ///// 1762 002665 0000 XI33, 0 /VIA (INDEV) 1763 002666 1264 TAD INBUF /ANY INPUT? 1764 002667 7550 SPA SNA 1765 002670 5266 JMP .-2 /NO = WAIT 1766 002671 3275 DCA XOUTL 1767 002672 3264 DCA INBUF /CLEAR INPUT BUFFER 1768 002673 1275 TAD XOUTL 1769 002674 5665 JMP I XI33 1770 ///// 1771 002675 0000 XOUTL, 0 /VIA (OUTDEV) 1772 002676 3265 DCA XI33 /SAVE CURRENT CHARACTER. 1773 002677 1265 TAD XI33 /IS IT A CR? 1774 002700 1065 TAD MCR 1775 002701 7650 SNA CLA 1776 002702 3053 DCA TABCTR /YES, RESET CARRIAGE INDEX 1777 002703 1265 TAD XI33 1778 002704 4732 JMS I SKPNP /SKIP IF A NON-PRINTING CHARACTER 1779 002705 2053 ISZ TABCTR /PRINTING: INCREMENT INDEX 1780 002706 0000 SIN, 0 1781 002707 6001 ION /BE SURE INTERRUPT IS ON. 1782 002710 1662 TAD I OPTRO /ANY ROOM? 1783 002711 7640 SZA CLA /A CHARACTER IS NON-ZERO 1784 002712 5310 JMP .-2 /NO = WAIT. 1785 002713 1260 TAD TELSW /IN PROGRESS? 1786 002714 7640 SZA CLA 1787 002715 5322 JMP .+5 1788 002716 1265 TAD XI33 /NO 1789 002717 6046 TLS /TYPE CHARACTER. 1790 002720 3260 DCA TELSW /SET IN-PROGRESS FLAG. 1791 002721 5675 JMP I XOUTL /RETURN 1792 002722 1265 TAD XI33 /SEND DATA 1793 002723 3662 DCA I OPTRO 1794 002724 1262 TAD OPTRO /SET POINTERS 1795 002725 7001 IAC 1796 002726 0031 AND P17 1797 002727 1261 TAD OPTR0 1798 002730 3262 DCA OPTRO 1799 002731 5675 JMP I XOUTL 1800 /////// 1801 002732 3014 SKPNP, SKIPNP 1802 ERROR2=ERROR; ERROR3=ERROR; ERROR4=ERROR 1803 002733 3225 WAITP, OWAIT 1804 002734 3203 OPTDOP, OPTTDO 1805 002735 3336 ERROR5, DCA .+1 /ERROR CALLED FROM A TABLE 1806 002736 0000 ERR2, 0 /LIMIT EXCEEDED 1807 002737 7240 CLA CMA /COMPUTE CALLING ADDRESS (ALSO "SPACE") 1808 002740 1336 TAD ERR2 /AND USE IT AS ERROR NUMBER. 1809 002741 3143 DCA LINENO /SAVE ERROR CODE. 1810 002742 4733 JMS I WAITP /WAIT FOR OUTPUT TO FINISH 1811 002743 6002 IOF /DISABLE INTERRUPT FOR INITIALIZATIONS 1812 002744 5347 JMP .+3 1813 002745 1015 RECOVR, TAD C200 1814 002746 3143 DCA LINENO /SAVE ERROR NUMBER 1815 002747 2260 ISZ TELSW /TURN ON IN-PROGRESS SWITCH 1816 002750 1025 TAD M20 /SETUP INIT COUNT 1817 002751 3132 DCA CNTR 1818 002752 7040 CMA 1819 002753 1261 TAD OPTR0 1820 002754 3011 DCA XRT /INIT I/O BUFFERS. 1821 002755 3411 DCA I XRT 1822 002756 2132 ISZ CNTR 1823 002757 5355 JMP .-2 1824 002760 3264 DCA INBUF /INIT KEY-BUFR. 1825 002761 1261 TAD OPTR0 /INIT TTY POINTERS. 1826 002762 3263 DCA OPTRI 1827 002763 1261 TAD OPTR0 1828 002764 3262 DCA OPTRO 1829 002765 4734 JMS I OPTDOP /SET TO TTY OUTPUT 1830 002766 1161 TAD PTCH /RESET "READC" 1831 002767 3113 DCA 113 /IF AN ERROR OCCURS. 1832 002770 7040 CMA /PREPARE A STOP BIT FOR TTY 1833 002771 6046 TLS /AND RAISE FLAG 1834 002772 7200 CLA 1835 002773 1060 TAD CCR /PRINT A CR 1836 002774 4512 PRINTC 1837 002775 1032 TAD P277 /MAKE A ? 1838 002776 4512 PRINTC /AND TURN ON THE INTERRUPT 1839 002777 4514 PRNTLN /PRINT ERROR NUMBER AND, 1840 003000 2145 ISZ PC 1841 003001 1545 TAD I PC /UNLESS IT IS ZERO, (X-MEM) 1842 003002 7450 SNA 1843 003003 5211 JMP .+6 1844 003004 3143 DCA LINENO 1845 003005 1062 TAD P7700 1846 003006 4512 PRINTC 1847 003007 4512 PRINTC /PRINT SPACE AGAIN AND 1848 003010 4514 PRNTLN /PRINT LINE OF ERROR. 1849 003011 1060 TAD CCR 1850 003012 4512 PRINTC 1851 003013 5177 JMP START /INTERRUPT WILL BE RE-ENABLED SOON. 1852 ///// 1853 /SKIP IF (AC) IS A NON-PRINTING CHARACTER 1854 003014 0000 SKIPNP, 0 1855 003015 4520 RTL6 /PRINTING CHARACTERS ARE 240-337 1856 003016 7710 SPA CLA 1857 003017 7020 CML 1858 003020 7420 SNL 1859 003021 2214 ISZ SKIPNP 1860 003022 5614 JMP I SKIPNP 1861 ///// 1862 /PACK A CHARACTER INTO THE BUFFER - "PACKC" 1863 003023 0000 PACBUF, 0 1864 003024 4510 SORTJ /LOOK FOR ? OR RUBOUT 1865 003025 3055 PACLST-1 1866 003026 6126 PACLS2-PACLST 1867 003027 1142 TAD CHAR 1868 003030 4214 JMS SKIPNP /PRINTING CHARACTER? 1869 003031 5234 JMP .+3 /YES 1870 003032 1071 TAD P77 /NO, PACK 77 FIRST 1871 003033 4242 JMS PCK1 1872 003034 1142 TAD CHAR /PACK 6-BIT CHARACTER 1873 003035 0071 AND P77 1874 003036 4242 JMS PCK1 1875 003037 5623 JMP I PACBUF 1876 ///// 1877 003040 1054 PQUES, TAD P337 /USE 337 FOR ? 1878 003041 5235 JMP .-4 1879 ///// 1880 /PACK ONE 6-BIT WORD 1881 003042 0000 PCK1, 0 1882 003043 2136 ISZ XCTIN 1883 003044 5260 JMP ROT /PACK LEFT HALF 1884 003045 1135 TAD ADD /PACK RIGHT HALF AND STORE 1885 003046 3410 DCA I AXIN 1886 003047 1013 TAD PDLXR /CHECK FOR SPACE 1887 003050 7141 CLL CIA 1888 003051 1005 TAD P13 1889 003052 1010 TAD AXIN 1890 003053 7630 SZL CLA 1891 003054 4526 ERROR /BUFFER OR STORAGE OVERFLOW 1892 003055 5642 JMP I PCK1 1893 ///// 1894 003056 0277 PACLST, 277 /? 1895 003057 0377 377 /RUBOUT 1896 ///// 1897 003060 4520 ROT, RTL6 /SAVE LEFT HALF 1898 003061 3135 DCA ADD 1899 003062 7040 CMA 1900 003063 3136 DCA XCTIN 1901 003064 5642 JMP I PCK1 1902 /RUBOUT ONE CHARACTER 1903 003065 1010 RUB1, TAD AXIN /SAVE POINTER 1904 003066 3242 DCA PCK1 1905 003067 1136 TAD XCTIN /CHARACTER IN ADD? 1906 003070 7640 SZA CLA 1907 003071 5277 JMP RUB2 /YES 1908 003072 1010 TAD AXIN /NO, BEGINNING OF BUFFER? 1909 003073 7041 CIA 1910 003074 1153 TAD PACKST 1911 003075 7700 SMA CLA 1912 003076 5322 JMP PKZERO /YES, IGNORE 1913 003077 1324 RUB2, TAD SPLAT /ECHO A BACKSLASH 1914 003100 4512 PRINTC 1915 003101 2136 ISZ XCTIN 1916 003102 5310 JMP RUB3 /BACKUP STORAGE 1917 003103 1642 TAD I PCK1 /KILL ADD AND CHECK FOR 77 1918 003104 0071 AND P77 /IN 2ND HALF OF LAST STORED WORD 1919 003105 1023 TAD M77 1920 003106 7640 SZA CLA 1921 003107 5322 JMP PKZERO /NO, DONE 1922 003110 1642 RUB3, TAD I PCK1 /KILL 2ND HALF OF LAST STORED WORD 1923 003111 0062 AND P7700 1924 003112 3135 DCA ADD 1925 003113 7040 CMA /BACKUP POINTER 1926 003114 1010 TAD AXIN 1927 003115 3010 DCA AXIN 1928 003116 1135 TAD ADD /TEST FOR 77 IN ADD 1929 003117 1006 TAD C100 1930 003120 7640 SZA CLA 1931 003121 7040 CMA 1932 003122 3136 PKZERO, DCA XCTIN 1933 003123 5623 JMP I PACBUF 1934 003124 0334 SPLAT, 334 1935 /DUMP THE SYMBOL TABLE CONTENTS 1936 003125 4504 TDUMP, PUSHF /SAVE TEXT POINTERS 1937 003126 0017 TEXTP 1938 003127 7040 CMA 1939 003130 1134 TAD STARTV /START VARIABLE LIST 1940 003131 3014 TDLOOP, DCA FLTXR 1941 003132 1014 TAD FLTXR /TEST FOR END OF LIST 1942 003133 7040 CMA 1943 003134 1155 TAD LASTV 1944 003135 7650 SNA CLA 1945 003136 5370 JMP TDEND /END FOUND 1946 003137 1375 TAD TDTEXT /NO, SET UP POINTERS 1947 003140 3017 DCA AXOUT 1948 003141 3020 DCA XCT 1949 003142 1414 TAD I FLTXR /2 LETTERS OF VAR. NAME 1950 003143 3376 DCA TDTEXT+1 1951 003144 4501 PUSHJ /PRINT NAME AND "(" 1952 003145 1241 TQUOT 1953 003146 1414 TAD I FLTXR /GET AND PRINT SUBSCRIPT 1954 003147 4774 JMS I TDOUTP 1955 003150 4501 PUSHJ /PRINT ")=" 1956 003151 1241 TQUOT 1957 003152 1005 TAD P13 /SPACE TO 11TH COLUMN 1958 003153 3046 DCA FLAC2 1959 003154 4501 PUSHJ 1960 003155 1374 TAB+12 1961 003156 2014 ISZ FLTXR 1962 003157 4407 FENT /PICK UP VALUE 1963 003160 5414 FGT I FLTXR /(DOES NOT AUTOINDEX) 1964 003161 0000 FEXT 1965 003162 4472 JMS I FOUTPUT /PRINT VALUE 1966 003163 1060 TAD CCR /AND A C.R. 1967 003164 4512 PRINTC 1968 003165 1014 TAD FLTXR /INCREMENT FOR NEXT VAR. 1969 003166 1035 TAD P2 1970 003167 5331 JMP TDLOOP 1971 003170 4505 TDEND, POPF /RESTORE TEXT POINTERS 1972 003171 0017 TEXTP 1973 003172 5773 JMP I .+1 1974 003173 1252 TASK4 1975 003174 6100 TDOUTP, SIGOUT 1976 003175 3175 TDTEXT, . /THE FOLLOWING IS FOCAL TEXT 1977 003176 0000 0 /VAR. NAME GOES HERE 1978 003177 5077 5077 /"(" AND C.R. 1979 003200 1551 1551 /")=" AND C.R. 1980 003201 7577 7577 1981 003202 1500 1500 1982 /OPTION ROUTINES 1983 / 1984 /ROUTINE TO SET UP OUTPUT 1985 003203 0000 OPTTDO, 0 1986 003204 1220 TAD CTSF 1987 003205 3621 DCA I OPTTL /TSF 1988 003206 1621 TAD I OPTTL 1989 003207 7001 IAC 1990 003210 3622 DCA I OPTTL+1 /TCF 1991 003211 1622 TAD I OPTTL+1 1992 003212 1035 TAD P2 1993 003213 3623 DCA I OPTTL+2 /TPC 1994 003214 1623 TAD I OPTTL+2 1995 003215 1035 TAD P2 1996 003216 3624 DCA I OPTTL+3 /TLS 1997 003217 5603 JMP I OPTTDO 1998 003220 6041 CTSF, TSF 1999 003221 2625 OPTTL, TINT 2000 003222 2627 TINT+2 2001 003223 2634 TINT+7 2002 003224 2717 SIN+11 2003 ///// 2004 /ROUTINE TO WAIT UNTIL OUTPUT FINISHES 2005 003225 0000 OWAIT, 0 2006 003226 6001 ION /(SWAP) - FOR 2-USER 2007 003227 1633 TAD I TSWP /LOOK AT TELSW 2008 003230 7640 SZA CLA 2009 003231 5226 JMP .-3 2010 003232 5625 JMP I OWAIT 2011 003233 2660 TSWP, TELSW 2012 ///// 2013 003234 4225 OPTP, JMS OWAIT /SET UP FOR PUNCH OUTPUT 2014 003235 1025 TAD M20 /CONVERT TO PSF, ETC. 2015 003236 7410 SKP 2016 003237 4225 OPTT, JMS OWAIT /SET UP FOR TTY OUTPUT 2017 003240 4203 JMS OPTTDO 2018 003241 5642 OPTXIT, JMP I .+1 /EXIT OPTIONS 2019 003242 6461 OPTRET 2020 2021 003243 1250 OPTX, TAD OPTC1 /SUPPRESS ":" ON ASK 2022 003244 1247 OPTCOL, TAD CPRINT /RESTORE ":" 2023 003245 3651 DCA I COLP 2024 003246 5241 JMP OPTXIT 2025 003247 4512 CPRINT, PRINTC 2026 003250 2466 OPTC1, CLA-PRINTC 2027 003251 1222 COLP, TASKCL 2028 ///// 2029 003252 1247 OPTE, TAD CPRINT /SET UP FOR KEYBOARD ECHO 2030 003253 3655 OPTN, DCA I ECHP /SUPPRESS ECHO 2031 003254 5241 JMP OPTXIT 2032 003255 2471 ECHP, ECHO 2033 ///// 2034 003256 4506 OPTS, GETC /SET UP USER TERMINATOR FOR "ASK" 2035 003257 4511 SORTC 2036 003260 2003 TERMS-3 2037 003261 7410 SKP 2038 003262 5256 JMP .-4 2039 003263 4501 PUSHJ /GET CHARACTER 2040 003264 1601 EVAL 2041 003265 4452 FIX 2042 003266 3670 DCA I USERTP 2043 003267 5241 JMP OPTXIT 2044 003270 6002 USERTP, USERT 2045 ///// 2046 003271 4225 OPTM, JMS OWAIT /EXIT TO DISK MONITOR 2047 003272 6002 IOF 2048 003273 5424 JMP I P7600 2049 ///// 2050 /THIS IS THE INITIALIZATION COMMAND 2051 003274 1301 HELLO, TAD HP 2052 003275 3017 DCA AXOUT 2053 003276 3020 DCA XCT 2054 003277 4501 PUSHJ /START BY SETTING FORMAT 2055 003300 1260 TINTR 2056 ///// 2057 003301 2036 HP, HPT-1 /FOCAL TEXT "%8.4;O K,T,I,E,:,S;E A" 2058 / I/O MODE OPTIONS 2059 003302 7240 OPTC, CLA CMA 2060 003303 3305 OPTI, DCA IOSW 2061 003304 5241 JMP OPTXIT 2062 ///// 2063 003305 0000 IOSW, 0 2064 / I/O MODE: "I" = 0000 = INTERPRETIVE INPUT, NUMERIC OUTPUT 2065 / "C" = 7777 = SINGLE CHARACTER I/O 2066 ///// 2067 /"ASK" MASTER ROUTINE 2068 003306 0000 INTASK, 0 2069 003307 1154 TAD PT1 /SAVE VAR. POINTER 2070 003310 3225 DCA OWAIT 2071 003311 1305 TAD IOSW /WHAT MODE OF INPUT? 2072 003312 7650 SNA CLA 2073 003313 5323 JMP STRING /INTERPRETIVE 2074 003314 4513 READC /SINGLE CHARACTER 2075 003315 1142 TAD CHAR /CONVERT CHARACTER CODE TO FLOATING 2076 003316 4430 FLOAT /POINT NUMBER 2077 003317 4407 ASKEND, FENT /SAVE VALUE 2078 003320 6625 FPT I OWAIT 2079 003321 0000 FEXT 2080 003322 5706 JMP I INTASK 2081 /INTERPRETIVE BUFFERED INPUT 2082 003323 1013 STRING, TAD PDLXR /SAVE PUSHDOWN LIST POINTER 2083 003324 3203 DCA OPTTDO 2084 003325 1364 TAD BUFTOP /PROTECT TOP OF ASKBUF 2085 003326 3013 DCA PDLXR 2086 003327 2151 ISZ DEBGSW /DISABLE TRACE 2087 003330 1363 INBARR, TAD BUFBOT /INITIALIZE ASKBUF 2088 003331 3010 DCA AXIN 2089 003332 3136 DCA XCTIN 2090 003333 1363 TAD BUFBOT 2091 003334 3153 DCA PACKST 2092 003335 4513 READC /IGNORE SPACES 2093 003336 4511 SORTC 2094 003337 0032 C240-1 2095 003340 5335 JMP .-3 2096 003341 4510 SORTJ /SEARCH FOR TERMINATOR 2097 003342 5775 ASKLST-1 2098 003343 0774 ASKLS2-ASKLST 2099 003344 4507 PACKC /PACK INTO BUFFER 2100 003345 4513 INGT, READC 2101 003346 5341 JMP .-5 2102 /TERMINATOR FOUND, PROCESS INPUT 2103 003347 1060 INTERM, TAD CCR /PACK A C.R. 2104 003350 3142 DCA CHAR 2105 003351 4507 PACKC 2106 003352 4507 PACKC 2107 003353 1203 TAD OPTTDO /RESTORE PDLXR 2108 003354 3013 DCA PDLXR 2109 003355 1363 TAD BUFBOT /INITIALIZE UNPACKING 2110 003356 3017 DCA AXOUT 2111 003357 3020 DCA XCT 2112 003360 4501 PUSHJ /EVALUATE EXPRESSION 2113 003361 1600 EVAL-1 2114 003362 5317 JMP ASKEND 2115 ///// 2116 003363 7550 BUFBOT, ASKBUF /BOTTOM OF BUFFER 2117 003364 7612 BUFTOP, ASKBND /TOP+12 OF BUFFER 2118 ///// 2119 /"TYPE" OUTPUT 2120 003365 0000 OUTPT, 0 2121 003366 1305 TAD IOSW /WHAT KIND OF OUTPUT 2122 003367 7640 SZA CLA 2123 003370 5373 JMP COUTPT /SINGLE CHARACTER 2124 003371 4472 JMS I FOUTPUT /NUMERIC OUTPUT, PRINT VALUE 2125 003372 5765 JMP I OUTPT 2126 ///// 2127 003373 4452 COUTPT, FIX /GET CODE FOR CHARACTER 2128 003374 7450 SNA /MODULO 256 2129 003375 7130 CLL CML RAR /TO ALLOW ZERO CODE TO BE PRINTED 2130 003376 4537 JMS I OUTDEV 2131 003377 5765 JMP I OUTPT 2132 /NOTE: "TDUMP" PRINTS ONLY IN NUMERIC MODE 2133 IOBUF=3400 2134 / 2135 *IOBUF+20 2136 003420 0000 FRST, 0 /TEXT POINTER 2137 003421 0000 0000 /DUMMY LINE NO 2138 003422 0355 0355 / C- 2139 003423 0617 0617 / FO 2140 003424 0301 0301 / CA 2141 003425 1454 1454 / L, 2142 003426 4040 4040 2143 003427 6557 6557 / 5/ 2144 003430 6671 FRSTX, 6671 / 69 2145 003431 7715 7715 2146 BUFBEG=. 2147 ///// 2148 LIBRARY=ERROR5 /COMMAND NOT AVAILABLE 2149 /FOCAL INITIALIZATION ROUTINE 2150 *BUFBEG 2151 003432 7300 BEGIN, CLA CLL 2152 003433 1377 TAD (RECOVR+1 /RESTORE RESTART 2153 003434 3176 DCA START-1 2154 003435 6002 IOF /CLEAR FLAGS TO PREVENT INTERRUPT 2155 003436 6022 6022 /PCF 2156 003437 6032 6032 /KCC 2157 003440 6203 6203 /CDF CIF 00 2158 003441 6402 6402 /CLEAR PT08'S 2159 003442 6412 6412 2160 003443 6422 6422 2161 003444 6432 6432 2162 003445 6442 6442 2163 003446 6452 6452 2164 003447 6462 6462 2165 003450 6472 6472 2166 003451 6764 6764 /CLEAR DECTAPE 2167 003452 6772 6772 2168 003453 7200 CLA 2169 003454 6046 TLS /START LOW SPEED OUTPUT 2170 003455 3414 DCA I FLTXR /CLEAR OUTPUT BUFFER 2171 003456 2376 ISZ (-20 2172 003457 5255 JMP .-2 2173 003460 1027 TAD BOTTOM /INITIALIZE PUSHDOWN LIST 2174 003461 3013 DCA PDLXR 2175 003462 6001 ION 2176 003463 4512 PRINTC /CHAR IS A C.R 2177 003464 4512 PRINTC 2178 003465 4512 PRINTC 2179 003466 4501 PUSHJ /TYPE FOCAL HEADING 2180 003467 0641 WRITE 2181 003470 5671 JMP I .+1 2182 003471 2232 ERV-3 /ERASE ALL 2183 2184 /***** FLOAT -- FOR FOCAL 5/69 ***** 2185 /E.A.TAFT 25-JUL-72 2186 003576 7760 *5600 003577 2746 2187 /DECIMAL TO BINARY CONVERSION 2/10/69 2188 005600 0000 DBCONV, 0 2189 005601 4430 FLOAT /FLOAT A ZERO 2190 005602 3364 DCA DECEXP /INITIALIZE 2191 005603 7040 CMA 2192 005604 3260 DCA PSWIT 2193 005605 1363 TAD C43 /35(10) 2194 005606 3044 DCA FLAC0 2195 005607 4755 JMS I SGNTST /SIGN OF MANTISSA 2196 005610 3365 DCA INSIGN 2197 005611 5215 JMP NEWDIG+1 2198 005612 2260 PERIOD, ISZ PSWIT /. FOUND, SEE IF FIRST 2199 005613 4526 ERROR /DOUBLE PERIODS 2200 005614 4506 NEWDIG, GETC /LOOK FOR A DIGIT 2201 005615 4522 TESTN 2202 005616 5212 JMP PERIOD /. FOUND 2203 005617 5250 JMP NOTDIG /NOT FOUND 2204 005620 1260 TAD PSWIT /DECREMENT DECIMAL EXPONENT 2205 005621 7700 SMA CLA /IF AFTER . 2206 005622 7040 CMA 2207 005623 1364 TAD DECEXP 2208 005624 3364 DCA DECEXP 2209 005625 4342 JMS MULT10 /MULTIPLY FLAC BY 10 2210 005626 1127 TAD SORTCN /ADD NEW DIGIT 2211 005627 3043 DCA FLOP3 2212 005630 3042 DCA FLOP2 2213 005631 3041 DCA FLOP1 2214 005632 4313 JMS TRPLAD 2215 005633 1162 OVCHEK, TAD REMAIN /CHECK FOR OVERFLOW 2216 005634 7640 SZA CLA 2217 005635 5241 JMP .+4 2218 005636 1045 TAD FLAC1 2219 005637 7700 SMA CLA 2220 005640 5214 JMP NEWDIG /NO OVERFLOW 2221 005641 1361 TAD IOVRL /OVERFLOW, ROTATE RIGHT 2222 005642 3760 DCA I IRARAC /SET UP RETURN TO OVCHEK 2223 005643 1162 TAD REMAIN /ROTATE REMAIN 2224 005644 7110 CLL RAR 2225 005645 3162 DCA REMAIN 2226 005646 1045 TAD FLAC1 2227 005647 5762 JMP I ROTRAC /ROTATE REST OF FLAC 2228 2229 005650 4511 NOTDIG, SORTC /TEST FOR LETTER E 2230 005651 6145 C305-1 2231 005652 5301 JMP EINPUT /FOUND E 2232 005653 2365 DBTERM, ISZ INSIGN /END OF INPUT, AFFIX SIGN 2233 005654 4450 NEGATE 2234 005655 1366 TAD CFNR /SET UP TO NORMALIZE 2235 005656 3260 DBLOOP, DCA .+2 2236 005657 4407 FENT 2237 005660 7000 PSWIT, FNR /OR FMY BY 10 OR .10 2238 005661 6554 FPT I PT1 /SAVE RESULT 2239 005662 0000 FEXT 2240 005663 1364 TAD DECEXP /CHECK DECIMAL EXPONENT 2241 005664 7450 SNA 2242 005665 5600 JMP I DBCONV /DONE 2243 005666 7500 SMA 2244 005667 5273 JMP .+4 2245 005670 7001 IAC /NEGATIVE, SET UP TO FMY BY .10 2246 005671 3364 DCA DECEXP 2247 005672 5277 JMP .+5 2248 005673 7240 CLA CMA /POSITIVE, SET UP TO FMY BY 10 2249 005674 1364 TAD DECEXP 2250 005675 3364 DCA DECEXP 2251 005676 1066 TAD M3 2252 005677 1367 TAD FLINST /INSTRUCTION FMY FLTEN OR FLPTEN 2253 005700 5256 JMP DBLOOP 2254 005701 4506 EINPUT, GETC /FOUND "E" 2255 005702 4755 JMS I SGNTST /TEST FOR SIGN 2256 005703 3040 DCA FLOP0 2257 005704 4757 JMS I DECIN1 /INPUT A DECIMAL INTEGER 2258 005705 1164 TAD DECNUM 2259 005706 2040 ISZ FLOP0 /CHECK SIGN 2260 005707 7041 CIA 2261 005710 1364 TAD DECEXP 2262 005711 3364 DCA DECEXP 2263 005712 5253 JMP DBTERM 2264 /ADD FLOP TO FLAC TRIPLE PRECISION WITH OVERFLOW 2265 005713 0000 TRPLAD, 0 2266 005714 7300 CLA CLL 2267 005715 1043 TAD FLOP3 2268 005716 1047 TAD FLAC3 2269 005717 3047 DCA FLAC3 2270 005720 7004 RAL 2271 005721 1042 TAD FLOP2 2272 005722 1046 TAD FLAC2 2273 005723 3046 DCA FLAC2 2274 005724 7004 RAL 2275 005725 1041 TAD FLOP1 2276 005726 1045 TAD FLAC1 2277 005727 3045 DCA FLAC1 2278 005730 7004 RAL 2279 005731 1162 TAD REMAIN 2280 005732 3162 DCA REMAIN 2281 005733 5713 JMP I TRPLAD 2282 /MULTIPLY FLAC BY 2 2283 005734 0000 MULT2, 0 2284 005735 4756 JMS I MULT2I 2285 005736 1162 TAD REMAIN 2286 005737 7004 RAL 2287 005740 3162 DCA REMAIN 2288 005741 5734 JMP I MULT2 2289 /MULTIPLY FLAC BY 10 2290 005742 0000 MULT10, 0 2291 005743 4504 PUSHF /FLAC=>FLOP 2292 005744 0045 FLAC1 2293 005745 4505 POPF 2294 005746 0041 FLOP1 2295 005747 3162 DCA REMAIN /CLEAR OVERFLOW 2296 005750 4334 JMS MULT2 /FLAC*10 = (FLAC*2*2+FLAC)*2 2297 005751 4334 JMS MULT2 2298 005752 4313 JMS TRPLAD 2299 005753 4334 JMS MULT2 2300 005754 5742 JMP I MULT10 2301 005755 6030 SGNTST, TSTSGN 2302 005756 7037 MULT2I, RALAC 2303 005757 6010 DECIN1, DECINT 2304 005760 7251 IRARAC, RARAC 2305 005761 5633 IOVRL, OVCHEK 2306 005762 7256 ROTRAC, RARAC+5 2307 005763 0043 C43, 43 2308 005764 0000 DECEXP, 0 /IMPLICIT DECIMAL EXPONENT 2309 005765 0000 INSIGN, 0 /SIGN OF MANTISSA 2310 005766 7000 CFNR, FNR 2311 005767 3373 FLINST, FMY .+4 2312 005770 0004 FLTEN, 0004 /10(10) FLOATING 2313 005771 2400 2400 2314 005772 0000 0000 2315 005773 7775 FLPTEN, 7775 /.10(10) FLOATING 2316 005774 3146 3146 2317 005775 3147 3147 2318 REMAIN=TEMP1 2319 /CHARACTER LIST FOR "ASK" 2320 005776 0215 ASKLST, 215 /CR 2321 005777 0214 214 /FF 2322 006000 0337 337 /BA 2323 006001 0254 254 /COMMA 2324 006002 0000 USERT, 0 /USER-SELECTED CHARACTER 2325 006003 0212 212 /LF 2326 /POWER OF 10 TABLE 2327 006004 6030 INTABL, -1750 /1000 2328 006005 7634 -144 /100 2329 006006 7766 -12 /10 2330 006007 7777 -1 /1 2331 /INPUT A DECIMAL INTEGER <2048 2332 006010 0000 DECINT, 0 2333 006011 3164 DCA DECNUM 2334 006012 4522 TESTN /GET A DIGIT 2335 006013 7000 NOP 2336 006014 5610 JMP I DECINT /NONE FOUND 2337 006015 4506 GETC 2338 006016 1164 TAD DECNUM /MULTIPLY PREV. # BY 10 2339 006017 7106 CLL RTL 2340 006020 7530 SPA SZL 2341 006021 5226 JMP .+5 /OVERFLOW (>2047) 2342 006022 1164 TAD DECNUM 2343 006023 7004 RAL 2344 006024 1127 TAD SORTCN /ADD NEW DIGIT 2345 006025 7530 SPA SZL 2346 006026 4526 ERROR 2347 006027 5211 JMP DECINT+1 2348 DECNUM=TEMP3 2349 /TEST FOR A SIGN 2350 006030 0000 TSTSGN, 0 2351 006031 4521 SPNOR 2352 006032 3127 DCA SORTCN 2353 006033 4511 SORTC /LOOK FOR + OR - 2354 006034 6114 SNLIST-1 2355 006035 4506 GETC /SIGN FOUND 2356 006036 4521 SPNOR /NOT FOUND 2357 006037 7240 CLA CMA 2358 006040 1127 TAD SORTCN /SORTCN: 0=+, 1=- 2359 006041 5630 JMP I TSTSGN /AC: 7777=+, 0=- 2360 DIGIT=TEMP2 2361 /PRINT A 2-4 DIGIT UNSIGNED DECIMAL INTEGER 2362 /FIRST 2 LEADING ZEROES NOT PRINTED 2363 006042 0000 INTOUT, 0 2364 006043 3164 DCA DECNUM 2365 006044 1314 TAD INTPTR /POWER OF 10 POINTER 2366 006045 3260 DCA INTSUB 2367 006046 3210 DCA DECINT /DECINT=0 MEANS SKIP 0 OUTPUT 2368 006047 4255 JMS INTDO /1ST DIGIT (1000S) 2369 006050 4255 JMS INTDO /2ND DIGIT (100S) 2370 006051 2210 ISZ DECINT /DECINT>0 MEANS PRINT 0S 2371 006052 4255 JMS INTDO /3RD DIGIT (10S) 2372 006053 4255 JMS INTDO /4TH DIGIT (UNITS) 2373 006054 5642 JMP I INTOUT 2374 006055 0000 INTDO, 0 2375 006056 3163 DCA DIGIT /INITIALIZE 2376 006057 1164 TAD DECNUM 2377 006060 1204 INTSUB, TAD INTABL /SUBTRACT A POWER OF 10 2378 006061 7510 SPA 2379 006062 5267 JMP INTNEG 2380 006063 3164 DCA DECNUM /POSITIVE RESULT 2381 006064 2163 ISZ DIGIT /NONZERO DIGIT, SO IGNORE NO 2382 006065 2210 ISZ DECINT /FURTHER ZEROES 2383 006066 5257 JMP INTSUB-1 2384 006067 7300 INTNEG, CLA CLL /NEGATIVE RESULT 2385 006070 2260 ISZ INTSUB /SET UP NEXT POWER OF 10 2386 006071 1210 TAD DECINT /IS IT A LEADING 0? 2387 006072 7650 SNA CLA 2388 006073 5655 JMP I INTDO /YES, SKIP IT 2389 006074 1163 TAD DIGIT /NO, PRINT DIGIT 2390 006075 1036 TAD C260 2391 006076 4512 PRINTC 2392 006077 5655 JMP I INTDO 2393 /OUTPUT A SIGNED INTEGER IN AC 2394 006100 0000 SIGOUT, 0 2395 006101 3164 DCA DECNUM /SAVE NUMBER 2396 006102 1164 TAD DECNUM 2397 006103 7710 SPA CLA 2398 006104 1035 TAD P2 /MAKE A - 2399 006105 1315 TAD C253 /MAKE A + 2400 006106 4512 PRINTC 2401 006107 1164 TAD DECNUM /OUTPUT ABSOLUTE VALUE 2402 006110 7510 SPA 2403 006111 7041 CIA 2404 006112 4242 JMS INTOUT /OUTPUT THE NUMBER 2405 006113 5700 JMP I SIGOUT 2406 006114 1204 INTPTR, TAD INTABL 2407 SNLIST=. /FOR SIGN TESTING 2408 006115 0253 C253, 253 /+ 2409 006116 0255 255 /- 2410 /E FORMAT OUTPUT ROUTINE 2411 006117 7200 XXX, CLA /CONVERT TO E FORMAT ON OVERFLOW 2412 006120 1051 TAD TOTDIG 2413 006121 7410 SKP 2414 006122 1133 FLOUT, TAD DECP /E FORMAT (%0) FLOATING OUTPUT 2415 006123 7041 CIA 2416 006124 7450 SNA 2417 006125 1347 TAD MDIG /6 DIGITS IF 0 GIVEN 2418 006126 3164 DCA DECNUM /DIGIT COUNTER 2419 006127 1022 TAD PER /PERIOD 2420 006130 4512 PRINTC 2421 006131 1412 FLDIG, TAD I XRT2 /NEXT DIGIT 2422 006132 2157 ISZ T2 /OUT OF SIG DIGITS? 2423 006133 5336 JMP .+3 /NO, PRINT DIGIT 2424 006134 7240 CLA CMA /YES, RESET POINTER AND PRINT 0 2425 006135 3157 DCA T2 2426 006136 4750 JMS I OUTP 2427 006137 7410 SKP /FIELD NOW FILLED, PRINT EXPONENT 2428 006140 5331 JMP FLDIG 2429 /B-D CONV EXPONENT OUTPUT 2430 006141 1346 TAD C305 /PRINT LETTER E 2431 006142 4512 PRINTC 2432 006143 1156 TAD T1 /OUTPUT THE EXPONENT 2433 006144 4300 JMS SIGOUT 2434 006145 5770 BDEND, JMP I BDCONV /DONE 2435 006146 0305 C305, 305 /E 2436 006147 7772 MDIG, -DIGITS 2437 006150 6437 OUTP, OUTA 2438 /PRINT A LINE NUMBER - "PRNTLN" 2439 006151 0000 XPRNTL, 0 2440 006152 1143 TAD LINENO 2441 006153 4520 RTL6 2442 006154 0071 AND P77 2443 006155 4242 JMS INTOUT /2-DIGIT PART NUMBER 2444 006156 1022 TAD PER 2445 006157 4512 PRINTC /DECIMAL POINT 2446 006160 1143 TAD LINENO 2447 006161 0026 AND P177 /2-DIGIT STEP NUMBER 2448 006162 4242 JMS INTOUT 2449 006163 1033 TAD C240 /SPACE 2450 006164 3142 DCA CHAR 2451 006165 4512 PRINTC 2452 006166 5751 JMP I XPRNTL 2453 2454 006167 0015 NEGSGN, 255-240 2455 /BINARY TO DECIMAL CONVERSION AND OUTPUT 2456 006170 0000 BDCONV, 0 2457 006171 1045 TAD FLAC1 /CHECK SIGN 2458 006172 7700 SMA CLA 2459 006173 5376 JMP .+3 2460 006174 4450 NEGATE /NEGATIVE, TAKE ABSOLUTE VALUE 2461 006175 1367 TAD NEGSGN /MAKE A - 2462 006176 1033 TAD C240 /MAKE A SPACE 2463 006177 4512 PRINTC 2464 006200 7240 CLA CMA /DECREMENT BINARY EXPONENT 2465 006201 1044 TAD FLAC0 2466 006202 3044 DCA FLAC0 2467 006203 3156 BDSCAL, DCA T1 /INITIALIZE DECIMAL EXPONENT 2468 006204 1044 TAD FLAC0 /START SCALING: -4= EXPONENT 2558 006332 1051 TAD TOTDIG 2559 006333 7510 SPA 2560 006334 5362 JMP FPRNT-2 /NO ROUNDING NEEDED 2561 006335 1226 TAD MDIGIT /ROUND TO DECP+EXP PLACES 2562 006336 7500 SMA 2563 006337 7200 CLA 2564 006340 1227 R6, TAD RND2 /START ROUNDING 2565 006341 3004 DCA FNEGSW /PLACES TO ROUND TO 2566 006342 1235 TAD BUFST /ROUNDING START ADDRESS 2567 006343 1004 TAD FNEGSW /SET UP ROUND COUNT 2568 006344 3040 DCA FLOP0 2569 006345 1004 TAD FNEGSW 2570 006346 7041 CIA 2571 006347 3004 DCA FNEGSW /START ROUNDING PROCESS BY 2572 006350 1631 TAD I TENPT /ADDING 4 TO FIRST DIGIT 2573 006351 2440 RET, ISZ I FLOP0 /INCREMENT CURRENT DIGIT 2574 006352 1440 TAD I FLOP0 2575 006353 1230 TAD M12 2576 006354 7710 SPA CLA /DIGIT>9? 2577 006355 5364 JMP FPRNT /NO, END ROUNDING 2578 006356 3440 DCA I FLOP0 /YES, SET DIGIT TO 0 AND CARRY 2579 006357 2004 ISZ FNEGSW /BEGINNING OF BUFFER? 2580 006360 5240 JMP DECR /NO DECREMENT BUFFER ADDRESS 2581 006361 2440 ISZ I FLOP0 /YES, FAKE CARRY FROM FIRST DIGIT 2582 006362 2156 ISZ T1 2583 006363 7200 CLA 2584 2585 006364 1051 FPRNT, TAD TOTDIG /SET UP FIELD SIZES 2586 006365 7450 SNA 2587 006366 5636 JMP I FLOUTP /E FORMAT OUTPUT 2588 006367 7041 CIA 2589 006370 3164 DCA DECNUM /NUMBER OF PLACES TO PRINT 2590 006371 1164 TAD DECNUM 2591 006372 1156 TAD T1 2592 006373 7540 SMA SZA 2593 006374 5637 JMP I XXXP /TOO BIG, PRINT E FORMAT 2594 006375 1133 TAD DECP /OK, TEST DECIMAL PLACES 2595 006376 7500 SMA 2596 006377 7200 CLA /ADJUST DECIMAL POINT 2597 006400 7041 CIA 2598 006401 1156 TAD T1 2599 006402 7141 CLL CIA 2600 006403 3004 DCA FNEGSW /NUMBER OF INTEGER PLACES 2601 006404 7430 SZL 2602 006405 5222 JMP IN+4 /NO INTEGER PLACES 2603 /START PRINTING 2604 006406 1156 BACK, TAD T1 2605 006407 1004 TAD FNEGSW 2606 006410 7650 SNA CLA 2607 006411 5225 JMP DIG /PRINT A DIGIT 2608 006412 1004 TAD FNEGSW 2609 006413 7001 IAC 2610 006414 7710 SPA CLA /PRINT 0 IF ONE INTEGER PLACE LEFT 2611 006415 1025 TAD M20 /OTHERWISE A SPACE 2612 006416 4237 IN, JMS OUTA /PRINT A CHARACTER 2613 006417 5645 JMP I BDENDP /FIELD FILLED, EXIT 2614 006420 2004 ISZ FNEGSW 2615 006421 5206 JMP BACK /CONTINUE 2616 006422 1022 TAD PER /DECIMAL POINT 2617 006423 4512 PRINTC 2618 006424 5206 JMP BACK 2619 006425 7040 DIG, CMA 2620 006426 1156 TAD T1 /DECREMENT DECIMAL EXPONENT 2621 006427 3156 DCA T1 2622 006430 2157 ISZ T2 /CHECK SIG DIGIT COUNT 2623 006431 5235 JMP .+4 /SOME LEFT 2624 006432 7040 CMA /ALL USED UP 2625 006433 3157 DCA T2 2626 006434 5216 JMP IN /PRINT A 0 2627 006435 1412 TAD I XRT2 /PRINT A SIG DIGIT 2628 006436 5216 JMP IN 2629 /DIGIT PRINT ROUTINE FOR BDCONV 2630 006437 0000 OUTA, 0 2631 006440 1036 TAD C260 /CONVERT TO ASCII 2632 006441 4512 PRINTC 2633 006442 2164 ISZ DECNUM /FIELD FILLED? 2634 006443 2237 ISZ OUTA /NO, GO TO SECOND RETURN 2635 006444 5637 JMP I OUTA 2636 006445 6145 BDENDP, BDEND 2637 / "OPTION" PROCESSOR 2638 006446 4521 OPTION, SPNOR /GET OPTION LETTER 2639 006447 4510 SORTJ 2640 006450 2377 OPTLST-1 2641 006451 7574 OPTTBL-OPTLST 2642 006452 4526 ERROR /ILLEGAL OPTION NAME 2643 ///// 2644 006453 7240 OPTR, CLA CMA /SWAP INPUT TO HIGH SPEED READER 2645 006454 3037 DCA HINBUF 2646 006455 6014 RFC /START READER 2647 006456 1317 TAD RESTR /POINT TO "HREAD" 2648 006457 1161 OPTK, TAD PTCH /SWAP TO KEYBOARD IF CALLED HERE 2649 006460 3113 DCA 113 2650 ///// 2651 006461 4565 OPTRET, TSTERM /MOVE TO ,;CR 2652 006462 5261 JMP .-1 2653 006463 5665 JMP I .+2 /END OF OPTIONS 2654 006464 5246 JMP OPTION /CONTINUE PROCESSING OPTIONS 2655 006465 0616 PROC 2656 ///// 2657 /HIGH SPEED INPUT ROUTINE 2658 006466 0000 HREAD, 0 2659 006467 7300 CLA CLL 2660 006470 7000 NOP /PLACE KEEPERS FOR COMPATIBILITY 2661 006471 7000 NOP /WITH THE OLD HREAD ROUTINE 2662 006472 6001 HREAD2, ION /(SWAP) - FOR 2-USER 2663 006473 1037 TAD HINBUF /WAIT FOR INPUT 2664 006474 7500 SMA 2665 006475 5300 JMP .+3 2666 006476 7200 CLA 2667 006477 5272 JMP HREAD2 2668 006500 7440 SZA /SWAPS BACK TO ADDS INPUT ON TRAILER CODE 2669 006501 5305 JMP HSGO / LEGIT CHAR 2670 006502 1161 TAD PTCH /ALL DONE READING TAPE 2671 006503 3113 DCA 113 /SWAP TO KEYBOARD INPUT 2672 006504 1054 TAD P337 /RETURN A B.A. TO KILL UNENDED LINE OR GARBAGE 2673 /CHARACTER 2674 006505 3142 HSGO, DCA CHAR /FOUND CHAR 2675 006506 7040 CMA 2676 006507 3037 DCA HINBUF /SET TO READ NEXT 2677 006510 1142 TAD CHAR 2678 006511 0026 AND P177 /IGNORE PARITY AND BLANK 2679 006512 7450 SNA 2680 006513 5267 JMP HREAD+1 2681 006514 1015 TAD C200 2682 006515 3142 DCA CHAR 2683 006516 5666 JMP I HREAD 2684 ///// 2685 006517 4003 RESTR, HREAD-CHIN 2686 2687 PAGE 2688 /FLOATING POINT PACKAGE 2689 /ARITHMETIC INTERPRETER 2690 006600 0000 FPNT, 0 2691 006601 7300 CLA CLL 2692 006602 1600 TAD I FPNT /FLOATING INSTRUCTION 2693 006603 7450 SNA 2694 006604 5600 JMP I FPNT /FEXT 2695 006605 0015 AND C200 /GET PAGE BIT 2696 006606 7640 SZA CLA 2697 006607 1200 TAD FPNT /CURRENT PAGE 2698 006610 0024 AND P7600 2699 006611 3231 DCA FLADDR /START ADDRESS OF ADDRESSED PAGE 2700 006612 1600 TAD I FPNT /GET ADDRESS BITS 2701 006613 0026 AND P177 2702 006614 1231 TAD FLADDR 2703 006615 3231 DCA FLADDR /FULL 12-BIT ADDRESS 2704 006616 1600 TAD I FPNT 2705 006617 2200 ISZ FPNT 2706 006620 7106 CLL RTL /OP BITS =>AC9-11 2707 006621 7006 RTL /INDIRECT BIT =>LINK 2708 006622 0031 AND P17 2709 006623 1236 TAD DRECTR /SET UP OP POINTER 2710 006624 3235 DCA DIRECT 2711 006625 1631 TAD I FLADDR /INDIRECT? 2712 006626 7430 SZL 2713 006627 3231 DCA FLADDR /YES 2714 006630 4504 PUSHF /NO, GET OPERAND 2715 006631 0000 FLADDR, 0 2716 006632 4505 POPF 2717 006633 0040 FLOP 2718 006634 3043 DCA FLOP3 /CLEAR LOW ORDER OPERAND 2719 006635 5637 DIRECT, JMP I .+2 /OP DIRECT INSTRUCTION 2720 006636 5637 DRECTR, JMP I .+1 /OP TABLE 2721 006637 7406 FLPOW 2722 006640 6720 FLADD 2723 006641 6717 FLSUB 2724 006642 7077 FLMUL 2725 006643 7171 FLDIV 2726 006644 6647 FLGET 2727 006645 6653 FLPUT 2728 006646 6762 FLNOR 2729 2730 006647 4504 FLGET, PUSHF /OP 5: GET FLAC FROM STORAGE 2731 006650 0040 FLOP 2732 006651 1254 TAD .+3 /SET UP POINTER TO FLAC 2733 006652 5256 JMP .+4 2734 006653 4504 FLPUT, PUSHF /OP 6: PUT FLAC IN STORAGE 2735 006654 0044 FLAC 2736 006655 1231 TAD FLADDR /SET UP POINTER TO STORAGE 2737 006656 3260 DCA .+2 2738 006657 4505 POPF 2739 006660 0000 0 /ADDRESS OF STORAGE LOCATION 2740 006661 5201 JMP FPNT+1 2741 006662 0000 NEGOP, 0 /ROUTINE TO NEGATE FLOP 2742 006663 1042 TAD FLOP2 2743 006664 7141 CLL CIA 2744 006665 3042 DCA FLOP2 2745 006666 7024 CML RAL 2746 006667 1041 TAD FLOP1 2747 006670 7041 CIA 2748 006671 3041 DCA FLOP1 2749 006672 1004 TAD FNEGSW /FNEGSW IS COMPLEMENTED WHEN 2750 006673 7140 CLL CMA /FLOP OR FLAC IS NEGATED 2751 006674 3004 DCA FNEGSW 2752 006675 5662 JMP I NEGOP 2753 006676 0000 NEGAC, 0 /ROUTINE TO NEGATE FLAC - "NEGATE" 2754 006677 7300 CLA CLL /TRIPLE PRECISION 2755 006700 1047 TAD FLAC3 2756 006701 7041 CIA 2757 006702 3047 DCA FLAC3 2758 006703 7024 CML RAL 2759 006704 1046 TAD FLAC2 2760 006705 7041 CIA 2761 006706 3046 DCA FLAC2 2762 006707 7024 CML RAL 2763 006710 1045 TAD FLAC1 2764 006711 7041 CIA 2765 006712 3045 DCA FLAC1 2766 006713 1004 TAD FNEGSW 2767 006714 7140 CLL CMA 2768 006715 3004 DCA FNEGSW 2769 006716 5676 JMP I NEGAC 2770 /ARITHMETIC OPERATIONS 2771 /BOTH FLAC AND FLOP MUST BE NORMALIZED FOR 2772 /+-*/^ (FAD,FSU,FMY,FDV,FXP) 2773 006717 4262 FLSUB, JMS NEGOP /OP 2: SUBTRACT OP (NEGATE AND ADD) 2774 006720 1045 FLADD, TAD FLAC1 /OP 1: ADD OP 2775 006721 7650 SNA CLA 2776 006722 5247 JMP FLGET /RESULT=OPERAND IF FLAC=0 2777 006723 1041 TAD FLOP1 2778 006724 7650 SNA CLA 2779 006725 5201 JMP FPNT+1 /RESULT=FLAC IF FLOP=0 2780 006726 1040 TAD FLOP0 /COMPARE EXPONENTS 2781 006727 7041 CIA 2782 006730 1044 TAD FLAC0 2783 006731 7450 SNA 2784 006732 5357 JMP CMBINE /EQUAL, GO ADD TOGETHER 2785 006733 7500 SMA /NOT EQUAL, NEED SHIFTING 2786 006734 5346 JMP SHFLOP /FLAC>FLOP, SHIFT FLOP 2787 006735 1365 TAD P27 /FLAC