1 /FOCAL-8 2 /DEC-8E-LFOCA-A-LA1 3 4 /OCTOBER 1971 RM/SM 5 6 /COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION 7 / MAYNARD, MASSACHUSETTS 01754 8 9 /FOCAL IS A REGISTERED TRADEMARK OF 10 /DIGITAL EQUIPMENT CORPORATION 11 12 /FOCAL-8 IS AN ON-LINE FORMULA CALCULATOR AND 13 /COMPILER FOR STATEMENTS IN ALGEBRAIC LANGUAGE 14 /THIS VERSION OF FOCAL-8 IS SUPPORTED ON THE PDP-8/E 15 16 /ASSEMBLY INSTRUCTIONS: 17 /.R PAL8 OR .R PAL10 18 /*FOCAL8,FOCAL8_FOCAL8,FLOAT 19 20 21 22 23 /NOTES ON LISTING COMMENTS: 24 25 /THE LIMITS OF PAGE BOUNDARY WANDERING ARE DENOTED BY: 26 27 /------------------------------------------------------------------- 28 /PAGE BOUNDARY 29 /------------------------------------------------------------------ 30 31 /LOCATIONS OVERLAYED BY THE 8K OVERLAY ARE DENOTED BY /*8K* 32 33 /PSEUDO-FLOATING POINT INSTRUCTIONS 34 35 FIXMRI FPOW=5000 36 FIXMRI FADD=1000 37 FIXMRI FSUB=2000 38 FIXMRI FMUL=4000 39 FIXMRI FDIV=3000 40 FIXMRI FGET=0000 41 FIXMRI FPUT=6000 42 43 FNOR=7000 44 FEXT=0 45 FXIT=0 46 FINT=JMS I 7 47 RFC=6014 48 SMP=6101 49 KCF=6030 50 51 52 /MISCELLANEOUS ITEMS 53 *1 54 000001 5403 JMP I .+2 /INTERRUPT PROCESSOR ENTRY . 55 000002 5403 JMP I .+1 /(USED BY PDP-5) 56 000003 2603 INTRPT 57 000004 0004 DDTJR, DDTJR /USED FOR DEBUGGING 58 000005 0013 P13, 13 /CONSTANT 59 000006 0100 C100, 100 /CONSTANT 60 *7 61 000007 6400 FPNT /ADDRESS OF FLOATING POINT INTERPRETER 62 63 /AUTO-INDEX REGISTERS - (START OF SAVE BY QUAD) 64 65 000010 0000 AXIN, 0 /STORAGE INDEX (LOC *10) 66 000011 0000 XRT, 0 /EXTRA XR 67 000012 0000 XRT2, 0 /EXTRA XR 68 000013 4370 PDLXR, BEGIN-1 /PUSHDOWN LIST INDEX REGISTER. 69 000014 3117 FLTXR, IOBUF-1 /XR FOR FLOATING POINT 70 000015 0000 FLTXR2, 0 /EXTRA FOR F.P. 71 000016 7402 TELSW, HLT /TELETYPE IN PROGRESS SWITCH 72 73 TEXTP=. /TEXT POINTERS (LOC *17) 74 000017 3215 AXOUT, FRSTX /OUTPUT INDEX 75 000020 0000 XCT, 0 /UNPACK SWITCH 76 000021 0000 GTEM, 0 /UNPACK STORAGE 77 000022 2407 PC, FLTZER /PROGRAM COUNTER /*8K* 78 79 000023 0000 THISLN, 0 /LINE POINTER FROM 'FINDLN' 80 000024 0000 THISOP, 0 /CURRENT 'EVAL' OPERATION 81 000025 0000 LASTLN, 0 /BACK POINTER FROM 'FINDLN' 82 000026 0001 DEBGSW, 1 /DEBUG SWITCH ; NON-ZERO FOR LITERAL. 83 000027 0000 PACKST, 0 /RUBOUT PROTECTION 84 000030 0000 PT1, 0 /VARIABLE POINTER 85 000031 3217 LASTV, BUFBEG /ADDRESS OF LAST VARIABLE /*8K* 86 000032 0000 T1, 0 /TEMPORARY REGISTER - MAIN 87 000033 0000 T3, 0 /TEMP REGISTER FOR OUTPUT 88 000034 0000 INBUF, 0 /KEYBOARD INPUT BUFFER 89 000035 4370 BOTTOM, BEGIN-1 /LAST LOCATION CURRENTLY AVAILABLE IN FIELD ZERO ** 90 000036 0000 INSUB, 0 /0= GETC; #0 = READC 91 000037 0000 HINBUF, 0 /HIGH SPEED INPUT BUFFER 92 93 / *40 = FLOATING POINT 94 95 *54 96 97 /VARIABLES - INITIALIZED FOR THE DIALOGUE 98 99 100 000054 0000 SORTCN, 0 /NUMBER IN TABLE FROM SORTC 101 000055 0000 LASTOP, 0 /LAST OPERATION FOR EVAL 102 EFOP=. /FUNCTION CODE. 103 000056 0000 ATSW, 0 /ASK-TYPE SWITCH 104 000057 7760 CNTR, -20 /DELETE AND ERROR COUNTER(USED BY F.P. ALSO) 105 106 STARTV=. /=END FOR 8K 107 108 000060 3217 BUFR, BUFBEG /NEXT LOCATION IN BUFFER = LAST LOCATION OF TEXT/*8K* 109 110 000061 1354 ADD, OUTL /CHAR. BUF. IN. (DEBUG AIDS.SEE BELOW.) 111 000062 2414 XCTIN, I33 /PACK SWITCH 112 000063 2676 OUTDEV, XOUTL /POINTER TO OUT. SUB. (OUTL)-FOR DEBUGGING 113 000064 2666 INDEV, XI33 /POINTER TO IN. SUB. (I33)-FOR DEBUGGING 114 115 000065 0001 NAGSW, 0001 /NOT ALL AND/OR GROUP SWITCH(4000=ONE;1=ALL;0=GROUP);(0000)-FOR TSS-8 116 000066 0215 CHAR, 215 /THE MOST IMPORTANT REGISTER 117 000067 0000 LINENO, 0000 /LINE NUMBER READ BY GETLN;(0400)-FOR TSS-8 118 000070 0005 GINC, WORDS+2 /=6 FOR 4-WORD - CONSTANT 119 120 000071 0000 T2, 0 /TEMP REGISTER - FOR NEW INST. ROUTINES. 121 122 123 124 /FOR DEBUGGING, SET OUTL AND I33 INTO OUTDEV AND INDEV; 125 /ALSO PATCH THE ERROR ROUTINE = FOUR 126 /PATCHES PLUS TWO FOR THE HIGH SPEED READER. 127 128 129 LIST6=. /INPUT LIST FOR "SFOUND". 130 000072 0214 214 /F.F. 131 000073 0207 207 /BELL 132 LIST7=. 133 000074 0203 203 /CONTROL-C FOR DEBUGGING AND TSS8 134 000075 0337 P337, 337 /LEFT ARR 135 000076 0212 CLF, 212 /L.F. 136 LIST3=. /EXCRETION LIST 137 000077 0215 CCR, 215 /LIST BRANCHER. 138 000100 7402 DMPSW, HLT /(SEARCH CHARACTER)-VARIABLE 139 /=0000 FOR TRACE ON. 140 141 142 /THE REST OF PAGE ZERO IS PURE TO THE MULTI-USER SYSTEM 143 144 M100=. 145 000101 7700 P7700, 7700 /LEFT MASK 146 000102 0256 PER, 256 /PERIOD 147 000103 7701 M77, -77 /EXTEND CODE TEST 148 000104 7600 P7600, 7600 /GROUP MASK 149 000105 7760 M20, -20 /CONSTANT 150 000106 0177 P177, 177 /STEP MASK 151 000107 0017 P17, 17 /BCD MASK 152 000110 0277 P277, 277 /"?" 153 000111 7776 M2, -2 /CONSTANT 154 000112 7477 MINUSA, -301 /CONSTANT 155 000113 0260 C260, 260 /ASCII FOR ZERO 156 000114 7540 M240, -240 /SPACE TEST 157 000115 7522 MPER, -256 /PERIOD TEST 158 000116 7563 MCR, -215 /C.R. TEST 159 000117 7775 MFLT, -WORDS /= -4 FOR 4-WORD 160 000120 7773 M5, -5 /PAREN TEST 161 000121 7767 M11, -11 /PAREN TEST 162 000122 0077 P77, 77 /RIGHT MASK 163 000123 0200 C200, 200 /CONSTANTS 164 000124 4000 P4000, 4000 /NAGSW TEST CONSTANT (FOR PDP-5) 165 166 000125 2030 FLARGP, FLARG /DATA ADDRESS 167 000126 2155 PTCH, CHIN /GENERAL CHARACTER INPUT ROUTINE. 168 000127 5715 DOUBLE, MULT2 /MULTIPLY FLAC BY 2 169 000130 6000 FOUTPUT,FLOUTP /FLOATING OUTPUT 170 000131 6200 FINPUT, FLINTP /FLOATING INPUT 171 000132 3140 COMBUF, COMEIN /COMMAND BUFFER START /*8K* 172 000133 3206 CFRS, FRST /ADDRESS OF DUMMY LINE /*(K* 173 000134 3140 END, COMEIN /FIRST LOCATION USED IN 8K. 174 000135 3217 ENDT, BUFBEG /START OF STORAGE AREA /*8K* 175 000136 2017 EFUN3I, EFUN3 /FUNCTION RETURN 176 000137 2407 CFRSX, FLTZER /POINTER TO ZERO DATA 177 178 /'FINPUT' USES CHAR AND GETC OR READC TO DEVELOP 179 /A NUMBER WHICH IS THEN STORED VIA PT1. 180 181 WORDS=3 /OR 4 182 183 /NEW INSTRUCTIONS: 184 185 PUSHJ=JMS I . /RECURSIVE SUBROUTINE CALL 186 000140 0521 XPUSHJ 187 POPA=TAD I PDLXR/RESTORE AC 188 POPJ=JMP I . /SUBROUTINE RETURN 189 000141 1565 XPOPJ 190 PUSHA=JMS I . /SAVE AC 191 000142 0477 XPUSHA 192 PUSHF=JMS I . /SAVE GROUP OF DATA 193 000143 0534 PD2 194 POPF=JMS I . /RESTORE GROUP 195 000144 0554 PD3 196 GETC=JMS I . /UNPACK A CHARACTER 197 000145 2274 UTRA 198 PACKC=JMS I . /PACK A CHARACTER 199 000146 2502 PACBUF 200 SORTJ=JMS I . /SORT AND BRANCH ON AC OR CHAR 201 000147 1314 SORTB 202 SORTC=JMS I . /SORT CHAR 203 000150 0721 XSORTC 204 PRINTC=JMS I . /PRINT AC OR CHAR 205 000151 2465 OUT 206 READC=JMS I . /READ DATA INTO CHAR AND PRINT IT 207 000152 2155 RDIV, CHIN 208 PRNTLN=JMS I . /PRINT C(LINENO) 209 000153 2425 XPRNT 210 GETLN=JMS I . /UNPACK AND FORM A LINENUMBER 211 000154 0302 XGETLN 212 FINDLN=JMS I . /SEARCH FOR A GIVEN LINE 213 000155 2242 XFIND 214 ENDLN=JMS I . /INSERT LINE POINTERS 215 000156 2360 XENDLN 216 RTL6=JMS I . /ROTATE LEFT SIX 217 000157 0413 XRTL6 218 SPNOR=JMS I . /IGNORE SPACES AND LEADING ZEROS 219 000160 1517 XSPNOR 220 TESTN=JMS I . /PERIOD; OTHER; NUMBER 221 000161 1533 XTESTN 222 TSTLPR=JMS I . /SKIP IF 5 0 246 000202 3022 DCA PC /FOR COMMAND MODE 247 000203 7001 IAC /USE ONE IN THE AC TO 248 000204 3100 DCA DMPSW /INIT UNPACK AND TRACE SWITCH 249 000205 3026 DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?) 250 000206 1226 TAD COMBOT /PROTECT COMMAND BUFFER 251 000207 3013 DCA PDLXR /NO PATCH TEST 252 000210 1225 TAD CSTAR /TYPE * TO INDICATE COMMAND MODE 253 000211 4551 PRINTC 254 000212 1132 IBAR, TAD COMBUF /INITIALIZE COMMAND BUFFER 255 000213 3010 DCA AXIN /FOR UNPACKING 256 000214 3062 DCA XCTIN 257 000215 1132 TAD COMBUF /RUBOUT PROTECTION 258 000216 3027 DCA PACKST 259 000217 4552 IGNOR, READC /READ COMMAND STRING 260 000220 4547 SORTJ 261 000221 0073 LIST7-1 262 000222 0474 INLIST-LIST7 263 000223 4546 PACKC /SAVE STRING CHARACTER. 264 000224 5217 JMP IGNOR 265 000225 0252 CSTAR, 252 /ACKNOWLEDGE CHARACTER 266 000226 3220 COMBOT, COMEOUT+12 /END OF COMMAND BUFFER,LESS PROTECTION COUNT/*8K* 267 268 /COMMAND/INPUT PROCESSOR 269 270 000227 4546 IRETN, PACKC /START TO PACK C.R. 271 000230 4546 PACKC /FINISH C.R. 272 000231 1132 TAD COMBUF /INITIALIZE "TEXTP" 273 000232 3017 GONE, DCA AXOUT /SETUP CURRENT LINE 274 000233 3020 DCA XCT 275 000234 4545 GETC /READ FIRST CHARACTER. 276 000235 1035 TAD BOTTOM /INIT PUSH-DOWN-LIST 277 000236 3013 DCA PDLXR 278 000237 4560 SPNOR /IGNORE LEADING BLANKS 279 000240 4561 TESTN /DOES THE LINE BEGIN WITH 1-9? 280 000241 5362 JMP GZERR /PERIOD =ILLEGAL GROUP ZERO USAGE 281 000242 5271 JMP INPUTX /NO 282 000243 2026 ISZ DEBGSW /YES,DISABLE TRACE FOR REPACKING 283 000244 4554 GETLN /READ THIS LINE NUMBER 284 000245 1124 TAD P4000 /TEST FOR SINGLE LINE. 285 000246 1065 TAD NAGSW 286 000247 7640 SZA CLA 287 000250 4566 ERROR3 /ILLEGAL LINE NUMBER ON INPUT 288 000251 1060 TAD BUFR /SET POINTERS 289 000252 3010 DCA AXIN 290 000253 3062 DCA XCTIN 291 000254 1067 TAD LINENO /SAVE LINE # 292 000255 3410 DCA I AXIN /*8K* 293 000256 4560 SPNOR /IGNORE SPACES AFTER LINE NUMBER 294 000257 7410 SKP 295 000260 4545 GETC /READ 1ST AFTER LINENO TERMINATOR. 296 000261 4546 SRETN, PACKC /SAVE TEXT AND RESTORE DATA FIELD 297 000262 1066 TAD CHAR /TEST FOR END OF INPUT STRING 298 000263 1116 TAD MCR 299 000264 7640 SZA CLA 300 000265 5260 JMP .-5 301 000266 4565 DELETE /REMOVE OLD LINE, IF ANY. 302 000267 4556 ENDLN /INSERT NEW LINE 303 000270 5177 JMP START /POINTERS MUST BE REINITIALIZED 304 000271 4540 INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND. 305 000272 0611 PROC 306 000273 1422 TAD I PC /CHECK NEXT LINE /*8K* 307 000274 7450 SNA /END OF PROGRAM? 308 000275 5177 JMP START /YES 309 000276 3022 DCA PC /SAVE NEW LINE NO. 310 000277 1022 TAD PC /START NEW LINE 311 000300 7001 IAC 312 000301 5232 JMP GONE /PROCESS OTHER COMMANDS 313 314 /TEXT LINE BUFFER FORMAT* 315 316 /#1 : POINTER OR ZERO IN LAST 317 /#2 : LINENO 318 /#3 - #N+1 : TEXT 319 /#N : C.R. 320 321 /LINE NUMBER FORMATION 322 323 000302 0000 XGETLN, 0 /DEVELOP I.D. - "GETLN" 324 000303 4560 SPNOR /IGNORE LEADING SPACES. 325 000304 1066 TAD CHAR /"ALL" IS A SPECIAL ARGUMENT. 326 000305 1112 TAD MINUSA 327 000306 7650 SNA CLA 328 000307 5322 JMP TESTA 329 000310 3036 DCA INSUB /CALL 'GETC' FROM 'INPUT' VIA 'DECON' 330 000311 4771 JMS I LCON /(DECONV - IN FLOAT.) 331 000312 1047 TAD FLAC+3 /GROUP TOO LARGE? 332 000313 0372 AND P7740 333 000314 1046 TAD FLAC+2 334 000315 7640 SZA CLA 335 000316 4566 ERROR2 /GROUP NUMBER TOO LARGE 336 000317 1047 TAD FLAC+3 337 000320 4557 RTL6 338 000321 7004 RAL 339 000322 3067 TESTA, DCA LINENO 340 000323 4561 TESTN /TEST3 341 000324 4545 GETC /READ STEP NUMBER. 342 000325 4561 TESTN /TEST4, OTHER 343 000326 5340 JMP GERR /DOUBLE PERIODS 344 000327 5352 JMP GEXIT /OTHER 345 000330 1054 TAD SORTCN /NUMBER 346 000331 7106 RTL CLL 347 000332 1054 TAD SORTCN 348 000333 7004 RAL 349 000334 1067 TAD LINENO 350 000335 3067 DCA LINENO 351 000336 4545 GETC /READ SECOND STEP NUMBER. 352 000337 4561 TESTN /TEST4, OTHER 353 000340 4566 GERR, ERROR4 /DOUBLE PERIODS 354 000341 5352 JMP GEXIT /OTHER 355 000342 1054 TAD SORTCN /NUMBER 356 000343 1067 TAD LINENO 357 000344 3067 DCA LINENO 358 000345 4545 GETC /TEST FOR CORRECT TERMINATOR 359 000346 4561 TESTN /CHECK SIZE 360 000347 5340 JMP GERR /. 361 000350 7410 SKP 362 000351 4566 ERROR2 /TOO LARGE A LINE NUMBER. 363 364 000352 7100 GEXIT, CLL /CLEAR LINK BIT 365 000353 1067 TAD LINENO /TEST FOR GROUP NUMBER. 366 000354 0104 AND P7600 367 000355 7640 SZA CLA 368 000356 7020 CML 369 000357 1067 TAD LINENO 370 000360 0106 AND P177 /REPARE "NAGSW" 371 000361 7460 SNL SZA 372 000362 4566 GZERR, ERROR2 /0.X = ERROR:ILLEGAL LINE NUMBER. 373 000363 7640 SZA CLA 374 000364 1373 TAD P2000 375 000365 7020 CML 376 000366 7004 RAL 377 000367 3065 DCA NAGSW 378 000370 5702 JMP I XGETLN /--RETURN-- 379 000371 5600 LCON, DECONV 380 000372 7740 P7740, 7740 381 000373 2000 P2000, 2000 382 /--------------------------------------------------------------------- 383 384 /RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 31.99 385 /NAGSW: 386 387 /GROUP=0000 388 /LINE=4000 389 /ALL=0001 390 391 /LIST OF FUNCTION ADDRESSES. (NAMES ARE IN "FNTABL") 392 393 FNTABF=. 394 000374 2014 XABS /FABS -ABSOLUTE VALUE 395 000375 2010 XSGN /FSGN -SIGN PART 396 000376 1160 XINT /FITR -INTEGER PART 397 000377 2725 ERROR5 /FY (USER DEFINED) 398 000400 1553 XRAN /FRAN -RANDOM NUMBER 399 000401 2725 ERROR5 /FZ (USER DEFINED) 400 000402 5000 ARTN /FATN -ARCTANGENT 401 000403 4620 FEXP /FEXP -E^X 402 000404 5040 FLOG /FLOG -LN(X) 403 000405 5205 FSIN /FSIN -SINE 404 000406 5200 FCOS /FCOS -COSINE 405 000407 7400 XSQRT /FSQT -SQUARE ROOT 406 000410 2725 ERROR5 /FNEW (USER DEFINED) 407 000411 2725 ERROR5 /FCOM (LIBRA OR USER DEFINED) 408 000412 2725 ERROR5 /FX (USER DEFINED) 409 410 /----------------------------------------------------------------------- 411 000413 0000 XRTL6, 0 /ROTATE AC LEFT SIX - "RTL6" 412 000414 7106 CLL RTL 413 000415 7006 RTL 414 000416 7006 RTL 415 000417 5613 JMP I XRTL6 /--RETURN-- 416 417 /RECURSIVE OPERATE, EXECUTE, OR CALL 418 419 000420 4554 DO, GETLN /EXECUTE ONE LINE, A GROUP,OR ALL 420 000421 1022 TAD PC /SAVE ADDRESS 421 000422 4542 PUSHA /OF CURRENT LINE 422 000423 4543 PUSHF /SAVE REST OF THIS LINE 423 000424 0017 TEXTP /ADDRESS OF TEXT POINTERS 424 000425 4543 DGRP, PUSHF /SAVE NAGSW; CHAR; AND LINENO. 425 000426 0065 NAGSW 426 000427 1065 TAD NAGSW /CHECK DATA FROM GETLN. 427 000430 7710 SPA CLA /SKIP IF GROUP OR ALL 428 000431 5263 JMP DOONE /DO ONE LINE 429 000432 4555 FINDLN /INIT FOR GROUP AND SET THISLN 430 000433 7000 NOP 431 000434 1023 TAD THISLN /TEST FOR GOOD GROUP NUMBER. 432 000435 3011 DCA XRT 433 000436 1411 TAD I XRT /*8K* 434 000437 4563 TSTGRP 435 000440 4566 ERROR2 /NO SUCH GROUP NUMBER 436 000441 4540 DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC. 437 000442 0606 PROCESS-2 438 000443 4544 POPF /RESTORE THE DATA 439 000444 0065 NAGSW 440 000445 1422 TAD I PC /CHECK FOR END OF TEXT /*8K* 441 000446 7450 SNA 442 000447 5271 JMP DCONT /ALL DONE 443 000450 7001 IAC 444 000451 3030 DCA PT1 /SAVE POINTER TO LINENO 445 000452 1065 TAD NAGSW /CHECK FOR GROUP 446 000453 7740 SMA SZA CLA 447 000454 5260 JMP .+4 /DO ALL 448 000455 1430 TAD I PT1 /TEST GROUP /*8K* 449 000456 4563 TSTGRP 450 000457 5271 JMP DCONT /NOT IN GROUP 451 000460 1430 TAD I PT1 /READ NEXT LINE NO. /*8K* 452 000461 3067 DCA LINENO 453 000462 5225 JMP DGRP /CONTINUE THE SUBROUTINE 454 000463 4555 DOONE, FINDLN /FIND THE LINE 455 000464 4566 ERROR2 /NO SUCH LINE NUMBER 456 000465 4540 PUSHJ /EXECUTE IT 457 000466 0610 PROCESS 458 000467 4544 POPF /RESTORE CHAR 459 000470 0065 NAGSW 460 000471 4544 DCONT, POPF /RESTORE TEXT POINTERS 461 000472 0017 TEXTP 462 000473 1413 POPA /RESTORE ADDRESS OF CURRENT LINE. 463 000474 3022 DCA PC 464 000475 5676 JMP I .+1 /CONTINUE PROCESSING THIS LINE. 465 000476 0611 PROC 466 467 /PUSHDOWN LIST CONTROLS 468 469 000477 0000 XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA" 470 000500 3071 DCA T2 /BACKUP POINTER 471 000501 7040 CMA /AND THEN 472 000502 4310 JMS PCHK /CHECK CORE USAGE 473 000503 1071 TAD T2 /OK 474 000504 3413 DCA I PDLXR /PUSH DOWN LIST POINTER 475 000505 7040 CMA /BACKUP AGAIN 476 000506 4310 JMS PCHK 477 000507 5677 JMP I XPUSHA /--RETURN-- 478 479 000510 0000 PCHK, 0 480 000511 1013 TAD PDLXR /INC IN AC 481 000512 3013 DCA PDLXR 482 000513 1013 TAD PDLXR 483 000514 7141 CIA CLL 484 000515 1031 TAD LASTV 485 000516 7630 SZL CLA 486 000517 4566 ERROR3 /STORAGE FILLED BY PUSH-DOWN LIST 487 000520 5710 JMP I PCHK /--RETURN-- 488 489 000521 0000 XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ" 490 000522 1721 TAD I XPUSHJ 491 000523 3071 DCA T2 /SAVE SUBR. ADDR. 492 000524 7040 CMA 493 000525 4310 JMS PCHK 494 000526 1321 TAD XPUSHJ 495 000527 7001 IAC 496 000530 3413 DCA I PDLXR /SAVE RETURN 497 000531 7040 CMA 498 000532 4310 JMS PCHK 499 000533 5471 JMP I T2 /TRANSFER CONTROL 500 501 000534 0000 PD2, 0 /SAVE A FLOATING POINT NUMBER - "PUSHF" 502 000535 7240 CLA CMA /COMPUTE VARIABLE ADDR 503 000536 1734 TAD I .-2 504 000537 3011 DCA XRT 505 000540 2334 ISZ PD2 /FIX RETURN 506 000541 1117 TAD MFLT /COMPUTE PUSH. POINTER 507 000542 4310 JMS PCHK 508 000543 1117 TAD MFLT 509 000544 3071 DCA T2 510 000545 1411 TAD I XRT 511 000546 3413 DCA I PDLXR 512 000547 2071 ISZ T2 513 000550 5345 JMP .-3 514 000551 1117 TAD MFLT /RESET POINTER 515 000552 4310 JMS PCHK 516 000553 5734 JMP I PD2 /--RETURN-- 517 518 000554 0000 PD3, 0 / RESTORE A FLOATING POINT NUMBER - "POPF" 519 000555 7240 CLA CMA /GET VAR. ADDR. 520 000556 1754 TAD I PD3 521 000557 2354 ISZ PD3 522 000560 3011 DCA XRT 523 000561 1117 TAD MFLT 524 000562 3071 DCA T2 525 000563 1413 TAD I PDLXR /MOVE 526 000564 3411 DCA I XRT 527 000565 2071 ISZ T2 528 000566 5363 JMP .-3 529 000567 5754 JMP I PD3 /--RETURN-- 530 /-------------------------------------------------------------------- 531 INLIST=. /INPUT CONTROL CHARACTERS 532 000570 1154 XINT-4 /CTRL/C = BREAK 533 000571 0212 IBAR /B.A. = RESTART 534 000572 0217 IGNOR /L.F. = IGNORE 535 000573 0227 IRETN /C.R. = TERMINATE STRING 536 537 000574 1075 FLIST2, FLIMIT /,=STANDARD 538 000575 1137 FINFIN /;=SHORT 539 000576 2725 ERROR5 /CR=DUMB 540 541 000577 1065 FLIST1, FINCR /,=STANDARD FORMAT 542 000600 0610 PROCESS /;=SET;PLUS ,.. 543 000601 0614 PC1 /C.R.=SET COMMAND. 544 545 000602 7472 MF, -306 /USED BY TESTC 546 547 548 /PRIMARY CONTROL AND TRANSFER 549 550 000603 4554 GOTO, GETLN /READ THE LINE NUMBER REQUESTED 551 000604 4555 FINDLN /LOCATE IT AND RESET TEXTP 552 000605 4566 ERROR2 /NOT THERE 553 000606 1023 TAD THISLN /SET PC 554 000607 3022 DCA PC 555 /--------------------------------------------------------------------- 556 000610 4545 PROCESS,GETC /TEST FOR END OF LINE 557 000611 1066 PROC, TAD CHAR /FIRST CHARACTER READY = USE PROC 558 000612 1116 TAD MCR 559 000613 7650 SNA CLA 560 000614 5541 PC1, POPJ /EXIT "PROCESS" 561 000615 4550 SORTC /IGNORE "SPACE",",", AND ";". 562 000616 1376 GLIST-1 563 000617 5210 JMP PROCESS 564 000620 1066 TAD CHAR /SAVE COMMAND CHARACTER 565 000621 0075 AND P337 /EXECUTE LOWER CASE ALSO 566 000622 4542 PUSHA 567 000623 4545 GETC /GO TO TERMINATOR 568 000624 4550 SORTC 569 000625 1376 GLIST-1 570 000626 7410 SKP 571 000627 5223 JMP .-4 572 000630 1413 POPA 573 000631 4547 SORTJ /GO DO COMMAND 574 000632 0773 COMLST-1 575 000633 0167 COMGO-COMLST 576 000634 4566 ERROR2 /ILLEGAL COMMAND 577 578 COMMENTS=PC1 /ALSO IS CONTINUE 579 580 /OUTPUT COMMAND TEXT 581 582 000635 4554 WRITE, GETLN /SET LINENO 583 000636 2026 ISZ DEBGSW /DISABLE TRACE 584 000637 4555 FINDLN /SEARCH FOR LINE NUMBER 585 000640 5267 JMP WTESTG /NOT THERE OR GROUP 586 000641 1067 TAD LINENO 587 000642 7640 SZA CLA 588 000643 4553 PRNTLN /PRINT LINE NUMBER AND A SPACE. 589 000644 4545 GETC 590 000645 4551 PRINTC /PRINT TEXT OF A LINE. 591 000646 1066 TAD CHAR 592 000647 1116 TAD MCR 593 000650 7640 SZA CLA /SKIP IF END OF LINE 594 000651 5244 JMP .-5 595 000652 1423 TAD I THISLN 596 000653 7450 WTEST2, SNA 597 000654 5271 JMP WX-2 598 000655 7001 IAC 599 000656 3030 DCA PT1 /SAVE POINTER TO LINENO OF NEXT 600 000657 1065 TAD NAGSW 601 000660 7700 SMA CLA 602 000661 1430 TAD I PT1 /*8K* 603 000662 4563 TSTGRP /TRY NEXT LINENO FOR GROUP. 604 000663 5273 JMP WX 605 000664 1430 WALL, TAD I PT1 /SET LINEN /*8K* 606 000665 3067 DCA LINENO 607 000666 5237 JMP WRITE+2 608 000667 1023 WTESTG, TAD THISLN /INIT GROUP PRINTOUT 609 000670 5253 JMP WTEST2 610 000671 3026 DCA DEBGSW 611 000672 5541 POPJ 612 000673 1065 WX, TAD NAGSW 613 000674 7750 SPA SNA CLA /SKIP IF ALL 614 000675 5271 JMP WX-2 615 000676 4551 PRINTC /PRINT C.R. AGAIN 616 000677 5264 JMP WALL 617 618 619 000700 0000 XTESTC, 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC" 620 000701 4560 SPNOR /IGNORE SPACES 621 000702 4550 SORTC /TEST THE VARIABLE TERMINATORS 622 000703 1767 TERMS-1 623 000704 5700 JMP I XTESTC /YES - SORTCN IS SET--RETURN-- 624 000705 1066 TAD CHAR /NO 625 000706 2300 ISZ XTESTC 626 000707 1202 TAD MF 627 000710 7650 SNA CLA /TEST FOR "F" 628 000711 5317 JMP XT3 629 000712 4561 TESTN 630 000713 5700 JMP I XTESTC /.--RETURN-- 631 000714 7410 SKP /OTHER 632 000715 5700 JMP I XTESTC /NUMBER--RETURN-- 633 000716 2300 ISZ XTESTC 634 000717 2300 XT3, ISZ XTESTC /RETURNS:T;N;F;A 635 000720 5700 JMP I XTESTC /--RETURN-- 636 637 000721 0000 XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORTC" 638 000722 1721 TAD I XSORTC 639 000723 3012 DCA XRT2 /1ST ARG IS LIST-1 640 000724 1412 TAD I XRT2 641 000725 7510 SPA /LIST IS ENDED BY A NEGATIVE NUMBER 642 000726 5340 JMP SEXC /2AND EXIT = NOT IN LIST 643 000727 7041 CIA 644 000730 1066 TAD CHAR 645 000731 7640 SZA CLA /COMPARE 646 000732 5324 JMP .-6 647 000733 1721 TAD I XSORTC /COMPUTE INCREMENT : 0 - N 648 000734 7040 CMA 649 000735 1012 TAD XRT2 650 000736 3054 DCA SORTCN 651 000737 7410 SKP /1ST EXIT = YES 652 000740 2321 SEXC, ISZ XSORTC 653 000741 2321 ISZ XSORTC 654 000742 7300 CLA CLL 655 000743 5721 JMP I XSORTC /--RETURN-- 656 657 658 000744 0000 GRPTST, 0 /AC VS LINENO - "TSTGRP" 659 000745 0104 AND P7600 660 000746 7041 CIA 661 000747 3071 DCA T2 662 000750 1067 TAD LINENO 663 000751 0104 AND P7600 664 000752 1071 TAD T2 665 000753 7650 SNA CLA 666 000754 2344 ISZ GRPTST 667 000755 5744 JMP I GRPTST /--RETURN-- 668 669 /INPUT FROM TEXT OR KEYBOARD; 670 /IF BACK-ARROW, RESTART INPUT 671 672 000756 0000 INPUT, 0 /INPUT A CHARACTER 673 000757 1036 TAD INSUB /NON-ZERO FOR KEYBOARD 674 000760 7640 SZA CLA 675 000761 5364 JMP .+3 676 000762 4545 GETC 677 000763 5756 JMP I INPUT /--RETURN-- 678 000764 4552 READC 679 000765 4547 SORTJ 680 000766 6776 SPECIAL-1 681 000767 3402 INFIX-SPECIAL 682 000770 5756 JMP I INPUT /--RETURN-- 683 684 /---------------------------------------------------------------------- 685 000771 1035 ILIST, IF1 /, 686 000772 0610 PROCESS /; 687 000773 0614 PC1 /CR 688 689 /ENGLISH-FRENCH 690 COMLST=. /COMMAND DECODING LIST 691 000774 0323 323 /SET - ORGANIZE 692 000775 0306 306 /FOR - QUAND 693 000776 0311 311 /IF - SI 694 000777 0304 304 /DO - FAIZ 695 001000 0307 307 /GOTO - VA 696 001001 0303 303 /COMMENT- COMMENTE 697 001002 0301 301 /ASK - DEMANDE 698 001003 0324 324 /TYPE - TAPE 699 001004 0314 314 /LIBRARY- ENTREPOSE 700 001005 0305 305 /ERASE - BIFFE 701 001006 0327 327 /WRITE - INSCRIS 702 001007 0315 315 /MODIFY - MODIFIE 703 001010 0321 321 /QUIT - ARRETE 704 001011 0322 322 /RETURN - RETOURNE 705 001012 0212 212 /(ASTERISK)=EXPANDABLE COMMAND 706 707 /THIS COMMAND LIST IS SPEED OPTIMIZED. 708 709 710 /CONDITIONAL TRANSFER PROCESS. 711 712 001013 4564 IF, TESTC /IGNORE SPACES AND TEST 713 /--------------------------------------------------------------------- 714 001014 4637 JMS I IECALL /T 715 001015 2013 ISZ PDLXR /N-DUMP THE (EFOP) 716 001016 4640 JMS I IPART /F-CHECK FOR PAREN MATCH 717 001017 1111 TAD M2 /A 718 001020 3032 DCA T1 719 001021 1045 TAD FLAC+1 /TEST -,0,+ 720 001022 7510 SPA 721 001023 2032 ISZ T1 /N-TO -1,-2,-3 722 001024 7750 SPA SNA CLA 723 001025 2032 IF3, ISZ T1 /COUNT COMMAS 724 001026 7410 SKP 725 001027 5767 JMP I COMGO+4 /TRANSFER 726 001030 4547 SORTJ /SEARCH TEXT UNTILL ,;C.R. 727 001031 1377 TLIST-1 728 001032 7371 ILIST-TLIST 729 001033 4545 GETC 730 001034 5230 JMP .-4 731 001035 4545 IF1, GETC /MOVE PAST COMMA 732 001036 5225 JMP IF3 733 001037 1601 IECALL, ECALL 734 001040 2047 IPART, PARTEST 735 736 /LOOP CONTROL STATEMENT 737 738 SET=. /SUBSET OF "FOR". 739 740 001041 4540 FOR, PUSHJ /LOOPS, ETC. 741 001042 1403 GETARG /LOOK FOR "=" NEXT 742 001043 4560 SPNOR /IGNORE SPACES 743 001044 1066 TAD CHAR 744 001045 1335 TAD MEQ 745 001046 7440 SZA 746 001047 4566 ERROR4 /LEFT OF "=" IN ERROR: 'FOR' OR 'SET' 747 001050 1030 TAD PT1 748 001051 4542 PUSHA /SAVE POINTER TO VARIABLE 749 001052 4540 PUSHJ 750 001053 1612 EVAL-1 /GET INITIAL VALUE EXPRESSION 751 001054 1413 POPA 752 001055 3030 DCA PT1 753 001056 4407 FINT /INITIALIZE NOW. 754 001057 6430 FPUT I PT1 755 001060 0000 FXIT 756 001061 4547 SORTJ /TEST LAST CHAR FROM "EVAL" 757 001062 1377 TLIST-1 758 001063 7177 FLIST1-TLIST 759 001064 4566 ERROR4 /EXCESS R-PAR 760 001065 1030 FINCR, TAD PT1 /SAVE VARIABLE ADDRESS * 761 001066 4542 PUSHA 762 001067 4540 PUSHJ /EVALUATE THE INCREMENT,IF ANY. 763 001070 1612 EVAL-1 764 001071 4547 SORTJ /TEST TERMINATORS 765 001072 1377 TLIST-1 766 001073 7174 FLIST2-TLIST 767 001074 4566 ERROR4 /ILLEGAL TERMINATOR IN 'FOR' 768 001075 4543 FLIMIT, PUSHF /SAVE THE INCREMENT. * 769 001076 2030 FLARG 770 001077 4540 PUSHJ /GET THE LIMIT(NO ERROR DETECTION AFTER LIMIT) 771 001100 1612 EVAL-1 772 001101 4543 FCONT, PUSHF /SAVE THE LIMIT * 773 001102 2030 FLARG 774 001103 4543 PUSHF /SAVE TEXT OF OBJECT STATEMENTS 775 001104 0017 TEXTP 776 001105 4540 PUSHJ /DO THE OBJECT STATEMENTS 777 001106 0610 PROCESS 778 001107 4544 POPF /RESTORE REMAINING TEXT. 779 001110 0017 TEXTP 780 001111 4544 POPF /GET LIMIT 781 001112 2030 FLARG 782 001113 4544 POPF /GET INCREMENT 783 001114 7470 ITER1 784 001115 1413 POPA /GET VARIABLE ADDRESS 785 001116 3030 DCA PT1 786 787 788 001117 4407 FINT /INCREMENT AND TEST 789 001120 0430 FGET I PT1 /LOAD THE VARIABLE 790 001121 1733 FADD I FINKP /INCREMENT IT 791 001122 6430 FPUT I PT1 /CHANGE IT 792 001123 2525 FSUB I FLARGP /TEST IT 793 001124 0000 FXIT 794 001125 1045 TAD FLAC+1 795 001126 7740 SMA SZA CLA 796 001127 5541 POPJ /END OF LOOP 797 001130 1030 TAD PT1 798 001131 4542 PUSHA /SAVE ADDRESS * 799 001132 4543 PUSHF /SAVE INCREMENT AGAIN * 800 001133 7470 FINKP, ITER1 801 001134 5301 JMP FCONT 802 001135 7503 MEQ, -275 803 001136 7524 MCOM, -254 804 001137 4543 FINFIN, PUSHF /SET INCREMENT TO ONE. 805 001140 2405 FLTONE 806 001141 5301 JMP FCONT 807 808 /PATCH TO WRITE ROUTINE 809 /INSERTS 2 NULL CHARACTERS (CODE 200) 810 / AFTER EACH OUTPUT CARRIAGE RETURN 811 812 001142 1123 XDYS, TAD C200 /OUTPUT NULL CHARACTER 813 001143 4551 PRINTC 814 001144 1123 TAD C200 815 001145 4551 PRINTC 816 001146 1423 TAD I THISLN /*8K* 817 001147 7450 SNA /XDYS+5 818 001150 5752 JMP I .+2 819 001151 5753 JMP I .+2 820 001152 0671 WX-2 821 001153 0655 WTEST2+2 822 /-------------------------------------------------------------------- 823 /CTRL/C HANDLER 824 001154 1123 TAD C200 825 001155 3067 DCA LINENO 826 001156 5757 JMP I .+1 827 001157 2741 RECOVR+1 828 829 830 /TAKE THE INTEGER PART 831 832 001160 4453 XINT, JMS I INTEGER /(FIX) 833 001161 7200 CLA 834 001162 5536 JMP I EFUN3I 835 836 837 838 COMGO=. /COMMAND ROUTINE ADDRESSES 839 001163 1041 SET 840 001164 1041 FOR 841 001165 1013 IF 842 001166 0420 DO 843 001167 0603 GOTO /(REFERENCED) 844 001170 0614 COMMENT 845 001171 1202 ASK 846 001172 1203 TYPE 847 001173 7503 LIBRARY 848 001174 2204 ERASE 849 001175 0635 WRITE 850 001176 1256 MODIFY 851 001177 0177 START /RETURN TO COMMAND MODE VIA 'QUIT' 852 001200 1563 RETRN 853 001201 6361 HSPX /ACTIVATE THE HIGH SPEED READER 854 855 856 857 858 859 /--------------------------------------------------------------------- 860 /INPUT-OUTPUT STATEMENTS 861 862 001202 7240 ASK, CLA CMA /REMEMBER WHICH CALL. 863 001203 3056 TYPE, DCA ATSW 864 001204 4547 TASK, SORTJ /SPECIAL CHARACTER? 865 001205 1371 ALIST-1 866 001206 0176 ATLIST-ALIST 867 001207 2056 ISZ ATSW /TEST QUOTE SWITCH 868 001210 5225 JMP TYPE2 869 001211 4540 PUSHJ /DO ASK; SETUP PT1 870 001212 1403 GETARG 871 001213 1066 TAD CHAR /SAVE IN-LINE CHARACTER. 872 001214 4542 PUSHA 873 001215 1255 TAD COL /TYPE COLON 874 001216 4551 PRINTC /(CLA)- TO SUPRESS ":" 875 001217 2036 ISZ INSUB /INDICATE 'READC' 876 001220 7001 IAC /POINT PAST CHAR 877 001221 4531 JMS I FINPUT /READ DATA AND SAVE 878 001222 1413 POPA /RE-TEST LAST TERMINATOR 879 001223 3066 DCA CHAR 880 001224 5202 JMP ASK /CONTINUE PROCESSING 881 001225 4540 TYPE2, PUSHJ /DO TYPE 882 001226 1613 EVAL 883 001227 4530 JMS I FOUTPUT /PRINT 884 001230 5203 JMP TYPE 885 886 887 888 001231 2026 TQUOT, ISZ DEBGSW /DISABLE TRACE 889 001232 4545 GETC /TYPE LITERALS 890 001233 4547 SORTJ 891 001234 1403 TLIST2-1 892 001235 0773 TLIST3-TLIST2 893 001236 4551 PRINTC 894 001237 5232 JMP TQUOT+1 895 001240 4545 TINTR, GETC /PASS PERCENT SIGN 896 001241 4554 GETLN /READ FORMAT CONTROL: "%7.03" 897 001242 1067 TAD LINENO 898 001243 3052 DCA FISW /SAVE FORMAT CODE 899 001244 5204 JMP TASK 900 001245 1077 TCRLF2, TAD CCR /SPLAT=CR ALONE 901 001246 4463 JMS I OUTDEV 902 001247 7001 IAC /NON-PRINTING DELAY FOR CR (216) 903 001250 1077 TCRLF, TAD CCR /EXCLAMATION POINT=CR,LF. 904 001251 4551 PRINTC 905 001252 3026 TASK4, DCA DEBGSW /RE-ENABLE THE TRACE 906 001253 4545 GETC /MOVE TO NEXT CHARACTER 907 001254 5204 JMP TASK 908 001255 0272 COL, 272 /":" 909 910 911 912 /IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW" 913 / #0: DISABLE AND RETURN ALL"?" ' S. 914 /IF DMPSW = 0: TRACE ON, IF ENABLED 915 / #0: TRACE OFF 916 /IF BOTH = 0 : PRINT TRACE. 917 918 919 920 /SEARCH ROUTINES 921 922 001256 4554 MODIFY, GETLN /READ LINE NO. 923 001257 4555 FINDLN /LOOK IT UP NOW. 924 001260 4566 ERROR2 /NOT THERE = BAD COMMAND UNLESS ZERO. 925 001261 1060 TAD BUFR /SET POINTERS 926 001262 3010 DCA AXIN /FOR INPUT 927 001263 3062 DCA XCTIN 928 001264 1067 TAD LINENO /COPY THE SAME LINE NUMBER. 929 001265 3410 DCA I AXIN /*8K* 930 001266 1010 TAD AXIN /SAVE START OF NEW LINE 931 001267 3027 DCA PACKST 932 001270 4464 SCONT, JMS I INDEV /READ THE TELETYPE INPUT SILENTLY. 933 001271 3100 DCA LIST3+1 /SAVE SEARCH CHARACTER 934 001272 2026 ISZ DEBGSW /NO BREAKS. 935 001273 4545 SCHAR, GETC /TYPE+TEST-F.F. 936 001274 4551 PRINTC /PLAYBACK THE TEXT 937 001275 4547 SORTJ /LOOK FOR MATCH 938 001276 0076 LIST3-1 939 001277 1271 LISTGO-LIST3 940 001300 4546 PACKC /SAVE NEW LINE. 941 001301 5273 JMP SCHAR 942 001302 1060 SBAR, TAD BUFR /RESTART-B.A. 943 001303 7001 IAC 944 001304 3010 DCA AXIN /SET POINTERS 945 001305 3062 DCA XCTIN 946 001306 4552 SFOUND, READC /READ FROM KEYBOARD 947 001307 4547 SORTJ /TEST 948 001310 0071 LIST6-1 949 001311 1271 SRNLST-LIST6 950 001312 4546 SGOT, PACKC /PACK CHAR. 951 001313 5306 JMP SFOUND /MORE 952 953 001314 0000 SORTB, 0 /SORT AND BRANCH ROUTINE. - "SORTJ" 954 001315 7450 SNA 955 001316 1066 TAD CHAR /ASSUME CHAR IF AC=0 956 001317 7041 CIA 957 001320 3071 DCA T2 /SAVE SORT ITEM 958 001321 1714 TAD I SORTB /FIRST ARG IS LIST LESS ONE 959 001322 2314 ISZ SORTB /2AND IS INTRA-LIST LENGTH 960 001323 3012 DCA XRT2 961 001324 1412 TAD I XRT2 962 001325 7510 SPA /**LISTS ENDED BY NEGATIVE NUMBERS** 963 001326 5340 JMP SEX /READ EXIT 964 001327 1071 TAD T2 /FIND ADDRESS 965 001330 7640 SZA CLA 966 001331 5324 JMP .-5 967 001332 1012 TAD XRT2 /MATCH FOUND. 968 001333 1714 TAD I SORTB 969 001334 3071 DCA T2 970 001335 1471 TAD I T2 971 001336 3071 DCA T2 /DEBUG : AC = ADDRESS 972 001337 5471 JMP I T2 973 001340 2314 SEX, ISZ SORTB /MATCH NOT FOUND. 974 001341 7300 CLA CLL 975 001342 5714 JMP I SORTB /--RETURN-- 976 977 978 979 /OUTPUT CARRIAGE RETURN BEFORE ERROR MESSAGE 980 981 001343 1077 XADC, TAD CCR /OUTPUT CARRIAGE RETURN/LINE FEED 982 001344 4551 PRINTC 983 001345 1110 TAD P277 /OUTPUT QUESTION MARK 984 001346 4551 PRINTC 985 001347 5750 JMP I .+1 986 001350 2765 RECOVX+4 987 001351 7600 7600 /XADC+6 USED BY L COMMAND 988 001352 7402 HLT 989 001353 7402 HLT 990 991 992 001354 0000 OUTL, 0 /SLOW OUTPUT FOR ODT SYNCRONIZATION 993 001355 6046 TLS /AND FOR H.S. PUNCH 994 001356 6026 PLS 995 001357 6041 TSF /IOT FOR SLOWEST DEVICE 996 001360 5357 JMP .-1 997 001361 7200 CLA 998 001362 5754 JMP I OUTL /--RETURN-- 999 1000 1001 1002 1003 /---------------------------------------------------------------------- 1004 SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE 1005 001363 1273 SCHAR /F.F. = CONTINUE 1006 001364 1270 SCONT /BELL = CHANGE SEARCH CHARACTER 1007 001365 1154 XINT-4 /CTRL/C = BREAK 1008 001366 1302 SBAR /B.A. = RESTART 1009 001367 1271 SCONT+1 /L.F. = FINISH THE LINE AS BEFORE. 1010 LISTGO=. 1011 001370 0261 SRETN /C.R. = END THE LINE HERE AS IS. 1012 001371 1312 SGOT /CHAR = SEARCH CHARACTER 1013 1014 1015 1016 1017 1018 ALIST=. / ASK/TYPE LIST OF CONTROLS. 1019 001372 0245 245 /% 1020 001373 0242 242 /" 1021 001374 0241 241 /! 1022 001375 0243 243 /# 1023 001376 0244 244 /$ 1024 GLIST=. 1025 001377 0240 240 /SPACE 1026 TLIST=. 1027 001400 0254 254 /, 1028 001401 0273 273 /; 1029 001402 0215 215 /C.R. 1030 /THIS LIST IS ENDED BY 'TESTC'. 1031 1032 1033 /FIND OR ENTER A VARIABLE IN THE LIST. 1034 1035 001403 4564 GETARG, TESTC /FIRST LETTER OF ARG 1036 001404 0242 TLIST2, 0242 /" 1037 001405 0215 0215 /C.R. - FUNCTION OR NUMBER IS NOT AN ARG. 1038 001406 4566 ERROR4 /BAD ARGUEMENT IN 'FOR', 'SET', OR 'ASK' 1039 001407 3062 GETVAR, DCA XCTIN /PACK INTO ADD. 1040 001410 4546 PACKC 1041 001411 4545 GETC /SECOND LETTER 1042 001412 4550 SORTC /TERMINATOR? 1043 001413 1767 TERMS-1 1044 /---------------------------------------------------------------------- 1045 001414 5226 JMP GSERCH /YES 1046 001415 1066 TAD CHAR /NO 1047 001416 0122 AND P77 /SAVE 2AND LETTER OF NAME 1048 001417 1061 TAD ADD 1049 001420 3061 DCA ADD 1050 001421 4545 GETC /IGNORE THE REST 1051 001422 4550 SORTC 1052 001423 1767 TERMS-1 1053 001424 5226 JMP GSERCH 1054 001425 5221 JMP .-4 1055 001426 4562 GSERCH, TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN 1056 001427 5237 JMP GS1 /NOT SUBSCRIPTED BY L-PAR. 1057 001430 1061 TAD ADD /SAVE NAME 1058 001431 3056 DCA EFOP /FOR RECURSIVE AND ERROR CHECK 1059 001432 4660 JMS I GECALL /TO EVAL 1060 001433 1413 POPA 1061 001434 3061 DCA ADD /RESTORE NAME 1062 001435 4657 JMS I PTEST /TEST PAREN MATCH, ETC. 1063 001436 4453 JMS I INTEGER /CONVERT TO 12-BIT NUMBER. 1064 001437 3317 GS1, DCA SUBS /SAVE SUBSCRIPT 1065 001440 1060 TAD STARTV /SEARCH FOR VARIABLE /*8K* 1066 001441 3030 GS3, DCA PT1 1067 001442 1030 TAD PT1 1068 001443 7041 CIA 1069 001444 1031 TAD LASTV /TEST FOR END OF LIST 1070 001445 7750 SPA SNA CLA 1071 001446 5261 JMP GS2 /END SEARCH 1072 001447 1430 TAD I PT1 /GET TABLE ENTRY 1073 001450 7041 CIA 1074 001451 1061 TAD ADD 1075 001452 7650 SNA CLA 1076 001453 5305 JMP GFND1 /FOUND XX 1077 001454 1030 GS4, TAD PT1 /TRY NEXT ONE 1078 001455 1070 TAD GINC 1079 001456 5241 JMP GS3 1080 001457 2047 PTEST, PARTEST 1081 001460 1601 GECALL, ECALL 1082 1083 1084 001461 1031 GS2, TAD LASTV /ADD THE VARIABLE 1085 001462 1005 TAD P13 /TEST STORAGE LIMITS 1086 001463 7141 CIA CLL 1087 001464 1013 TAD PDLXR 1088 001465 7620 SNL CLA 1089 001466 4566 ERROR3 1090 001467 1031 TAD LASTV /UPDATE THE LIST. 1091 001470 1070 TAD GINC 1092 001471 3031 DCA LASTV 1093 001472 1061 TAD ADD /SAVE NAME 1094 001473 3430 DCA I PT1 1095 001474 2030 ISZ PT1 /SAVE SUBSCRIPT 1096 001475 1317 TAD SUBS 1097 001476 3430 DCA I PT1 1098 001477 2030 ISZ PT1 /SET PT1 1099 001500 4407 FINT 1100 001501 0537 FGET I CFRSX 1101 001502 6430 FPUT I PT1 1102 001503 0000 FXIT 1103 001504 5541 POPJ /EXIT 1104 001505 1030 GFND1, TAD PT1 /FOUND SAME 1105 001506 3011 DCA XRT /TEST SUBSCRIPTS 1106 001507 1411 TAD I XRT 1107 001510 7041 CIA 1108 001511 1317 TAD SUBS 1109 001512 7640 SZA CLA 1110 001513 5254 JMP GS4 /WRONG SUBSCRIPT 1111 001514 2030 ISZ PT1 /SET POINTER TO DATA 1112 001515 2030 ISZ PT1 1113 001516 5541 POPJ 1114 1115 1116 1117 SUBS=. 1118 001517 0000 XSPNOR, 0 /IGNORE LEADING SPACES - "SPNOR" 1119 001520 1066 TAD CHAR 1120 001521 1114 TAD M240 1121 001522 7640 SZA CLA 1122 001523 5717 JMP I XSPNOR /--RETURN-- 1123 001524 4545 GETC 1124 001525 5320 JMP XSPNOR+1 1125 1126 1127 001526 7520 M260, -260 1128 001527 7507 M271, -271 1129 1130 1131 1132 001530 0000 RANO, 0000 /RANDOM NUMBER STORAGE! 1133 001531 2000 2000 1134 001532 0000 0000 1135 001533 0000 XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN" 1136 001534 1066 TAD CHAR 1137 001535 1115 TAD MPER 1138 001536 7640 SZA CLA 1139 001537 2333 ISZ XTESTN 1140 001540 1066 TAD CHAR 1141 001541 1326 TAD M260 1142 001542 3054 DCA SORTCN /SAVE VALUE OF THE NUMBER 1143 001543 1054 TAD SORTCN /TEST IF REALLY A DIGIT. 1144 001544 7710 SPA CLA 1145 001545 5733 JMP I XTESTN /--RETURN-- 1146 001546 1066 TAD CHAR 1147 001547 1327 TAD M271 1148 001550 7750 SPA SNA CLA 1149 001551 2333 ISZ XTESTN /IF A NUMBER 1150 001552 5733 JMP I XTESTN /--RETURN-- 1151 001553 4407 XRAN, FINT /PSEUDO-RANDOM NUMBER GENERATOR. 1152 001554 1330 FADD RANO /ADD RUNNING RESULT TO THE ARGUMENT, IF ANY. 1153 001555 4350 FMUL .-5 /BLAST THE ARGUMENT 1154 001556 6330 FPUT RANO 1155 001557 0000 FXIT 1156 001560 3330 DCA RANO /CONVERT TO .5 THROUGH .999 1157 /---------------------------------------------------------------------- 1158 001561 3044 DCA FLAC /SAME AS RETURN 1159 001562 5536 JMP I EFUN3I 1160 1161 1162 /EXIT FROM A "DO" SUBROUTINE 1163 1164 1165 001563 1137 RETRN, TAD CFRSX /(PC) => 0 /*8K* 1166 001564 3022 DCA PC 1167 001565 1413 XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ" 1168 001566 3071 DCA T2 1169 001567 5471 JMP I T2 1170 1171 1172 1173 ATLIST=. /ASK-TYPE CONTROL CHARACTER TABLE 1174 001570 1240 TINTR /% - FORMAT DELIMITER 1175 001571 1231 TQUOT /" - LITERAL DELIMITER 1176 001572 1250 TCRLF /! - CARRIAGE RETURN AND LINE FEED 1177 001573 1245 TCRLF2 /# - CARRIAGE RETURN ONLY 1178 001574 3052 TDUMP /$/- DUMP THE SYMBOL TABLE CONTENTS 1179 001575 1252 TASK4 /SP- TERMINATOR FOR NAMES 1180 001576 1252 TASK4 /, - TERMINATOR FOR EXPRESSIONS 1181 001577 0610 PROCESS /; - TERMINATOR FOR COMMANDS 1182 001600 0614 PC1 /C.R. - TERMINATOR FOR STRINGS 1183 1184 /$ - FOR 'TDUMP' TERMINATES THE COMMAND. 1185 1186 1187 1188 /EVALUATE AN EXPRESSION WHICH 1189 /TERMINATES WITH AN R-PAR,; OR C.R. AND 1190 /LEAVE THE RESULT IN FLAC AND IN FLARG. 1191 1192 1193 1194 1195 /---------------------------------------------------------------------- 1196 001601 0000 ECALL, 0 /RECURSIVE CALL TO "EVAL" 1197 001602 1054 TAD SORTCN /SAVE 'SORTCN','LASTOP',AND 'EFOP' 1198 001603 4542 PUSHA 1199 001604 1055 TAD LASTOP 1200 001605 4542 PUSHA 1201 001606 1056 TAD EFOP /SAVE FUNCTION CODE. 1202 001607 4542 PUSHA 1203 001610 1201 TAD ECALL /RETURN TO CALLING 1204 001611 4542 PUSHA /ADDRESS AFTER NEXT POPJ 1205 1206 001612 4545 GETC /MOVE PAST EXTRA CHARACTER 1207 001613 3055 EVAL, DCA LASTOP /EVAUATION CONTROLLER (CHECKPOINT ?) 1208 001614 4564 TESTC /TEST CHARACTER AND IGNORE SPACES 1209 001615 5227 JMP ETERM1 /TERMINATOR 1210 001616 5332 JMP ENUM /NUMBER 1211 001617 5343 JMP EFUN /FUNCTION 1212 001620 4540 PUSHJ /LETTER OF VARIABLE 1213 001621 1407 GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1. 1214 001622 4564 OPNEXT, TESTC /PT1=>ARG 1215 001623 5244 JMP ETERMN /T 1216 001624 0212 ECHOLST,0212 /N-ERROR IN FORMAT 1217 001625 0377 0377 /F 1218 001626 4566 ERROR4 /L - MISSING OPERATOR 1219 001627 1137 ETERM1, TAD CFRSX /SET PT1. 1220 001630 3030 DCA PT1 /TO POINT TO ZERO 1221 001631 1111 TAD M2 /TEST FOR UNARY OPERATIONS 1222 001632 1054 TAD SORTCN 1223 001633 7450 SNA 1224 001634 5247 JMP ETERM /CREATE DUMMY FOR UNARY MINUS 1225 001635 7001 IAC 1226 001636 7650 SNA CLA 1227 001637 5323 JMP ARGNXT /IGNORE UNARY PLUS 1228 001640 1054 TAD SORTCN /TEST FOR NULL PARENS. 1229 001641 1121 TAD M11 1230 001642 7710 SPA CLA 1231 001643 5363 JMP ELPAR /MIGHT BE AN L-PAR. 1232 001644 4562 ETERMN, TSTLPR 1233 001645 7410 SKP 1234 001646 4566 ERROR4 /OPERATOR MISSING BEFORE PAREN 1235 001647 1054 ETERM, TAD SORTCN /SET FROM "TESTC"-"SORTC" 1236 001650 3024 DCA THISOP 1237 001651 1024 TAD THISOP 1238 001652 1121 TAD M11 1239 001653 7700 SMA CLA /END? 1240 001654 3024 DCA THISOP /"THISOP" EQUIV. TO END OF EXP. 1241 1242 001655 1024 ETERM2, TAD THISOP /COMPARE PRIORITIES 1243 001656 7041 CIA 1244 001657 1055 TAD LASTOP 1245 001660 7710 SPA CLA 1246 001661 5310 JMP EPAR /CONTINUE 1247 001662 1055 TAD LASTOP /FIND OPERATION 1248 001663 7112 CLL RTR 1249 001664 7012 RTR 1250 001665 1331 TAD OPTABL 1251 001666 3274 DCA FLOP 1252 001667 1055 TAD LASTOP 1253 001670 7640 SZA CLA /TEST FOR END OF DATA INTO FLOATING AC. 1254 001671 4544 POPF /GET LAST DATA 1255 001672 0044 FLAC 1256 001673 4407 FINT 1257 001674 0000 FLOP, 00 /(FLOPR I PT1)+-*/ 1258 001675 6525 FPUT I FLARGP /SAVE RESULT 1259 001676 0000 FXIT 1260 001677 1125 TAD FLARGP 1261 001700 3030 DCA PT1 1262 001701 1024 TAD THISOP 1263 001702 1055 TAD LASTOP /=0? 1264 001703 7650 SNA CLA 1265 001704 5541 POPJ /EXIT "EVAL" 1266 001705 1413 POPA /GET PRIOR OP 1267 001706 3055 DCA LASTOP 1268 001707 5255 JMP ETERM2 /COMPARE THIS OP 1269 001710 4562 EPAR, TSTLPR /TEST FOR SUB-EXPRESSION 1270 001711 7410 SKP 1271 001712 5365 JMP EPAR2 /GO EVALUATE EXPRESSION 1272 001713 1055 TAD LASTOP /CONTINUE READING THE EXPRESSION 1273 001714 4542 PUSHA /SAVE "LASTOP". 1274 001715 1030 TAD PT1 1275 001716 3320 DCA .+2 1276 001717 4543 PUSHF /SAVE LAST ARGUMENT 1277 001720 0000 00 1278 001721 1024 TAD THISOP /MORE TO COME 1279 001722 3055 DCA LASTOP 1280 001723 4545 ARGNXT, GETC /READ 1ST CHAR OF AN ARG. 1281 001724 4564 TESTC /DO SPECIAL CHECK 1282 001725 5363 JMP ELPAR /COULD BE LEFT PAREN 1283 001726 5332 JMP ENUM /N 1284 001727 5343 JMP EFUN /F 1285 001730 5220 JMP OPNEXT-2 /L 1286 001731 0430 OPTABL, FGET I PT1 /BASE FOR OPERATION COMPUTATION 1287 1288 001732 4543 ENUM, PUSHF /TO PROCESS A NUMBER,SAVE AC 1289 001733 0044 FLAC 1290 001734 1125 TAD FLARGP /SET POINTER AS FOR A VARIABLE. 1291 001735 3030 DCA PT1 1292 001736 3036 DCA INSUB /POINT TO 'GETC' AND USE CHAR 1293 001737 4531 JMS I FINPUT /READ TEXT NUMBER => (PT1) 1294 001740 4544 POPF /RESTORE THE AC 1295 001741 0044 FLAC 1296 001742 5222 JMP OPNEXT /CONTINUE 1297 001743 3056 EFUN, DCA EFOP /SET CODE 1298 001744 4545 GETC /READ FUNCTION NAME.(1,2,OR 3 LETTERS) 1299 001745 4550 SORTC /LOOK FOR TERMINATION CHARACTER. 1300 001746 1767 TERMS-1 1301 001747 5354 JMP EFUN2 /YES 1302 001750 1056 TAD EFOP /NO 1303 001751 7104 CLL RAL /MISH-MASH HASH CODE 1304 001752 1066 TAD CHAR 1305 001753 5343 JMP EFUN 1306 001754 4562 EFUN2, TSTLPR 1307 001755 4566 ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT 1308 001756 4201 JMS ECALL /CALL "EVAL" TO COMPUTE ARGUMENT 1309 001757 1413 POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I. 1310 001760 4547 SORTJ 1311 001761 2164 FNTABL-1 1312 001762 6207 FNTABF-FNTABL 1313 001763 4562 ELPAR, TSTLPR /LEFT PAREN OR FELL THROUGH FUNCTION TABLE 1314 001764 4566 ERROR4 /DOUBLE OPERATORS OR ILLEGAL FUNCTION NAME. 1315 001765 4201 EPAR2, JMS ECALL /EVALUATE NESTED EXPRESSION 1316 /-------------------------------------------------------------------- 1317 001766 2013 ISZ PDLXR /DUMP EXTRA ARG. 1318 001767 5536 JMP I EFUN3I 1319 1320 TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR' 1321 001770 0240 240 /SPACE 0 1322 001771 0253 253 /+ 1 1323 001772 0255 255 /- 2 1324 001773 0257 257 // 3 1325 001774 0252 252 /* 4 1326 001775 0336 336 /UP ARR 5 1327 001776 0250 250 /( 6 L-PARS 1328 001777 0333 333 /[ 7 1329 002000 0274 274 /< 10 1330 002001 0251 251 /) 11 R-PARS 1331 002002 0335 335 /] 12 1332 002003 0276 276 /> 13 1333 002004 0254 254 /, 14 1334 002005 0273 273 /; 15 1335 002006 0215 215 /C.R. 16 1336 002007 0275 275 /= TO END GETARG FROM 'SET' 1337 1338 /TWO MINOR FUNCTIONS 1339 1340 1341 002010 4543 XSGN, PUSHF /TAKE SIGN*1 OF FLARG 1342 002011 2405 FLTONE 1343 002012 4544 POPF 1344 002013 0044 FLAC 1345 /----------------------------------------------------------------------- 1346 002014 1231 XABS, TAD FLARG+1 /TAKE ABSOLUTE VALUE OF FLAC 1347 002015 7710 SPA CLA /SKIP TO CONTINUE 1348 002016 4451 JMS I MINSKI /NEGATE THE FLOATING AC 1349 1350 /CONTINUATION OF FUNCTION CALLS. 1351 1352 002017 4407 EFUN3, FINT 1353 002020 7000 FNOR /NORMALIZE FUNCTION RETURN 1354 002021 6230 FPUT FLARG /SAVE FUNCTION VALUE 1355 002022 0000 FXIT 1356 002023 1125 TAD FLARGP /SET POINTER 1357 002024 3030 DCA PT1 1358 002025 4247 JMS PARTEST 1359 002026 5627 JMP I .+1 /FUNCTION RETURN IS OK 1360 002027 1622 OPNEXT 1361 1362 002030 0000 FLARG, 0 /DATA TEMPORARY STORAGE 1363 002031 0000 0 1364 002032 0000 0 1365 002033 0000 0 1366 1367 002034 0003 P3, 3 1368 002035 0000 LPRTST, 0 /SKIP IF LEFT PAREN. - 'TSTLPR' 1369 002036 1054 TAD SORTCN 1370 002037 1121 TAD M11 1371 002040 7700 SMA CLA 1372 002041 5635 JMP I LPRTST /--RETURN-- 1373 002042 1054 TAD SORTCN 1374 002043 1120 TAD M5 1375 002044 7740 SMA SZA CLA 1376 002045 2235 ISZ LPRTST 1377 002046 5635 JMP I LPRTST /--RETURN-- 1378 1379 002047 0000 PARTEST,0 /TEST THE PAREN MATCHINGS 1380 002050 1413 POPA /RESTORE LAST OPERATION 1381 002051 3055 DCA LASTOP 1382 002052 1234 TAD P3 /+3 TO COMPARE CODES 1383 002053 1413 POPA /GET LAST PAREN CODE. 1384 002054 7041 CIA /CHECK FOR PAREN MATCH. 1385 002055 1054 TAD SORTCN /(STILL SET FROM THE LAST "EVAL") 1386 002056 7640 SZA CLA /SKIP IF MATCH 1387 002057 4566 ERROR4 /PAREN ERROR 1388 002060 4545 GETC /MOVE PAST R-PAR 1389 002061 5647 JMP I PARTEST /--RETURN-- 1390 1391 /THE DELETE A LINE ROUTINE 1392 1393 002062 0000 XDELETE,0 /UNCHAIN A LINE AND RECOVER THE SPACE. 1394 002063 6002 IOF /PROTECT POINTER CHANGES FROM INTERRUPTIONS 1395 002064 4555 FINDLN /SETS "THISLN" AND "LASTLN". 1396 002065 5662 JMP I XDELETE /ALREADY GONE --RETURN-- 1397 002066 2026 ISZ DEBGSW /DISABLE TRACE 1398 002067 4545 GETC /MEASURE LENGTH 1399 002070 1066 TAD CHAR 1400 002071 1116 TAD MCR 1401 002072 7640 SZA CLA 1402 002073 5267 JMP .-4 1403 002074 1017 TAD AXOUT /SAVE LAST ADDRESS 1404 002075 7040 CMA 1405 002076 1023 TAD THISLN 1406 002077 3057 DCA CNTR /LENGTH < 0 1407 002100 1133 TAD CFRS /IT IS ILLEGAL TO DELETE THE FIRST LINE 1408 002101 7041 CIA 1409 002102 1023 TAD THISLN 1410 002103 7650 SNA CLA 1411 002104 5177 JMP START /JUST IGNORE SUCH COMMANDS 1412 002105 7000 NOP /CHANGE DATA FIELD TO TEXT /*8K* 1413 002106 1423 TAD I THISLN /DISCONNECT 1414 002107 3425 DCA I LASTLN 1415 002110 1133 TAD CFRS /START LIST AT TOP 1416 002111 3071 DOK, DCA T2 /EXAMINATION ADDRESS 1417 002112 1471 TAD I T2 /GET THE NEXT ADDR. 1418 002113 7450 SNA /TEST FOR END 1419 002114 5327 JMP DONE /YES-WRAP UP ALL. 1420 002115 3032 DCA T1 /SAVE NEXT ADDRESS. 1421 002116 1023 TAD THISLN /COMPARE LINE POSITIONS 1422 002117 7141 CIA CLL 1423 002120 1032 TAD T1 1424 002121 7630 SZL CLA /SKIP IF THISLN > X 1425 002122 1057 TAD CNTR /CHANGE (X) TO ACCOUNT FOR 1426 002123 1032 TAD T1 /GARBAGE COLLECTION. 1427 002124 3471 DCA I T2 1428 002125 1032 TAD T1 /GET NEXT 1429 002126 5311 JMP DOK 1430 1431 /GARBAGE COLLECTION 1432 1433 002127 7040 DONE, CMA /BACKUP L FOR XR 1434 002130 1023 TAD THISLN 1435 002131 3011 DCA XRT 1436 002132 1057 TAD CNTR /SETUP END OF HOSE 1437 002133 7040 CMA 1438 002134 1023 TAD THISLN 1439 002135 3012 DCA XRT2 1440 002136 1057 TAD CNTR /CORRECT END OF BUFFER POINTER. 1441 002137 1060 TAD BUFR 1442 002140 3060 DCA BUFR 1443 002141 1010 TAD AXIN /COMPUTE COUNT 1444 002142 7040 CMA 1445 002143 1012 TAD XRT2 1446 002144 3032 DCA T1 1447 002145 1010 TAD AXIN 1448 002146 1057 TAD CNTR 1449 002147 3010 DCA AXIN 1450 002150 1412 TAD I XRT2 /SIPHON LOWER PART. 1451 002151 3411 DCA I XRT 1452 002152 2032 ISZ T1 1453 002153 5350 JMP .-3 1454 002154 5263 JMP XDELETE+1 /RESET 'LASTLN','THISLN', AND DATA FIELD. 1455 1456 1457 002155 0000 CHIN, 0 /READ IN A CHARACTER SUBR. - "READC" 1458 002156 4464 JMS I INDEV 1459 002157 3066 DCA CHAR 1460 002160 4550 SORTC /LINEFEED OR RUBOUT? 1461 002161 1623 ECHOLST-1 1462 002162 5755 JMP I CHIN /YES 1463 002163 4551 PRINTC /ECHO THE INPUT 1464 002164 5755 JMP I CHIN /--RETURN-- 1465 /------------------------------------------------------------------- 1466 1467 1468 FNTABL=. 1469 002165 2533 2533 /FABS 1470 002166 2650 2650 /FSGN 1471 002167 2636 2636 /FITR 1472 002170 0331 0331 /FY 1473 002171 2630 2630 /FRAN 1474 002172 0332 0332 /FZ 1475 002173 2572 2572 /FATN 1476 002174 2624 2624 /FEXP 1477 002175 2625 2625 /FLOG 1478 002176 2654 2654 /FSIN 1479 002177 2575 2575 /FCOS 1480 002200 2702 2702 /FSQT 1481 002201 2631 2631 /FNEW 1482 002202 2567 2567 /FCOM 1483 002203 0330 0330 /FX 1484 1485 /ERASE SINGLE LINES, GROUPS, OR VARIABLES 1486 1487 002204 4564 ERASE, TESTC /TEST THE SECOND WORD, IF ANY. 1488 /--------------------------------------------------------------------- 1489 002205 5237 JMP ERVX /ERASE VARIABLES 1490 002206 5222 JMP ERL /LINES OR GROUPS 1491 002207 5213 JMP .+4 /ERROR 1492 002210 1066 TAD CHAR /ALL TEXT 1493 002211 1112 TAD MINUSA 1494 002212 7440 SZA 1495 002213 4566 ERROR3 /BAD ARG FOR ERASE. 1496 002214 1135 ERT, TAD ENDT /ERASE ALL TEXT ** 1497 002215 3060 DCA BUFR 1498 002216 3533 DCA I CFRS /*8K* 1499 002217 1060 ERV, TAD STARTV /ERASE VARIABLES /*8K* 1500 002220 3031 DCA LASTV /*8K* 1501 002221 5177 JMP START /POINTERS MAY BE DIFFERENT NOW. 1502 002222 4554 ERL, GETLN /ERASE LINES. 1503 002223 1060 TAD BUFR /PROTECT REST OF TEXT. 1504 002224 3010 DCA AXIN 1505 002225 4565 ERG, DELETE /EXTRACT ONE LINE 1506 002226 2023 ISZ THISLN 1507 002227 1065 TAD NAGSW 1508 002230 7700 SMA CLA 1509 002231 1423 TAD I THISLN /*8K* 1510 002232 4563 TSTGRP /SKIP IF G(AC) = G(LINENO) /*8K* 1511 002233 5217 JMP ERV /*8K* 1512 002234 1423 TAD I THISLN /*8K* 1513 002235 3067 DCA LINENO 1514 002236 5225 JMP ERG 1515 002237 1060 ERVX, TAD STARTV /INIT VARIABLES MAY BE INDIRECT COMMAND/*8K* 1516 002240 3031 DCA LASTV 1517 002241 5541 POPJ 1518 1519 1520 /ROUTINE CALLED VIA "FINDLN": 1521 1522 /SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ] 1523 /1ST RETURN IF NOT FOUND, 1524 /2AND IF FOUND. 1525 /"THISLN" = FOUND LINE OR NEXT LARGER. 1526 /"LASTLN" = LESSER AND/OR LAST. 1527 /"TEXTP" IS SET 1528 1529 002242 0000 XFIND, 0 1530 002243 1133 TAD CFRS /INITIALIZE POINTERS TO FIRST LINE 1531 002244 3025 DCA LASTLN 1532 002245 1133 TAD CFRS 1533 002246 3023 FINDN, DCA THISLN /SAVE THIS ONE 1534 002247 1023 TAD THISLN 1535 002250 3011 DCA XRT 1536 002251 1067 TAD LINENO 1537 002252 7141 CLL CMA IAC /CLEAR LINK AND NEGATE LINENO. 1538 002253 1411 TAD I XRT /LINENO=0 WILL ALSO BE FOUND /*8K* 1539 002254 7450 SNA 1540 002255 5266 JMP FEND3-1 /FOUND IT. 1541 002256 7630 SZL CLA 1542 002257 5267 JMP FEND3 /PAST IT. 1543 002260 1023 TAD THISLN /MOVE POINTERS 1544 002261 3025 DCA LASTLN 1545 002262 1423 TAD I THISLN /END OF TEXT? (X_MEM) 1546 002263 7440 SZA 1547 002264 5246 JMP FINDN /NOT YET 1548 002265 7410 SKP 1549 002266 2242 ISZ XFIND /2ND EXIT = FOUND 1550 002267 1023 FEND3, TAD THISLN /1ST RETURN = NOT FOUND 1551 002270 7001 IAC 1552 002271 3017 DCA AXOUT /SET "TEXTP". 1553 002272 3020 DCA XCT 1554 002273 5642 JMP I XFIND /--RETURN-- 1555 1556 1557 002274 0000 UTRA, 0 /UNPACK CHARACTER. - "GETC" 1558 002275 4330 JMS GET1 1559 002276 7710 UTE, SPA CLA /NORM & EXTEND 1560 002277 1006 TAD C100 /300-337 & 340-376 1561 002300 1357 TAD M137 /240-276 & 200-236 1562 002301 1066 TAD CHAR 1563 002302 7450 SNA 1564 002303 5316 JMP UTX /"?" FOUND 1565 002304 1075 TAD P337 1566 002305 3066 UTQ, DCA CHAR 1567 002306 1026 TAD DEBGSW 1568 002307 1100 TAD DMPSW 1569 002310 7650 SNA CLA /PRINT ONLY IF BOTH ARE ZERO. 1570 002311 4551 PRINTC 1571 002312 5674 JMP I UTRA /--RETURN-- 1572 002313 4330 EXTR, JMS GET1 1573 002314 7040 CMA 1574 002315 5276 JMP UTE 1575 002316 1026 UTX, TAD DEBGSW /TEST FOR TRACE-ENABLED 1576 002317 7640 SZA CLA 1577 002320 5326 JMP .+6 1578 002321 1100 TAD DMPSW /FLIP THE TRACE FLOP 1579 002322 7650 SNA CLA 1580 002323 7001 IAC 1581 002324 3100 DCA DMPSW 1582 002325 5275 JMP UTRA+1 /GET NEXT CHARACTER INSTEAD. 1583 002326 1110 TAD P277 /TRACE DISABLED = RETURN "?" 1584 002327 5305 JMP UTQ 1585 002330 0000 GET1, 0 /UNPACK 6-BITS 1586 002331 2020 ISZ XCT /STARTS=0 1587 002332 5345 JMP GET3 1588 002333 1021 TAD GTEM 1589 002334 0122 GEND, AND P77 1590 002335 3066 DCA CHAR /SAVE 1591 002336 1066 TAD CHAR 1592 002337 1103 TAD M77 1593 002340 7650 SNA CLA 1594 002341 5313 JMP EXTR /EXTENDED 1595 002342 1066 TAD CHAR 1596 002343 1356 TAD M40 1597 002344 5730 JMP I GET1 /--RETURN-- 1598 002345 1417 GET3, TAD I AXOUT /*8K* 1599 002346 3021 DCA GTEM 1600 002347 7040 CMA 1601 002350 3020 DCA XCT 1602 002351 1021 TAD GTEM 1603 002352 7112 RTR CLL 1604 002353 7012 RTR 1605 002354 7012 RTR 1606 002355 5334 JMP GEND 1607 002356 7740 M40, -40 1608 002357 7641 M137, -137 1609 002360 0000 XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN" 1610 002361 7000 NOP /*8K* 1611 002362 1425 TAD I LASTLN /SAVE OLD POINTER 1612 002363 3460 DCA I BUFR 1613 002364 1060 TAD BUFR /POINT TO NEW LAST LINE 1614 002365 3425 DCA I LASTLN 1615 002366 1061 TAD ADD /CHECK FOR EXTRA INFO 1616 002367 7440 SZA 1617 002370 3410 DCA I AXIN 1618 002371 1010 TAD AXIN /COMPUTE NEW END OF BUFFER 1619 002372 7001 IAC 1620 002373 3060 DCA BUFR 1621 002374 1060 TAD STARTV /RESET VARIABLE LIST /*8K* 1622 002375 3031 DCA LASTV /*8K* 1623 002376 5760 JMP I XENDLN /--RETURN-- 1624 /--------------------------------------------------------------------- 1625 1626 1627 1628 TLIST3=. /LITERAL TERMINATORS 1629 002377 1252 TASK4 /" 1630 002400 0614 PC1 /C.R. = AUTOMATIC QUOTE MATCH 1631 1632 1633 INFIX=. /DATA CONTROL CHARACTERS 1634 002401 6202 FLINTP+2 /LEFT ARROW = KILL 1635 002402 0757 INPUT+1 /RUBOUT = IGNORE 1636 002403 0757 INPUT+1 /L.F. = IGNORE 1637 002404 6250 ENDFI+5 /ALT MODE = EXIT 1638 1639 002405 0001 FLTONE, 0001 /(NO RELATIVE REFERENCES) 1640 002406 2000 2000 1641 002407 0000 FLTZER, 0000 1642 002410 0000 0000 1643 002411 0000 0000 1644 002412 0000 0000 1645 002413 7766 M12, -12 /DECIMAL CONVERSION FACTOR FOR "PRNT" 1646 /---------------------------------------------------------------------- 1647 1648 1649 002414 3034 I33, DCA INBUF /CLEAR INPUT BUFFER 1650 002415 6032 KCC /INITIATE NEXT READ 1651 002416 1621 TAD I .+3 /GET CHARACTER 1652 002417 5620 JMP I .+1 1653 002420 2675 XOUTL-1 1654 002421 2676 XOUTL 1655 002422 7402 HLT 1656 002423 7402 HLT 1657 002424 7402 HLT 1658 002425 0000 XPRNT, 0 /PRINT A LINE NUMBER - "PRNTLN" 1659 002426 1067 TAD LINENO 1660 002427 4557 RTL6 1661 002430 0122 AND P77 1662 002431 4242 JMS PRNT /TWO DIGIT "PART" NUMBER 1663 002432 1102 TAD PER 1664 002433 4551 PRINTC /PERIOD FOR SEPARATION 1665 002434 1067 TAD LINENO 1666 002435 4242 JMS PRNT /TWO DIGIT "STEP" NUMBER. 1667 002436 1356 TAD M140 1668 002437 3066 DCA CHAR /SAVE SPACE IN CHAR. 1669 002440 4551 PRINTC /PRINT TRAILING SPACE 1670 002441 5625 JMP I XPRNT /--RETURN-- 1671 VAL=T1 1672 002442 0000 PRNT, 0 /PRINT TWO DECIMAL DIGITS 1673 002443 0106 AND P177 1674 002444 3032 DCA VAL 1675 002445 1113 TAD C260 1676 002446 3033 DCA T3 1677 002447 5252 JMP .+3 1678 002450 2033 ISZ T3 1679 002451 3032 XYZ, DCA VAL 1680 002452 1032 TAD VAL 1681 002453 1213 TAD M12 1682 002454 7500 SMA 1683 002455 5250 JMP XYZ-1 1684 002456 7200 CLA 1685 002457 1033 TAD T3 1686 002460 4551 PRINTC 1687 002461 1032 TAD VAL 1688 002462 1113 TAD C260 1689 002463 4551 PRINTC 1690 002464 5642 JMP I PRNT /--RETURN-- 1691 002465 0000 OUT, 0 /OUTPUT A CHARACTER - "PRINTC" 1692 002466 7450 SNA /USE (AC) OR (CHAR) 1693 002467 1066 TAD CHAR 1694 002470 1116 TAD MCR 1695 002471 7450 SNA 1696 002472 5276 JMP OUTCR 1697 002473 1077 TAD CCR 1698 002474 4463 JMS I OUTDEV 1699 002475 5665 OUTX, JMP I OUT /--RETURN-- 1700 002476 1077 OUTCR, TAD CCR 1701 002477 4463 JMS I OUTDEV 1702 002500 1076 TAD CLF 1703 002501 5274 JMP OUTX-1 1704 1705 1706 002502 0000 PACBUF, 0 /PACK A CHARACTER - "PACKC" 1707 002503 1110 TAD P277 1708 002504 7041 CIA 1709 002505 1066 TAD CHAR 1710 002506 7450 SNA /CHANGE 277 TO 337 1711 002507 1352 TAD P40 1712 002510 1101 TAD M100 1713 002511 7450 SNA /TEST FOR RUBOUT. 1714 002512 5755 JMP I RUBIT 1715 002513 1353 TAD P377 1716 002514 3071 DCA T2 /SAVE INPUT ITEM 1717 002515 1071 TAD T2 /SO THAT QUESTION DOESN'T MAKE 1718 002516 0354 AND C140 /CHAR LOOK LIKE A LEFT-ARROW 1719 002517 1356 TAD M140 1720 002520 7440 SZA /DATA WORD. 1721 002521 1354 TAD C140 1722 002522 7650 SNA CLA 1723 002523 5332 JMP ESCA /340-377 AND 200-237 1724 002524 1071 PA1, TAD T2 /240-337 1725 002525 0122 AND P77 1726 002526 7440 SZA /IGNORE 300 1727 002527 4335 JMS PCK1 1728 002530 7000 PACX, NOP /*8K* 1729 002531 5702 JMP I PACBUF /--RETURN-- 1730 002532 1122 ESCA, TAD P77 1731 002533 4335 JMS PCK1 1732 002534 5324 JMP PA1 1733 002535 0000 PCK1, 0 1734 002536 2062 ISZ XCTIN /=0 TO START 1735 002537 5357 JMP ROT 1736 002540 1061 TAD ADD 1737 002541 3410 DCA I AXIN /*8K* 1738 002542 3061 DCA ADD /CLEAR PACKING WORD /*8K* 1739 002543 1013 TAD PDLXR /CHECK FOR OVERFLOW /*8K* 1740 002544 7141 CMA IAC CLL /*8K* 1741 002545 1005 TAD P13 /RESERVATIONS FOR PUSH-DOWN LIST/*8K* 1742 002546 1010 TAD AXIN 1743 002547 7620 SNL CLA 1744 002550 5735 JMP I PCK1 /--RETURN-- 1745 002551 4566 ERROR2 /FULL BUFFER 1746 002552 0040 P40, 40 1747 002553 0377 P377, 377 1748 002554 0140 C140, 140 1749 002555 3004 RUBIT, RUB1 1750 002556 7640 M140, -140 1751 002557 4557 ROT, RTL6 /(EAE) 1752 002560 3061 DCA ADD 1753 002561 7040 CMA 1754 002562 3062 DCA XCTIN 1755 002563 5735 JMP I PCK1 1756 /2564-2570, 2572-2576 ARE USED BY 8K OVERLAY /*8K* 1757 *2600 1758 /------------------------------------------------------------------- 1759 /---------------------------------------------------------------------- 1760 1761 /INTERRUPT PROCESSOR. 1762 1763 002600 0000 SAVAC, 0 /CONTENTS OF AC 1764 002601 0000 SAVLK, 0 /CONTENTS OF LINK 1765 002602 7575 MBREAK, -203 /CONTROL-C 1766 002603 3200 INTRPT, DCA SAVAC /SAVE WORKING DATA 1767 002604 7010 RAR 1768 002605 3201 DCA SAVLK 1769 002606 6041 TSF /GIVE OUTPUT PRIORITY 1770 002607 5225 JMP KINT 1771 002610 6042 TCF 1772 002611 3016 DCA TELSW /TURN OFF THE IN-PROGRESS FLAG. 1773 002612 1665 TAD I OPTRI 1774 002613 7450 SNA 1775 002614 5225 JMP KINT /DONE 1776 002615 6044 TPC /TYPE NEXT. 1777 002616 3016 DCA TELSW /CLEAR AC AND TURN ON THE FLAG. 1778 002617 3665 DCA I OPTRI /ZERO OUT THE DATA AREA 1779 002620 1265 TAD OPTRI 1780 002621 7001 IAC 1781 002622 0107 AND P17 1782 002623 1263 TAD OPTR0 1783 002624 3265 DCA OPTRI 1784 002625 6031 KINT, KSF /CHECK FOR KEYBOARD FIRST 1785 002626 5246 JMP EXIT 1786 002627 6034 KRS /INPUT CHARACTER 1787 002630 6030 KCF /CLEAR FLAG 1788 002631 0106 AND P177 /IGNORE BIT 8 1789 002632 7450 SNA /BLANK? 1790 002633 5245 JMP EXIT-1 /YES--GO INITIATE NEXT READ 1791 002634 1123 TAD C200 /FORCE BIT 8 ON 1792 002635 3262 DCA SIN 1793 002636 1262 TAD SIN 1794 002637 1202 TAD MBREAK 1795 002640 7650 SNA CLA /WAS IT CTRL/C? 1796 002641 5740 JMP I RECOVR /YES--HANDLE CTRL/C 1797 002642 1262 TAD SIN 1798 002643 3034 DCA INBUF 1799 002644 7410 SKP 1800 002645 6032 KCC /INITIATE NEXT READ--CHAR. WAS BLANK 1801 002646 6011 EXIT, RSF /TEST H.S. READER FLAG 1802 002647 5252 JMP .+3 1803 002650 6012 RRB /READ BUFFER AND CLEAR FLAG 1804 002651 3037 DCA HINBUF /SAVE CHARACTER 1805 002652 6244 RMF /RESTORE MEMORY FIELD. 1806 002653 6101 SMP /(THESE TWO COULD PATCH TO OTHER PDP-8 DEVICES) 1807 002654 7000 NOP /ONLY POSSIBLE HALT = PARITY ERROR IN 8/S ONLY. 1808 002655 1201 TAD SAVLK 1809 002656 7104 RAL CLL 1810 002657 1200 TAD SAVAC 1811 002660 6001 ION 1812 002661 5400 EXITJ, JMP I 0 /MODIFIED FOR PDP-5 1813 002662 0000 SIN, 0 1814 1815 002663 3120 OPTR0, IOBUF /OUTPUT POINTERS 1816 002664 3120 OPTRO, IOBUF /VARS 1817 002665 3120 OPTRI, IOBUF 1818 002666 0000 XI33, 0 /VIA (INDEV) 1819 002667 1034 TAD INBUF /ANY INPUT? 1820 002670 7550 SPA SNA 1821 002671 5267 JMP .-2 /NO = WAIT 1822 002672 3276 DCA XOUTL 1823 002673 5674 JMP I .+1 1824 002674 2414 I33 1825 002675 5666 JMP I XI33 /--RETURN-- 1826 1827 002676 0000 XOUTL, 0 /VIA (OUTDEV) 1828 002677 3266 DCA XI33 /SAVE CURRENT CHARACTER. 1829 002700 6001 ION /BE SURE INTERRUPT IS ON. 1830 002701 1664 TAD I OPTRO /ANY ROOM? 1831 002702 7640 SZA CLA /A CHARACTER IS NON-ZERO 1832 002703 5301 JMP .-2 /NO = WAIT. 1833 002704 6002 IOF 1834 002705 1016 TAD TELSW /IN PROGRESS? 1835 002706 7640 SZA CLA 1836 002707 5314 JMP .+5 1837 002710 1266 TAD XI33 /NO 1838 002711 6046 TLS /TYPE CHARACTER. 1839 002712 3016 DCA TELSW /SET IN-PROGRESS FLAG. 1840 002713 5323 JMP .+10 /RETURN 1841 002714 1266 TAD XI33 /SEND DATA 1842 002715 3664 DCA I OPTRO 1843 002716 1264 TAD OPTRO /SET POINTERS 1844 002717 7001 IAC 1845 002720 0107 AND P17 1846 002721 1263 TAD OPTR0 1847 002722 3264 DCA OPTRO 1848 002723 6001 ION 1849 002724 5676 JMP I XOUTL /--RETURN-- 1850 1851 /ERROR RECOVERY PROCEEDURE 1852 1853 002725 3326 ERROR5, DCA .+1 /ERROR CALLED FROM A TABLE 1854 002726 0000 ERR2, 0 /LIMIT EXCEEDED 1855 002727 7240 CLA CMA /COMPUTE CALLING ADDRESS (ALSO "SPACE") 1856 002730 1326 TAD ERR2 /AND USE IT AS ERROR NUMBER. 1857 002731 3067 DCA LINENO /SAVE ERROR CODE. 1858 002732 6001 ION / (JMP.+4) - FOR DEBUGGING 1859 002733 1016 TAD TELSW /WAIT FOR OUTPUT TO FINISH 1860 002734 7640 SZA CLA 1861 002735 5333 JMP .-2 1862 002736 6002 IOF /DISABLE INTERRUPT FOR INITIALIZATIONS 1863 002737 5342 JMP .+3 1864 002740 1154 RECOVR, XINT-4 1865 002741 6032 KCC 1866 002742 1105 TAD M20 /SETUP INIT COUNT 1867 002743 3057 DCA CNTR 1868 002744 2016 ISZ TELSW /TURN ON IN-PROGRESS SWITCH 1869 002745 7040 CMA 1870 002746 1263 TAD OPTR0 1871 002747 3010 DCA AXIN /INIT I/O BUFFERS. 1872 002750 7000 NOP /*8K* 1873 002751 3410 DCA I AXIN 1874 002752 2057 ISZ CNTR 1875 002753 5351 JMP .-2 1876 002754 3034 DCA INBUF /INIT KEY-BUFR. 1877 002755 1263 TAD OPTR0 /INIT TTY POINTERS. 1878 002756 3265 DCA OPTRI 1879 002757 1263 TAD OPTR0 1880 002760 3264 DCA OPTRO 1881 002761 7200 RECOVX, CLA 1882 002762 6046 TLS / RAISE TTY FLAG. (NOP) - FOR DEBUGGING 1883 002763 5764 JMP I .+1 /OUTPUT CR/LF AND ? 1884 002764 1343 XADC 1885 002765 4553 PRNTLN /PRINT ERROR NUMBER AND, 1886 002766 2022 ISZ PC 1887 002767 1422 TAD I PC /UNLESS IT IS ZERO, /*8K* 1888 002770 7450 SNA 1889 002771 5377 JMP .+6 1890 002772 3067 DCA LINENO 1891 002773 1101 TAD P7700 /PRINT ATSIGN 1892 002774 4551 PRINTC 1893 002775 4551 PRINTC /PRINT SPACE AGAIN AND 1894 002776 4553 PRNTLN /PRINT LINE OF ERROR. 1895 002777 1077 TAD CCR 1896 /------------------------------------------------------------------ 1897 003000 4551 PRINTC 1898 003001 1126 TAD PTCH /RESET "READC" 1899 003002 3152 DCA RDIV /IF AN ERROR OCCURS. 1900 003003 5177 JMP START /INTERRUPT WILL BE RE-ENABLED SOON. 1901 1902 /CHRACTER REMOVAL ROUTINE 1903 1904 003004 1062 RUB1, TAD XCTIN /RUBOUT ONE LETTER 1905 003005 7640 SZA CLA 1906 /---------------------------------------------------------------------- 1907 003006 5214 JMP .+6 1908 003007 1010 TAD AXIN 1909 003010 7041 CIA 1910 003011 1027 TAD PACKST 1911 003012 7700 SMA CLA /TEST NULL LINE 1912 003013 5641 JMP I RUB5 1913 003014 1251 TAD SPLAT /FOR A RUBOUT ACKNOWLEDGEMENT 1914 003015 4551 PRINTC 1915 003016 1010 TAD AXIN 1916 003017 3071 DCA T2 1917 003020 7000 NOP /*8K* 1918 003021 2062 ISZ XCTIN /TEST HALF 1919 003022 5242 JMP RUB2 1920 003023 1471 TAD I T2 /"ADD" IS FULL. 1921 003024 0122 AND P77 1922 003025 1103 TAD M77 1923 003026 7640 SZA CLA /TEST FOR EXTEND 1924 003027 5237 JMP RUB4 1925 003030 7040 RUB3, CMA /SET SWITCH 1926 003031 3062 DCA XCTIN 1927 003032 7040 CMA /BACKUP POINTER 1928 003033 1010 TAD AXIN 1929 003034 3010 DCA AXIN 1930 003035 1471 TAD I T2 /RESET ADD 1931 003036 0101 AND P7700 1932 003037 3061 RUB4, DCA ADD 1933 003040 5641 JMP I RUB5 1934 003041 2530 RUB5, PACX 1935 003042 1471 RUB2, TAD I T2 /CHECK FOR EXTENDED 1936 003043 0101 AND P7700 1937 003044 1006 TAD C100 1938 003045 7640 SZA CLA 1939 003046 5230 JMP RUB3 1940 003047 3471 DCA I T2 /SAVE CORRECTION 1941 003050 5231 JMP RUB3+1 1942 003051 0334 SPLAT, 334 1943 1944 1945 /SYMBOL TABLE TYPEOUT ROUTINE 1946 1947 003052 1060 TDUMP, TAD STARTV /INIT POINTER FOR SYMBOL DUMP /*8K* 1948 003053 3030 DCA PT1 1949 003054 1031 TAD LASTV /TEST FOR END OF LIST 1950 003055 7041 CIA 1951 003056 1030 TAD PT1 1952 003057 7650 SNA CLA 1953 003060 5541 POPJ 1954 003061 1430 TAD I PT1 /GET THE VARIABLE 1955 003062 3316 DCA OP+1 /(DCA I (4)-FOR 8K:SAVE NAME 1956 003063 1315 TAD OP /SETUP UNPACK POINTERS 1957 003064 3017 DCA AXOUT 1958 003065 3020 DCA XCT 1959 003066 4545 GETC /READ AND PRINT "XX(" 1960 003067 4551 PRINTC 1961 003070 4545 GETC 1962 003071 4551 PRINTC 1963 003072 4545 GETC 1964 003073 4551 PRINTC 1965 003074 2030 ISZ PT1 1966 003075 1430 TAD I PT1 /PRINT SUBSCRIPT TO 99 1967 003076 4714 JMS I PRNT2 1968 003077 4545 GETC /PRINT ")" 1969 003100 4551 PRINTC 1970 003101 2030 ISZ PT1 1971 003102 4407 FINT /PICK UP VALUE 1972 003103 0430 FGET I PT1 1973 003104 0000 FXIT 1974 003105 4530 JMS I FOUTPUT /PRINT VALUE 1975 003106 1077 TAD CCR 1976 003107 4551 PRINTC 1977 003110 1070 TAD GINC 1978 003111 1111 TAD M2 1979 003112 1030 TAD PT1 1980 003113 5253 JMP TDUMP+1 1981 003114 2442 PRNT2, PRNT 1982 003115 3115 OP, . /*8K* 1983 003116 0000 0000 /*8K* 1984 003117 5051 5051 /(THESE GO IN 10005 FOR X-MEM) 1985 1986 1987 /OUTPUT CHARACTER BUFFER (ADDRESS IS A MULTIPLE OF 20) 1988 1989 IOBUF=3120 1990 1991 COMEIN=IOBUF+20 /COMMAND - INPUT BUFFER 1992 /------------------------------------------------------------------- 1993 /------------------------------------------------------------------- 1994 1995 COMEOUT=COMEIN+46 1996 1997 1998 *COMEOUT 1999 2000 2001 2002 003206 0000 FRST, 0 /TEXT POINTER 2003 003207 0000 0000 /DUMMY LINE NO. 2004 003210 0340 0340 /TITLE C FOCAL-8 2005 003211 0617 0617 /FO 2006 003212 0301 0301 /CA 2007 003213 1455 1455 /L- 2008 003214 7040 7040 /8 2009 003215 4040 FRSTX, 4040 2010 003216 7715 7715 /DUMMY C.R. 2011 2012 /TO SAVE TEXT ,SAVE C(BUFR), C(LASTV), AND C( FRST TO C(BUFR)) 2013 /WITH ODT-JR46. THE TAPES MAY BE TOGETHER WITH 2014 /THE SYMBOLIC DUMP LAST : FOCAL + FLOAT + DIALOG . 2015 /LOADING THE LAST SECTION MAY BE CONSIDERED OPTIONAL. 2016 2017 2018 2019 BUFBEG=. /TEXT BUFFER STARTS HERE. 2020 2021 2022 2023 2024 2025 *4400-10 2026 2027 004370 1155 O1, XINT-3 /STARTING ADDRESS 2028 004371 1370 BEGIN, TAD O1 /INITIALIZE ANY 8-FAMILY COMPUTER. 2029 /-------------------------------------------------------------------- 2030 004372 3176 DCA START-1 2031 004373 6142 6142 /CLEAR F.H.'S 8.((JMP ATES+1)-FOR TSS-8) 2032 004374 6077 6077 /SET INTENSITY LEVEL, 34D 2033 004375 6152 6152 /CLEAR LPT 2034 004376 6762 6762 /TC01 2035 004377 6012 6012 /CLEAR PC02 FOR PDP-5 2036 004400 6346 6346 /CLEAR LAB-8 2037 004401 6032 KCC /READER START 2038 004402 7300 CLA CLL 2039 /-------------------------------------------------------------------- 2040 004403 3414 DCA I FLTXR 2041 004404 2057 ISZ CNTR /INITIALIZED BY LOAD. 2042 004405 5203 JMP .-2 /CLEAR INPUT BUFFER 2043 2044 /TEST FOR COMPUTER TYPE 2045 2046 004406 7000 NOP 2047 004407 7000 NOP 2048 004410 1370 TAD PDP5 /TEST FOR PDP-5 2049 004411 3000 DCA 0000 2050 004412 7040 O4, CMA /LINC-8 OR PDP-12? 2051 004413 6167 6167 /SET LINC AC- (INITS AND KILLS 338) 2052 004414 7200 CLA 2053 004415 6171 6171 /READ LINC AC 2054 004416 7650 SNA CLA 2055 004417 5226 JMP T12 2056 2057 004420 1365 TAD P7 /CLEAR LINC-INTERRUPTS 2058 004421 6141 6141 2059 004422 1366 TAD P2 2060 004423 6141 6141 2061 004424 7200 CLA 2062 004425 5314 JMP ATES+1 /YES 2063 2064 004426 6141 T12, 6141 /BECOME A LINC 2065 004427 0017 0017 /COMPLEMENT AC 2066 004430 0002 0002 /BACK TO 8 MODE 2067 004431 7001 IAC /SET TO ZERO IF PDP-12 2068 004432 7650 SNA CLA 2069 004433 5314 JMP ATES+1 2070 2071 004434 5246 JMP .+12 2072 004435 1106 TAD P177 /SET UP FOR 8K L COMMAND 2073 004436 3640 DCA I .+2 /TO RESTART FOCAL8 2074 004437 5310 JMP ATES-3 2075 004440 1351 XADC+6 2076 004441 7000 NOP 2077 004442 7000 NOP 2078 004443 7000 NOP 2079 004444 7000 NOP 2080 004445 5314 JMP ATES+1 2081 2082 004446 7354 7354 /NL3776 2083 004447 1367 TAD PDP8I /IS THIS A PDP-8/I OR 8/L? 2084 004450 7650 SNA CLA 2085 004451 5265 JMP ATEI /8/I 2086 004452 7344 7344 /NL7776 2087 004453 1366 TAD P2 2088 004454 7650 SNA CLA 2089 004455 5314 JMP ATES+1 /8/L 2090 2091 004456 1100 TAD CCR+1 /PDP-8/S 2092 004457 3764 DCA I O6 /SETUP PARITY-ERROR HALT 2093 004460 1327 TAD OOUT-15 /CORRECT READER WAIT 2094 004461 3763 DCA I O5 2095 004462 5313 JMP ATES 2096 004463 2761 PDP5X, ISZ I O2 /INCREMENT INTERRUPT RETURN 2097 004464 5314 JMP ATES+1 2098 004465 6046 ATEI, TLS 2099 004466 6000 G8L, 6000 2100 004467 6000 6000 2101 004470 6000 6000 2102 004471 6000 6000 2103 2104 004472 6000 6000 2105 004473 6000 6000 2106 004474 6000 6000 2107 004475 6000 6000 2108 004476 2057 ISZ CNTR 2109 004477 6041 TSF 2110 004500 5266 JMP G8L 2111 004501 5314 JMP ATES+1 2112 2113 2114 004502 1362 TAD PDP 2115 004503 4371 JMS LOOKUP 2116 004504 7740 SMA SZA CLA /MONITOR IN USE? 2117 004505 5235 JMP T12+7 2118 004506 5707 JMP I .+1 /YES 2119 004507 2214 ERT /ERASE ALL AND PROCEED 2120 004510 1352 TAD L8AY /NO-SET UP FOR L COMMAND 2121 004511 3753 DCA I L8AX /TO RETURN TO COMMAND MODE 2122 004512 5707 JMP I .-3 /ERASE ALL AND PROCEED 2123 004513 7402 ATES, HLT 2124 2125 /INITIALIZE THE DIALOGUE 2126 2127 004514 6046 TLS 2128 004515 6001 ION /ENABLE INTERRUPT 2129 004516 4540 PUSHJ 2130 004517 0421 DO+1 2131 004520 6002 IOF 2132 /RETAIN EXP,LOG,ATN ? (256) 2133 /RETAIN SINE,COSINE? (128) 2134 /XF = +1(NO) -1(YES) 0(YES) 2135 004521 1360 TAD XF 2136 004522 4371 JMS LOOKUP 2137 004523 7450 SNA 2138 004524 5344 JMP OOUT /NO DIALOGUE EXECUTED 2139 004525 7710 SPA CLA 2140 004526 1366 TAD P2 /DELETE EXTENDED FUNCTIONS 2141 004527 1120 TAD M5 /(OOUT-15 FOR 8/S READER) 2142 004530 3057 DCA CNTR 2143 004531 1354 TAD FNPT 2144 004532 3011 DCA XRT 2145 004533 1355 TAD ER5 2146 004534 3411 DCA I XRT /SET THE TABLE 2147 004535 2057 ISZ CNTR 2148 004536 5333 JMP .-3 2149 004537 1360 TAD XF /CORRECT BUFFER PROTECT 2150 004540 4371 JMS LOOKUP 2151 004541 7710 SPA CLA 2152 004542 1104 TAD P7600 /(-200) 2153 004543 1356 TAD BFXX 2154 004544 1357 OOUT, TAD BFX 2155 004545 3035 DCA BOTTOM 2156 004546 5302 JMP ATES-11 2157 004547 7402 HLT 2158 2159 004550 6313 L8A, 6313 2160 004551 6307 L8B, 6307 2161 004552 5177 L8AY, JMP START 2162 004553 7526 L8AX, PRNT8-1 2163 2164 004554 0401 FNPT, FNTABF+5 2165 004555 2725 ER5, ERROR5 2166 004556 0560 BFXX, TGO-FEXP/WITHOUT 2167 004557 4617 BFX, FEXP-1 /WITH 2168 004560 3006 XF, 3006 /X,F 2169 004561 2661 O2, EXITJ /INTERRUPT EXIT 2170 004562 2004 PDP, 2004 /P,D 2171 004563 6322 O5, HREAD+1 2172 004564 2654 O6, EXIT+6 2173 004565 0007 P7, 7 2174 004566 0002 P2, 2 2175 004567 4002 PDP8I, 4002 /(-3776) 2176 004570 4462 PDP5, PDP5X-1 2177 004571 2344 LOOKUP, DDTJR+DMULT4+END+RECOVX+PSIN /MAKE BELIEVE 2178 004572 3061 DCA ADD 2179 004573 4540 PUSHJ /CALL THE VARIABLE SEARCH ROUTINE. 2180 004574 1437 GS1 2181 004575 2030 ISZ PT1 2182 004576 1430 TAD I PT1 2183 004577 5771 JMP I LOOKUP 2184 /-------------------------------------------------------------------- 2185 /-------------------------------------------------------------------- 2186 2187 *6321 /STUCK INTO THE FLOATING POINT PACKAGE. 2188 2189 006321 0000 HREAD, 0 2190 006322 1105 TAD M20 /TAD M5 FOR 8/S 2191 006323 3343 DCA HSWITC 2192 006324 1037 HREAD2, TAD HINBUF /(RSF) -WHEN DEBUGGING 2193 006325 7700 SMA CLA /(SKP) 2194 006326 5364 JMP HSGO 2195 006327 2032 ISZ T1 /SKIP IF OUT OF TAPE 2196 006330 5324 JMP HREAD2 2197 006331 2343 ISZ HSWITC 2198 006332 5324 JMP HREAD2 2199 006333 4343 JMS HSWITC /LEAVES LINK ZERO 2200 006334 1013 TAD PDLXR / < FRST ? 2201 006335 1376 TAD HTST 2202 006336 7630 SZL CLA 2203 006337 4566 ERROR3 /DIRECT COMMAND 2204 006340 4343 JMS HSWITC 2205 006341 5177 JMP START 2206 006342 0212 IBAR 2207 006343 0000 HSWITC, 0 2208 006344 1375 TAD HSPSW /INITIALIZE H.S. READER 2209 006345 7040 CMA 2210 006346 3375 DCA HSPSW /CHANGE STATUS 2211 006347 7140 CMA CLL /CLEAR LINK 2212 006350 3037 DCA HINBUF /CLEAR BUFFER 2213 006351 1375 TAD HSPSW 2214 006352 7440 SZA 2215 006353 6014 RFC /START HARDWARE 2216 006354 7640 SZA CLA 2217 006355 1377 TAD RESTR /(HREAD) 2218 006356 1126 TAD PTCH 2219 006357 3152 DCA RDIV /"READC" 2220 006360 5743 JMP I HSWITC /--RETURN-- 2221 006361 4343 HSPX, JMS HSWITC /COMMAND "*" - SWAP 2222 006362 5763 JMP I .+1 2223 006363 0611 PROC 2224 006364 7040 HSGO, CMA /FETCH NEXT CHARACTER 2225 006365 3037 DCA HINBUF 2226 006366 6016 RFC RRB /PICK UP NEXT CHARACTER 2227 006367 0106 AND P177 /CHECK FOR LEADER-TRAILER,ETC. 2228 006370 7450 SNA 2229 006371 5322 JMP HREAD+1 2230 006372 1123 TAD C200 2231 006373 3066 DCA CHAR /SAVE INPUT 2232 006374 5721 JMP I HREAD /--RETURN-- 2233 006375 0000 HSPSW, 0 2234 006376 4557 HTST, -COMEOUT-13 2235 006377 4144 RESTR, HREAD-CHIN 2236 2237 /DISK MONITOR INTERACTIVE COMMAND OPERATES VIA THE KEYBOARD. 2238 /THIS FITS UNDER THE 10DIGIT FLOATING POINT OUTPUT BUFFER. 2239 2240 *7503 2241 2242 007503 1133 LIBRARY,TAD CFRS 2243 007504 4327 JMS PRNT8 2244 007505 1060 TAD BUFR /TYPE C(CFRS), C(BUFR),C(LASTV),C(BOTTOM) 2245 007506 4327 JMS PRNT8 /OCTAL OUTPUT + COMMA 2246 007507 1031 TAD LASTV 2247 007510 4327 JMS PRNT8 2248 007511 1035 TAD BOTTOM 2249 007512 4327 JMS PRNT8 2250 007513 5316 JMP .+3 2251 007514 4545 GETC 2252 007515 4551 PRINTC 2253 007516 1066 TAD CHAR 2254 007517 1116 TAD MCR 2255 007520 7640 SZA CLA 2256 007521 5314 JMP .-5 2257 007522 1016 TAD TELSW 2258 007523 7640 SZA CLA 2259 007524 5322 JMP .-2 /(NOP) - WHEN DEBUGGING 2260 007525 6002 IOF /*8K* 2261 007526 5504 JMP I P7600 /(7600=DISK MONITOR) /*8K* 2262 007527 0000 PRNT8, 0 2263 007530 3032 DCA T1 2264 007531 1032 TAD T1 2265 007532 7006 RTL 2266 007533 7006 RTL 2267 007534 4350 JMS PRINTD 2268 007535 4557 RTL6 2269 007536 7004 RAL 2270 007537 4350 JMS PRINTD 2271 007540 7012 RTR 2272 007541 7010 RAR 2273 007542 4350 JMS PRINTD 2274 007543 4350 JMS PRINTD 2275 007544 7200 CLA 2276 007545 1077 TAD CCR 2277 007546 4551 PRINTC 2278 007547 5727 JMP I PRNT8 /--RETURN-- 2279 007550 0000 PRINTD, 0 2280 007551 0356 AND LP7 2281 007552 1113 TAD C260 2282 007553 4551 PRINTC 2283 007554 1032 TAD T1 2284 007555 5750 JMP I PRINTD /--RETURN-- 2285 007556 0007 LP7, 7 2286 /7557-7577 ARE USED BY 8K OVERLAY /*8K* 2287 PAUSE 2288 2289 /FOCAL-8 FLOATING POINT PACKAGE 2290 2291 /COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION 2292 / MAYNARD, MASSACHUSETTS 01754 2293 2294 / 2323 IFNDEF T 2324 2325 2326 2327 2328 /PAGE ZERO OF THE 2329 /FLOATING POINT ARITHMETIC INTERPRETER FOR FOCAL 2330 2331 2332 2333 *40 2334 2335 000040 0000 EX1, 0 /OPERAND STORAGE 2336 000041 0000 AC1H, 0 2337 000042 0000 AC1L, 0 2338 000043 0000 OVER1, 0 2339 2340 FLAC=. /FLOATING ACCUMULATOR 2341 000044 0000 EXP, 0 /F.A. 2342 000045 0000 HORD, 0 2343 000046 0000 LORD, 0 2344 000047 0000 OVER2, 0 2345 2346 000050 0000 SIGNF, 0 /FLOATIN SIGN 2347 2348 000051 6603 MINSKI, ACMINS /NEGATE FLAC SUBROUTINE 2349 000052 2004 FISW, 2004 /OUTPUT FORMAT 2350 000053 6724 INTEGER,FIX /FIX FLAC 2351 2352 2353 2354 /FUNCTIONS CONTAINED IN THIS SECTION 2355 2356 /ARTN 2357 /FEXP 2358 /FLOG 2359 /FSIN 2360 /FCOS 2361 /XSQRT 2362 /FLOATING POINT PACKAGE - EXPONENTIAL 2363 2364 GETSGN=TAD FLAC+1 2365 RETURN=JMP I EFUN3I 2366 2367 *4600+20 2368 2369 004620 1045 FEXP, GETSGN /TAKE ABSOLUTE VALUE 2370 004621 7710 SPA CLA 2371 004622 4724 JMS I NEGP 2372 004623 3033 DCA T3 /C(SIGN)=-1 IF I X2<0 2373 004624 4407 FINT 2374 004625 4313 FMUL LG2E 2375 004626 6675 FPUT I X2 2376 004627 0000 FEXT 2377 004630 4453 JMS I INTEGER /TAKE INTEGER PART 2378 004631 3325 DCA FLAG2 /SAVE LOW ORDER DATA 2379 004632 4407 FINT 2380 004633 7000 FNOR 2381 004634 6676 FPUT I XSQ2 2382 004635 0675 FGET I X2 2383 004636 2676 FSUB I XSQ2 2384 004637 6675 FPUT I X2 2385 004640 4675 FMUL I X2 2386 004641 6676 FPUT I XSQ2 2387 004642 1310 FADD DF 2388 004643 6326 FPUT TEMP 2389 004644 0305 FGET CF 2390 004645 3326 FDIV TEMP 2391 004646 2675 FSUB I X2 2392 004647 1277 FADD AF 2393 004650 6326 FPUT TEMP 2394 004651 0302 FGET BF 2395 004652 4676 FMUL I XSQ2 2396 004653 1326 FADD TEMP 2397 004654 6326 FPUT TEMP 2398 004655 0675 FGET I X2 2399 004656 3326 FDIV TEMP 2400 004657 4321 FMUL TWO 2401 004660 1316 FADD ONE 2402 004661 0000 FEXT 2403 004662 1325 TAD FLAG2 2404 004663 1044 TAD FLAC 2405 004664 3044 DCA FLAC 2406 004665 2033 ISZ T3 2407 004666 5536 RETURN 2408 004667 4407 FINT 2409 004670 6675 FPUT I X2 2410 004671 0316 FGET ONE 2411 004672 3675 FDIV I X2 2412 004673 0000 FEXT 2413 004674 5536 RETURN 2414 2415 /CONSTANTS FOR FEXP 2416 2417 004675 5322 X2, X 2418 004676 5326 XSQ2, XSQR 2419 004677 0004 AF, 0004 2420 004700 2372 2372 2421 004701 1402 1402 2422 004702 7774 BF, 7774 2423 004703 2157 2157 2424 004704 5157 5157 2425 004705 0012 CF, 0012 2426 004706 5454 5454 2427 004707 0343 0343 2428 004710 0007 DF, 0007 2429 004711 2566 2566 2430 004712 5341 5341 2431 004713 0001 LG2E, 0001 2432 004714 2705 2705 2433 004715 2435 2435 2434 004716 0001 ONE, 0001 2435 004717 2000 2000 2436 004720 0000 0000 2437 004721 0002 TWO, 0002 2438 004722 2000 2000 2439 004723 0000 0000 2440 004724 5163 NEGP, FNEG 2441 2442 004725 0000 FLAG2, 0 2443 004726 0000 TEMP, 0 2444 004727 0000 0 2445 004730 0000 0 2446 004731 0000 0 2447 2448 2449 2450 /MAIN ALGORITHM FOR ARCTANGENT 2451 2452 004732 4407 ARCALG, FINT 2453 004733 0675 FGET I X2 2454 004734 4675 FMUL I X2 2455 004735 6676 FPUT I XSQ2 2456 004736 4374 FMUL BET2 2457 004737 1371 FADD BET1 2458 004740 4676 FMUL I XSQ2 2459 004741 1366 FADD BETZ 2460 004742 6326 FPUT TEMP 2461 004743 0363 FGET ALF2 2462 004744 4676 FMUL I XSQ2 2463 004745 1360 FADD ALF1 2464 004746 4676 FMUL I XSQ2 2465 004747 1355 FADD ALFZ 2466 004750 4675 FMUL I X2 2467 004751 3326 FDIV TEMP 2468 004752 0000 FEXT 2469 004753 5754 JMP I .+1 2470 004754 5024 ARCRTN 2471 2472 2473 2474 /CONSTANTS - FLOATING ARC TANGENT 2475 004755 0000 ALFZ, 0000 2476 004756 2437 2437 2477 004757 1643 1643 2478 004760 7777 ALF1, 7777 2479 004761 3304 3304 2480 004762 4434 4434 2481 004763 7773 ALF2, 7773 2482 004764 3306 3306 2483 004765 5454 5454 2484 004766 0000 BETZ, 0000 2485 004767 2437 2437 2486 004770 1646 1646 2487 004771 0000 BET1, 0000 2488 004772 2427 2427 2489 004773 2323 2323 2490 004774 7775 BET2, 7775 2491 004775 3427 3427 2492 004776 7052 7052 2493 2494 2495 2496 /------------------------------------------------------------ 2497 /------------------------------------------------------------ 2498 /FLOATING POINT ARC TANGENT 2499 2500 *5000 2501 2502 005000 1045 ARTN, GETSGN /TAKE ABSOLUTE VALUE 2503 005001 7710 SPA CLA 2504 005002 4363 JMS FNEG 2505 005003 3033 DCA T3 2506 005004 4407 FINT 2507 005005 6635 FPUT I X1 2508 005006 2637 FSUB I CON1 2509 005007 0000 FEXT 2510 005010 1045 GETSGN 2511 005011 7710 SPA CLA 2512 005012 5221 JMP GO /LESS THAN ONE 2513 005013 4407 FINT 2514 005014 0637 FGET I CON1 2515 005015 3635 FDIV I X1 2516 005016 6635 FPUT I X1 2517 005017 0000 FEXT 2518 005020 7240 CLA CMA 2519 005021 3362 GO, DCA FLAG1 /SIGN FLAG OF RESULT 2520 005022 5623 JMP I .+1 /CALL ALGORITHM 2521 005023 4732 ARCALG 2522 005024 2362 ARCRTN, ISZ FLAG1 /RETURN HERE 2523 005025 5634 JMP I EXIT1 2524 005026 4407 FINT 2525 005027 6635 FPUT I X1 2526 005030 0636 FGET I PI2 2527 005031 2635 FSUB I X1 2528 005032 0000 FEXT 2529 005033 5634 JMP I .+1 2530 005034 5302 EXIT1, EXIT2 2531 2532 /CONSTANTS FOR ARCTANGENT 2533 005035 5322 X1, X 2534 005036 5316 PI2, PIOT 2535 005037 4716 CON1, ONE 2536 2537 2538 005040 1045 FLOG, GETSGN /FLOATING LOGARITHM 2539 005041 7450 SNA 2540 005042 4566 ERROR3 /ZERO ARGUEMENT FOR LOG 2541 005043 7710 SPA CLA 2542 005044 4566 ERROR3 /NEGATIVE ARGUMENT 2543 005045 4407 FINT 2544 005046 6756 FPUT I TEM 2545 005047 2637 FSUB I CON1 2546 005050 0000 FEXT 2547 005051 1045 GETSGN 2548 005052 7450 SNA 2549 005053 5536 RETURN 2550 005054 7700 SMA CLA 2551 005055 5264 JMP STARTL 2552 005056 4407 FINT 2553 005057 0637 FGET I CON1 2554 005060 3756 FDIV I TEM 2555 005061 6756 FPUT I TEM 2556 005062 0000 FEXT 2557 005063 7240 CLA CMA 2558 005064 3033 STARTL, DCA T3 2559 005065 1005 TAD P13 2560 005066 3044 DCA FLAC 2561 005067 7040 CMA 2562 005070 1756 TAD I TEM 2563 005071 3045 DCA FLAC+1 2564 005072 3046 DCA FLAC+2 2565 005073 3047 DCA FLAC+3 2566 005074 7001 IAC 2567 005075 3756 DCA I TEM 2568 005076 4407 FINT 2569 005077 4357 FMUL LOG2 2570 005100 6635 FPUT I X1 2571 005101 0756 FGET I TEM 2572 005102 2637 FSUB I CON1 2573 005103 6756 FPUT I TEM 2574 005104 4353 FMUL LOG8 2575 005105 1350 FADD LOG7 2576 005106 4756 FMUL I TEM 2577 005107 1345 FADD LOG6 2578 005110 4756 FMUL I TEM 2579 005111 1342 FADD LOG5 2580 005112 4756 FMUL I TEM 2581 005113 1337 FADD L4 2582 005114 4756 FMUL I TEM 2583 005115 1334 FADD L3 2584 005116 4756 FMUL I TEM 2585 005117 1331 FADD L2 2586 005120 4756 FMUL I TEM 2587 005121 1326 FADD L1 2588 005122 4756 FMUL I TEM 2589 005123 1635 FADD I X1 2590 005124 0000 FEXT 2591 005125 5634 JMP I EXIT1 2592 2593 2594 005126 0000 L1, 0000 2595 005127 3777 3777 2596 005130 7742 7742 2597 005131 7777 L2, 7777 2598 005132 4000 4000 2599 005133 4100 4100 2600 005134 7777 L3, 7777 2601 005135 2517 2517 2602 005136 0310 0310 2603 005137 7776 L4, 7776 2604 005140 4113 4113 2605 005141 7211 7211 2606 2607 /LOGARITHM CONSTANTS 2608 2609 005142 7776 LOG5, 7776 2610 005143 2535 2535 2611 005144 3301 3301 2612 005145 7775 LOG6, 7775 2613 005146 4746 4746 2614 005147 0771 0771 2615 005150 7774 LOG7, 7774 2616 005151 2236 2236 2617 005152 4304 4304 2618 005153 7771 LOG8, 7771 2619 005154 4544 4544 2620 005155 1735 1735 2621 2622 005156 4726 TEM, TEMP 2623 005157 0000 LOG2, 0 2624 005160 2613 2613 2625 005161 4414 4414 2626 005162 0000 FLAG1, 0 2627 2628 2629 2630 2631 005163 0000 FNEG, 0 2632 005164 4451 JMS I MINSKI 2633 005165 7240 CLA CMA 2634 005166 5763 JMP I FNEG 2635 2636 2637 /------------------------------------------------------------ 2638 /------------------------------------------------------------ 2639 /FLOATING POINT SINE AND COSINE 2640 2641 *5200 2642 2643 005200 4407 FCOS, FINT /COS(X)=SIN(PI/2-X) 2644 005201 6322 FPUT X 2645 005202 0316 FGET PIOT 2646 005203 2322 FSUB X 2647 005204 0000 FEXT 2648 005205 1045 FSIN, GETSGN 2649 005206 7740 SMA SZA CLA 2650 005207 5215 JMP MOD 2651 005210 1045 GETSGN 2652 005211 7700 SMA CLA 2653 005212 5536 RETURN /YES SIN(0)=0 2654 005213 4451 JMS I MINSKI 2655 005214 7040 CMA /NO:SIN(-X)=-SIN(X) 2656 005215 3033 MOD, DCA T3 2657 /REDUCE X MODULO 2 PI 2658 005216 4407 FINT 2659 005217 3306 FDIV TWOPI 2660 005220 6326 FPUT XSQR 2661 005221 0000 FEXT 2662 005222 4453 JMS I INTEGER 2663 005223 4407 FINT 2664 005224 7000 FNOR 2665 005225 6322 FPUT X 2666 005226 0326 FGET XSQR 2667 005227 2322 FSUB X 2668 005230 4306 FMUL TWOPI 2669 005231 6322 FPUT X 2670 005232 2312 FSUB PI /X 0 ? 2807 005423 5230 JMP .+5 /YES 2808 005424 7240 CLA CMA /NO, 2809 005425 1032 TAD T1 2810 005426 3333 DCA DECP /MAKE D = F-1 2811 005427 7040 CMA 2812 005430 1033 TAD T3 /COMPARE DECIMAL EXPONENT 2813 005431 7500 SMA / F-D > E? 2814 005432 7200 CLA /NO, ROUND OFF TO .F PLACES 2815 005433 1032 TAD T1 /YES 2816 005434 7510 SPA / D+E < 0 ? 2817 005435 5263 JMP FPRNT-2 /YES, NO ROUNDING NEEDED, GO TO PRINT 2818 005436 1326 TAD MD /NO, ROUND TO D+E PLACES, 2819 005437 7500 SMA /TO A MAXIMUM OF D PLACES 2820 005440 7200 CLA 2821 2822 005441 1327 R6, TAD RND2 / *ROUND UP * 2823 005442 3071 DCA T2 /SAVE NUMBER+1 OF PLACES TO ROUND TO. 2824 005443 1731 TAD I BUFST 2825 005444 1071 TAD T2 /SET UP BUFFER ADDRESS AT WHICH 2826 005445 3336 DCA PLCE /ROUNDING OFF SHOULD START 2827 005446 1071 TAD T2 2828 005447 7041 CIA /SET UP COUNT OF MAXIMUM NUMBER 2829 005450 3071 DCA T2 /OF CARRIES ALLOWABLE 2830 005451 1325 TAD K4 /LITTLE EXTRA ON FIRST DIGIT. 2831 005452 2736 RET, ISZ I PLCE /ADD 1 TO DIGIT AT CURRENT POSITION 2832 005453 1736 TAD I PLCE 2833 005454 1330 TAD OM12 2834 005455 7710 SPA CLA /CARRY REQUIRED? 2835 005456 5265 JMP FPRNT /NO, GO TO OUTPUT 2836 005457 3736 DCA I PLCE /YES, MAKE CURRENT DIGIT ZERO 2837 005460 2071 ISZ T2 /BEGINNING OF BUFFER REACHED? 2838 005461 5321 JMP DECR /NO, DECREMENT BUFFER ADDRESS AND REPEAT 2839 005462 2736 ISZ I PLCE /YES, SET MANTISSA TO 0.1 2840 005463 2033 ISZ T3 /COMPENSATE BY INCREMENTING EXPONENT 2841 005464 7200 CLA 2842 005465 1052 FPRNT, TAD FISW /AUTO-INDEX REGISTER ALREADY SET. - *PRINT* 2843 005466 7650 SNA CLA / F = 0 ? 2844 005467 5356 JMP FLOUT /YES, OUTPUT AS FLOATING NUMBER 2845 005470 1335 TAD FCOUNT 2846 005471 1033 TAD T3 2847 005472 7540 SMA SZA / E > F ? 2848 005473 5355 JMP FLOUT-1 /YES,CONVERT TO E FORMAT 2849 005474 1333 TAD DECP 2850 005475 7500 SMA / E < F-D ? 2851 005476 7200 CLA /NO, TAKE P = E 2852 005477 7041 CIA /YES, TAKE P = F-D 2853 005500 1033 TAD T3 2854 005501 7041 CIA 2855 005502 3032 DCA T1 /SET UP MINUS P 2856 005503 1033 BACK, TAD T3 /PRINT DD.DDD 2857 005504 1032 TAD T1 2858 005505 7650 SNA CLA / P = E ? 2859 005506 5343 JMP DIG /YES, PRINT DIGIT 2860 005507 1032 TAD T1 /NO, 2861 005510 7001 IAC 2862 005511 7710 SPA CLA / P > 1 ? 2863 005512 1105 TAD M20 /YES, TAKE SPACE (240-260); OTHERWISE ZERO 2864 005513 4336 IN, JMS OUTA /PRINT CHARACTER 2865 005514 2032 ISZ T1 /P CHARACTERS PRINTED? 2866 005515 5303 JMP BACK /NO 2867 005516 1102 TAD PER /YES, 2868 005517 4551 PRINTC /PRINT DECIMAL POINT 2869 005520 5303 JMP BACK 2870 2871 005521 7040 DECR, CMA /BACKUP TO TOP OF BUFFER. 2872 005522 1336 TAD PLCE 2873 005523 3336 DCA PLCE 2874 005524 5252 JMP RET 2875 005525 0004 K4, 4 2876 005526 7772 MD, -DIGITS 2877 005527 0007 RND2, DIGITS+1 2878 005530 7766 OM12, -12 2879 005531 6150 BUFST, SADR 2880 005532 6154 OPUT, OUTDG 2881 005533 0000 DECP, 0 /MODIFIABLE LOCATIONS 2882 005534 0000 SCOUNT, 0 2883 005535 0000 FCOUNT, 0 2884 PLCE=. 2885 005536 0000 OUTA, 0 /MODIFIED REGISTERS. 2886 005537 4732 JMS I OPUT /PRINT CHARACTER 2887 005540 2335 ISZ FCOUNT /F CHARACTERS PRINTED? 2888 005541 5736 JMP I OUTA /NO--RETURN-- 2889 005542 5600 JMP I TGO /YES, NUMBER FINSHED 2890 005543 7040 DIG, CMA 2891 005544 1033 TAD T3 /REDUCE E, BY 1 2892 005545 3033 DCA T3 2893 005546 2334 ISZ SCOUNT /ARE ALL SIG. FIGS. USED? 2894 005547 5353 JMP .+4 /NO 2895 005550 7040 CMA /YES, 2896 005551 3334 DCA SCOUNT /RESET COUNT TO -1 2897 005552 5313 JMP IN /AND LEAVE C(AC) = 0 2898 005553 1414 TAD I FLTXR /TAKE NEXT DIGIT FROM BUFFER 2899 005554 5313 JMP IN 2900 /DO FLOATING OUTPUT 2901 005555 7200 CLA /IF OUTPUT TOO LARGE, 2902 005556 4732 FLOUT, JMS I OPUT /PRINT "0" 2903 005557 1102 TAD PER 2904 005560 4551 PRINTC /PRINT "." 2905 005561 2200 ISZ TGO /SECOND RETURN 2906 005562 1414 TAD I FLTXR /TAKE NEXT DIGIT FROM BUFFER 2907 005563 4336 JMS OUTA /PRINT IT 2908 005564 2334 ISZ SCOUNT /TEST FOR END OF INPUT 2909 005565 5362 JMP .-3 /AND REPEAT 2910 005566 7040 CMA 2911 005567 3334 DCA SCOUNT /OUTPUT EXTRA ZEROS. 2912 005570 5363 JMP .-5 2913 005571 0000 ABSOLV, 0 2914 005572 1045 TAD HORD 2915 005573 3050 DCA SIGNF 2916 005574 1045 TAD HORD 2917 005575 7710 SPA CLA 2918 005576 4451 JMS I MINSKI 2919 005577 5771 JMP I ABSOLV /--RETURN-- 2920 2921 2922 /------------------------------------------------------------ 2923 /------------------------------------------------------------ 2924 /DOUBLE PRECISION DECIMAL-BINARY 2925 /INPUT AND CONVERSION FOR + OR - XXX... 2926 2927 *5600 2928 2929 005600 0000 DECONV, 0 2930 005601 3046 DCA LORD 2931 005602 3044 DCA EXP /ZERO THE EXPONENT AND 2932 005603 3045 DCA HORD /INITIALIZE FLOATING AC. 2933 005604 3047 DCA OVER2 2934 005605 3314 DCA DNUMBR 2935 005606 3050 DCA SIGNF 2936 005607 1066 TAD CHAR /ALLOW KEYBOARD SIGN CHECKS. 2937 005610 1264 TAD MPLUS 2938 005611 7450 SNA 2939 005612 5220 JMP .+6 /+SIGN; GET NEXT 2940 005613 1111 TAD M2 /CHECK - SIGN 2941 005614 7640 SZA CLA 2942 005615 5221 JMP .+4 2943 005616 7040 CMA /INIT SIGN CHECK TO POS. 2944 005617 3050 DCA SIGNF 2945 005620 4666 JMS I XINPUT /GET NEXT 2946 005621 1066 TAD CHAR /A SPACE PERHAPS? 2947 005622 1265 TAD MSPACE 2948 005623 7650 SNA CLA 2949 005624 5220 JMP .-4 2950 005625 4227 JMS DECON 2951 005626 5600 JMP I DECONV /--RETURN-- 2952 2953 2954 005627 0000 DECON, 0 2955 005630 1066 TAD CHAR /TEST LEAD CHARACTER FOR TERMINATOR 2956 005631 1262 TAD MINE 2957 005632 7650 SNA CLA 2958 005633 5627 JMP I DECON /E--RETURN-- 2959 005634 4561 TESTN 2960 005635 5627 JMP I DECON /.--RETURN-- 2961 005636 5247 JMP DTST /OTHER 2962 005637 1054 TAD SORTCN /N 2963 005640 3313 DSAVE, DCA DIGIT /YES 2964 005641 4267 JMS MULT10 /REMAIN MUST =0 SINCE OVERFLOW IS CHECKED 2965 005642 2314 ISZ DNUMBR /COUNT DIGITS 2966 005643 7640 SZA CLA 2967 005644 4566 ERROR2 /INPUT-OVERFLOW ERROR 2968 005645 4666 JMS I XINPUT 2969 005646 5230 JMP DECON+1 /CONTINUE 2970 005647 1066 DTST, TAD CHAR /ALLOW A-Z 2971 005650 1112 TAD MINUSA 2972 005651 7710 SPA CLA 2973 005652 5627 JMP I DECON /--RETURN-- 2974 005653 1066 TAD CHAR 2975 005654 1263 TAD MINUSZ 2976 005655 7740 SZA SMA CLA 2977 005656 5627 JMP I DECON /USE SIX BITS OF ASCII--RETURN-- 2978 005657 1066 TAD CHAR 2979 005660 0122 AND P77 2980 005661 5240 JMP DSAVE 2981 005662 7473 MINE, -305 /(7532)- FOR AMPERSAND 2982 005663 7446 MINUSZ, -332 2983 005664 7525 MPLUS, -253 2984 005665 7540 MSPACE, -240 2985 005666 0756 XINPUT, INPUT 2986 2987 2988 2989 2990 2991 005667 0000 MULT10, 0 /ROUTINE TO MULTIPLY FLAC BY TEN (10) 2992 005670 1047 TAD OVER2 2993 005671 3043 DCA OVER1 2994 005672 1046 TAD LORD /DOUBLE PRECISION WORD 2995 005673 3042 DCA AC1L /BY TEN (DECIMAL) 2996 005674 1045 TAD HORD /REMAIN=REMAINDER 2997 005675 3041 DCA AC1H 2998 005676 3312 DCA REMAIN /CLEAR OVERFLOW WORD 2999 005677 4315 JMS MULT2 /CALL SUBROUTINE TO 3000 005700 4315 JMS MULT2 /MULTIPLY BY TWO 3001 005701 4333 JMS DUBLAD /CALL DOUBLE ADD 3002 005702 4315 JMS MULT2 3003 005703 1313 TAD DIGIT /ADD LAST DIGIT RECEIVED 3004 005704 3043 DCA OVER1 3005 005705 3042 DCA AC1L 3006 005706 3041 DCA AC1H 3007 005707 4333 JMS DUBLAD 3008 005710 1312 TAD REMAIN /EXIT WITH REMAINDER 3009 005711 5667 JMP I MULT10 /IN AC--RETURN-- 3010 3011 005712 0000 REMAIN, 0 3012 3013 005713 0000 DIGIT, 0 /STORAGE FOR DIGIT 3014 005714 0000 DNUMBR, 0 /=NUMBER OF DIGITS 3015 005715 0000 MULT2, 0 /MULTIPLY OVER2, LORD, HORD BY 2 3016 005716 1047 TAD OVER2 3017 005717 7104 CLL RAL /CARRY INSERT BIT IS IN LINK 3018 005720 3047 DCA OVER2 3019 005721 1046 TAD LORD 3020 005722 7004 RAL 3021 005723 3046 DCA LORD 3022 005724 1045 TAD HORD 3023 005725 7004 RAL 3024 005726 3045 DCA HORD 3025 005727 1312 TAD REMAIN 3026 005730 7004 RAL 3027 005731 3312 DCA REMAIN 3028 005732 5715 JMP I MULT2 /--RETURN-- 3029 3030 3031 3032 3033 3034 3035 005733 0000 DUBLAD, 0 /TRIPLE PRECISION ADDITION 3036 005734 7300 CLA CLL 3037 005735 1047 TAD OVER2 3038 005736 1043 TAD OVER1 3039 005737 3047 DCA OVER2 3040 005740 7004 RAL 3041 005741 1046 TAD LORD 3042 005742 1042 TAD AC1L 3043 005743 3046 DCA LORD 3044 005744 7004 RAL 3045 005745 1045 TAD HORD 3046 005746 1041 TAD AC1H 3047 005747 3045 DCA HORD 3048 005750 7004 RAL 3049 005751 1312 TAD REMAIN /WITH OVERFLOW 3050 005752 3312 DCA REMAIN 3051 005753 5733 JMP I DUBLAD /--RETURN-- 3052 3053 005754 0000 DIV1, 0 /SHIFT OPERAND RIGHT 3054 005755 7300 CLA CLL /TRIPLE PRECISION 3055 005756 1041 TAD AC1H 3056 005757 7510 SPA 3057 005760 7120 CLL CML 3058 005761 7010 RAR 3059 005762 3041 DCA AC1H 3060 005763 1042 TAD AC1L 3061 005764 7010 RAR 3062 005765 3042 DCA AC1L 3063 005766 1043 TAD OVER1 3064 005767 7010 RAR 3065 005770 3043 DCA OVER1 3066 005771 2040 ISZ EX1 3067 005772 5754 JMP I DIV1 /--RETURN-- 3068 005773 5754 JMP I DIV1 /--RETURN-- 3069 3070 3071 /------------------------------------------------------------ 3072 /------------------------------------------------------------ 3073 *6000 3074 3075 /FLOATING OUTPUT CONVERSION ROUTINE 3076 3077 006000 0000 FLOUTP, 0 3078 006001 1335 TAD PEQ 3079 006002 4551 PRINTC /(CLA)_ TO SUPPRESS "=" 3080 006003 1045 TAD HORD /NUMBER>0?? 3081 006004 7700 SMA CLA 3082 006005 1334 TAD SMSP /PRINT "-" OR A SPACE. 3083 006006 1336 TAD SMIN 3084 006007 4551 PRINTC 3085 006010 4753 JMS I ABSOL2 3086 006011 3033 FGO2, DCA T3 /INITIALIZE DECIMAL EXPONENT 3087 006012 1044 TAD EXP /IS EXP 0 TO 4? 3088 006013 7510 SPA 3089 006014 5227 JMP FGO3 /TOO LARGE:MULTIPLY BY 1/10 3090 006015 7440 SZA 3091 006016 1341 TAD M4 3092 006017 7750 SPA SNA CLA 3093 006020 5234 JMP FGO4 3094 006021 4407 FINT 3095 006022 4744 FMUL I PPTEN 3096 006023 0000 FEXT 3097 006024 7001 IAC 3098 006025 1033 TAD T3 3099 006026 5211 JMP FGO2 3100 006027 4407 FGO3, FINT 3101 006030 4752 FMUL I TENPT 3102 006031 0000 FEXT 3103 006032 7040 CMA 3104 006033 5225 JMP .-6 3105 3106 006034 3745 FGO4, DCA I DPT /MULTIPLY BY TWO TO POSITION BIT0 3107 006035 3746 DCA I REPT /CLEAR OVERFLOW WORD 3108 006036 1350 TAD SADR /INIT BUFFER POINTER 3109 006037 3014 DCA FLTXR 3110 006040 1044 TAD EXP /COMPUTE BITS IN 1ST DIGIT 3111 006041 7140 CMA CLL 3112 006042 3354 DCA OUTDG /TEMP COUNT 3113 006043 1343 TAD DCOUNT /SETUP COUNT OF TOTAL OUTPUT 3114 006044 3044 DCA EXP 3115 006045 4527 JMS I DOUBLE /ROTATE OUT THE 1ST 4 BITS 3116 006046 2354 ISZ OUTDG 3117 006047 5245 JMP .-2 3118 006050 1746 TAD I REPT /TEST FOR 10-15,0,1-9 3119 006051 7450 SNA 3120 006052 5270 JMP FGO5 /IGNORE 1ST ZERO 3121 006053 1342 TAD FM12 3122 006054 7710 SPA CLA 3123 006055 5264 JMP .+7 /0-9 3124 006056 7001 IAC 3125 006057 3414 DCA I FLTXR /OUTPUT A 1 3126 006060 2044 ISZ EXP /COUNT THE DIGIT 3127 006061 1342 TAD FM12 /CORRECT REMAINDER 3128 006062 2033 ISZ T3 /BUMP DECIMAL EXPONENT 3129 006063 7000 NOP 3130 006064 1746 TAD I REPT /COMPUTE RESULTANT OR SECOND DIGIT 3131 006065 2033 ISZ T3 3132 006066 7000 NOP 3133 006067 7410 SKP 3134 006070 4747 FGO5, JMS I M10PT /IE. .672X10=6+.72.. ETC 3135 006071 3414 DCA I FLTXR 3136 006072 2044 ISZ EXP /ALL DIGITS OUTPUT?? 3137 006073 5270 JMP .-3 /NO: CONTINUE 3138 006074 1350 TAD SADR /INIT BUFFER POINTER 3139 006075 3014 DCA FLTXR 3140 006076 1343 TAD DCOUNT 3141 006077 4751 JMS I ROUND /OUTPUT MANTISSA 3142 006100 5600 JMP I FLOUTP /FIXED POINT DONE--RETURN-- 3143 006101 1333 TAD CHRT /PRINT "E" 3144 006102 4551 PRINTC 3145 3146 /OUTPUT THE EXPONENT 3147 3148 006103 1033 TAD T3 /TAKE ABSOLUTE VALUE OF EXPONENT 3149 006104 7510 SPA 3150 006105 7041 CIA 3151 006106 3045 DCA HORD /SAVE + POWER 3152 006107 1033 TAD T3 /PRINT SIGN 3153 006110 7700 SMA CLA 3154 006111 1111 TAD M2 3155 006112 1336 TAD SMIN 3156 006113 4551 PRINTC 3157 006114 1045 TAD HORD 3158 006115 2044 ISZ EXP 3159 006116 1337 TAD M144 3160 006117 7500 SMA 3161 006120 5315 JMP .-3 3162 006121 1340 TAD C144 3163 006122 3045 DCA HORD /SAVE TENS AND UNITS 3164 006123 7040 CMA /OUTPUT HUNDREDS 3165 006124 1044 TAD EXP 3166 006125 7440 SZA /UNLESS ZERO 3167 006126 4354 JMS OUTDG 3168 006127 1045 TAD HORD /PRINT TWO DIGITS 3169 006130 4732 JMS I PRNTI 3170 006131 5600 JMP I FLOUTP /--RETURN-- 3171 006132 2442 PRNTI, PRNT 3172 006133 0305 CHRT, 305 /E (0246) - FOR AMPERSAND 3173 006134 7763 SMSP, 240-255 / 3174 006135 0275 PEQ, 275 3175 006136 0255 SMIN, 255 3176 006137 7634 M144, -144 /-100 3177 006140 0144 C144, 0144 /+100 3178 006141 7774 M4, -4 3179 006142 7766 FM12, -12 3180 006143 7771 DCOUNT, -DIGITS-1 /NUMBER OF DIGITS OUTPUT 3181 006144 6275 PPTEN, PTEN /IEI 3182 006145 5713 DPT, DIGIT 3183 006146 5712 REPT, REMAIN /OVERFLOW FROM INTEGER MULTIPLY 3184 006147 5667 M10PT, MULT10 3185 006150 7467 SADR, BUFFER-1 3186 006151 5400 ROUND, TGO /ACTUAL OUTPUT ROUTINE 3187 006152 6271 TENPT, TEN 3188 006153 5571 ABSOL2, ABSOLV 3189 006154 0000 OUTDG, 0 /OUTPUT ONE DIGIT 3190 006155 1113 TAD C260 3191 006156 4551 PRINTC 3192 006157 5754 JMP I OUTDG /--RETURN-- 3193 3194 /USED BY 8K 3195 3196 3197 3198 /------------------------------------------------------------ 3199 /------------------------------------------------------------ 3200 /FLOATING POINT INPUT 3201 3202 *6200 3203 3204 006200 0000 FLINTP, 0 /IF C(AC) = 0, USE CHAR 3205 006201 7640 SZA CLA /IF C(AC) NON-ZERO , GET NEXT 3206 006202 4706 JMS I XIN /GET FIRST CHAR 3207 006203 1066 TAD CHAR /IGNORE LEADING SPACES 3208 006204 1114 TAD M240 3209 006205 7650 SNA CLA 3210 006206 5202 JMP .-4 3211 006207 4702 JMS I DPCVPT /READ FIRST DIGIT GROUP 3212 006210 1066 TAD CHAR /AND SET "SIGNF" 3213 006211 1115 TAD MPER 3214 006212 7640 SZA CLA /ENDED BY PERIOD? 3215 006213 5221 JMP FIGO1 3216 006214 4706 JMS I XIN /YES, READ 2AND GROUP 3217 006215 3705 DCA I DPN 3218 006216 4703 JMS I DCONP 3219 006217 1705 TAD I DPN /SAVE NUMBER OF DIGITS IN T3 3220 006220 7041 CMA IAC 3221 006221 3033 FIGO1, DCA T3 /NO, 3222 006222 1310 TAD P43 3223 006223 3044 DCA EXP 3224 006224 4704 JMS I RESOL5 3225 006225 4707 JMS I INORM /NORMALIZE FIRST, THEN 3226 006226 4407 FINT 3227 006227 6430 FPUT I PT1 /SAVE NUMBER 3228 006230 0000 FEXT 3229 006231 1066 TAD CHAR 3230 006232 1301 TAD MINUSE 3231 006233 7640 SZA CLA /"E" READ IN? 3232 006234 5246 JMP ENDFI+3 /NO 3233 006235 4706 JMS I XIN /YES, READ 3RD DIGIT GROUP 3234 006236 4702 JMS I DPCVPT /I.E. CONVERT DECIMAL EXPONENT 3235 006237 4704 JMS I RESOL5 3236 006240 1047 TAD OVER2 3237 006241 1033 TAD T3 /C(SEXP)PLACES TO RIGHT 3238 006242 3033 DCA T3 /OF LAST DIGIT 3239 3240 3241 3242 3243 /COMPENSATE FOR DECIMAL EXPONENTS 3244 3245 006243 4407 ENDFI, FINT /RESTORE MANTISSA 3246 006244 0430 FGET I PT1 3247 006245 0000 FEXT 3248 006246 1033 TAD T3 /TEST DECIMAL EXPONENT 3249 006247 7450 SNA 3250 006250 5600 JMP I FLINTP /FINISHED--RETURN-- 3251 006251 7700 SMA CLA 3252 006252 5261 JMP FIGO4 3253 006253 4407 FINT /. IS TO THE LEFT: 3254 006254 4275 FMUL PTEN /TIMES .1000 3255 006255 6430 FPUT I PT1 3256 006256 0000 FEXT 3257 006257 7001 IAC 3258 006260 5266 JMP .+6 3259 006261 4407 FIGO4, FINT /. IS TO THE RIGHT: 3260 006262 4271 FMUL TEN /MULTIPLY BY 10 3261 006263 6430 FPUT I PT1 3262 006264 0000 FEXT 3263 006265 7040 CMA 3264 006266 1033 TAD T3 3265 006267 3033 DCA T3 3266 006270 5246 JMP ENDFI+3 3267 006271 0004 TEN, 0004 3268 006272 2400 2400 3269 006273 0000 0000 3270 006274 0000 0000 3271 3272 006275 7775 PTEN, 7775 3273 006276 3146 3146 3274 006277 3147 3147 /(3146) - FOR 4-WORD 3275 006300 3150 3150 3276 3277 006301 7473 MINUSE, -305 /(7532) - FOR AMPERSAND 3278 3279 006302 5600 DPCVPT, DECONV 3280 006303 5627 DCONP, DECON 3281 006304 7173 RESOL5, RESOLV 3282 006305 5714 DPN, DNUMBR 3283 006306 0756 XIN, INPUT 3284 006307 7335 INORM, DNORM 3285 006310 0043 P43, 43 3286 3287 /END OF FLOATING POINT INPUT 3288 3289 /7 FREE 3290 3291 /USED BY H.S. READER 3292 3293 /------------------------------------------------------------ 3294 /------------------------------------------------------------ 3295 *6400 3296 / FLOATING-POINT INTERPRETER FOR FOCAL. 3297 3298 006400 0000 FPNT, 0 3299 006401 7300 CLA CLL 3300 006402 3047 DCA OVER2 /(NOP) - FOR 4-WORD 3301 006403 3043 DCA OVER1 /(NOP) - FOR 4-WORD. 3302 006404 1600 TAD I FPNT /GET NEXT INSTRUCTION 3303 006405 7450 SNA 3304 006406 5600 JMP I FPNT /FAST EXIT--RETURN-- 3305 006407 3262 DCA JUMP 3306 006410 1262 TAD JUMP 3307 006411 0123 AND C200 /GET PAGE BIT 3308 006412 7650 SNA CLA /PAGE ZERO? 3309 006413 5216 JMP .+3 /YES 3310 006414 1104 TAD P7600 /NO 3311 006415 0200 AND FPNT /C(FPNT)0-4 CONTAINS PAGE BITS 3312 006416 3040 DCA ADDR 3313 006417 1106 TAD P177 /GET 7 BIT ADDRESS 3314 006420 0262 AND JUMP 3315 006421 1040 TAD ADDR 3316 006422 3040 DCA ADDR 3317 006423 1263 TAD INDRCT /INDIRECT BIT=1? 3318 006424 0262 AND JUMP 3319 006425 7650 SNA CLA 3320 006426 5231 JMP LOOP01 /NO-GO ON 3321 006427 1440 TAD I ADDR /YES ,DEFER ,W/O AUTO-INDEX 3322 006430 3040 DCA ADDR 3323 006431 2200 LOOP01, ISZ FPNT 3324 006432 7040 CMA 3325 006433 1040 TAD ADDR 3326 006434 3015 DCA FLTXR2 3327 006435 1262 TAD JUMP /GET COMMAND 3328 006436 7106 CLL RTL 3329 006437 7006 RTL 3330 006440 0107 AND P17 /GET BITS 0-2,IE OPCODE 3331 006441 7450 SNA 3332 006442 5267 JMP FLGT 3333 006443 1264 TAD TABLE /LOOKUP IN TABLE 3334 006444 3262 DCA JUMP 3335 006445 1662 TAD I JUMP 3336 006446 7450 SNA 3337 006447 5265 JMP FLPT 3338 006450 3262 DCA JUMP 3339 006451 1304 TAD CEX1 /SAVE FLOATING ARGUEMENT,UNLESS'GET' OR 'PUT' 3340 006452 3014 DCA FLTXR 3341 006453 1117 TAD MFLT 3342 006454 3057 DCA CNTR 3343 006455 1415 TAD I FLTXR2 3344 006456 3414 DCA I FLTXR 3345 006457 2057 ISZ CNTR 3346 006460 5255 JMP .-3 3347 006461 5662 JMP I JUMP /GO THERE 3348 3349 3350 006462 0000 JUMP, 0 3351 3352 ADDR=EX1 3353 3354 006463 0400 INDRCT, 0400 3355 006464 6573 TABLE, ITABLE 3356 006465 1303 FLPT, TAD CEXP /EXP TO (ADDR) 3357 006466 5273 JMP .+5 3358 006467 1303 FLGT, TAD CEXP /(ADDR) TO EXP 3359 006470 3015 DCA FLTXR2 3360 006471 7040 CMA 3361 006472 1040 TAD ADDR 3362 006473 3014 DCA FLTXR /SAVE 'FROM' ADDRESS 3363 006474 1117 TAD MFLT /3 OR 4 WORDS 3364 006475 3057 DCA CNTR 3365 006476 1414 TAD I FLTXR 3366 006477 3415 DCA I FLTXR2 3367 006500 2057 ISZ CNTR 3368 006501 5276 JMP .-3 3369 006502 5201 JMP FPNT+1 3370 006503 0043 CEXP, EXP-1 3371 006504 0037 CEX1, EX1-1 3372 3373 3374 006505 4765 FLSU, JMS I OPMINS /FSUB=2 - NEGATE THE OPERAND 3375 006506 4770 FLAD, JMS I ALGN /FLAD=1 - FIRST ALIGN EXPONENTS 3376 006507 5201 JMP FPNT+1 /RETURN IF NO ALIGNMENT IS POSSIBLE 3377 006510 4772 JMS I RAR2 /TRIPLE PRECISION ADDDITION 3378 006511 4771 JMS I RAR1 /SINCE BITS ARE SHIFTED 3379 006512 4773 JMS I TRAD /RIGHT 3380 006513 4767 NORF, JMS I NORM /NORMALIZE THE RESULT 3381 006514 5201 JMP FPNT+1 /HINT:USE 700X FOR FUNCTIONS. 3382 3383 /INTERPRETIVE POWER 3384 3385 006515 7000 NOP /3 FREE LOCATIONS ************ 3386 006516 7000 NOP 3387 006517 7000 NOP 3388 006520 3044 ZERO, DCA EXP /YES 3389 006521 3045 DCA HORD 3390 006522 3046 DCA LORD 3391 006523 3047 DCA OVER2 3392 006524 5201 JMP FPNT+1 3393 006525 4543 FLEX, PUSHF /AC TO A + POWER 3394 006526 0044 FLAC 3395 006527 4543 PUSHF /SETUP ARGUMENT ( THE EXPONENT) 3396 006530 0040 EX1 3397 006531 4544 POPF 3398 006532 0044 FLAC 3399 006533 4453 JMS I INTEGER /ONLY POSITIVE, INTEGER EXPONENTS 3400 006534 7510 SPA 3401 006535 5342 JMP .+5 /(COULD DIVIDE) 3402 006536 7040 CMA 3403 006537 3262 DCA JUMP /TEMP STORAGE 3404 006540 3043 DCA OVER1 /(NOP) - FOR 4-WORD 3405 006541 1045 TAD HORD 3406 006542 7640 SZA CLA 3407 006543 4566 ERROR2 /TOO LARGE OR NEGATIVE EXPONENT 3408 006544 4543 PUSHF /INITIALIZE TO ONE. 3409 006545 2405 FLTONE 3410 006546 4544 POPF 3411 006547 0044 FLAC 3412 006550 4544 POPF 3413 006551 7470 ITER1 3414 006552 5360 JMP .+6 3415 006553 4543 PUSHF 3416 006554 7470 ITER1 3417 006555 4544 POPF 3418 006556 0040 EX1 3419 006557 4766 JMS I MULT /"MULT" 3420 006560 2262 ISZ JUMP 3421 006561 5353 JMP .-6 3422 006562 5201 JMP FPNT+1 3423 006563 4766 FLMY, JMS I MULT /MULTIPLY 3424 006564 5201 JMP FPNT+1 3425 /------------------------------------------------------------ 3426 3427 3428 006565 7153 OPMINS, MINUS2 3429 006566 7004 MULT, DMULT 3430 006567 7335 NORM, DNORM 3431 006570 6623 ALGN, ALIGN 3432 006571 5754 RAR1, DIV1 3433 006572 6757 RAR2, DIV2 3434 006573 5733 TRAD, DUBLAD 3435 3436 ITABLE=.-1 3437 006574 6506 FLAD 3438 006575 6505 FLSU 3439 006576 7107 FLDV 3440 006577 6563 FLMY 3441 006600 6525 FLEX 3442 006601 0000 0000 3443 006602 6513 NORF 3444 /------------------------------------------------------------ 3445 3446 006603 0000 ACMINS, 0 /ROUTINE TO COMPLEMENT FLAC - VIA "MINSKI" 3447 006604 7300 CLL CLA 3448 006605 1047 TAD OVER2 /TRIPLE PRECISION NEGATION 3449 006606 7041 CMA IAC /OF FLOATING AC 3450 006607 3047 DCA OVER2 3451 006610 1046 TAD LORD 3452 006611 7040 CMA 3453 006612 7430 SZL 3454 006613 7101 IAC CLL 3455 006614 3046 DCA LORD 3456 006615 1045 TAD HORD 3457 006616 7040 CMA 3458 006617 7430 SZL 3459 006620 7101 IAC CLL 3460 006621 3045 DCA HORD 3461 006622 5603 JMP I ACMINS /--RETURN-- 3462 3463 3464 006623 0000 ALIGN, 0 /SUBROUTINE TO ALIGN 3465 006624 1045 TAD HORD /BINARY POINTS 3466 006625 7450 SNA 3467 006626 1046 TAD LORD /IS MANTISSA ZERO? 3468 006627 7650 SNA CLA 3469 006630 5311 JMP NOX1 /YES, RESULT=OPERAND 3470 006631 1041 TAD AC1H /NO,IS OPERAND ZERO? 3471 006632 7450 SNA 3472 006633 1042 TAD AC1L 3473 006634 7450 SNA 3474 006635 1043 TAD OVER1 3475 006636 7650 SNA CLA 3476 006637 5623 JMP I ALIGN /YES--RETURN-- 3477 006640 1040 TAD EX1 3478 006641 7041 CMA IAC 3479 006642 1044 TAD EXP 3480 006643 7450 SNA /ARE EXPONENTS EQUAL? 3481 006644 5273 JMP ADONE /YES 3482 006645 3203 DCA ACMINS 3483 006646 1203 TAD ACMINS 3484 006647 7500 SMA /NO 3485 006650 7041 CIA /NEGATE AND 3486 006651 3322 DCA AMOUNT /SAVE THE DIFFERENCE 3487 006652 1322 TAD AMOUNT 3488 006653 1336 TAD TEST2 3489 006654 7710 SPA CLA /CAN THE EXPONENTS BE ALIGNED? 3490 006655 5275 JMP NOX /NO, USE LARGER OF THE TWO. 3491 006656 1203 TAD ACMINS /YES, SHIFT THE SMALLER 3492 006657 7700 SMA CLA 3493 006660 5265 JMP ASHFT 3494 006661 4357 JMS DIV2 3495 006662 2322 ISZ AMOUNT 3496 006663 5261 JMP .-2 3497 006664 5273 JMP ADONE 3498 006665 7040 ASHFT, CMA 3499 006666 1040 TAD EX1 3500 006667 3040 DCA EX1 3501 006670 4723 JMS I TAG1 3502 006671 2322 ISZ AMOUNT 3503 006672 5270 JMP .-2 3504 006673 2223 ADONE, ISZ ALIGN 3505 006674 5623 JMP I ALIGN /--RETURN-- 3506 006675 1040 NOX, TAD EX1 /MISSION IMPOSSIBLE! 3507 006676 7700 SMA CLA /CHECK FOR SIGN DIFFERENCE 3508 006677 5304 JMP NOX2 3509 006700 1044 TAD EXP 3510 006701 7700 SMA CLA 3511 006702 5623 JMP I ALIGN /-+--RETURN-- 3512 006703 5306 JMP .+3 /-- 3513 006704 1044 NOX2, TAD EXP 3514 006705 7700 SMA CLA 3515 006706 1203 TAD ACMINS /TEMP STORAGE OF DIFFERENCE. BOTH POS EXP OR BOTH NEG. 3516 006707 7740 SMA SZA CLA 3517 006710 5623 JMP I ALIGN /OK (+-)--RETURN-- 3518 006711 1040 NOX1, TAD EX1 /USE LARGER 3519 006712 3044 DCA EXP 3520 006713 1041 TAD AC1H 3521 006714 3045 DCA HORD 3522 006715 1042 TAD AC1L 3523 006716 3046 DCA LORD 3524 006717 1043 TAD OVER1 3525 006720 3047 DCA OVER2 3526 006721 5623 JMP I ALIGN /--RETURN-- 3527 006722 0000 AMOUNT, 0 3528 006723 5754 TAG1, DIV1 3529 /LEAVE 12 BIT ANSWER IN AC UPON RETURN 3530 /LEAVE FLAC AS AN INTEGER, 3531 3532 006724 0000 FIX, 0 /VIA (INTEGER) 3533 006725 4751 JMS I ABSOL 3534 006726 1044 TAD EXP /TEST FOR FRACTION 3535 006727 7750 SPA SNA CLA 3536 006730 5353 JMP FIXM /DOUBLE CHECK FOR MINUS ONE. 3537 006731 7001 IAC 3538 006732 3043 DCA OVER1 3539 006733 1350 TAD P27 /INIT ALIGNMENT 3540 006734 3040 DCA EX1 3541 006735 4223 JMS ALIGN /DO THE ALIGNMENT TO AN INTEGER 3542 006736 0027 TEST2, 0027 /ALREADY DONE; (43)-FOR 4-WORD 3543 006737 2047 ISZ OVER2 3544 006740 5344 JMP .+4 3545 006741 2046 ISZ LORD 3546 006742 7410 SKP 3547 006743 2045 ISZ HORD 3548 006744 3047 DCA OVER2 /CLEAR THE FRACTION 3549 006745 4752 JMS I RESOL 3550 006746 1046 TAD LORD /EXIT WITH LOW ORDER RESULT IN AC. 3551 006747 5724 JMP I FIX /--RETURN-- 3552 006750 0027 P27, 27 3553 006751 5571 ABSOL, ABSOLV 3554 006752 7173 RESOL, RESOLV 3555 006753 3044 FIXM, DCA EXP /CLEAR EXPONENT 3556 006754 3045 DCA HORD 3557 006755 3046 DCA LORD 3558 006756 5344 JMP TEST2+6 3559 006757 0000 DIV2, 0 /SHIFT FLAC RIGHT 3560 006760 7300 CLA CLL 3561 006761 1045 TAD HORD 3562 006762 7510 SPA 3563 006763 7020 CML 3564 006764 7010 RAR 3565 006765 3045 DCA HORD 3566 006766 1046 TAD LORD 3567 006767 7010 RAR 3568 006770 3046 DCA LORD 3569 006771 1047 TAD OVER2 3570 006772 7010 RAR 3571 006773 3047 DCA OVER2 3572 006774 2044 ISZ EXP 3573 006775 5757 JMP I DIV2 /--RETURN-- 3574 006776 5757 JMP I DIV2 /--RETURN-- 3575 /------------------------------------------------------------ 3576 SPECIAL=. /INPUT CHARACTERS 3577 006777 0337 337 /LEFT ARROW 3578 007000 0377 377 /RUBOUT 3579 007001 0212 212 /L.F. 3580 007002 0375 375 /ALT MODE 3581 007003 7777 -1 3582 /------------------------------------------------------------ 3583 /(A+B+C)*(D+E+F)=A*D,A*E,B*D,B*E 3584 3585 007004 0000 DMULT, 0 /N- PRECISION MULTIPLY WITH 3586 007005 7001 IAC /PRODUCT IN TRIPLE PRECISION 3587 007006 1040 TAD EX1 /ADD EXPONENTS+1 3588 007007 4324 JMS SIGN /AND DETERMINE SIGN OF RESULT 3589 007010 7710 SPA CLA 3590 007011 4353 JMS MINUS2 3591 007012 3301 DCA DATUM-1 /INITIALIZE RESULT 3592 007013 3300 DCA DATUM-2 3593 007014 3277 DCA DATUM-3 3594 007015 3276 DCA DATUM-4 3595 007016 1045 TAD A /A*D 3596 007017 3751 SAVE /STORE IN MP2 3597 007020 1041 TAD D /SINGLE PRECISION MULTIPLY 3598 007021 4752 MULTY 3599 007022 0002 2 /ACCUMULATE STARTING IN #2 DATA WORD 3600 007023 1042 TAD E /A*E 3601 007024 4752 MULTY 3602 007025 0003 3 3603 007026 1046 TAD B /B*D 3604 007027 3751 SAVE 3605 007030 1041 TAD D 3606 007031 4752 MULTY 3607 007032 0003 3 3608 007033 1042 TAD E /B*E 3609 007034 4752 MULTY 3610 007035 0004 4 3611 007036 5263 DMULT4, JMP DMDONE /(DCA DATUM-5)-FOR 4-WORD 3612 007037 3274 DCA DATUM-6 3613 007040 1043 TAD F /A*F 3614 007041 3751 SAVE 3615 007042 1045 TAD A 3616 007043 4752 MULTY 3617 007044 0004 4 3618 007045 1046 TAD B /B*F 3619 007046 4752 MULTY 3620 007047 0005 5 3621 007050 1047 TAD C /C*D 3622 007051 3751 SAVE 3623 007052 1041 TAD D 3624 007053 4752 MULTY 3625 007054 0004 4 3626 007055 1042 TAD E /C*E 3627 007056 4752 MULTY 3628 007057 0005 5 3629 007060 1043 TAD F /C*F 3630 007061 4752 MULTY 3631 007062 0006 6 3632 3633 007063 1301 DMDONE, TAD DATUM-1 /COPY RESULT 3634 007064 3045 DCA HORD 3635 007065 1300 TAD DATUM-2 3636 007066 3046 DCA LORD 3637 007067 1277 TAD DATUM-3 3638 007070 3047 DCA OVER2 3639 007071 4301 JMS MULDIV 3640 007072 3047 DCA OVER2 /(NOP) - FOR 4-WORD 3641 007073 5604 JMP I DMULT /--RETURN-- 3642 3643 DATUM=.+6 /INTERMEDIATE STORAGE 3644 3645 /#6-LOW ORDER RESULT 3646 /#5 3647 /#4 3648 /#3 3649 /#2 3650 /#1-HIGH ORDER RESULT 3651 3652 *DATUM-1 3653 3654 007101 0000 MULDIV, 0 /TERMINATE MULTIPLY AND DIVIDE. 3655 007102 2050 ISZ SIGNF /CORRECT FOR SIGN 3656 007103 4451 JMS I MINSKI 3657 007104 4747 JMS I NORMF /SHIFT LEFT 3658 007105 7000 NOP 3659 007106 5701 JMP I MULDIV /--RETURN-- 3660 007107 1041 FLDV, TAD AC1H /4:DIVIDE 3661 007110 7650 SNA CLA 3662 007111 4566 ERROR2 /DIVISION BY ZERO 3663 007112 1040 TAD EX1 /SUBTRACT EXPONENTS+1 3664 007113 7041 CMA IAC 3665 007114 7001 IAC 3666 007115 4324 JMS SIGN /SET UP SIGNS 3667 007116 7700 SMA CLA 3668 007117 4353 JMS MINUS2 /NEGATE DIVISOR 3669 007120 4750 JMS I DIVIDE /DIVIDE 3670 007121 4301 JMS MULDIV 3671 007122 5723 JMP I .+1 3672 007123 6401 FPNT+1 3673 3674 /THIS SUBROUTINE PREPARES MULTIPLY AND DIVIDE 3675 /FOR ANY COMBINATION OF SIGNED ARGUMENTS AND FOR ZERO. 3676 /THE RESULT OF EITHER IS ZERO IF FLAC = 0. 3677 /RESULT OF MULTIPLY IS ZERO IF EITHER IS ZERO; 3678 /DIVISION BY ZERO IS CHECKED BEFORE THIS 3679 /ROUTINE IS CALLED. 3680 3681 /THE CALLING AC CONTAINS AN UPDATE VALUE FOR THE 3682 /EXPONENT. THE RETURNING AC CONTAINS THE SIGN OF 3683 /THE ARGUMENT FOR FURTHER TESTING BY EACH ROUTINE. 3684 3685 3686 007124 0000 SIGN, 0 /TEST AND SAVE SIGN OF RESULT 3687 007125 1044 TAD EXP /COMPUTE NEW EXPONENT FOR MUL-DIV. 3688 007126 3044 DCA EXP 3689 007127 1124 TAD P4000 /LOAD 4000 TO XOR THE SIGN BITS 3690 007130 0045 AND HORD 3691 007131 1041 TAD AC1H 3692 007132 7700 SMA CLA /RESULT MAY BE ZERO 3693 007133 7040 CMA 3694 007134 3050 DCA SIGNF 3695 007135 1045 TAD HORD 3696 007136 7450 SNA 3697 007137 5746 JMP I REVIT /ANSWER IS ZERO. 3698 007140 7710 SPA CLA /TAKE ABSOLUTE VALUE OF FLAC 3699 007141 4451 JMS I MINSKI 3700 007142 1041 TAD AC1H 3701 007143 7450 SNA /RESULT OF EITHER MAY BE ZERO 3702 007144 5746 JMP I REVIT 3703 007145 5724 JMP I SIGN /--RETURN-- 3704 3705 /SIGN OF RESULT = SIGNF 3706 /+=-1 3707 /-=0 3708 3709 007146 6520 REVIT, ZERO 3710 007147 7335 NORMF, DNORM 3711 007150 7261 DIVIDE, DUBDIV 3712 3713 SAVE=DCA I . 3714 007151 7256 MP2 3715 MULTY=JMS I . 3716 007152 7200 MP4 3717 3718 A=FLAC+1 3719 B=FLAC+2 3720 C=FLAC+3 3721 D=AC1H 3722 E=AC1L 3723 F=OVER1 3724 3725 3726 007153 0000 MINUS2, 0 /NEGATE OPERAND 3727 007154 7300 CLA CLL /TRIPLE PRECISION 3728 007155 1043 TAD OVER1 3729 007156 7041 CMA IAC 3730 007157 3043 DCA OVER1 3731 007160 1042 TAD AC1L 3732 007161 7040 CMA 3733 007162 7430 SZL 3734 007163 7101 IAC CLL 3735 007164 3042 DCA AC1L 3736 007165 1041 TAD AC1H 3737 007166 7040 CMA 3738 007167 7430 SZL 3739 007170 7101 IAC CLL 3740 007171 3041 DCA AC1H 3741 007172 5753 JMP I MINUS2 /--RETURN-- 3742 3743 007173 0000 RESOLV, 0 3744 007174 1050 TAD SIGNF 3745 007175 7710 SPA CLA 3746 007176 4451 JMS I MINSKI 3747 007177 5773 JMP I RESOLV /--RETURN-- 3748 /------------------------------------------------------------ 3749 /------------------------------------------------------------ 3750 *7200 3751 3752 007200 0000 MP4, 0 /SINGLE PRECISION, UNSIGNED MULTIPLY - "MULTY" 3753 007201 7450 SNA /NO RESULT ADDED IF ZERO 3754 007202 5600 JMP I MP4 /--RETURN-- 3755 3756 /FOR EAE INSERT THE FOLLOWING: 3757 3758 /7203 3206 DCA .+3 3759 /7204 1256 TAD MP2 3760 /7205 7425 MQL MUY 3761 /7206 0000 0 3762 /7207 3253 DCA MP5 3763 /7210 7501 MQA 3764 /7211 3255 DCA MP3 3765 /7212 5227 JMP .+15 3766 3767 3768 007203 3254 DCA MP1 /12 BITS BY 12 BITS 3769 007204 3253 DCA MP5 3770 007205 1257 TAD THIR 3771 007206 3255 DCA MP3 3772 007207 7100 CLL 3773 007210 1254 MP6, TAD MP1 3774 007211 7010 RAR 3775 007212 3254 DCA MP1 3776 007213 1253 TAD MP5 3777 007214 7420 SNL 3778 007215 5220 JMP .+3 3779 007216 7100 CLL 3780 007217 1256 TAD MP2 3781 007220 7010 RAR 3782 007221 3253 DCA MP5 /SAVE HIGH ORDER RESULT 3783 007222 2255 ISZ MP3 3784 007223 5210 JMP MP6 3785 007224 1254 TAD MP1 /CORRECT LOW ORDER RESULT 3786 007225 7010 RAR 3787 007226 3255 DCA MP3 3788 007227 1600 TAD I MP4 /PICKUP SCALE FACTOR 3789 007230 7041 CIA 3790 007231 1252 TAD DATUMA /COMPUTE ADDRESS 3791 007232 3254 DCA MP1 /TEMP 3792 007233 1255 TAD MP3 /LOW ORDER PART 3793 007234 7100 CLL 3794 007235 1654 TAD I MP1 /ACCUMULATE 3795 007236 3654 DCA I MP1 3796 007237 2254 ISZ MP1 3797 007240 7004 RAL 3798 007241 1253 TAD MP5 3799 007242 1654 TAD I MP1 3800 007243 3654 DCA I MP1 3801 007244 7420 SNL 3802 007245 5600 JMP I MP4 /NO CARRY--RETURN-- 3803 007246 2254 ISZ MP1 3804 007247 2654 ISZ I MP1 3805 007250 5600 JMP I MP4 /--RETURN 3806 007251 5246 JMP .-3 /CARRY AGAIN 3807 007252 7102 DATUMA, DATUM 3808 007253 0000 MP5, 0 /PRODUCT 3809 007254 0000 MP1, 0 /MULTIPLIER 3810 007255 0000 MP3, 0 3811 007256 0000 MP2, 0 /MULTIPLICAND 3812 007257 7764 THIR, -14 /12 BITS 3813 3814 3815 007260 7751 MIF, -27 /(-43) - FOR 4-WORD(=7735) 3816 3817 007261 0000 DUBDIV, 0 /2 OR 3 PRECISION DIVIDE 3818 007262 3200 DCA MP4 3819 007263 3254 DCA MP1 3820 007264 1260 TAD MIF /INIT BIT COUNTER 3821 007265 3255 DCA MP3 3822 007266 7410 SKP 3823 007267 4527 DV3, JMS I DOUBLE /SHIFT FLAC LEFT 3824 007270 7100 CLL 3825 007271 1042 TAD AC1L /COMBINE ONE POSITION AND (4-WORD) 3826 007272 1046 TAD LORD 3827 007273 3256 DCA MP2 /SAVE RESULT 3828 007274 7004 RAL 3829 007275 1045 TAD HORD /ADD OVERFLOW 3830 007276 1041 TAD AC1H 3831 007277 7420 SNL /SKIP IF OVERFLOW 3832 007300 5304 JMP .+4 3833 007301 3045 DCA HORD /UPDATE FLAC 3834 007302 1256 TAD MP2 3835 007303 3046 DCA LORD 3836 007304 7200 CLA /CLEAR ACCUMULATOR 3837 007305 1254 TAD MP1 /SAVE OVERFLOW BITS CIRCULARLY 3838 007306 7004 RAL 3839 007307 3254 DCA MP1 3840 007310 1200 TAD MP4 3841 007311 7004 RAL 3842 007312 3200 DCA MP4 3843 007313 2255 ISZ MP3 /TEST FOR END OF DIVIDE 3844 007314 5267 JMP DV3 3845 007315 1254 TAD MP1 /LOAD RESULTS 3846 007316 3046 DCA LORD 3847 007317 1200 TAD MP4 3848 007320 3045 DCA HORD 3849 007321 5661 JMP I DUBDIV /(NOP)--RETURN-- 3850 007322 7004 RAL /EXTRA FOR 4-WORD 3851 007323 3335 DCA DNORM 3852 007324 2255 ISZ MP3 /TEST FOR END OF DIVIDE 3853 007325 5267 JMP DV3 3854 007326 1335 TAD DNORM 3855 007327 3045 DCA HORD 3856 007330 1200 TAD MP4 3857 007331 3046 DCA LORD 3858 007332 1254 TAD MP1 3859 007333 3047 DCA OVER2 3860 007334 5661 JMP I DUBDIV /--RETURN-- 3861 3862 3863 3864 007335 0000 DNORM, 0 /SUBROUTINE TO NORMALIZE FLAC 3865 007336 4775 JMS I ABSOL3 3866 007337 4366 JMS TEST4 3867 007340 1045 TAD HORD 3868 007341 7450 SNA /IS MANTISSA=0? 3869 007342 1047 TAD OVER2 3870 007343 7450 SNA 3871 007344 1046 TAD LORD 3872 007345 7650 SNA CLA 3873 007346 5363 JMP EXIT3 /YES 3874 007347 1045 TAD HORD 3875 007350 7104 RAL CLL 3876 007351 7710 SPA CLA /WILL SHIFT BE TOO FAR? 3877 007352 5360 JMP .+6 3878 007353 4527 JMS I DOUBLE 3879 007354 7140 CMA CLL 3880 007355 1044 TAD EXP 3881 007356 3044 DCA EXP 3882 007357 5347 JMP .-10 3883 007360 4776 JMS I RESOL3 3884 007361 4366 JMS TEST4 /DON'T LEAVE 4000 3885 007362 5735 JMP I DNORM /--RETURN-- 3886 007363 3044 EXIT3, DCA EXP /SET TO ZERO 3887 007364 5735 JMP I DNORM /--RETURN-- 3888 007365 6757 XRAR2, DIV2 3889 007366 0000 TEST4, 0 3890 007367 1045 TAD HORD /TEST FOR 4000 3891 007370 7510 SPA 3892 007371 7041 CIA 3893 007372 7710 SPA CLA 3894 007373 4765 JMS I XRAR2 /SHIFT BACK 3895 007374 5766 JMP I TEST4 /--RETURN-- 3896 3897 007375 5571 ABSOL3, ABSOLV 3898 007376 7173 RESOL3, RESOLV 3899 3900 /------------------------------------------------------------ 3901 /------------------------------------------------------------ 3902 *7400 3903 3904 3905 /PAGE 18 3906 3907 /FLOATING SQUARE ROOT FUNCTION 3908 3909 007400 4407 XSQRT, FINT 3910 007401 6274 FPUT FPAC1 /VALUE 3911 007402 0000 FEXT /NEWTON'S METHOD IS USED 3912 007403 1045 GETSGN 3913 007404 7710 SPA CLA 3914 007405 4566 ERROR2 /NUMBER IS NEGATIVE=IMAGINARY ROOTS 3915 007406 1044 TAD EXP /LINK IS =0 FROM FINT 3916 007407 7510 SPA /MATCH THE SIGN WITH LINK BIT 3917 007410 7020 CML 3918 007411 7010 RAR 3919 007412 3270 DCA ITER1 /MAKE FIRST APPROXIMATION 3920 007413 7430 SZL /TEST LSB OF EXP 3921 007414 2270 ISZ ITER1 3922 007415 7000 NOP 3923 007416 1267 TAD SQCON1 3924 007417 3271 DCA ITER1+1 3925 007420 3272 DCA ITER1+2 3926 007421 3273 DCA ITER1+3 3927 007422 1275 TAD FPAC1+1 3928 007423 7450 SNA 3929 007424 1276 TAD FPAC1+2 3930 007425 7650 SNA CLA 3931 007426 5265 JMP SQEND /NUMBER=0 3932 007427 4407 CLCU, FINT 3933 007430 0274 FGET FPAC1 3934 007431 3270 FDIV ITER1 3935 007432 1270 FADD ITER1 3936 007433 0000 FEXT 3937 3938 3939 3940 3941 007434 7240 CLA CMA 3942 007435 1044 TAD EXP 3943 007436 3044 DCA EXP 3944 007437 1044 TAD EXP 3945 007440 7041 CMA IAC 3946 007441 1270 TAD ITER1 3947 007442 7640 SZA CLA /ARE EXPONENTS EQUAL? 3948 007443 5261 JMP ROOTGO /NO 3949 007444 1045 TAD HORD /ARE HIGH-ORDER MANTISSAS EQUAL? 3950 007445 7041 CMA IAC 3951 007446 1271 TAD ITER1+1 3952 007447 7640 SZA CLA 3953 007450 5261 JMP ROOTGO /NO 3954 007451 1046 TAD LORD 3955 007452 7041 CMA IAC 3956 007453 1272 TAD ITER1+2 /DO LOW-ORDER MANTISSAS AGREE 3957 007454 7500 SMA 3958 007455 7041 CMA IAC /WITHIN ONE BIT? 3959 007456 7001 IAC 3960 007457 7700 SMA CLA 3961 007460 5536 RETURN 3962 007461 4407 ROOTGO, FINT 3963 007462 6270 FPUT ITER1 3964 007463 0000 FEXT 3965 007464 5227 JMP CLCU 3966 007465 3044 SQEND, DCA EXP 3967 007466 5536 RETURN 3968 007467 3015 SQCON1, 3015 3969 3970 BUFFER=. 3971 3972 007470 0000 ITER1, 0 3973 007471 0000 0 3974 007472 0000 0 3975 007473 0000 0 3976 3977 007474 0000 FPAC1, 0 3978 007475 0000 0 3979 007476 0000 0 3980 007477 7503 BUFFER+13 /ADDRESS OF NEXT FREE LOCATION IN 10-DIGIT VERSION. 3981 3982 3983 3984 3985 ENPUNCH 3986 3987 $ A 0045 ABSOL 6751 ABSOL2 6153 ABSOL3 7375 ABSOLV 5571 AC1H 0041 AC1L 0042 ACMINS 6603 ADD 0061 ADDR 0040 ADONE 6673 AF 4677 ALF1 4760 ALF2 4763 ALFZ 4755 ALGN 6570 ALIGN 6623 ALIST 1372 AMOUNT 6722 ARCALG 4732 ARCRTN 5024 ARGNXT 1723 ARTN 5000 ASHFT 6665 ASK 1202 ATEI 4465 ATES 4513 ATLIST 1570 ATSW 0056 AXIN 0010 AXOUT 0017 B 0046 BACK 5503 BEGIN 4371 BET1 4771 BET2 4774 BETZ 4766 BF 4702 BFX 4557 BFXX 4556 BOTTOM 0035 BUFBEG 3217 BUFFER 7470 BUFR 0060 BUFST 5531 C 0047 C100 0006 C140 2554 C144 6140 C200 0123 C260 0113 C3 5346 C5 5342 C7 5336 C9 5332 CCR 0077 CEX1 6504 CEXP 6503 CF 4705 CFRS 0133 CFRSX 0137 CHAR 0066 CHIN 2155 CHRT 6133 CLCU 7427 CLF 0076 CNTR 0057 COL 1255 COMBOT 0226 COMBUF 0132 COMEIN 3140 COMEOU 3206 COMGO 1163 COMLST 0774 COMMEN 0614 CON1 5037 CSTAR 0225 D 0041 DATUM 7102 DATUMA 7252 DCONP 6303 DCONT 0471 DCOUNT 6143 DDTJR 0004 DEBGSW 0026 DECON 5627 DECONV 5600 DECP 5533 DECR 5521 DELETE 4565 DF 4710 DGRP 0425 DGRP1 0441 unreferenced DIG 5543 DIGIT 5713 DIGITS 0006 DIV1 5754 DIV2 6757 DIVIDE 7150 DMDONE 7063 DMPSW 0100 DMULT 7004 DMULT4 7036 DNORM 7335 DNUMBR 5714 DO 0420 DOK 2111 DONE 2127 DOONE 0463 DOUBLE 0127 DPCVPT 6302 DPN 6305 DPT 6145 DSAVE 5640 DTST 5647 DUBDIV 7261 DUBLAD 5733 DV3 7267 E 0042 ECALL 1601 ECHOLS 1624 EFOP 0056 EFUN 1743 EFUN2 1754 EFUN3 2017 EFUN3I 0136 ELPAR 1763 END 0134 ENDFI 6243 ENDLN 4556 ENDT 0135 ENUM 1732 EPAR 1710 EPAR2 1765 ER5 4555 ERASE 2204 ERG 2225 ERL 2222 ERR2 2726 ERROR2 4566 ERROR3 4566 ERROR4 4566 ERROR5 2725 ERT 2214 ERV 2217 ERVX 2237 ESCA 2532 ETERM 1647 ETERM1 1627 ETERM2 1655 ETERMN 1644 EVAL 1613 EX1 0040 EXIT 2646 EXIT1 5034 EXIT2 5302 EXIT3 7363 EXITJ 2661 EXP 0044 EXTR 2313 F 0043 FADD 1000 FCONT 1101 FCOS 5200 FCOUNT 5535 FDIV 3000 FEND3 2267 FEXP 4620 FEXT 0000 FGET 0000 FGO2 6011 FGO3 6027 FGO4 6034 FGO5 6070 FIGO1 6221 FIGO4 6261 FINCR 1065 FINDLN 4555 FINDN 2246 FINFIN 1137 FINKP 1133 FINPUT 0131 FINT 4407 FISW 0052 FIX 6724 FIXM 6753 FLAC 0044 FLAD 6506 FLAG1 5162 FLAG2 4725 FLARG 2030 FLARGP 0125 FLDV 7107 FLEX 6525 FLGT 6467 FLIMIT 1075 FLINTP 6200 FLIST1 0577 FLIST2 0574 FLMY 6563 FLOG 5040 FLOP 1674 FLOUT 5556 FLOUTP 6000 FLPT 6465 FLSU 6505 FLTONE 2405 FLTXR 0014 FLTXR2 0015 FLTZER 2407 FM12 6142 FMUL 4000 FNEG 5163 FNOR 7000 FNPT 4554 FNTABF 0374 FNTABL 2165 FOR 1041 FOUTPU 0130 FPAC1 7474 FPNT 6400 FPOW 5000 unreferenced FPRNT 5465 FPUT 6000 FRST 3206 FRSTX 3215 FSIN 5205 FSUB 2000 FXIT 0000 G8L 4466 GECALL 1460 GEND 2334 GERR 0340 GET1 2330 GET3 2345 GETARG 1403 GETC 4545 GETLN 4554 GETSGN 1045 GETVAR 1407 GEXIT 0352 GFND1 1505 GINC 0070 GLIST 1377 GO 5021 GONE 0232 GOTO 0603 GRPTST 0744 GS1 1437 GS2 1461 GS3 1441 GS4 1454 GSERCH 1426 GTEM 0021 GZERR 0362 HINBUF 0037 HORD 0045 HREAD 6321 HREAD2 6324 HSGO 6364 HSPSW 6375 HSPX 6361 HSWITC 6343 HTST 6376 I33 2414 IBAR 0212 IECALL 1037 IF 1013 IF1 1035 IF3 1025 IGNOR 0217 ILIST 0771 IN 5513 INBUF 0034 INDEV 0064 INDRCT 6463 INFIX 2401 INLIST 0570 INORM 6307 INPUT 0756 INPUTX 0271 INSUB 0036 INTEGE 0053 INTRPT 2603 IOBUF 3120 IPART 1040 IRETN 0227 ITABLE 6573 ITER1 7470 JUMP 6462 K4 5525 KCF 6030 KINT 2625 L1 5126 L2 5131 L3 5134 L4 5137 L8A 4550 unreferenced L8AX 4553 L8AY 4552 L8B 4551 unreferenced LASTLN 0025 LASTOP 0055 LASTV 0031 LCON 0371 LG2E 4713 LIBRAR 7503 LINENO 0067 LIST3 0077 LIST6 0072 LIST7 0074 LISTGO 1370 LOG2 5157 LOG5 5142 LOG6 5145 LOG7 5150 LOG8 5153 LOOKUP 4571 LOOP01 6431 LORD 0046 LP7 7556 LPRTST 2035 M100 0101 M10PT 6147 M11 0121 M12 2413 M137 2357 M140 2556 M144 6137 M2 0111 M20 0105 M240 0114 M260 1526 M271 1527 M4 6141 M40 2356 M5 0120 M77 0103 MBREAK 2602 MCOM 1136 unreferenced MCR 0116 MD 5526 MEQ 1135 MF 0602 MFLT 0117 MIF 7260 MINE 5662 MINSKI 0051 MINUS2 7153 MINUSA 0112 MINUSE 6301 MINUSZ 5663 MOD 5215 MODIFY 1256 MP1 7254 MP2 7256 MP3 7255 MP4 7200 MP5 7253 MP6 7210 MPER 0115 MPLUS 5664 MSPACE 5665 MULDIV 7101 MULT 6566 MULT10 5667 MULT2 5715 MULTY 4752 NAGSW 0065 NEGP 4724 NORF 6513 NORM 6567 NORMF 7147 NOX 6675 NOX1 6711 NOX2 6704 O1 4370 O2 4561 O4 4412 unreferenced O5 4563 O6 4564 OM12 5530 ONE 4716 OOUT 4544 OP 3115 OPMINS 6565 OPNEXT 1622 OPTABL 1731 OPTR0 2663 OPTRI 2665 OPTRO 2664 OPUT 5532 OUT 2465 OUTA 5536 OUTCR 2476 OUTDEV 0063 OUTDG 6154 OUTL 1354 OUTX 2475 OVER1 0043 OVER2 0047 P13 0005 P17 0107 P177 0106 P2 4566 P2000 0373 P27 6750 P277 0110 P3 2034 P337 0075 P377 2553 P40 2552 P4000 0124 P43 6310 P7 4565 P7600 0104 P77 0122 P7700 0101 P7740 0372 PA1 2524 PACBUF 2502 PACKC 4546 PACKST 0027 PACX 2530 PALG 5261 PARTES 2047 PC 0022 PC1 0614 PCHECK 5245 PCHK 0510 PCK1 2535 PD2 0534 PD3 0554 PDLXR 0013 PDP 4562 PDP5 4570 PDP5X 4463 PDP8I 4567 PEQ 6135 PER 0102 PI 5312 PI2 5036 PIOT 5316 PLCE 5536 POPA 1413 POPF 4544 POPJ 5541 PPTEN 6144 PRINTC 4551 PRINTD 7550 PRNT 2442 PRNT2 3114 PRNT8 7527 PRNTI 6132 PRNTLN 4553 PROC 0611 PROCES 0610 PSIN 0165 PT1 0030 PTCH 0126 PTEN 6275 PTEST 1457 PUSHA 4542 PUSHF 4543 PUSHJ 4540 R6 5441 RANO 1530 RAR1 6571 RAR2 6572 RDIV 0152 READC 4552 RECOVR 2740 RECOVX 2761 REMAIN 5712 REPT 6146 RESOL 6752 RESOL3 7376 RESOL5 6304 RESOLV 7173 RESTR 6377 RET 5452 RETRN 1563 RETURN 5536 REVIT 7146 RFC 6014 RND2 5527 ROOTGO 7461 ROT 2557 ROUND 6151 RTL6 4557 RUB1 3004 RUB2 3042 RUB3 3030 RUB4 3037 RUB5 3041 RUBIT 2555 SADR 6150 SAVAC 2600 SAVE 3751 SAVLK 2601 SBAR 1302 SCHAR 1273 SCONT 1270 SCOUNT 5534 SET 1041 SEX 1340 SEXC 0740 SFOUND 1306 SGOT 1312 SIGN 7124 SIGNF 0050 SIN 2662 SMIN 6136 SMP 6101 SMSP 6134 SORTB 1314 SORTC 4550 SORTCN 0054 SORTJ 4547 SPECIA 6777 SPLAT 3051 SPNOR 4560 SQCON1 7467 SQEND 7465 SRETN 0261 SRNLST 1363 START 0177 STARTL 5064 STARTV 0060 SUBS 1517 T1 0032 T12 4426 T2 0071 T3 0033 TABLE 6464 TAG1 6723 TASK 1204 TASK4 1252 TCRLF 1250 TCRLF2 1245 TDUMP 3052 TELSW 0016 TEM 5156 TEMP 4726 TEN 6271 TENPT 6152 TERMS 1770 TEST2 6736 TEST4 7366 TESTA 0322 TESTC 4564 TESTN 4561 TEXTP 0017 TGO 5400 THIR 7257 THISLN 0023 THISOP 0024 TINTR 1240 TLIST 1400 TLIST2 1404 TLIST3 2377 TQUOT 1231 TRAD 6573 TSTGRP 4563 TSTLPR 4562 TWO 4721 TWOPI 5306 TYPE 1203 TYPE2 1225 UTE 2276 UTQ 2305 UTRA 2274 UTX 2316 VAL 0032 WALL 0664 WORDS 0003 WRITE 0635 WTEST2 0653 WTESTG 0667 WX 0673 X 5322 X1 5035 X2 4675 XABS 2014 XADC 1343 XCT 0020 XCTIN 0062 XDELET 2062 XDYS 1142 unreferenced XENDLN 2360 XF 4560 XFIND 2242 XGETLN 0302 XI33 2666 XIN 6306 XINPUT 5666 XINT 1160 XOUTL 2676 XPOPJ 1565 XPRNT 2425 XPUSHA 0477 XPUSHJ 0521 XRAN 1553 XRAR2 7365 XRT 0011 XRT2 0012 XRTL6 0413 XSGN 2010 XSORTC 0721 XSPNOR 1517 XSQ2 4676 XSQR 5326 XSQRT 7400 XT3 0717 XTESTC 0700 XTESTN 1533 XYZ 2451 ZERO 6520