1 / U/W-FOCAL VERSION 4E FOR 16K 2 / 16KCPR.PA 3 / REVISIONS: 4 / NEW FLAGS CLEARED AT 13112 - 13126 5 6 7 8 / COPYRIGHT (C) 1978 - ALL RIGHTS RESERVED BY 9 / LAB DATA SYSTEMS - SEATTLE, WASHINGTON 98125 10 11 12 13 / **CORE MAP** 14 / (16K VERSION) 15 16 17 18 /FIELD 0: USER AREA, STACK, OS/8 ROUTINES, & I/O BUFFERS 19 20 /FIELD 1: INTERPRETER, FUNCTIONS, FLOATING POINT PACKAGE 21 22 /FIELD 2: PROGRAM TEXT ASCENDING - FCOM AREA COMING DOWN 23 24 /FIELD 3: VARIABLES 25 26 27 28 / ADDITIONAL INSTRUCTION CODES: 29 30 31 FENT=JMS I 7 32 FIXMRI FGET=0000 33 FIXMRI FADD=1000 34 FIXMRI FSUB=2000 35 FIXMRI FDIV=3000 36 FIXMRI FMUL=4000 37 FIXMRI FPWR=5000 38 FIXMRI FPUT=6000 39 FIXMRI FNOR=7000 40 FEXT=0000 41 42 CDI=CDF CIF 43 FIXTAB 44 45 / SPECIAL PSEUDO-OPS FOR CROSS-FIELD CALLS: 46 47 FGETIPT1=FGET I 0 48 FADDIPT1=FADD I 0 49 FMULIPT1=FMUL I 0 50 FPUTIPT1=FPUT I 0 51 52 / ASSEMBLY INSTRUCTIONS USING PAL8-V10: 53 54 / UWF.BN<16KCPR,12KFNS,8KFIO,8KFPP,16KLIB/L/K=100 55 / EAE VERSION: 8XFIO,8XFPP 56 / 57 FIELD 1 /PROCESSOR FIELD 58 PAGE 0 59 60 010000 0134 P134, "\&177 /SCOPE INPUT LIST 61 010001 0207 BELL, "G&277 /MODIFY " " 62 010002 0337 P337, "_ /COMMAND " " 63 010003 0214 CFF, FF 64 010004 0212 CLF, LF 65 010005 0215 CCR, CR 66 010006 0377 TRACE, RO /SEARCH CHAR & TRACE SWITCH 67 010007 6400 FPNT /ADDRESS OF F.P. INTERPRETER 68 69 /AUTO-INDEX REGISTERS 70 71 010010 0000 SAVMQ, 0 /INTERRUPT REGISTERS 72 010011 0000 SAVAC, 0 73 010012 0000 SAVLK, 0 74 010013 3023 PDLXR, PCHK-1 /PUSHDOWN LIST INDEX REGISTER 75 010014 0000 XRT, 0 /FOR POPF, GETARG, DELETE, FINDLN 76 010015 0000 XRT2, 0 /FOR SORTJ, DELETE, FLOATING PT. 77 010016 0000 AXIN, 0 /INPUT (PACKING) POINTER 78 79 TEXTP=. 80 010017 0000 AXOUT, 0 /OUTPUT (UNPACKING) REG. 81 010020 0000 GTEM, 0 /UNPACKING TEMP. STORAGE 82 010021 7643 XCT, RANDOM+1 /UNPACKING SWITCH 83 010022 0100 PC, 100 /PROGRAM (LINE) POINTER 84 85 /PACKING AND STORAGE CONSTANTS 86 87 010023 3023 BOTTOM, PCHK-1 /BEGINNING OF PDL 88 010024 7642 LEVEL0, RANDOM /BEGINNING OF 'FOR' STACK 89 010025 7642 FORLVL, RANDOM /'FOR' LOOP STACK POINTER 90 91 010026 0202 HEADER, LINE0 /BEGINNING OF TEXT BUFFER 92 010027 0221 BUFEND, -7557 /LAST PROGRAM LOCATION 93 010030 0201 TXTEND, -7577 /LAST LOCATION FOR INPUT 94 95 010031 0000 FIRSTV, STVAR /**MASTER LOCATION** 96 010032 7777 SECRTV, STVAR-1 /BEGINNING OF VARIABLES 97 010033 7775 TABEND, -3 /END OF THE SYMBOL TABLE 98 /'E1' FOR 8K, '2200' FOR 12K 99 100 IFNDEF STVAR /'3200' FOR 8K, '2200' FOR 12K 101 102 /MISCELLANEOUS THINGS 103 104 CONTINUE=JMP I . /COMMAND RETURN 105 010034 0755 CONT 106 NORMALIZE=JMS I . /NORMALIZE C(FLAC) 107 010035 7045 NORM 108 010036 6722 ABSOL, ABSOLV /TAKE THE ABSOLUTE VALUE 109 010037 6727 RESOL, RESOLV /RESTORE THE PROPER SIGN 110 /FLOATING POINT REGISTERS (LOC *40) 111 112 010040 0000 SIGN, 0 /FOR ABS VALUE & MUL/DIV 113 010041 0000 T1, 0 /FOR INSTRUCTIONS & F.P.P. 114 010042 0000 T2, 0 /FOR FUNCTIONS & I/O 115 010043 0000 T3, 0 /ARGUMENT SIGN & DEC. EXP. 116 117 FLAC=. 118 010044 0000 EXP, 0 /FLOATING ACCUMULATOR 119 010045 0000 HORD, 0 120 010046 0000 LORD, 0 121 010047 0000 OVER, 0 122 123 FLOP=. 124 010050 0000 EX1, 0 /FLOATING OPERAND 125 010051 0000 AC1H, 0 126 010052 0000 AC1L, 0 127 010053 0000 OVR1, 0 128 129 010054 0000 TELSW, 0 /OUTPUT DONE FLAG 130 010055 0000 INBUF, 0 /INPUT BUFFER (*LOC 55) 131 010056 3007 INDEV, XI33 /POINTER TO INPUT DEVICE 132 010057 3021 OUTDEV, XOUTL /AND OUTPUT DEVICE (TTY) 133 134 010060 0224 BUFR, LINE1 /NEXT LOCATION IN TEXT BUFFER 135 010061 0000 LASTV, STVAR /NEXT LOCATION IN SYMBOL TABLE 136 137 010062 0000 PT1, 0 /VARIABLE POINTER 138 010063 0000 THISOP, 0 /CURRENT OP, FN OR VARIABLE NAME 139 010064 0000 LASTOP, 0 /PREVIOUS ARITHEMETIC OPERATION 140 010065 0000 SORTCN, 0 /RELATIVE POSITION IN A LIST 141 142 010066 0000 CHAR, 0 /THE MOST IMPORTANT REGISTER 143 010067 0000 LINENO, 0 /SET BY 'GETLN' 144 010070 0000 NAGSW, 0 /'NOT ALL' AND/OR 'GROUP' SWITCH 145 010071 0000 LASTC, 0 /FOR 'NEXT', 'ASK', 'ON' & FSF'S 146 010072 0000 FISW, 0 /CODED OUTPUT FORMAT 147 148 THISLN= THISOP /NOT USED SIMULTANEOUSLY 149 LASTLN= LASTOP 150 /CONSTANTS USEFUL THROUGHOUT FOCAL: 151 152 010073 0007 P7, 7 /FOR 'FPOW' AND DIGIT MASK 153 010074 0013 P13, 13 /FOR FLOAT AND PDLXR POINTER 154 010075 0177 P177, 177 /STEP MASK & POINTER 155 010076 0043 P43, 43 /35 BITS 156 010077 0077 P77, 77 /RIGHT MASK 157 010100 0100 C100, 100 /CHARACTER TESTS & PC0 158 010101 0017 P17, 17 /BCD MASK AND CONSTANT 159 010102 0200 C200, 200 /TEST CONSTANT & POINTER 160 010103 0240 C240, 240 /SPACE 161 010104 7600 P7600, 7600 /GROUP MASK & FLARG POINTER 162 FLARGP= P7600 /TEMPORARY STORAGE FOR 'EVAL' 163 164 010105 7774 M4, -4 /FOR 'GETARG', 'FPOW', & 'FRAN' 165 010106 7773 M5, -5 /FOR 'PRINTN', 'QUIT', ' 'FSQT' 166 010107 7764 M14, -14 /FOR 'LPRTST', 'TESTN' 167 010110 7563 MCR, -CR /FOR 'WRITE','IF','DELETE','PRINTC' 168 010111 6522 FP1, FLTONE /FOR 'FLOG', 'FSIN', 'Y' & 'DBLSUB' 169 010112 0006 GINC, WORDS+2 /FOR 'GETARG', 'TDUMP' & 'FSF'S 170 171 *.+5 /FOR USER CONSTANTS 172 173 174 /TEMPORARY STORAGE HAS ALL BEEN PLACED ON THE LAST 175 /PAGE USING THE COMMAND DECODER AREA FROM 7600-7646. 176 177 FLARG= 7600 /TEMPORARY FOR 'EVAL' 178 NEXTP= 7604 /TEXT POINTERS FOR 'NEXT' & 'BREAK' 179 BUFFER= 7610 /TEMPORARY FOR FUNCTIONS & OUTPUT 180 RANDOM= 7642 /UPPER LIMIT FOR STACK POINTERS 181 182 /SYMBOLS USEFUL THROUGHOUT FOCAL: 183 184 WORDS=4 /HURRAY! 185 DIGITS=12 186 187 L=00 /DATA FIELD FOR LIBRARY 188 V=30 /DATA FIELD FOR VARIABLES 189 S=00 /DATA FIELD FOR THE STACK 190 P=10 /DATA FIELD FOR PROCESSOR 191 T=20 /DATA FIELD FOR THE TEXT 192 193 LF=212 194 FF=214 195 CR=215 196 SP=240 197 RO=377 198 /NEW INSTRUCTIONS: 199 200 PUSHA= JMS I . /SAVE THE AC ON THE STACK 201 010120 1333 XPUSHA 202 POPA= JMS I . /UNLOAD THE STACK 203 010121 1343 XPOPA 204 PUSHJ= JMS I . /CALL A SUBROUTINE 205 010122 1325 XPUSHJ 206 POPJ= JMP I . /RETURN FROM A SUBROUTINE 207 010123 1337 XPOPJ 208 PUSHF= JMS I . /SAVE 4 WORDS 209 010124 1350 XPUSHF 210 POPF= JMS I . /RESTORE THEM 211 010125 1356 XPOPF 212 SORTJ= JMS I . /SORT AND BRANCH ON AC OR CHAR 213 010126 2605 SORTB 214 SORTX= JMS I . /LOOK FOR SP, COMMA, SEMI, CR 215 010127 2337 XSORT 216 TESTC= JMS I . /TEST FOR TERM, FN, NO., OR VAR. 217 010130 2035 CTEST 218 TESTX= JMS I . /TEST FOR TERM AND SET SORTCN 219 010131 2053 XTEST 220 TESTN= JMS I . /TEST FOR PERIOD, NUMBER 221 010132 2117 NTEST 222 READC= JMS I . /READ & ECHO A CHARACTER (AC=0) 223 ECHOC= JMS I . /PRINT C(AC) WHEN ECHO IS ENABLED 224 010133 6262 CHIN 225 PRINTC= JMS I . /PRINT C(AC) OR 'CHAR' (IF AC = 0) 226 010134 6277 CHOUT 227 PRINTD= JMS I . /PRINT A SINGLE DIGIT FROM THE AC 228 010135 6066 OUTDG 229 READN= JMS I . /USE 'FETCH' TO INPUT A NUMBER 230 010136 5400 FLINTP 231 PRINTN= JMS I . /CONVERT BINARY TO ASCII & PRINT 232 010137 6001 ATSW, FLOUTP /FOR 'ASK', 'TYPE', 'FBLK' & 'FRA' 233 PACKC= JMS I . /PACK A CHARACTER 234 010140 2423 PACBUF 235 GETC= JMS I . /UNPACK A CHARACTER 236 010141 2236 BKSW, UTRA /'BREAK' SWITCH 237 SPNOR= JMS I . /IGNORE LEADING SPACES 238 010142 2275 XSPNOR 239 TSTCMA= JMS I . /SKIP IF CHAR=COMMA & MOVE PAST IT 240 010143 0763 CMATST 241 TESTCR= JMS I . /SKIP IF CHAR = CR 242 010144 0641 CRTEST 243 GETLN= JMS I . /COMPUTE A LINE NUMBER (RECURSIVE) 244 010145 0312 XGETLN 245 FINDLN= JMS I . /SEARCH TEXT FOR A GIVEN LINE 246 010146 1145 XFIND 247 PRNTLN= JMS I . /PRINT LINE NUMBER 248 010147 2317 DMPSW, XPRNT /TRACE DISABLE SWITCH 249 DELETE= JMS I . /REMOVE A LINE AND 250 010150 2721 PACEND, XDELETE /RECOVER THE SPACE 251 DCAIAXIN=JMS I . /'DCA I AXIN' IN FIELD T 252 010151 1320 AXIND 253 /FLOATING POINT PSEUDO INSTRUCTIONS: 254 255 FLOAT= JMS I . /FLOAT THE AC 256 010152 5503 FIGO6 257 FLOATR= JMP I . /FLOAT THE AC AND RETURN 258 010153 7446 FIN+2 259 FL0ATR= JMP I . /UNSIGNED FLOAT & RETURN 260 010154 2021 FL0AT 261 RETURN= JMP I . /REGULAR FUNCTION RETURNS 262 010155 2026 FINISH, EFUN3 263 SHIFTL= JMS I . /MULTIPLY FLAC BY 2 264 010156 6231 MULT2 265 NEGATE= JMS I . /COMPLEMENT AND INCREMENT FLAC 266 010157 6734 INVERT 267 FIXIT= JMS I . /CONVERT FLAC TO A 24-BIT INTEGER 268 010160 7260 INTEGER 269 MULT10= JMS I . /MULTIPLY FLAC BY TEN & ADD THE AC 270 010161 6204 XTEN 271 CHKSGN= JMS I . /TAKE ABSOLUTE VALUE + CHECK FOR 0 272 010162 5303 SGNCHK 273 RTL6= JMS I . /ROTATE THE AC LEFT 6 274 010163 2014 BETA, XRTL6 /FOR THE PDP12 OVERLAY 275 276 *.+4 /PATCH AREA 277 278 PRODUCT=. /FOR SOFTWARE MULTIPLY 279 280 *176 281 ERROR2= JMS I . /FIELD 1 ERROR 282 010176 2554 TABCNT, ERROR /ENTRY POINT IS THE TAB COUNTER 283 284 /DEFINE SOME MICROCODED INSTRUCTIONS: 285 286 SP1= CLA STL RAL 287 SP2= CLA STL RTL 288 SM0= CLA STL RAR 289 SM1= CMA STL RAL /NO CLA 290 SM2= STA CLL RAL 291 SM3= STA CLL RTL 292 293 I0N= ION /MAKE THESE EASY TO CHANGE 294 I0F= IOF /OR 'NOP' 295 / COMMAND PROCESSOR FOR VERSION 4 296 297 *177 298 START=. /PROGRAM SELF-START (=7610) 299 010177 7610 BUFFPT, SKP CLA /OUTPUT BUFFER IS AT 17610. 300 010200 5652 JMP I "* /CONSOLE START (FROM 10200) 301 010201 1200 TAD .-1 /ANNOUNCE PRESENCE 302 010202 4533 ECHOC /(DON'T PRINT IF THE ECHO IS OFF) 303 010203 1023 TAD BOTTOM 304 010204 3013 DCA PDLXR /RESET THE STACK POINTERS 305 010205 1024 TAD LEVEL0 306 010206 3025 DCA FORLVL 307 010207 1030 TAD TXTEND /SET THE INPUT LIMIT 308 010210 3550 DCA I PACEND 309 010211 1100 TAD C100 /SET PC FOR COMMAND MODE 310 010212 3022 DCA PC 311 010213 3043 IBAR, DCA T3 /RESET THE PACKING SWITCH 312 313 *FF /RETURN FROM LINEFEED 314 010214 1060 TAD BUFR /INITIALIZE THE BUFFER POINTER 315 010215 3016 DCA AXIN /=*CR 316 010216 3006 DCA TRACE /TURN OFF THE TRACE 317 010217 3547 DCA I DMPSW /BUT ENABLE THE TRAP 318 319 010220 4533 IGNOR, READC /READ THE COMMAND STRING 320 010221 4526 SORTJ 321 010222 0001 P337-1 322 010223 0224 INLIST-P337 323 010224 4540 PACKC /SAVE EACH LITTLE CHARACTER 324 010225 5220 JMP IGNOR 325 ///// 326 327 010226 0213 INLIST, IBAR /B.A. = RESTART 328 010227 0220 IGNOR /F.F. = IGNORE 329 010230 6175 LNFEED /L.F. = RETYPE 330 010231 0232 IRETN /C.R. = TERMINATE 331 ///// 332 333 010232 4540 IRETN, PACKC /PACK THE CR 334 010233 4540 PACKC /BE SURE ITS ALL THERE 335 010234 1027 TAD BUFEND 336 010235 3550 DCA I PACEND /SET REPACKING LIMIT 337 010236 1060 TAD BUFR /INITIALIZE 'TEXTP' 338 ///// 339 340 /TEXT BUFFER FORMAT: 341 342 /#1 : POINTER OR ZERO IN LAST 343 /#2 : LINENO 344 /#3 - #N-1 : TEXT 345 /#N : CR (=7715) 346 /IMMEDIATE AND SEQUENTIAL COMMAND EXECUTION: 347 348 010237 3017 NEXTLN, DCA AXOUT /SET LINE POINTERS 349 010240 3021 DCA XCT 350 010241 4541 GETC /READ FIRST CHARACTER 351 010242 4542 SPNOR /IGNORE LEADING BLANKS 352 010243 4532 TESTN /DOES THE LINE BEGIN WITH 0-9? 353 010244 7410 SKP /PERIOD: ALLOW GROUP ZERO 354 010245 5300 JMP INPUTX /NO, ITS A DIRECT COMMAND 355 010246 2547 ISZ I DMPSW /YES, KILL TRACE TO PROTECT '?' 356 010247 4545 GETLN /READ THE LINE NUMBER 357 010250 4771 JMS I MODIFY+2 /INITIALIZE THE NEW LINE 358 010251 5256 JMP SRETN /REPACK THE FIRST CHARACTER 359 360 *"* /FOR 'LINEFEED' 361 010252 3144 M20-1 /MANUAL RESTART 362 010253 4534 ECHOFF, PRINTC /ECHO FF TO CLEAR THE SCREEN 363 010254 5220 JMP IGNOR /(FOR THE SCOPE VERSIONS) 364 365 010255 4541 GETC /GET THE NEXT CHARACTER 366 010256 4540 SRETN, PACKC /REPACK 367 010257 4544 TESTCR /TEST FOR THE END OF LINE 368 010260 5255 JMP .-3 369 010261 4540 PACKC /FINISH THE CR 370 371 010262 4550 DELETE /REMOVE THE OLD LINE, IF ANY 372 010263 6221 CDF T 373 010264 1464 TAD I LASTLN /INSERT NEW ONE 374 010265 3460 DCA I BUFR 375 010266 1060 TAD BUFR 376 010267 3464 DCA I LASTLN 377 010270 1043 TAD T3 /-1 IF CR NEEDED 2ND WORD 378 010271 7041 CIA 379 010272 1016 TAD AXIN /COMPUTE NEW END-OF-BUFFER 380 010273 3060 DCA BUFR 381 010274 6203 CDI L 382 010275 3477 DCA I P77 /SET 'PROGRAM MODIFIED' FLAG 383 010276 5100 JMP 100 /TURN ON INTERRUPTS & RESTART 384 ///// 385 *"? /FOR 'QUIT' VIA 'PACLST' 386 010277 1106 TAD M5 /CREATES 'PUSHJ;GOTO+1' 387 010300 4522 INPUTX, PUSHJ /PROCESS THE IMMEDIATE COMMAND 388 010301 0616 PROC 389 010302 6221 CDF T 390 010303 1422 TAD I PC 391 010304 7450 SNA /END OF THE PROGRAM? 392 010305 5177 JMP START /YES 393 010306 3022 DCA PC /SAVE THE NEW LINE POINTER 394 010307 1022 TAD PC 395 010310 7001 IAC /ADVANCE TO THE LINENO 396 010311 5237 JMP NEXTLN /AND CONTINUE PROCESSING 397 /LINE NUMBER EVALUATION: 'GETLN' 398 399 010312 0000 XGETLN, 0 /NOW HANDLES NEGATIVE NUMBERS 400 010313 1312 TAD .-1 / AND PERMITS RECURSIVE CALLS 401 010314 4520 PUSHA 402 010315 4522 PUSHJ /EVALUATE THE ARGUMENT 403 010316 1610 EVAL 404 010317 1044 MODEPT, TAD EXP /MODIFY AND FSF ENTRY POINT 405 010320 1106 TAD M5 406 010321 7740 SMA SZA CLA /.GT. 31? 407 010322 4576 ERROR2 408 010323 1022 TAD PC /POINT TO THE CURRENT LINE 409 010324 3014 DCA XRT 410 010325 7164 TYPEPT, SM1 /TFRMT ENTRY POINT 411 010326 3070 DCA NAGSW /SET NAGSW FOR 'ALL' 412 010327 4562 CHKSGN /TAKE THE ABSOLUTE VALUE 413 010330 5356 JMP ALL /ZERO=ALL, L=1 FROM 'FPUT' 414 010331 7740 SMA SZA CLA /CHECK THE ORIGINAL SIGN 415 010332 3070 DCA NAGSW /CLEAR SWITCH IF POSITIVE 416 010333 4560 FIXIT /GET THE GROUP NUMBER 417 010334 4563 RTL6 /SHIFT INTO PLACE ('BSW') 418 010335 7104 CLL RAL 419 010336 6221 CDF T /SHIFT TO TEXT BUFFER 420 010337 7450 SNA /RELATIVE ADDRESSING? 421 010340 1414 TAD I XRT /YES, USE CURRENT GROUP 422 010341 0104 AND P7600 423 010342 3067 DCA LINENO /SAVE GROUP NUMBER 424 010343 4557 NEGATE 425 010344 4407 FENT /RESETS D.F. 426 010345 1504 FADD I FLARGP /SUBTRACT THE GROUP NUMBER 427 010346 4360 FMUL FL100 /SHIFT THE DECIMAL POINT 428 010347 1363 FADD FLP5 /ROUND OFF THE RESULT 429 010350 0000 FEXT 430 010351 4560 FIXIT /LEAVES L=0 431 010352 2070 ISZ NAGSW /FORCE ZERO FOR NEG LINENO 432 010353 3070 DCA NAGSW /SET 'NOT-ALL/GROUP SWITCH' 433 010354 1070 TAD NAGSW /AC = LINENO IF WE SKIPPED 434 010355 1067 TAD LINENO /COMBINE LINE & GROUP NUMBERS 435 010356 3067 ALL, DCA LINENO 436 010357 5523 POPJ /LINK=1 IF ALL (SET BY CHKSGN) 437 438 010360 0007 FL100, 7;3100;0 /CONSTANTS FOR 'GETLN' 010361 3100 010362 0000 439 010363 0000 FLP5, 0;2000;ZBLOCK 2 / ALSO USED BY 'FSQT' 010364 2000 010365 0000 010366 0000 440 441 /LINE NUMBERS MAY RANGE FROM 0 TO +- 31.99 442 /NEGATIVE NUMBERS FORCE THE 'GROUP' SWITCH. 443 444 / NAGSW: 445 /ALL= 7777(1) 446 /GROUP= 0000(0) 447 /LINE= 0XXX(0) 448 /'MODIFY' AND 'MOVE' COMMANDS DIFFER ONLY IN THAT 'MOVE' 449 /HAS A SECOND LINE NUMBER (SEPARATED BY A COMMA) WHICH 450 /BECOMES THE LINENO OF THE CORRECTED LINE. THE OLD LINE 451 /REMAINS UNCHANGED IN THIS CASE. 452 453 010367 4545 MODIFY, GETLN /READ THE FIRST LINENO 454 010370 4543 TSTCMA /PASS THE COMMA IF THERE IS ONE 455 010371 0434 INITLN /'NOP' 456 010372 4522 PUSHJ /OTHERWISE 'EVAL' GIVES ZERO 457 010373 1610 EVAL 458 010374 4546 FINDLN /LOOK UP THE OLD LINE 459 010375 4576 ERROR2 /NOT THERE 460 010376 1045 TAD HORD /TEST SECOND ARGUMENT 461 010377 7640 SZA CLA /NEW LINENO? 462 010400 4522 PUSHJ /YES: 'MOVE' AS WELL AS 'MODIFY' 463 010401 0317 MODEPT /.LT. 1000 SO WE CAN DO THIS 464 010402 4547 MODLN, PRNTLN /'NOP' TO OMIT THE NUMBER 465 ///// 466 010403 4234 JMS INITLN /SAVE LINENO 467 010404 4456 SCONT, JMS I INDEV /GET SEARCH CHARACTER (SILENTLY) 468 010405 3006 DCA TRACE 469 010406 4541 SCHAR, GETC /PLAYBACK TEXT 470 010407 1066 TAD CHAR 471 010410 4533 ECHOC /ALLOW SILENT EDITING 472 010411 4526 SORTJ /LOOK FOR A MATCH 473 010412 0004 CCR-1 474 010413 0425 LISTGO-CCR 475 010414 4540 PACKC /SAVE THE NEW LINE 476 010415 5206 JMP SCHAR 477 ///// 478 010416 4234 SBAR, JMS INITLN /RESTART AFTER A '_' 479 010417 4533 SFOUND, READC /READ FROM KEYBOARD 480 010420 4526 SORTJ /AND TEST 481 010421 0000 BELL-1 482 010422 0425 SRNLST-BELL 483 010423 7324 SGOT, SP1 /PROTECT LINENO FROM RUBOUTS 484 010424 4540 PACKC /PACK CHAR 485 010425 5217 JMP SFOUND /MORE 486 ///// 487 010426 0404 SRNLST, SCONT /BELL = CHANGE SEARCH CHARACTER 488 010427 0416 SBAR /B.A. = DELETE LINE TO THE LEFT 489 010430 0406 SCHAR /F.F. = LOOK FOR NEXT OCCURANCE 490 010431 0405 SCONT+1 /L.F. = FINISH THE LINE AS BEFORE 491 010432 0256 LISTGO, SRETN /C.R. = END THE LINE RIGHT HERE 492 010433 0423 SGOT /CHAR = STOP ON SEARCH CHARACTER 493 ///// 494 495 010434 0000 INITLN, ZBLOCK 2 /INITIALIZE A NEW LINE 010435 0000 496 010436 3043 DCA T3 497 010437 1060 TAD BUFR /RESET INPUT POINTERS 498 010440 3016 DCA AXIN 499 010441 1067 TAD LINENO /PACK LINENO 500 010442 4551 DCAIAXIN 501 010443 2547 ISZ I DMPSW /KILL THE TRACE 502 010444 5634 JMP I INITLN /USED BY MODIFY, ERASE AND INPUT 503 /OUTPUT THE INDIRECT PROGRAM 504 505 010445 4521 WEND, POPA /RESTORE TEXT POINTERS 506 010446 3066 DCA CHAR 507 010447 4525 POPF 508 010450 0017 TEXTP 509 010451 3547 DCA I DMPSW /RESTORE TRACE 510 010452 4543 TSTCMA /CHECK FOR MULTIPLE LISTING 511 010453 5434 CONTINUE 512 010454 1005 TAD CCR 513 010455 4534 PRINTC /SEPARATE MULTIPLE CALLS 514 ///// 515 010456 4545 WRITE, GETLN /SET LINENO 516 010457 4524 PUSHF /SAVE TEXT POSITION 517 010460 0017 TEXTP 518 010461 1066 TAD CHAR 519 010462 4520 PUSHA 520 010463 4546 WCONT, FINDLN /SEARCH FOR LINE NUMBER 521 010464 5273 JMP WTESTG /NOT THERE OR GROUP 522 010465 4547 PRNTLN /ALSO DISABLES THE TRACE 523 010466 4541 GETC 524 010467 4534 PRINTC /PRINT A LINE OF TEXT 525 010470 4544 TESTCR /SKIP AT THE END 526 010471 5266 JMP .-3 527 010472 1063 TAD THISLN /POINT TO THE NEXT LINE 528 010473 4341 WTESTG, JMS GRPCHK /CHECK ITS VALIDITY 529 010474 5245 JMP WEND /LAST ONE OR ONLY ONE 530 010475 1064 TAD LASTLN /STILL IN THE GROUP? 531 010476 7640 SZA CLA 532 010477 4534 PRINTC /SEPARATE GROUPS 533 010500 5263 JMP WCONT /RETURN TO LOOP 534 535 /DELETE SINGLE LINES, GROUPS OR EVERYTHING 536 537 010501 4545 ERASE, GETLN /WHICH SHALL IT BE? 538 010502 7430 SZL /ALL? 539 010503 5313 JMP ERA /YES 540 010504 4234 JMS INITLN /SET MEMORY PROTECTION 541 010505 4550 ERG, DELETE /REMOVE A SINGLE LINE 542 010506 1064 TAD LASTLN /WATCH OUT FOR THE END 543 010507 4341 JMS GRPCHK /CHECK IF NEXT LINE IS OK 544 010510 5317 JMP ERX /DONE: CLEAR PROGRAM FLAG 545 010511 5305 JMP ERG /DELETE SOME MORE 546 ///// 547 010512 0224 LINE1 548 010513 1312 ERA, TAD .-1 /RESET THE COMMAND BUFFER 549 010514 3060 DCA BUFR 550 010515 6221 CDF T /PUT ZERO IN THE FIRST LINE 551 010516 3426 DCA I HEADER 552 010517 6203 ERX, CDI L /AND REMOVE THE PROGRAM NAME 553 010520 5020 JMP NONAME 554 /CLEAR THE SYMBOL TABLE AND/OR SELECTED VARIABLES 555 556 010521 4530 ZERO, TESTC /CHECK FOR AN ARGUMENT 557 010522 5336 JMP ZALL /NO ARG = ALL VARIABLES 558 010523 4541 GETC /F (SLIGHT FUDGE) 559 010524 4542 SPNOR /N (ALSO ILLEGAL) 560 010525 4526 SORTJ /L VARIABLE NAME 561 010526 1271 ZLIST-1 562 010527 7763 ZGO-ZLIST 563 010530 4522 PUSHJ /NOT A TERMINATOR 564 010531 1400 GETARG /SO IT MUST BE A NAME 565 010532 2015 ISZ XRT2 /ADVANCE DATA POINTER 566 010533 4522 PUSHJ 567 010534 1521 ZFOUND /THEN ZAP IT 568 010535 5324 JMP ZERO+3 569 570 010536 1031 ZALL, TAD FIRSTV /RESET THE TABLE 571 010537 3061 DCA LASTV 572 010540 5325 JMP ZERO+4 /E.G. Z,A,B,C... 573 ///// 574 575 576 010541 0000 GRPCHK, 0 /FOR REPEATED OPERATIONS 577 010542 6221 CDF T /TEXT BUFFER 578 010543 7450 SNA /AC = POINTER TO NEXT 579 010544 5352 JMP .+6 /FIRST LINE IN A GROUP 580 010545 3234 DCA INITLN /SAVE POINTER 581 010546 1634 TAD I INITLN /'THISLN', 'LASTLN', 'PC' 582 010547 7450 SNA /END OF TEXT BUFFER? 583 010550 5372 JMP GRPXIT+1 /YES 584 010551 3063 DCA THISLN /SAVE NEW POINTER 585 010552 1070 TAD NAGSW /CHECK THE TYPE OF OPERATION 586 010553 7540 SMA SZA /FIRST EXIT = SINGLE OR E.O.G. 587 010554 5371 JMP GRPXIT /ALSO SERVES FOR END-OF-TEXT 588 010555 3064 DCA LASTLN /SAVE A COPY OF NAGSW 589 010556 2063 ISZ THISLN /POINT TO LINE NUMBER 590 010557 1463 TAD I THISLN 591 010560 0104 AND P7600 592 010561 7041 CIA 593 010562 1067 TAD LINENO /COMPARE WITH CURRENT 594 010563 0104 AND P7600 595 010564 2064 ISZ LASTLN /FORCE 2ND EXIT FOR 'ALL' 596 010565 7650 SNA CLA 597 010566 2341 ISZ GRPCHK /SECOND EXIT = KEEP GOING 598 010567 3064 DCA LASTLN /NON-ZERO = 'ALL' BUT N.I.G. 599 010570 1463 TAD I THISLN 600 010571 3067 GRPXIT, DCA LINENO /UPDATE THE LINE NUMBER 601 010572 6211 CDF P 602 010573 5741 JMP I GRPCHK 603 ///// 604 / THE IMPROVED 'RETURN' COMMAND PERMITS AN OPTIONAL LINE 605 /NUMBER WHICH WILL TRANSFER TO THAT LINE RATHER THAN RE- 606 /TURNING TO THE CALL. A VERY USEFUL FEATURE! 607 608 010574 4524 RETRN, PUSHF /SAVE FSF RESULTS 609 010575 7600 FLARG 610 010576 4545 GETLN /CHECK FOR A LINENO 611 010577 1067 TAD LINENO /SAVE IT 612 010600 3063 DCA THISLN 613 010601 1100 TAD C100 /POINT TO PC0 614 010602 3022 DCA PC 615 010603 7070 CML CMA RAR / 3777 OR 7777 616 010604 3064 DCA LASTLN /SET RETURN FLAG 617 010605 4525 POPF /RESTORE FSF 618 010606 7600 FLARG /'CLA' 619 010607 5523 POPJ /GO BACK A LEVEL 620 621 /PRIMARY CONTROL AND TRANSFER 622 623 010610 4545 GOTO, GETLN /READ THE LINE NUMBER REQUESTED 624 010611 4546 FINDLN /LOCATE IT AND RESET TEXTP 625 010612 4576 ERROR2 /NOT THERE - 'NOP' TO USE NEXT! 626 010613 1063 TAD THISLN /SET THE PC 627 010614 3022 DCA PC 628 629 010615 4541 GETC /TEST FOR THE END OF THE LINE 630 010616 1066 PROC, TAD CHAR 631 010617 0002 AND P337 /EXECUTE LOWER CASE TOO! 632 010620 3071 DCA LASTC /SAVE COMMAND & CLEAR A FLAG 633 010621 4527 SORTX /CHECK FOR SP, COMMA, SEMI, CR 634 010622 5226 JMP PC1+1 /NONE OF THE ABOVE 635 010623 4241 JMS CRTEST /CR? 636 010624 5215 JMP PROC-1 /IGNORE SPACES, COMMAS, SEMIS 637 010625 5721 PC1, JMP I COMGO-1 /EXIT AT THE END OF A LINE 638 639 010626 4541 GETC /SKIP TO END OF THE COMMAND 640 010627 4527 SORTX 641 010630 5226 JMP .-2 642 010631 1071 TAD LASTC /RECALL COMMAND LETTER 643 010632 1377 TAD (-"Z-1 644 010633 7121 STL IAC 645 010634 1376 TAD ("Z-"? 646 010635 7470 SZL SNA /IS IT @-Z? 647 010636 4576 CERR, ERROR2 /ILLEGAL COMMAND 648 010637 1225 TAD PC1 649 010640 3241 DCA .+1 /EXECUTE AN INDIRECT JUMP 650 ///// 651 652 010641 0000 CRTEST, 0 /SKIP IF CHAR IS A CR: 'TESTCR' 653 010642 1066 TAD CHAR 654 010643 1110 TAD MCR 655 010644 7650 SNA CLA 656 010645 2241 ISZ CRTEST 657 010646 5641 JMP I CRTEST 658 /RECURSIVE OPERATE, EXECUTE, OR CALL 659 660 010647 1104 LGOSUB, TAD P7600 /GET RETURN FLAG 661 010650 5261 JMP DO+1 /EXECUTE THE SUBROUTINE 662 010651 4542 LCMNDS, SPNOR /'L' COMMAND ENTRY POINT 663 010652 6202 CIF L 664 010653 5407 JMP I FENT&177 /SAME ADDRESS AS THE FPP 665 ///// 666 667 010654 7440 DOXIT, SZA /CHECK FOR 'DO' OR 'GOSUB' 668 010655 5252 JMP LCMNDS+1 /RETURN TO CALLING PROGRAM 669 010656 4543 TSTCMA /CHECK FOR ADDITIONAL CALLS 670 010657 5434 CONTINUE /NONE: PROCESS NEXT COMMAND 671 ///// 672 010660 4545 DO, GETLN /EXECUTE A LINE, GROUP, OR ALL 673 010661 3065 DCA SORTCN /ENTRY POINT FOR GOSUB 674 010662 4524 PUSHF /ENTRY POINT FOR FSF'S 675 010663 0017 TEXTP /SAVE TEXT POINTERS 676 ///// 677 010664 4524 DOGRP, PUSHF /SAVE SORTCN, CHAR, LINENO, NAGSW 678 010665 0065 SORTCN 679 010666 4546 FINDLN /FIND THE OBJECT LINE 680 010667 5316 JMP DOERR /NOT THERE: DO WE CARE? 681 010670 4522 PUSHJ /EXECUTE A SINGLE LINE 682 010671 0613 GOTO+3 683 010672 4525 POPF /RESTORE THE DATA 684 010673 0065 SORTCN 685 010674 1022 TAD PC /CHECK THE NEXT LINE 686 010675 4775 JMS I (GRPCHK /SHOULD WE EXECUTE IT? 687 010676 5300 JMP DORTN /ALL DONE 688 010677 5264 JMP DOGRP /CONTINUE SUBROUTINE 689 ///// 690 010700 4525 DORTN, POPF /RESTORE TEXT POINTERS 691 010701 0017 TEXTP 692 010702 1065 TAD SORTCN /CHECK RETURN FLAG 693 010703 7540 SMA SZA 694 010704 5206 JMP GOTO-2 /FSF RETURN ('CLA;POPJ') 695 010705 2064 ISZ LASTLN /CHECK RETURN OPTION 696 010706 5254 JMP DOXIT /NONE, RETURN TO CALL 697 010707 7640 SZA CLA /GOSUB? 698 010710 4525 POPF /YES, DUMP PROGRAM INFO 699 010711 0050 FLOP /OTHERWISE 'NOP' 700 010712 1063 TAD THISLN 701 010713 3067 DCA LINENO /GET THE LINE NUMBER 702 010714 5211 JMP GOTO+1 /AND GO SOMEWHERE ELSE 703 ///// 704 010715 2554 ERROR /PATCHED BY PROGRAM INTERRUPT 705 010716 4775 DOERR, JMS I (GRPCHK /TEST FOR A GOOD LINE OR GROUP 706 010717 4715 JMS I .-2 /SORRY 707 010720 5266 JMP DOGRP+2 /OK- GET THE FIRST LINE 708 ///// 709 /COMMAND BRANCH TABLE: NINE NEW COMMANDS ARE AVAILABLE 710 711 010721 1337 XPOPJ /STARTS THE TABLE 712 010722 0636 COMGO, CERR /@ INDIRECT 713 010723 1233 ASK /A 714 010724 1130 BREAK /B 715 010725 0625 PC1 /C 716 010726 0660 DO /D 717 010727 0501 ERASE /E 718 010730 1000 FOR /F 719 010731 0610 GOTO /G 720 010732 4460 HESI /H HESITATE 721 010733 1557 IF /I 722 010734 2574 JUMP /J 723 010735 0636 CERR /K KONTROL 724 010736 0651 LCMNDS /L 725 010737 0367 MODIFY /M 726 010740 1132 NEXT /N 727 010741 1542 ON /O 728 010742 0636 CERR /P PLOT 729 010743 2535 QUIT /Q 730 010744 0574 RETRN /R 731 010745 1174 SET /S 732 010746 1234 TYPE /T 733 010747 0636 CERR /U USER 734 010750 0636 CERR /V VIEW 735 010751 0456 WRITE /W 736 010752 1174 SET /X XECUTE 737 010753 7420 YNCR /Y YNCREMENT 738 010754 0521 ZERO /Z 739 ///// 740 741 010755 7610 CONT, SKP CLA /COMMAND RETURN - 'CONTINUE' 742 010756 4541 GETC 743 010757 4526 SORTJ /SEARCH FOR A ';' OR A C.R. 744 010760 1273 ILIST-1 745 010761 7763 IGO-ILIST 746 010762 5356 JMP CONT+1 747 ///// 748 749 010763 0000 CMATST, 0 /TEST FOR A COMMA: 'TSTCMA' 750 010764 7200 CLA 751 010765 1066 TAD CHAR 752 010766 1374 TAD (-", 753 010767 7640 SZA CLA 754 010770 5763 JMP I CMATST /FIRST RETURN IF IT'S NOT 755 010771 4541 GETC 756 010772 2363 ISZ CMATST 757 010773 5763 JMP I CMATST /REMOVE IT AND TAKE 2ND RTN 758 ///// 759 010774 7524 PAGE 4 010775 0541 010776 0033 010777 7445 760 011000 4522 FOR, PUSHJ /LOOP CONTROL BEGINS WITH 'SET' 761 011001 1610 EVAL 762 011002 4526 SORTJ /TEST LAST CHAR FROM 'EVAL' 763 011003 1272 TLIST-1 764 011004 7763 FGO-TLIST 765 011005 5200 JMP FOR /ALLOW SPACES BUT DON'T ADVERTISE 766 011006 7503 MEQ, -"= 767 768 /'EVAL' FOUND A REPLACEMENT OPERATOR (=): STACK THE 769 / LAST OPERATION AND LOCK THE VARIABLE IN POSITION. 770 771 *TAD FENT&177 /WIERD! 772 011007 0000 EQLS, 0 /PLACED HERE TO SAVE A WORD 773 011010 1066 TAD CHAR 774 011011 1206 TAD MEQ 775 011012 7640 SZA CLA 776 011013 5607 JMP I EQLS 777 011014 6231 CDF V /SOLVE THE 'ZVR' PROBLEM! 778 011015 1415 TAD I XRT2 779 011016 7650 SNA CLA 780 011017 7040 CMA /PROTECT ZERO VARIABLES 781 011020 1462 TAD I PT1 782 011021 3462 DCA I PT1 783 011022 1064 TAD LASTOP /STACK CURRENT OPERATOR 784 011023 4520 PUSHA 785 011024 1062 TAD PT1 786 011025 4520 PUSHA /SAVE POINTER TO VARIABLE 787 011026 7324 SP1 788 011027 5652 JMP I FCONT-1 /SET 'LASTOP' TO 1 FOR '=' 789 ///// 790 791 011030 4541 FINCR, GETC /SKIP THE COMMA THAT GOT US HERE 792 011031 1071 TAD LASTC /IS IT 'SET' OR 'FOR' ? 793 011032 7650 SNA CLA 794 011033 5200 JMP FOR /'SET I=1,N=2' 795 011034 1062 TAD PT1 /'FOR I=1,N' 796 011035 4520 PUSHA /RESAVE THE VARIABLE POINTER 797 011036 4522 PUSHJ /EVALUATE THE INCREMENT 798 011037 1610 EVAL 799 011040 4526 SORTJ /TEST THE NEW TERMINATOR 800 011041 1273 ILIST-1 801 011042 0660 FLIST-ILIST 802 011043 4576 ERROR2 /ILLEGAL TERMINATOR IN 'FOR' 803 ///// 804 805 011044 4524 FINFIN, PUSHF /STANDARD INCREMENT 806 011045 6522 FLTONE 807 011046 5253 JMP FCONT 808 809 011047 4524 FLIMIT, PUSHF /SAVE THE INCREMENT; GET THE LIMIT 810 011050 0044 FLAC 811 011051 4522 PUSHJ /(NO ERROR DETECTION AFTER LIMIT) 812 011052 1605 EVAL-3 813 011053 4524 FCONT, PUSHF /SAVE THE LIMIT 814 011054 0044 FLAC 815 /THE POINTER TO THE TOP OF THE STACK IS SAVED EACH TIME. 816 /THIS PERMITS 'BREAKS' WHICH CUT THROUGH ALL INTERVENING 817 /SUBROUTINE CALLS. THE LEVEL POINTERS ARE STACKED FROM 818 /'RANDOM' DOWNWARDS, PERMITTING 15 OR MORE NESTED LOOPS. 819 /NO CHECKING IS PERFORMED SINCE THE PROBABILITY OF AN 820 /OVERFLOW OCCURING IS VANISHINGLY SMALL. 821 822 011055 4524 PUSHF /SAVE THE CURRENT TEXT POSITION 823 011056 0017 TEXTP 824 011057 7040 CMA 825 011060 1025 TAD FORLVL /ADJUST LEVEL COUNTER 826 011061 3025 DCA FORLVL 827 011062 7040 CMA 828 011063 1013 TAD PDLXR /SAVE RETURN POINTER 829 011064 3425 DCA I FORLVL 830 011065 4522 PUSHJ /EXECUTE TO THE END 831 011066 0615 FPROC, PROC-1 832 833 /RETURN FROM OBJECT STATEMENTS 834 835 011067 4525 POPF /RESET THE TEXT POINTERS 836 011070 0017 TEXTP 837 011071 4525 POPF /RECOVER THE LIMIT 838 011072 7610 BUFFER 839 011073 4525 POPF /LOAD THE INCREMENT 840 011074 0044 FLAC 841 011075 4521 POPA /RESTORE THE VARIABLE POINTER 842 011076 3062 DCA PT1 843 011077 2541 ISZ I BKSW /TEST FOR A 'BREAK' 844 011100 5311 JMP FTEST /NONE 845 846 011101 2025 FEXIT, ISZ FORLVL /REMOVE ONE LEVEL 847 011102 2071 ISZ LASTC /CHECK FOR CONTINUATION 848 011103 5523 POPJ /NONE, END THIS LINE 849 011104 4524 PUSHF 850 011105 7604 NEXTP 851 011106 4525 POPF /MOVE TO NEW TEXT POSITION 852 011107 0017 TEXTP 853 011110 5510 JMP I MCR /CHECK FOR A LINENO (CF. 'IF') 854 855 011111 7330 FTEST, SM0 856 011112 0045 AND HORD 857 011113 3040 DCA SIGN /SAVE SIGN OF THE INCREMENT 858 011114 4407 FENT 859 011115 1400 FADDIPT1 /INCREMENT LOOP INDEX 860 011116 6400 FPUTIPT1 /AND SAVE IT AGAIN 861 011117 2577 FSUB I BUFFPT /COMPARE WITH LIMIT 862 011120 0000 FEXT 863 011121 1040 TAD SIGN 864 011122 1045 TAD HORD /TEST RESULT 865 011123 7740 SMA SZA CLA 866 011124 5301 JMP FEXIT /EXIT FROM 'FOR' 867 011125 1425 TAD I FORLVL /EFFECTIVE PUSHDOWN FOR 868 011126 3013 DCA PDLXR /PT1, INCREMENT, LIMIT 869 011127 5666 JMP I FPROC /TEXTP, & PUSHJ(PROC-1) 870 /THE 'NEXT' AND 'BREAK' COMMANDS ADD A NEW DIMENSION TO 871 /FOCAL'S LOOPS BY PERMITTING NESTED OPERATIONS AND EARLY 872 /TERMINATION. THEY ARE PATTERNED AFTER SIMILAR COMMANDS 873 /IN 'COLPAC' & 'FOCLF'. SPECIAL THANKS TO THESE AUTHORS! 874 875 /BOTH COMMANDS MAY INCLUDE A LINENO TO SPECIFY A BRANCH. 876 /WHEN NO LOOPS ARE IN PROGRESS THESE COMMANDS ARE SIMPLY 877 /'NOPS' UNLESS A BRANCH IS SPECIFIED, IN WHICH CASE IT 878 /WILL BE TAKEN. THUS A LINE CONTAINING AN 'N' OR A 'B' 879 /COMMAND CAN BE EXECUTED BY ANY PART OF THE PROGRAM. 880 881 011130 7164 BREAK, SM1 /SET THE 'BREAK' FLAG 882 011131 3541 DCA I BKSW / (RESET BY 'GETC') 883 011132 1425 NEXT, TAD I FORLVL /IS THERE A MATCHING 'FOR'? 884 011133 7450 SNA 885 011134 5510 JMP I MCR /NO, TREAT LIKE A SPECIAL 'GOTO' 886 011135 3013 DCA PDLXR /YES, DROP THE STACK TO THIS LEVEL 887 011136 7164 SM1 /SET THE 'NEXT' SWITCH 888 011137 3071 DCA LASTC 889 011140 4524 PUSHF 890 011141 0017 TEXTP 891 011142 4525 POPF /AND SAVE THE CURRENT POSITION 892 011143 7604 NEXTP 893 011144 5523 POPJ /THEN RETURN TO THE 'FOR' LOOP 894 ///// 895 896 /SEARCH FOR A GIVEN LINE NUMBER: 1ST RETURN IF MISSING, 897 / 2ND IF FOUND. 'THISLN'= TARGET LINE OR NEXT LARGER - 898 /'LASTLN'=LESSER AND OR LAST. 'GETC' POINTERS ARE SET, 899 /BUT NOT THE PC SO ERRORS SHOW THE CORRECT LINE NUMBER. 900 901 011145 0000 XFIND, 0 /FIND A LINE OF TEXT - 'FINDLN' 902 011146 6221 CDF T 903 011147 1026 TAD HEADER 904 011150 3064 DCA LASTLN /INITIALIZE TO THE HEADER LINE 905 011151 1064 TAD LASTLN 906 907 011152 3063 FINDN, DCA THISLN /SAVE NEW LINE POINTER 908 011153 1063 TAD THISLN 909 011154 3017 DCA AXOUT /INITIALIZE UNPACKING REG. 910 011155 1067 TAD LINENO 911 011156 7161 STL CIA 912 011157 1417 TAD I AXOUT /ADVANCE AND COMPARE 913 011160 7650 SNA CLA 914 011161 2345 ISZ XFIND /FOUND IT - TAKE 2ND EXIT 915 011162 7420 SNL 916 011163 5371 JMP FINDX /FOUND IT OR PAST IT 917 011164 1063 TAD THISLN 918 011165 3064 DCA LASTLN /SAVE POINTER 919 011166 1463 TAD I THISLN 920 011167 7440 SZA /END OF TEXT? 921 011170 5352 JMP FINDN /NOT YET 922 011171 3021 FINDX, DCA XCT /CLEAR UNPACKING SWITCH 923 011172 6211 CDF P 924 011173 5745 JMP I XFIND /1ST RETURN = NOT FOUND 925 /INPUT-OUTPUT COMMANDS: -ASK- AND -TYPE- 926 /'SET' TURNS INTO 'TYPE' WHEN THE TRACE SWITCH IS ON 927 928 *.!177-3 /PUT 'SET' JUST BEFORE 'TYPE' 929 011174 3071 SET, DCA LASTC /THE MOST IMPORTANT COMMAND ! 930 011175 1006 TAD TRACE /CHECK THE TRACE SWITCH 931 011176 7700 SMA CLA /SKIP IF ITS ON 932 011177 5200 JMP FOR /OFF: USE THE 'FOR' ROUTINE 933 ///// 934 935 011200 4522 TYPSET, PUSHJ /EVALUATE THE EXPRESSION 936 011201 1610 EVAL 937 011202 4537 PRINTN /OUTPUT IT & RESET 'ATSW' 938 939 011203 4542 TASK, SPNOR /MOVE TO NEXT ARGUMENT 940 011204 4526 SORTJ /!,",#,$,%,: ? 941 011205 1262 ALIST-1 942 011206 7763 AGO-ALIST 943 011207 2537 ISZ I ATSW /'ASK' OR 'TYPE'? 944 011210 5200 JMP TYPSET 945 ///// 946 947 011211 4522 PUSHJ /LOOKUP THE VARIABLE 948 011212 1400 GETARG 949 011213 1066 TAD CHAR /SAVE THE CHARACTER 950 011214 3071 DCA LASTC 951 011215 1271 TAD PROMPT 952 011216 7000 NOP /'ECHOC' 953 011217 7324 READ, SP1 954 011220 4536 READN /GET THE NUMBER 955 011221 0273 YLST, "; 956 011222 0215 CR /SORT LIST FOR 'YNCR' 957 011223 0255 "- /IS THE INPUT SWITCH 958 011224 4407 FENT 959 011225 6400 FPUTIPT1 /SAVE THE VALUE 960 011226 0000 FEXT 961 011227 1066 ENDFI, TAD CHAR /'ALTMODE' RETURN 962 011230 3633 DCA I ASK /SAVE THE TERMINATOR 963 011231 1071 TAD LASTC 964 011232 3066 DCA CHAR /RESTORE TEXT CHARACTER 965 011233 7364 ASK, CLA SM1 /POINTS TO 'TERM' 966 011234 3537 TYPE, DCA I ATSW /SET THE SWITCH 967 011235 5203 JMP TASK 968 ///// 969 970 011236 1005 TBACK, TAD CCR /'#' = CR ONLY 971 011237 4457 JMS I OUTDEV 972 011240 3576 DCA I TABCNT 973 011241 1377 TAD (200-CR /CREATE A NULL FOR DELAY 974 011242 1005 TCRLF, TAD CCR /'!' = CR AND LF 975 011243 4534 PRINTC 976 011244 4541 TASK4, GETC /MOVE ALONG 977 011245 5203 JMP TASK 978 ///// 979 /DISPATCH TABLE FOR 'ASK' 'TYPE' 'ZERO' 'FOR' 'SET' 'IF' 980 981 011246 1311 AGO, TQUOT+1 /" - PRINT CHAR STRING 982 011247 1244 TASK4 /, - END OF EXPRESSION 983 011250 1242 TCRLF /! - CR AND LF 984 011251 1277 TFRMT /% - SET OUTPUT FORMAT 985 011252 1236 TBACK /# - CARRIAGE RETURN ONLY 986 011253 2633 TDUMP /$ - DUMP THE SYMBOL TABLE 987 011254 6312 TABX /: - TABULATE OR SKIP 988 011255 0523 ZGO, ZERO+2 /, - MULTIPLE ZERO COMMAND 989 011256 1030 FGO, FINCR /, - MULTIPLE SETS OR FOR 990 011257 1570 IGO, THEN /, - UNUSED 'IF' BRANCHES 991 011260 0615 YGO, PROC-1 /; - END OF COMMAND 992 011261 0620 PROC+2 /CR END OF LINE 993 011262 7400 DECR /- - DECREMENT A VARIABLE 994 ///// 995 011263 0242 ALIST, "" /'SORTJ' CONTROL TABLE 996 011264 0254 ", 997 011265 0241 "! 998 011266 0245 "% 999 011267 0243 "# 1000 011270 0244 "$ 1001 011271 0272 PROMPT, ": /FOR 'ASK' 1002 011272 0254 ZLIST, ", /FOR 'ZERO' 1003 011273 0254 TLIST, ", /FOR 'SET' 1004 011274 0254 ILIST, ", /FOR 'IF/ON' 1005 011275 0273 "; 1006 011276 0215 CR /'PUSHJ' ENDS THE LIST 1007 ///// 1008 1009 011277 4522 TFRMT, PUSHJ /MOVE PAST THE '%' 1010 011300 1605 EVAL-3 1011 011301 1100 TAD C100 /POINT TO PC0 1012 011302 3014 DCA XRT 1013 011303 4522 PUSHJ /READ FORMAT 1014 011304 0325 TYPEPT 1015 011305 1067 TAD LINENO 1016 011306 3072 DCA FISW /SAVE FOR LATER 1017 011307 5203 JMP TASK 1018 ///// 1019 011310 4534 TQUOT, PRINTC /ECHO 1020 011311 2547 ISZ I DMPSW /DISABLE TRACE 1021 011312 4541 GETC /PASS QUOTE - READ NEXT 1022 011313 3547 DCA I DMPSW /RESTORE THE TRACE 1023 011314 4526 SORTJ 1024 011315 1625 TLIST2-1 /QUOTE OR CR 1025 011316 7712 TLIST3-TLIST2 1026 011317 5310 JMP TQUOT 1027 ///// 1028 1029 011320 0000 AXIND, 0 /'DCAIAXIN' 1030 011321 6221 CDF T 1031 011322 3416 DCA I AXIN 1032 011323 6211 CDF P 1033 011324 5720 JMP I AXIND 1034 /PUSHDOWN LIST SUBROUTINES - STACK IS IN FIELD 0 1035 1036 011325 0000 XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL 1037 011326 1725 TAD I XPUSHJ /GET THE TARGET ADDRESS 1038 011327 3333 DCA XPUSHA /SAVE FOR THE INDIRECT JUMP 1039 011330 1325 TAD XPUSHJ /GET THE RETURN ADDRESS 1040 011331 7001 IAC /BUMP IT 1041 011332 7410 SKP /AND PUSH IT ON THE STACK 1042 1043 011333 0000 XPUSHA, 0 /PUSH THE AC ONTO THE STACK 1044 011334 6203 CDI L 1045 011335 5776 JMP I (APUSHX 1046 011336 5733 JMP I XPUSHA 1047 1048 011337 6201 XPOPJ, CDF S 1049 011340 1413 TAD I PDLXR /GET THE RETURN ADDRESS 1050 011341 3343 DCA XPOPA 1051 011342 5346 JMP XPOPA+3 /RESTORE D.F. AND BRANCH 1052 1053 011343 0000 XPOPA, 0 /PULL SOMETHING OFF THE STACK 1054 011344 6201 CDF S 1055 011345 1413 TAD I PDLXR 1056 011346 6211 CDF P 1057 011347 5743 JMP I XPOPA 1058 1059 011350 0000 XPUSHF, 0 /SAVE A FLOATING-POINT NUMBER 1060 011351 1350 TAD XPUSHF 1061 011352 6203 CDI L /USE LOWER FIELD ROUTINE FOR THIS 1062 011353 3775 DCA I (MPUSHF 1063 011354 6211 CDF P /RESET THE CALLING FIELD 1064 011355 5774 JMP I (MPUSHF+2 /UPPER FIELD ENTRY POINT 1065 1066 011356 0000 XPOPF, 0 /RESTORE A FLOATING-POINT NUMBER 1067 011357 7240 CLA CMA 1068 011360 1756 TAD I XPOPF /BACKUP DATA POINTER 1069 011361 2356 ISZ XPOPF /AND ADVANCE THE RETURN 1070 011362 3014 DCA XRT 1071 011363 4343 JMS XPOPA /DUMP FOUR WORDS 1072 011364 3414 DCA I XRT 1073 011365 4343 JMS XPOPA 1074 011366 3414 DCA I XRT 1075 011367 4343 JMS XPOPA 1076 011370 3414 DCA I XRT 1077 011371 4343 JMS XPOPA 1078 011372 3414 DCA I XRT 1079 011373 5756 JMP I XPOPF 1080 1081 011374 3044 PAGE 011375 3042 011376 3071 011377 7763 1082 /FIND OR ENTER A VARIABLE IN THE SYMBOL TABLE 1083 1084 011400 4530 GETARG, TESTC /GET FIRST LETTER OF NAME 1085 011401 1760 LPRTST /FUNCTIONS AND NUMBERS 1086 011402 0005 XINC, WORDS+1 /ARE NOT GOOD VARIABLES 1087 011403 4576 ERROR2 /BAD ARG IN ASK, YNCR OR ZERO 1088 011404 7164 GETVAR, SM1 /ENTRY POINT FOR 'EVAL' 1089 011405 4552 FLOAT /SET COUNTER & CLEAR SUBSCRIPT 1090 011406 1066 TAD CHAR 1091 011407 0077 AND P77 /USE 6-BIT CODES 1092 011410 4563 RTL6 /MOVE TO THE LEFT - 'BSW' 1093 011411 3063 DCA THISOP /SAVE WHERE WE CAN PUSH IT 1094 011412 4541 GETLP, GETC /GET NEXT CHARACTER 1095 011413 4531 TESTX /END OF THE NAME? 1096 011414 5223 JMP GSERCH /YES 1097 011415 2045 ISZ HORD /IS THIS THE SECOND CHAR? 1098 011416 5212 JMP GETLP /IGNORE ADDITIONAL CHARS 1099 011417 1066 TAD CHAR 1100 011420 0077 AND P77 /MASK IT OFF 1101 011421 1063 TAD THISOP /MERGE THE OTHER HALF 1102 011422 5211 JMP GETLP-1 1103 ///// 1104 011423 4601 GSERCH, JMS I GETARG+1 /CHECK FOR A SUBSCRIPT 1105 011424 5234 JMP GS1 /NONE 1106 011425 4777 JMS I (ECALL /PICK IT UP 1107 011426 4776 JMS I (DBLSUB /CHECK FOR DOUBLE SUBSCRIPTS 1108 011427 4521 POPA /GET VARIABLE NAME FROM PDL 1109 011430 4775 JMS I (PARTEST /CHECK FOR PROPER RIGHT PAREN. 1110 011431 4541 GETC /MOVE PAST CLOSING PARENS 1111 011432 4560 FIXIT /CONVERT ALL THIS TO AN INTEGER 1112 011433 7041 CIA /INVERT FOR FAST CHECKING 1113 011434 3043 GS1, DCA T3 /SAVE SUBSCRIPT 1114 011435 1063 TAD THISOP 1115 011436 7041 CIA /INVERT NAME FOR THE SAME REASON 1116 011437 3041 DCA T1 1117 011440 6231 CDF V 1118 011441 3461 DCA I LASTV /DEFINE THE END OF THE TABLE 1119 011442 1032 TAD SECRTV /BEGIN WITH SECRET VARIABLES 1120 011443 5247 JMP GLOOP+2 1121 ///// 1122 011444 7040 CMA /BACKUP TO NAME 1123 011445 1202 GLOOP, TAD XINC /ADVANCE ONE 1124 011446 1015 TAD XRT2 1125 011447 3015 DCA XRT2 1126 011450 1415 TAD I XRT2 /CHECK NAME 1127 011451 7450 SNA /END OF THE TABLE? 1128 011452 5267 JMP MAKVAR /YES 1129 011453 1041 TAD T1 /'SAM' 1130 011454 7640 SZA CLA /MATCH? 1131 011455 5245 JMP GLOOP /TRY AGAIN 1132 011456 1043 TAD T3 1133 011457 1415 TAD I XRT2 /CHECK SUBSCRIPT 1134 011460 7640 SZA CLA 1135 011461 5244 JMP GLOOP-1 /NOT THIS ONE 1136 011462 7120 STL /L=1 IF FOUND 1137 011463 2015 ISZ XRT2 /POINT TO DATA 1138 011464 1015 GEXIT, TAD XRT2 1139 011465 3062 DCA PT1 1140 011466 5523 POPJ /RESETS D.F. 1141 ///// 1142 011467 1033 MAKVAR, TAD TABEND /SYMBOL TABLE LIMIT 1143 011470 7161 STL CIA 1144 011471 1061 TAD LASTV 1145 011472 1112 TAD GINC /COMPARE WITH NEW END POINT 1146 011473 7420 SNL 1147 011474 5301 JMP ZSERCH /FULL: TRY TO REPLACE A ZERO 1148 011475 1033 TAD TABEND 1149 011476 3061 DCA LASTV /UPDATE STORAGE POINTER 1150 011477 7160 STL CMA 1151 011500 5323 JMP ZFOUND+2 /INSERT NAME & CLEAR DATA 1152 ///// 1153 011501 7321 ZSERCH, CLA STL IAC /INITIATE SEARCH FOR ZERO 1154 011502 1031 TAD FIRSTV 1155 011503 5313 JMP ZINITL 1156 1157 011504 1061 ZLOOP, TAD LASTV /CHECK PROGRESS 1158 011505 7140 CLL CMA 1159 011506 1202 TAD XINC /ADVANCE TO NEXT ONE 1160 011507 1015 TAD XRT2 1161 011510 7430 SZL /ALL DONE? 1162 011511 4576 ERROR2 /YES: SYMBOL TABLE IS FULL 1163 011512 1061 TAD LASTV /SETS THE LINK 1164 011513 3015 ZINITL, DCA XRT2 /XRT2=XRT2+XINC-1 1165 011514 1415 TAD I XRT2 /EXPONENT + 1166 011515 1415 TAD I XRT2 /HIGH ORDER 1167 011516 7650 SNA CLA /CHECK THAT BOTH ARE ZERO 1168 011517 7420 SNL /AND NOT ADDITIVE INVERSES 1169 011520 5304 JMP ZLOOP 1170 ///// 1171 011521 6231 ZFOUND, CDF V /ALSO USED BY 'ZERO' 1172 011522 1105 TAD M4 /POINT TO THE NAME 1173 011523 1015 TAD XRT2 /CLEAR THE LINK 1174 011524 3015 DCA XRT2 1175 011525 1063 TAD THISOP /REPLACE IT 1176 011526 3415 DCA I XRT2 1177 011527 1046 TAD LORD /AND THE SUBSCRIPT TOO 1178 011530 3415 DCA I XRT2 1179 1180 011531 3415 DCA I XRT2 /ZERO THE DATA 1181 011532 1015 TAD XRT2 1182 011533 3014 DCA XRT /SWITCH INDEX REGISTERS 1183 011534 3414 DCA I XRT 1184 011535 3414 DCA I XRT 1185 011536 3414 DCA I XRT /'NOP' FOR 3-WORD VERSION 1186 011537 5264 JMP GEXIT /L=0 1187 ///// 1188 011540 1244 TLIST3, TASK4 /SORT LIST FOR QUOTED STRINGS 1189 011541 1337 XPOPJ /AUTOMATIC RIGHT QUOTE MARK 1190 /CONDITIONAL TRANSFER PROCESSES: 'IF', 'ON' AND 'JUMP' 1191 1192 /'IF' TRANSFERS WITH A 'GOTO' BRANCH WHILE 'ON' USES A 1193 /'DO' CALL AND RETURNS TO THE CALLING POINT AFTERWARDS. 1194 /'JUMP' USES THE VALUE OF THE EXPRESSION TO SELECT CALL 1195 1196 011542 4530 ON, TESTC /THIS IS ALSO THE 'O' COMMAND 1197 011543 7164 SM1 /T R-PAR MEANS ITS 'ON' 1198 011544 3071 DCA LASTC /F ILLEGAL - WILL BE TRAPPED 1199 011545 5360 JMP IF+1 /N CONTINUE WITH 'IF' 1200 011546 6202 CIF L /L DOUBLE-WORD 'O' COMMAND 1201 011547 5750 JMP I .+1 /CONTINUE WITH LOWER-FIELD CHECKS 1202 011550 6021 OCMND 1203 1204 011551 4777 JM, JMS I (ECALL /'JUMP (...) S1,S2,S3,S4,S5,...' 1205 011552 7164 SM1 /SET THE 'DO' FLAG 1206 011553 3071 DCA LASTC 1207 011554 4560 FIXIT /GET SUBROUTINE CALL 1208 011555 7041 CIA 1209 011556 5362 JMP IF+3 /THEN USE 'IF' TO FINISH UP 1210 1211 011557 4530 IF, TESTC /IGNORE SPACES AND TEST 1212 011560 4777 JMS I (ECALL /T 1213 011561 7344 SM2 /F 1214 011562 2013 ISZ PDLXR /N DUMP 'THISOP' 1215 011563 4775 JMS I (PARTEST /L CHECK FOR PAREN MATCH 1216 011564 1045 TAD HORD /TEST -,0,+ 1217 011565 7510 SPA 1218 011566 2063 ISZ THISOP 1219 011567 7750 SPA SNA CLA 1220 011570 2063 THEN, ISZ THISOP /COUNT COMMAS 1221 011571 5774 JMP I (CONT+1 /KEEP LOOKING 1222 011572 4541 GETC /MOVE PAST IT 1223 011573 5510 JMP I MCR /CHECK WHETHER ITS 'IF' OR 'ON' 1224 ///// 1225 1226 011574 0756 *-CR /VIA MCR ! 011575 2001 011576 5756 011577 1600 1227 1228 017563 4545 GETLN /PATCH TO CHECK FOR MISSING LINENO 1229 017564 7430 SZL /AND TO CHOOSE BETWEEN 'IF' & 'ON' 1230 017565 5434 CONTINUE /NO NUMBER = CONT. WITH SAME LINE 1231 017566 2071 ISZ LASTC /TEST FLAG 1232 017567 5777 JMP I (GOTO+1 /IF (ALSO 'NEXT' OR 'BREAK') 1233 017570 4543 TSTCMA /ON (ALSO 'JUMP') 1234 017571 5776 JMP I (DO+1 /CALL THE SUBROUTINE 1235 017572 5370 JMP .-2 /PREVENT MULTIPLE 'DO' CALLS 1236 1237 017576 0661 PAGE 7 017577 0611 1238 /EVALUTE AN EXPRESSION ENDING WITH A TERMINATOR AND LEAVE 1239 /THE RESULT IN 'FLAC' AND 'FLARG'. 'JMS ECALL' EVALUATES 1240 /SUB-EXPRESSIONS, 'PUSHJ;EVAL' SCANS THE CURRENT ONE. NOW 1241 /HANDLES MULTIPLE REPLACEMENT OPERATORS AND CHAR VALUE OP 1242 /ALA FOCAL65. THANKS TO WAYNE WALL FOR SOME SUPER IDEAS! 1243 1244 011600 0000 ECALL, 0 /RECURSIVE CALL TO 'EVAL' 1245 011601 1200 TAD .-1 1246 011602 3062 DCA PT1 1247 011603 4524 PUSHF /= 'PT1, THISOP, LASTOP, SORTCN' 1248 011604 0062 PT1 1249 011605 3064 ARGNXT, DCA LASTOP /SET OR CLEAR THE OP CODE 1250 011606 4541 GETC /SKIP THE TERMINATOR 1251 011607 7410 SKP /CONTINUE 'EVAL' 1252 ///// 1253 1254 011610 3064 EVAL, DCA LASTOP /EVALUATION CONTROLLER 1255 011611 4530 TESTC /TEST CHARACTER & IGNORE SPACES 1256 011612 5231 JMP ETERM1 /TERMINATOR 1257 011613 5331 JMP EFUN /FUNCTION 1258 011614 5371 JMP ENUM /NUMBER 1259 011615 4522 PUSHJ /LETTER OF VARIABLE 1260 011616 1404 GETVAR /LOOKUP THE NAME 1261 011617 4542 SPNOR /SKIP TO THE OPERATOR 1262 011620 4716 JMS I EQLSPT /IS IT AN 'EQUAL SIGN'? 1263 011621 4407 FENT 1264 011622 0400 FGETIPT1 /NO, MOVE VALUE TO FLAC 1265 011623 0000 FEXT 1266 ///// 1267 1268 011624 4530 OPNEXT, TESTC /CHECK NEXT OPERATOR 1269 011625 5251 JMP ETERMN /T 1270 011626 0242 TLIST2, "" /F - ERROR IN FORMAT 1271 011627 0215 CR /N 1272 011630 5260 JMP EMINUS+1 /L - MISSING OPERATOR 1273 ///// 1274 1275 011631 7344 ETERM1, SM2 /DO SPECIAL CHAR CHECK 1276 011632 1064 TAD LASTOP 1277 011633 7700 SMA CLA /INITIALLY OR AFTER AN '=' 1278 011634 5353 JMP ELPAR 1279 011635 4552 FLOAT /SET UP DEFAULT VALUE 1280 011636 3044 DCA FLAC 1281 011637 1065 TAD SORTCN /CHECK FOR '-', '+', PARENS 1282 011640 1105 TAD M4 1283 011641 7450 SNA 1284 011642 5257 JMP EMINUS /CREATE DUMMY FOR UNARY MINUS 1285 011643 7710 SPA CLA 1286 011644 5206 JMP EVAL-2 /IGNORE UNARY PLUS, EXTRA '=' 1287 011645 1065 TAD SORTCN /TEST FOR NULL PARENTHESES 1288 011646 1107 TAD M14 1289 011647 7710 SPA CLA 1290 011650 5353 JMP ELPAR /MIGHT BE A LEFT PARENTHESIS 1291 011651 4360 ETERMN, JMS LPRTST /ETERM1 FALLS THROUGH 'LPRTST' 1292 011652 1065 TAD SORTCN 1293 011653 7450 SNA /PARENS OR AN '=' OUT OF PLACE 1294 011654 4576 ERROR2 /MISSING OPERATOR OR ILLEGAL '=' 1295 011655 1107 TAD M14 1296 011656 7710 SPA CLA /CHECK FOR END OF THE EXPRESSION 1297 011657 1065 EMINUS, TAD SORTCN 1298 011660 3063 DCA THISOP /ZERO = **THE END** 1299 1300 011661 1063 ETERM2, TAD THISOP /COMPARE PRIORITIES 1301 011662 7041 CIA 1302 011663 1064 TAD LASTOP 1303 011664 7710 SPA CLA 1304 011665 5320 JMP ESTACK /STACK AND CONTINUE 1305 011666 4407 FENT 1306 011667 6504 BASE, FPUT I FLARGP /MOVE THE OPERAND 1307 011670 0000 FEXT 1308 011671 7164 SM1 1309 011672 1064 TAD LASTOP /FIND OPERATION 1310 011673 7450 SNA 1311 011674 5314 JMP EQUALS /PROCESS AN '=' 1312 011675 7770 M10, SPA SNA SZL CLA 1313 011676 5523 POPJ /NONE, EXIT 'EVAL' 1314 011677 4525 POPF 1315 011700 0044 FLAC /GET THE PREVIOUS RESULT 1316 011701 1064 TAD LASTOP 1317 011702 7112 CLL RTR /SHIFT OP CODE INTO PLACE 1318 011703 7012 RTR 1319 011704 1267 TAD BASE /COMPENSATES FOR OP CODE 1320 011705 3307 DCA OPER 1321 011706 4407 FENT 1322 011707 0000 OPER, 0000 /'FXXX I FLARGP' 1323 011710 0000 FEXT 1324 011711 4521 POPA /GET NEXT OPERATION 1325 011712 3064 DCA LASTOP 1326 011713 5261 JMP ETERM2 1327 ///// 1328 1329 011714 4521 EQUALS, POPA /GET VARIABLE POINTER 1330 011715 3062 DCA PT1 1331 011716 1007 EQLSPT, TAD FENT&177 /DOUBLE KLUDGE = 'FPUTIPT1' 1332 011717 5305 JMP OPER-2 1333 ///// 1334 1335 011720 4360 ESTACK, JMS LPRTST /TEST FOR SUB-EXPRESSION 1336 011721 7410 SKP 1337 011722 5355 JMP EPAR2 /GO EVALUATE EXPRESSION 1338 011723 1064 TAD LASTOP /STACK CURRENT OPERATOR 1339 011724 4520 PUSHA 1340 011725 4524 PUSHF /SAVE THE RESULT TOO 1341 011726 0044 FLAC 1342 011727 1063 TAD THISOP /ADVANCE THE OPERATOR 1343 011730 5205 JMP ARGNXT 1344 ///// 1345 011731 3063 EFUN, DCA THISOP /CLEAR THE FUNCTION NAME 1346 011732 4541 GETC 1347 011733 4531 TESTX /LOOK FOR A TERMINATOR 1348 011734 5342 JMP EFUN2 /FOUND ONE 1349 011735 1063 TAD THISOP 1350 011736 7106 CLL RTL /GENERATE THE HASH CODE 1351 011737 1066 TAD CHAR 1352 011740 1104 TAD P7600 1353 011741 5331 JMP EFUN 1354 ///// 1355 1356 011742 4360 EFUN2, JMS LPRTST /MUST BE FOLLOWED BY PARENS 1357 011743 4576 ERROR2 /VARIABLE NAME BEGINS WITH 'F' 1358 011744 4200 JMS ECALL /CALL 'EVAL' TO READ THE ARGUMENT 1359 011745 4521 POPA 1360 011746 7450 SNA /IS IT A FSF? 1361 011747 5746 JMP I .-1 1362 011750 4526 SORTJ /BRANCH ON FUNCTION CODE 1363 011751 2156 FNTABL-1 1364 011752 0200 FNTABF-FNTABL 1365 1366 011753 4360 ELPAR, JMS LPRTST /LEFT PAREN OR FELL THROUGH TABLE 1367 011754 4576 ERROR3, ERROR2 /DOUBLE OPERATORS OR UNKNOWN FUNC 1368 011755 4200 EPAR2, JMS ECALL /EVALUATE NESTED EXPRESSION 1369 011756 2013 ISZ PDLXR /DUMP THE EXTRA ARGUMENT 1370 011757 5555 RETURN /COMPLETE THE FUNCTION CALL 1371 ///// 1372 1373 011760 0000 LPRTST, 0 /SKIP IF CHAR IS A LEFT PAREN 1374 011761 1065 TAD SORTCN 1375 011762 1275 TAD M10 1376 011763 7450 SNA /AND CATCH SINGLE QUOTES TOO 1377 011764 5373 JMP ECHR 1378 011765 0105 AND M4 /=7774 1379 011766 7650 SNA CLA 1380 011767 2360 ISZ LPRTST /1-3 ARE PARENS 1381 011770 5760 JMP I LPRTST 1382 ///// 1383 1384 011771 4536 ENUM, READN /READ A NUMBER FROM TEXT 1385 011772 5224 JMP OPNEXT /'JMP' IS NEGATIVE 1386 ///// 1387 1388 *.!177-4 /PUT THIS RIGHT AT THE END 1389 011773 2547 ECHR, ISZ I DMPSW 1390 011774 4541 GETC /GET THE NEXT CHARACTER 1391 011775 3547 DCA I DMPSW 1392 011776 1066 TAD CHAR /FLOAT IT 1393 011777 4552 FLOAT 1394 012000 5227 JMP EFUN3+1 /ALMOST LIKE A 'RETURN' 1395 ///// 1396 /FUNCTION RETURNS AND CHARACTER TESTING: 1397 1398 *2001 1399 012001 0000 PARTEST,0 /TEST THE PAREN MATCHING 1400 012002 3063 DCA THISOP /SAVE THE AC IN 'THISOP' 1401 012003 4521 POPA /RESTORE LAST OPERATION 1402 012004 3064 DCA LASTOP 1403 012005 7326 SP2 /GET OPENING PAREN + TWO 1404 012006 4521 POPA 1405 012007 7040 CMA /NEGATE AND SUBTRACT ONE 1406 012010 1065 TAD SORTCN /(PARENS DIFFER BY THREE) 1407 012011 7640 SZA CLA /DO THEY MATCH? 1408 012012 4576 ERROR2 /NO THEY DON'T - TOO BAD! 1409 012013 5601 JMP I PARTEST /ENTRY POINT IS A BETA REGISTER 1410 ///// 1411 1412 012014 0000 XRTL6, 0 /ROTATE THE AC LEFT SIX - 'RTL6' 1413 012015 7106 CLL RTL 1414 012016 7006 RTL 1415 012017 7006 RTL 1416 012020 5614 JMP I XRTL6 /'XRTL6' IS ALSO A BETA REGISTER 1417 ///// 1418 1419 012021 7110 FL0AT, CLL RAR /UNSIGNED INTEGER FLOAT ROUTINE 1420 012022 4552 FLOAT 1421 012023 7010 RAR 1422 012024 3046 DCA LORD /JUST SHIFT EVERYTHING RIGHT ONE 1423 012025 2044 ISZ EXP 1424 1425 012026 4201 EFUN3, JMS PARTEST /'RETURN' - CLEARS AC & RESETS DF 1426 012027 4435 NORMALIZE 1427 012030 4541 GETC /SKIP THE TERMINATOR 1428 012031 5632 JMP I .+1 1429 012032 1624 OPNEXT /CONTINUE WITH 'EVAL' 1430 ///// 1431 012033 7472 MF, -"F /'FN' CHECK FOR 'TESTC' 1432 012034 0232 C232, 232 /'EOF' CHECK FOR 'FIND' 1433 ///// 1434 1435 012035 0000 CTEST, 0 /TEST THE NEXT CHARACTER - 'TESTC' 1436 012036 4542 SPNOR /IGNORE SPACES 1437 012037 4253 JMS XTEST /CHECK ALL THE TERMINATORS 1438 012040 5635 JMP I CTEST /IT WAS A TERM - 'SORTCN' IS SET 1439 012041 1066 TAD CHAR 1440 012042 1233 TAD MF 1441 012043 7650 SNA CLA 1442 012044 5251 JMP XT3 /FUNCTION 1443 012045 4317 JMS NTEST 1444 012046 7410 SKP /PERIOD 1445 012047 2235 ISZ CTEST /OTHER 1446 012050 2235 ISZ CTEST /NUMBER 1447 012051 2235 XT3, ISZ CTEST 1448 012052 5635 JMP I CTEST /RETURNS: T;F;N;L 1449 ///// 1450 /NEW ROUTINE TO TEST IF 'CHAR' IS A TERMINATOR - 'TESTX' 1451 1452 /THIS ROUTINE WAS DEVISED BY JIM CRAPUCHETTES (FOCAL8-269) 1453 /TO SHORTEN THE TIME REQUIRED FOR THIS TEST BY A FACTOR OF 1454 /3-5. THIS RESULTS IN A NET IMPROVEMENT OF ABOUT 12%. 1455 1456 012053 0000 XTEST, 0 /TERMINATOR TEST - SETS 'SORTCN' 1457 012054 1066 TAD CHAR 1458 012055 1351 TAD M336 1459 012056 7540 SMA SZA /IS IT > 336? 1460 012057 5302 JMP NO /NOT A TERMINATOR 1461 012060 1345 TAD P4 1462 012061 7540 SMA SZA /IS IT > 332? 1463 012062 5306 JMP YES 1464 012063 1333 RANK, TAD P34 1465 012064 7540 SMA SZA /IS IT > 276? 1466 012065 5302 JMP NO /IT'S A LETTER 1467 012066 1343 TAD P3 1468 012067 7500 SMA /IS IT > 272? 1469 012070 5310 JMP YES+2 1470 012071 1341 TAD P14 1471 012072 7540 SMA SZA /IS IT > 257? 1472 012073 5302 JMP NO /IT'S A NUMBER 1473 012074 1340 TAD P11 1474 012075 7540 SMA SZA /IS IT > 247? 1475 012076 5307 JMP YES+1 1476 012077 1342 TAD P6 1477 012100 7440 SZA /IS IT A SPACE? 1478 012101 1344 TAD P23 1479 012102 7650 NO, SNA CLA /IS IT A CR? 1480 012103 5310 JMP YES+2 1481 012104 2253 ISZ XTEST /NOT A TERMINATOR 1482 012105 5653 JMP I XTEST 1483 1484 012106 1340 YES, TAD P11 / [ \ ] ^ 1485 012107 1343 TAD P3 / ' ( ) * + , - . / 1486 012110 1263 TAD RANK / ; < = > CR 1487 012111 3312 DCA .+1 1488 012112 1263 TAD RANK /GET PRIORITY NO. 1489 012113 7510 SPA 1490 012114 5302 JMP NO /OMIT PERIOD & \ 1491 012115 3065 DCA SORTCN 1492 012116 5653 JMP I XTEST 1493 ///// 1494 012117 0000 NTEST, 0 /TEST FOR PERIOD, NUMBER - 'TESTN' 1495 012120 1066 TAD CHAR 1496 012121 1346 TAD MPER 1497 012122 7440 SZA 1498 012123 2317 ISZ NTEST 1499 012124 1107 TAD M14 /TEST FOR 0-9 1500 012125 7100 CLL 1501 012126 1350 TAD P12 1502 012127 3065 DCA SORTCN /SAVE RESULT 1503 012130 7430 SZL 1504 012131 2317 ISZ NTEST /IF A NUMBER 1505 012132 5717 JMP I NTEST 1506 ///// 1507 1508 / PRIORITY TABLE FOR 'EVAL' 1509 1510 012133 0034 P34, 34 /; 01 = = 1511 012134 0013 13 /< 03 = + 1512 012135 0000 0 /= 04 = - 1513 012136 0016 16 /> 05 = / 1514 012137 0010 10 /' 06 = * 1515 012140 0011 P11, 11 /( 07 = ^ 1516 012141 0014 P14, 14 /) 10 = ' 1517 012142 0006 P6, 6 /* 11 = ( 1518 012143 0003 P3, 3 /+ 12 = [ 1519 012144 0023 P23, 23 /, 13 = < 1520 012145 0004 P4, 4 /- 14 = ) 1521 012146 7522 MPER, -". /. 15 = ] 1522 012147 0005 5 // 16 = > 1523 012150 0012 P12, 12 /[ 23 = , 1524 012151 7442 M336, -"^ /\ 34 = ; 1525 012152 0015 15 /] 34 = CR 1526 012153 0007 7 /^ 34 = SPACE 1527 ///// 1528 1529 /TRANSFER LIST FOR 'SET' AND 'FOR' 1530 1531 012154 1047 FLIST, FLIMIT /, 1532 012155 1044 FINFIN /; 1533 012156 1043 FINFIN-1 /CR 1534 ///// 1535 /LIST OF CODED FUNCTION NAMES (LOCATIONS IN 'FNTABF') 1536 1537 1538 F2=200^4+200 1539 F3=200^4+200^4+200 1540 1541 FNTABL=. 1542 012157 2671 "C^4+"O^4+"M-F3 /COM 1543 012160 3062 "I^4+"T^4+"R-F3 /ITR 1544 012161 3147 "R^4+"A^4+"C-F3 /RAC 1545 012162 3232 "S^4+"G^4+"N-F3 /SGN 1546 012163 2553 "A^4+"B^4+"S-F3 /ABS 1547 012164 3310 "S^4+"Q^4+"T-F3 /SQT 1548 012165 3162 "R^4+"A^4+"N-F3 /RAN 1549 012166 3242 "S^4+"I^4+"N-F3 /SIN 1550 012167 2677 "C^4+"O^4+"S-F3 /COS 1551 012170 2656 "A^4+"T^4+"N-F3 /ATN 1552 012171 3103 "L^4+"O^4+"G-F3 /LOG 1553 012172 3000 "E^4+"X^4+"P-F3 /EXP 1554 1555 012173 0611 "R^4+"A-F2 /RA 1556 012174 0603 "L^4+"S-F2 /LS 1557 012175 0636 "S^4+"R-F2 /SR 1558 012176 0605 "M^4+"Q-F2 /MQ 1559 012177 0562 "I^4+"N-F2 /IN 1560 012200 3230 "O^4+"U^4+"T-F3 /OUT 1561 012201 3014 "I^4+"N^4+"D-F3 /IND 1562 012202 3102 "M^4+"I^4+"N-F3 /MIN 1563 012203 3054 "M^4+"A^4+"X-F3 /MAX 1564 012204 2633 "B^4+"L^4+"K-F3 /BLK 1565 012205 3042 "L^4+"E^4+"N-F3 /LEN 1566 012206 3325 "T^4+"R^4+"M-F3 /TRM 1567 1568 012207 2607 "D^4+"A^4+"C-F3 /DAC 1569 012210 2543 "A^4+"D^4+"C-F3 /ADC 1570 012211 3317 "T^4+"R^4+"G-F3 /TRG 1571 012212 2672 "B^4+"U^4+"F-F3 /BUF 1572 012213 3261 "T^4+"I^4+"M-F3 /TIM 1573 012214 2662 "D^4+"I^4+"N-F3 /DIN 1574 012215 3205 "R^4+"E^4+"Q-F3 /REQ 1575 012216 2722 "C^4+"T^4+"R-F3 /CTR 1576 012217 2745 "D^4+"V^4+"M-F3 /DVM 1577 012220 3442 "X^4+"T^4+"R-F3 /XTR 1578 012221 3113 "N^4+"E^4+"W-F3 /NEW 1579 012222 2635 "D^4+"A^4+"Y-F3 /DAY 1580 1581 1582 /THE HASH CODE HAS BEEN CHANGED TO IMPROVE UNIQUENESS. 1583 /CHARACTERS ARE SHIFTED 2 BITS AT A TIME AFTER MASKING 1584 /THE LEADING BIT. THE TABLE IS ENDED BY 'EXTR' 1585 /UNPACK A CHARACTER FROM THE TEXT BUFFER: 'GETC' 1586 1587 012223 4262 EXTR, JMS GET1 /EXTENDED CHARACTER 1588 012224 7450 SNA /300? 1589 012225 5241 JMP UTE-1 /RESTORE '@' 1590 012226 1235 TAD M40 1591 012227 7500 SMA /REVERSE THE TEST 1592 012230 5243 JMP UTE+1 /340-376 1593 012231 5244 JMP UTE+2 /201-237 1594 ///// 1595 012232 2006 TOGL, ISZ TRACE /TOGGLE THE TRACE FLOP 1596 012233 7164 SM1 1597 012234 3006 DCA TRACE 1598 012235 7740 M40, SMA SZA CLA /GET THE NEXT CHARACTER 1599 1600 012236 0000 UTRA, 0 /UNPACK A CHARACTER 1601 012237 4262 JMS GET1 1602 012240 7440 SZA /TURN NULLS INTO SPACES 1603 012241 1235 TAD M40 /SUBTRACT 40 1604 012242 7510 UTE, SPA /WHICH SET? 1605 012243 1100 TAD C100 /300-337 1606 012244 1274 TAD M77 /240-276, 200 1607 012245 7440 SZA /IS IT A QUESTION MARK? 1608 012246 5253 JMP UTX /NO, RESTORE THE CHAR 1609 012247 1317 TAD XPRNT /YES 1610 012250 7650 SNA CLA /DOES IT GET SPECIAL ATTN? 1611 012251 5232 JMP TOGL /YES, TOGGLE THE TRACE FLOP 1612 012252 1235 TAD M40 /NO, TREAT IT NORMALLY 1613 012253 1002 UTX, TAD P337 1614 012254 3066 DCA CHAR 1615 012255 1317 TAD XPRNT /IF XPRNT=0, TRAP '?' MARKS 1616 012256 1006 TAD TRACE / >0, IGNORE '?' MARKS 1617 012257 7710 SPA CLA /IF TRACE=0, THE TRACE IS OFF 1618 012260 4534 PRINTC / -1, THE TRACE IS ON 1619 012261 5636 JMP I UTRA /PRINT ONLY IF SUM IS NEGATIVE 1620 ///// 1621 012262 0000 GET1, 0 /UNPACK 6 BITS 1622 012263 2021 ISZ XCT /STARTS WITH 0 1623 012264 5304 JMP GET3 1624 012265 1020 TAD GTEM 1625 012266 0077 GEND, AND P77 1626 012267 1274 TAD M77 1627 012270 7450 SNA 1628 012271 5223 JMP EXTR /EXTENDED 1629 012272 1077 TAD P77 1630 012273 5662 JMP I GET1 1631 012274 7701 M77, -77 1632 ///// 1633 012275 0000 XSPNOR, 0 /IGNORE INTERVENING SPACES: 'SPNOR' 1634 012276 1066 TAD CHAR 1635 012277 1344 TAD M240 1636 012300 7640 SZA CLA 1637 012301 5675 JMP I XSPNOR 1638 012302 4236 JMS UTRA 1639 012303 5276 JMP XSPNOR+1 1640 012304 7240 GET3, CLA CMA /RESET THE FLIP-FLOP 1641 012305 3021 DCA XCT 1642 012306 6221 CDF T 1643 012307 1417 TAD I AXOUT /GET 12-BITS 1644 012310 6211 CDF P 1645 012311 3020 DCA GTEM 1646 012312 1020 TAD GTEM 1647 012313 7012 RTR 1648 012314 7012 RTR /BSW 1649 012315 7012 RTR 1650 012316 5266 JMP GEND /RETURN WITH THE FIRST CHARACTER 1651 ///// 1652 1653 012317 0000 XPRNT, 0 /PRINT A LINE NO. - 'PRNTLN' 1654 012320 1103 TAD C240 /SET UP A SPACE 1655 012321 3066 DCA CHAR 1656 012322 1067 TAD LINENO /THE ENTRY POINT IS 'DMPSW' 1657 012323 7450 SNA 1658 012324 5717 JMP I XPRNT /NO NUMBER FOR THE HEADER 1659 012325 4563 RTL6 1660 012326 0077 AND P77 1661 012327 4736 JMS I PRNTX /TWO-DIGIT 'GROUP' NUMBER 1662 012330 7344 SM2 /TO GENERATE A '.' 1663 012331 4535 PRINTD 1664 012332 1067 TAD LINENO 1665 012333 4736 JMS I PRNTX /TWO-DIGIT 'STEP' NUMBER 1666 012334 4534 PRINTC 1667 012335 5717 JMP I XPRNT 1668 012336 6126 PRNTX, PRNT 1669 ///// 1670 1671 / NEW ROUTINE TO TEST IF 'CHAR' IS A SPACE, SEMICOLON, 1672 /COMMA OR CARRIAGE RETURN; SKIPS IF IT IS ANY OF THESE. 1673 1674 012337 0000 XSORT, 0 /COMMAND WORD SORT - 'SORTX' 1675 012340 4544 TESTCR 1676 012341 1344 TAD M240 /-SPACE 1677 012342 7440 SZA 1678 012343 1066 TAD CHAR /NOT CR 1679 012344 7540 M240, SMA SZA 1680 012345 1353 TAD MSC /SEMICOLON 1681 012346 7510 SPA 1682 012347 1101 TAD P17 /COMMA 1683 012350 7650 SNA CLA 1684 012351 2337 ISZ XSORT /ONE OF THE ABOVE 1685 012352 5737 JMP I XSORT 1686 012353 7745 MSC, SP-"; 1687 ///// 1688 1689 /'PACKC' LIST - ALLOWS ROOM FOR 'FNTABF' TO GROW 1690 1691 012354 2464 PACGO, PQST /? 1692 012355 2435 PCAT /@ 1693 012356 2466 RUB1 /RO 1694 /LIST OF FUNCTION ADDRESSES (NAMES ARE IN 'FNTABL') 1695 1696 1697 FNTABF=. 1698 012357 4400 FCOM /COM -COMMON STORAGE 1699 012360 5370 FITR /ITR -NEW INTEGER FN 1700 012361 5355 FRAC /RAC -FRACTIONAL PART 1701 012362 5364 FSGN /SGN -SIGN= -1, 0, +1 1702 012363 5372 FABS /ABS -ABSOLUTE VALUE 1703 012364 5326 FSQT /SQT -SQUARE ROOT 1704 012365 7515 FRAN /RAN -RANDOM NUMBER 1705 012366 5205 FSIN /SIN -TRIG FUNCTIONS FOR 1706 012367 5200 FCOS /COS -ANGLES IN RADIANS 1707 012370 5020 FATN /ATN -USE PI TO CONVERT 1708 012371 4746 FLOG /LOG -NAPERIAN LOGARITHM 1709 012372 4622 FEXP /EXP -EXPONENTIAL (BASE E) 1710 1711 /END OF BASIC NUMERICAL FUNCTIONS - REMAINDER DO I/O 1712 1713 012373 4200 FRA /RA -RANDOM ACCESS STORAGE 1714 012374 1754 ERROR3 /LS -READ THE LEFT SWITCHES 1715 012375 5325 FSR /SR -SW. REG. OR R. SWITCHES 1716 012376 6563 FMQ /MQ -DISPLAY A NO. IN THE MQ 1717 012377 7444 FIN /IN -SINGLE CHARACTER INPUT 1718 012400 5360 FOUT /OUT -SINGLE CHARACTER OUTPUT 1719 012401 6363 FIND /IND -CHARACTER SEARCH 1720 012402 7423 FMIN /MIN -MINIMUM VALUE 1721 012403 7424 FMAX /MAX -MAXIMUM VALUE 1722 012404 6360 FBLK /BLK -STARTING BLOCK 1723 012405 6330 FLEN /LEN -FILE LENGTH 1724 012406 5754 FTRM /TRM -INPUT TERMINATOR 1725 1726 /ADDITIONAL LABORATORY-TYPE FUNCTIONS 1727 1728 012407 1754 ERROR3 /DAC -ANALOG OUTPUT 1729 012410 1754 ERROR3 /ADC -ANALOG INPUT 1730 012411 1754 ERROR3 /TRG -SCHMITT TRIGGERS 1731 012412 1754 ERROR3 /BUF -DISPLAY BUFFER STORAGE 1732 012413 1754 ERROR3 /TIM -ELAPSED TIME INTERVAL 1733 012414 1754 ERROR3 /DIN -DIGITAL INPUT REGISTER 1734 012415 1754 ERROR3 /REQ -PROGRAMABLE OSCILLATOR 1735 012416 1754 ERROR3 /CTR -FREQUENCY COUNTER 1736 012417 1754 ERROR3 /DVM -DIGITAL VOLTMETER 1737 012420 1754 ERROR3 /XTR -EXTRA FUNCTION SLOT 1738 012421 1754 ERROR3 /NEW -UNDEFINED FUNCTION 1739 012422 6566 FDAY /DAY -SET THE OS/8 DATE 1740 /INSERT A CHAR IN THE TEXT BUFFER - 'PACKC' 1741 1742 012423 0000 PACBUF, 0 /ALSO HANDLES DELETIONS 1743 012424 3244 DCA PCK1 /SAVE LINENO PROTECTION 1744 012425 4526 SORTJ 1745 012426 2575 PACLST-1 /CHECK FOR '?', '@', 'RO' 1746 012427 7556 PACGO-PACLST 1747 012430 1066 TAD CHAR 1748 012431 1103 TAD C240 /DECODE 1749 012432 0100 AND C100 1750 012433 7640 SZA CLA /EXTENDED? 1751 012434 5237 JMP .+3 1752 012435 1077 PCAT, TAD P77 /201-237, 300, 340-376 1753 012436 4244 JMS PCK1 1754 012437 1066 TAD CHAR /200, 240-276, 301-336 1755 012440 4244 JMS PCK1 1756 012441 6211 PACX, CDF P 1757 012442 3325 DCA RUB3 /RESET ERROR TRAP 1758 012443 5623 JMP I PACBUF 1759 ///// 1760 1761 012444 0000 PCK1, 0 1762 012445 0077 AND P77 1763 012446 2043 ISZ T3 /=0 TO START 1764 012447 5253 JMP PCK2 1765 012450 1071 TAD LASTC 1766 012451 4551 DCAIAXIN 1767 012452 5644 JMP I PCK1 1768 ///// 1769 1770 012453 4563 PCK2, RTL6 /'BSW' 1771 012454 3071 DCA LASTC 1772 012455 7160 STL CMA 1773 012456 3043 DCA T3 1774 012457 1016 TAD AXIN 1775 012460 1550 TAD I PACEND /CHECK TEXT LIMIT 1776 012461 7620 SNL CLA 1777 012462 4576 ERROR2 /TEXT BUFFER FULL 1778 012463 5644 JMP I PCK1 1779 ///// 1780 1781 012464 1002 PQST, TAD P337 /REPLACE 277 WITH 337 1782 012465 5240 JMP PACX-1 1783 ///// 1784 1785 /A NOTE OF APPRECIATION TO EDWARD TAFT III 1786 /FOR HELPING WITH THIS APPROACH TO 'PACKC'. 1787 /REFERENCE: DECUS FOCAL8-52 (FOCAL 5/69) 1788 012466 1043 RUB1, TAD T3 /RUBOUT ONE LETTER 1789 012467 7700 SMA CLA /HALF-WORD? 1790 012470 4325 JMS RUB3 /CHECK POSITION 1791 012471 1000 TAD P134 /'TAD START' 1792 012472 5276 JMP .+4 /'ECHOC' PRODUCES 1793 012473 1307 TAD SPAC /'BS', 'SP', 'BS' 1794 012474 4533 ECHOC /FOR VIDEO TERMINALS 1795 012475 1177 TAD START 1796 012476 4533 ECHOC /7-BIT '\' OTHERWISE 1797 012477 1016 TAD AXIN 1798 012500 3062 DCA PT1 1799 012501 6221 CDF T 1800 012502 2043 ISZ T3 /WHICH HALF? 1801 012503 5312 JMP RUB2 1802 1803 012504 1462 TAD I PT1 /'T3' HAS BEEN RESET! 1804 012505 7040 CMA 1805 012506 0077 AND P77 /TEST FOR EXTENDED CHAR 1806 012507 7640 SPAC, SZA CLA 1807 012510 5241 JMP PACX 1808 012511 4325 JMS RUB3 /LOOK OUT FOR LINE NUMBERS! 1809 1810 012512 7140 RUB2, CLL CMA /REMOVE 2ND HALF OF STORED WORD 1811 012513 1016 TAD AXIN 1812 012514 3016 DCA AXIN /RESET STORAGE POINTER 1813 012515 1462 TAD I PT1 1814 012516 0267 AND RUB1+1 /=7700 1815 012517 3071 DCA LASTC 1816 012520 1071 TAD LASTC 1817 012521 1100 TAD C100 /CHECK FOR EXTENDED 1818 012522 7250 CLA CMA RAR /L=1 IF NOT " 1819 012523 3043 DCA T3 /RESET BYTE COUNTER 1820 012524 5241 JMP PACX 1821 ///// 1822 1823 012525 0000 RUB3, 0 /WATCH OUT FOR THE BEGINNING 1824 012526 1016 TAD AXIN 1825 012527 7161 STL CIA 1826 012530 1060 TAD BUFR 1827 012531 1244 TAD PCK1 /PROTECT THE LINENO 1828 012532 7620 SNL CLA 1829 012533 5241 JMP PACX /DON'T DO ANYTHING! 1830 012534 5725 JMP I RUB3 1831 ///// 1832 /THE QUIT COMMAND NOW HAS A 'RESTART' OPTION: 'QUIT 5.1' 1833 /WILL STOP THE PROGRAM, AND THEN RESTART IT AT LINE 5.1. 1834 /'QUIT 0' (OR JUST 'Q') WORKS AS BEFORE. THE RESTART CAN 1835 /BE DEFERRED UNTIL THE OCCURRENCE OF ANY ERROR BY SPECI- 1836 /FYING A NEGATIVE LINE NUMBER: 'QUIT -5.1' WILL SAVE THE 1837 /LINE NUMBER UNTIL YOU ACTUALLY GET AN ERROR. 1838 1839 012535 4545 QUIT, GETLN /GET THE LINE NUMBER 1840 012536 7430 SZL 1841 012537 5177 JMP START /ZERO: (OR NO ARGUMENT) 1842 012540 1043 TAD T3 1843 012541 7700 SMA CLA /CHECK THE SIGN 1844 012542 5347 JMP ERTRAP+1 /POSITIVE: AUTO-RESTART 1845 012543 1067 TAD LINENO 1846 012544 3325 DCA RUB3 /NEGATIVE: SAVE FOR LATER 1847 012545 5434 CONTINUE 1848 ///// 1849 1850 012546 3067 ERTRAP, DCA LINENO /MOVE THE LINE NUMBER 1851 012547 1023 TAD BOTTOM 1852 012550 3013 DCA PDLXR 1853 012551 1024 TAD LEVEL0 /CLEAR THE STACKS 1854 012552 3025 DCA FORLVL 1855 012553 5776 JMP I PACLST /THEN RESTART THE PROG. 1856 1857 /ERROR RECOVERY ROUTINE: MODIFIED FOR THE ERROR TRAP 1858 1859 012554 0000 ERROR, 0 /TAB COUNTER TOO ! 1860 012555 6001 I0N 1861 012556 7200 CLA 1862 012557 1054 TAD TELSW /WAIT FOR TTY TO FINISH 1863 012560 7640 SZA CLA 1864 012561 5356 JMP .-3 1865 012562 6211 CDF P 1866 012563 1325 TAD RUB3 /SHOULD WE TRAP THIS ONE? 1867 012564 7440 SZA 1868 012565 5346 JMP ERTRAP /YES 1869 012566 1354 TAD ERROR /PROCESS ERROR CODE TO 1870 012567 0100 AND C100 /ELIMINATE NON-NUMERICS 1871 012570 7170 CMA STL RAR /7777 OR 7737 1872 012571 5772 JMP I .+1 /NO - REPORT IT 1873 012572 3146 M20+1 1874 1875 /THE EXPANDED 'JUMP' COMMAND PROVIDES KEYBOARD CHECKING 1876 1877 012573 1551 JM 1878 012574 4530 JUMP, TESTC /CHECK WHICH FORM WE'VE GOT 1879 012575 5773 JMP I JUMP-1 /T = 'JUMP (...) *, *, *, *, ' 1880 012576 0277 PACLST, "? /N 'PACKC' LIST FITS IN HERE TO 1881 012577 0300 "@ /F SERVE AS 'NOPS' FOR 'TESTC' 1882 012600 0377 RO /L 1883 012601 1055 TAD INBUF / IF NOT A TERMINATOR, ASSUME A 1884 012602 7640 SZA CLA / LINE NUMBER & CHECK THE INPUT 1885 012603 5434 CONTINUE / BUFFER. NOTHING THERE: BRANCH 1886 012604 5510 JMP I MCR / OTHERWISE CONTINUE WITH PROG. 1887 012605 0000 SORTB, 0 /SORT AND BRANCH ROUTINE - 'SORTJ' 1888 012606 7450 SNA 1889 012607 1066 TAD CHAR /ASSUME CHAR IF AC=0 1890 012610 7041 CIA 1891 012611 3266 DCA DCAT2 1892 012612 1605 TAD I SORTB /FIRST ARGUMENT IS LIST-1 1893 012613 2205 ISZ SORTB 1894 012614 3014 DCA XRT 1895 012615 1414 TAD I XRT 1896 012616 7510 SPA /LISTS ARE ENDED BY NEGATIVE NOS.! 1897 012617 5230 JMP SEX /NOT THERE! 1898 012620 1266 TAD DCAT2 1899 012621 7640 SZA CLA /MATCH? 1900 012622 5215 JMP .-5 /NOT REALLY 1901 012623 1014 TAD XRT 1902 012624 1605 TAD I SORTB /COMPUTE ADDRESS 1903 012625 3205 DCA SORTB 1904 012626 1605 TAD I SORTB /DEBUG: AC = ADDRESS 1905 012627 3205 DCA SORTB 1906 012630 7640 SEX, SZA CLA /CLEAR AC IF NO MATCH 1907 012631 2205 ISZ SORTB /TAKE THE SECOND EXIT 1908 012632 5605 JMP I SORTB 1909 ///// 1910 1911 1912 1913 /IMPROVED SYMBOL TABLE DUMP 1914 1915 /THE NUMBER OF VARIABLES PER LINE IS DETERMINED BY THE EX- 1916 /PRESSION FOLLOWING THE '$'. THUS 'TYPE $4' WILL PRINT 4 1917 /VARIABLES PER LINE. IF NO VALUE IS SPECIFIED (OR 0) THE 1918 /PREVIOUS VALUE WILL BE USED. THE DEFAULT IS INITIALLY 3. 1919 1920 012633 4522 TDUMP, PUSHJ /GET NUMBER OF VARIABLES PER LINE 1921 012634 1605 EVAL-3 1922 012635 4560 FIXIT 1923 012636 7041 CIA 1924 012637 7440 SZA 1925 012640 3315 DCA DMPNO /CHANGE DEFAULT VALUE 1926 012641 1006 TAD TRACE 1927 012642 3071 DCA LASTC /SAVE THE TRACE SWITCH 1928 012643 1031 TAD FIRSTV 1929 012644 3062 DCA PT1 /START AT THE BEGINNING 1930 012645 1315 TAD DMPNO 1931 012646 3006 DCA TRACE /INITIALIZE THE COUNTER 1932 012647 5254 JMP DUMPT+4 /(THESE THREE COULD GO) 1933 ///// 1934 012650 1315 DUMPT, TAD DMPNO /SET COUNTER AND TURN ON TRACE 1935 012651 3006 DCA TRACE 1936 012652 1005 TAD CCR 1937 012653 4534 PRINTC /RESETS THE DF 1938 012654 1112 TAD GINC 1939 012655 7041 CIA 1940 012656 3021 DCA XCT /INITIALIZE LOOP 1941 012657 1336 TAD DCAT1 1942 012660 3266 DCA DCAT2 1943 1944 012661 6231 CDF V 1945 012662 3461 DCA I LASTV /CLEAR THE LAST NAME 1946 012663 1462 TAD I PT1 /MOVE VAR. TO THIS FIELD 1947 012664 2062 ISZ PT1 /NO HARM IF IT SKIPS 1948 012665 2266 ISZ .+1 1949 012666 3041 DCAT2, DCA T1 /T2, T3, ETC. 1950 012667 2021 ISZ XCT /RESETS THE SWITCH TOO! 1951 012670 5263 JMP .-5 1952 1953 012671 1042 TAD T2 /LAST ONE? 1954 012672 7450 SNA 1955 012673 5316 JMP DUMPX /YES 1956 012674 6221 CDF T 1957 012675 3502 DCA I C200 /SAVE THE NAME 1958 012676 1075 TAD P177 1959 012677 3017 DCA AXOUT /SET 'TEXTP' 1960 1961 012700 4541 GETC /RESETS THE DF 1962 012701 4541 GETC 1963 012702 4541 GETC /PRINT 'XX(' 1964 012703 4777 JMS I (FGO6 /PRINT SUBSCRIPT 1965 012704 4541 GETC /PRINT ')' 1966 012705 4537 PRINTN /PRINT VALUE 1967 1968 012706 6231 CDF V 1969 012707 2006 ISZ TRACE /FINISHED THIS LINE? 1970 012710 1462 TAD I PT1 /NO, LAST ENTRY? 1971 012711 7650 SNA CLA /NEITHER 1972 012712 5250 JMP DUMPT /START A NEW LINE 1973 012713 1103 TAD C240 1974 012714 5253 JMP DUMPT+3 /SEPARATE THE VARIABLES 1975 ///// 1976 012715 7775 DMPNO, -3 /DEFAULT = 3 1977 1978 012716 1071 DUMPX, TAD LASTC /RESET THE TRACE SWITCH 1979 012717 3006 DCA TRACE 1980 012720 5523 POPJ /RESET DF AND END THE LINE 1981 ///// 1982 /REMOVE A LINE OF TEXT AND RECOVER THE SPACE - 'DELETE' 1983 1984 012721 0000 XDELETE,0 /ENTRY POINT IS PACKING LIMIT 1985 012722 1067 TAD LINENO /TRYING TO DELETE LINE 0? 1986 012723 7650 SNA CLA 1987 012724 5177 JMP START /JUST IGNORE SUCH COMMANDS 1988 012725 4546 FINDLN /SETS THISLN, LASTLN, AND TEXTP 1989 012726 5721 JMP I XDELETE /ALREADY GONE 1990 ///// 1991 012727 6002 I0F /PROTECT TEXT POINTERS 1992 012730 4541 GETC /MEASURE LENGTH 1993 012731 4544 TESTCR 1994 012732 5330 JMP .-2 1995 012733 1017 TAD AXOUT /GET LAST ADDRESS 1996 012734 7040 CMA 1997 012735 1063 TAD THISLN /SUBTRACT FROM FIRST 1998 012736 3041 DCAT1, DCA T1 1999 012737 1041 TAD T1 /CORRECT BUFFER POINTER 2000 012740 1060 TAD BUFR 2001 012741 3060 DCA BUFR 2002 2003 012742 6221 CDF T 2004 012743 1463 TAD I THISLN /DISCONNECT 2005 012744 3464 DCA I LASTLN 2006 012745 1026 TAD HEADER /START AT THE BEGINNING 2007 012746 3064 XLOOP, DCA LASTLN /CORRECT LINE POINTERS 2008 012747 1464 TAD I LASTLN /GET THE NEXT ADDR 2009 012750 3020 DCA GTEM /SAVE 2010 012751 1020 TAD GTEM /COMPARE LINE POSITIONS 2011 012752 7141 CLL CIA 2012 012753 1063 TAD THISLN 2013 012754 7620 SNL CLA /SKIP IF THISLN > X 2014 012755 1041 TAD T1 /CHANGE (X) TO ACCOUNT 2015 012756 1020 TAD GTEM /FOR GARBAGE COLLECTION 2016 012757 3464 DCA I LASTLN 2017 012760 1020 TAD GTEM /GET NEXT 2018 012761 7440 SZA /TEST FOR END 2019 012762 5346 JMP XLOOP 2020 ///// 2021 012763 1016 TAD AXIN /COMPUTE COUNT 2022 012764 7041 CIA 2023 012765 1017 TAD AXOUT 2024 012766 3021 DCA XCT 2025 012767 7040 CMA 2026 012770 1063 TAD THISLN /RESET AXIN 2027 012771 3016 DCA AXIN 2028 012772 1417 TAD I AXOUT 2029 012773 3416 DCA I AXIN /SHIFT REMAINDER OF BUFFER DOWN 2030 012774 2021 ISZ XCT 2031 012775 5372 JMP .-3 2032 012776 5325 JMP XDELETE+4 /RESET 'LASTLN', 'THISLN' AND D.F. 2033 2034 012777 6104 PAGE 2035 /TTY INTERUPT I/O HANDLERS: 2036 /OUTPUT BUFFER HAS BEEN MOVED AND THE INPUT MODIFIED 2037 /TO INCREMENT A RANDOM NO. OR CALL A DISPLAY ROUTINE 2038 2039 013000 3010 KEYCK, XI33+1 /PATCHED BY DISPLAY ROUTINE 2040 2041 013001 1207 XOUTN, TAD XI33 2042 013002 6046 TLS /TYPE FIRST CHARACTER 2043 013003 3054 DCA TELSW /SET IN-PROGRESS FLAG 2044 013004 6211 CDF P 2045 013005 5621 JMP I XOUTL 2046 013006 7757 P7757, 7757 /LOC = PAGE+6 2047 2048 013007 3177 XI33, (REKOVR /VIA (INDEV) 2049 013010 2421 ISZ I XCT /BUMP RANDOM NUMBER 2050 013011 1055 TAD INBUF /ANY INPUT? 2051 013012 7450 SNA /YES AND NON-ZERO RNDM NO. 2052 013013 5600 JMP I KEYCK /NO OR ZERO RANDOM NUMBER 2053 013014 3210 DCA XI33+1 /SAVE AND KILL 'ISZ' 2054 013015 3055 DCA INBUF /CLEAR INPUT BUFFER 2055 013016 1210 TAD XI33+1 /PLACE CHARACTER IN AC 2056 013017 5607 JMP I XI33 2057 2058 013020 7763 MCP, "C-"P /OINK, OINK 2059 2060 013021 0000 XOUTL, 0 /VIA (OUTDEV) 2061 013022 3207 DCA XI33 /SAVE CURRENT CHARACTER 2062 013023 6201 CDF L 2063 013024 6001 I0N /BE SURE INTERRUPT IS ON 2064 013025 1742 TAD I OPTRI /ANY ROOM? 2065 013026 7640 SZA CLA /A CHARACTER IS NON-ZERO 2066 013027 5224 JMP .-3 /NO = WAIT 2067 013030 6212 CIF P /INHIBIT POINTER CHANGES 2068 013031 1054 TAD TELSW /IN PROGRESS? 2069 013032 7650 SNA CLA 2070 013033 5201 JMP XOUTN /NO 2071 013034 1207 TAD XI33 /PUT DATA IN EXTRA 2072 013035 3742 DCA I OPTRI /BUFFER SPACE 2073 013036 1342 TAD OPTRI /ADVANCE POINTER 2074 013037 7001 IAC /MODULO 20 2075 013040 0206 AND P7757 /(CIRCULAR STORE) 2076 013041 3342 DCA OPTRI /NEW VALUE 2077 013042 5204 JMP XOUTN+3 /RE-ENABLE INTERRUPTS 2078 2079 013043 6203 MINT, CDI /CTRL/C EXIT 2080 013044 5504 JMP I P7600 /MONITOR = 07600 2081 2082 SM8=6254 2083 DCMA=6601 2084 PCLF=6662 2085 RCTF=6677 2086 /INTERRUPT PROCESSOR: CHANGES FOR ^C AND ^F OR ^P 2087 2088 013045 3011 INTRPT, DCA SAVAC /SAVE WORKING REGISTERS 2089 013046 7010 RAR 2090 013047 3012 DCA SAVLK 2091 2092 013050 6041 TINT, TSF /CHECK OUTPUT FIRST WHILE DF=0 2093 013051 5266 JMP KINT 2094 013052 6042 TCF 2095 013053 3054 DCA TELSW /TURN OFF THE IN-PROGRESS FLAG 2096 013054 1743 TAD I OPTRO /I/O BUFFER IS IN FIELD 0 NOW 2097 013055 7450 SNA 2098 013056 5266 JMP KINT /DONE 2099 013057 6046 TLS /TYPE NEXT CHARACTER 2100 013060 3054 DCA TELSW /CLEAR AC & TURN ON THE FLAG 2101 013061 3743 DCA I OPTRO /ZERO OUT THE DATA JUST USED 2102 013062 1343 TAD OPTRO /GET POINTER AND 2103 013063 7001 IAC /ADVANCE MODULO 20 2104 013064 0206 CTRLF, AND P7757 /(CIRCULAR BUFFER) 2105 013065 3343 DCA OPTRO /NEW POINTER 2106 2107 013066 6031 KINT, KSF /NOW CHECK THE KEYBOARD 2108 013067 5312 JMP UINT 2109 013070 6034 KRS /READ BUFFER 2110 013071 0075 AND P177 /IGNORE PARITY 2111 013072 1376 TAD (-3 2112 013073 7450 SNA /TEST FOR CTRL C 2113 013074 5243 JMP MINT 2114 013075 1376 TAD (-3 /'TAD MCP' -> ^P 2115 013076 7650 SNA CLA /TEST FOR CTRL F 2116 013077 5347 JMP M20+2 2117 013100 1055 TAD INBUF /CHECK BUFFER 2118 013101 7141 CLL CIA 2119 013102 6036 KRB /RE-READ CHAR 2120 013103 0075 AND P177 2121 013104 7450 SNA /LEADER/TRAILER? 2122 013105 5312 JMP UINT 2123 013106 1102 TAD C200 2124 013107 7420 SNL /OVERFLOW? 2125 013110 4576 ERROR2 /'NOP' IF YOU DON'T CARE 2126 013111 3055 DCA INBUF 2127 2128 013112 7000 UINT, NOP /RESERVED FOR PLOTTER OVERLAY 2129 013113 7000 NOP / " 2130 013114 7000 NOP / " 2131 013115 6302 6302 /NOW CLEAR SOME ANNOYING FLAGS 2132 013116 6312 6312 2133 013117 6322 6322 2134 013120 6332 6332 2135 013121 6342 6342 2136 013122 6076 6076 2137 013123 6402 6402 2138 013124 5327 JMP XINT /CDI 0 /USE THS PATCH FOR ADDITIONAL 2139 013125 7000 NOP /JMP I .+1 /INTERRUPT SERVICE 2140 013126 7000 NOP /DDRESS /IN ANY FIELD 2141 013127 7000 XINT, NOP /16KXII.PA OVERLAYS HERE 2142 013130 7000 NOP / " 2143 013131 6677 RCTF 2144 013132 6601 DCMA 2145 013133 6662 PCLF /LPT8I.PA OVERLAYS HERE 2146 013134 6022 PCF 2147 013135 1012 TAD SAVLK 2148 013136 7104 CLL RAL 2149 013137 1011 TAD SAVAC 2150 013140 6203 CDI 2151 013141 5003 JMP PRNTC /RETURN FROM THE INTERRUPT 2152 2153 013142 3100 OPTRI, TBUF /OUTPUT BUFFER POINTERS 2154 013143 3100 OPTRO, TBUF /'I'= 'IN', 'O'= 'OUT' 2155 2156 /PRINT THE ERROR MESSAGE 2157 2158 013144 3054 DCA TELSW /CLEAR THE BUSY FLAG 2159 013145 7760 M20, SMA SZA SNL CLA /SKIP ERROR CODE 2160 013146 1576 TAD I TABCNT /AC= -1 OR -41 2161 013147 3067 DCA LINENO 2162 013150 3055 DCA INBUF 2163 013151 1342 TAD OPTRI /RESET POINTER 2164 013152 3343 DCA OPTRO 2165 013153 6203 CDI L 2166 013154 4350 JMS REKOVR /CLEAR OUTPUT BUFFER 2167 ///// 2168 013155 1375 TAD ("?-"_ /RETURN VIA 'EOF' 2169 013156 4534 PRINTC /PRINT A "?" 2170 013157 4547 PRNTLN /FOLLOWED BY ERROR CODE 2171 013160 2022 ISZ PC 2172 013161 6221 CDF T 2173 013162 1422 TAD I PC /GET PROGRAM STEP 2174 013163 7450 SNA 2175 013164 5372 JMP .+6 /DIRECT COMMAND ERROR 2176 013165 3067 DCA LINENO 2177 013166 1100 TAD C100 /ATSIGN 2178 013167 4534 PRINTC /RESETS DF 2179 013170 4534 PRINTC /SPACE 2180 013171 4547 PRNTLN /LINE NO. 2181 013172 1005 TAD CCR 2182 013173 4534 PRINTC 2183 013174 5177 BATXIT, JMP START /OR RETURN TO BATCH 2184 ///// 2185 2186 013175 7740 PAGE /END OF COMMAND PROCESSOR 013176 7775 013177 3150 2187 2188 /IN THE 8K VERSION THE VARIABLES COME NEXT AND EXTEND TO 2189 /THE BEGINNING OF THE FUNCTIONS. IN THE 12K VERSION THIS 2190 /SPACE IS AVAILABLE FOR USER ADDITIONS - HELP FOCAL GROW! 2191 / FUNCTION PACKAGE FOR 12K U/W-FOCAL: -JVZ- 2192 / 12KFNS.PA 2193 /REVISIONS: 2194 / TAD TXTEND CHANGED TO TAD BUFEND AT 14447 1/3/79 2195 2196 / FCOM AND FRA: RANDOM ACCESS FUNCTIONS 2197 2198 /THE 'FCOM' FUNCTION PROVIDES ACCESS TO DATA ARRAYS IN FIELD 2199 /2 (OR 4) USING EITHER OF 2 STORAGE MODES: SIGNED DOUBLE PRE- 2200 /CISION OR 4-WORD FLOATING-POINT. THE STORAGE MODE IS DETER- 2201 /MINED BY THE SIGN OF THE 'FCOM' INDEX. POSITIVE INDICES 2202 /(0-1023) ACCESS FLOATING-POINT NUMBERS WHILE NEGATIVE VALUES 2203 /REFERENCE DOUBLE PRECISION INTEGERS IN THE SAME WAY THAT THE 2204 /KE-8E EAE DOES IT. STORAGE BEGINS AT THE TOP OF THE FIELD & 2205 /EXTENDS DOWNWARD TOWARD THE TEXT AREA. THIS PROVIDES A REA- 2206 /SONABLE TRADEOFF BETWEEN LARGE DATA ARRAYS AND LONG PROGRAMS. 2207 2208 /THE VALUE OF THE 'FCOM' FUNCTION IS JUST THE VALUE OF THE 2209 /VARIABLE AT THE LOCATION REFERENCED. TO STORE A NEW VALUE 2210 /AT THAT LOCATION, SIMPLY INCLUDE A SECOND PARAMETER IN THE 2211 /FUNCTION CALL; THE VALUE OF THIS EXPRESSION WILL THEN BE 2212 /PLACED IN THE ARRAY AT THE SPECIFIED LOCATION. DATA CON- 2213 /VERSION BETWEEN INTEGER AND FLOATING-POINT MODES IS AUTO- 2214 /MATIC. EXAMPLES: SET X(I)=FCOM(I+100); X FCOM(J,FSIN(J)) 2215 2216 /THE 'FRA' FUNCTION PROVIDES 'FCOM-LIKE' ACCESS TO DATA ARRAYS 2217 /STORED IN BINARY FORM ON ANY MASS-STORAGE DEVICE. SEVERAL 2218 /DATA MODES ARE AVAILABLE: SINGLE WORD (SIGNED OR UNSIGNED), 2219 /DOUBLE PRECISION AND 4-WORD FLOATING POINT. A DIFFERENT 2220 /INDEXING SCHEME IS EMPLOYED TO HANDLE ALL THESE MODES. 2221 2222 /THE FILE USED BY FRA MUST FIRST BE LOOKED UP USING THE 2223 /'OPEN INPUT' COMMAND. FOLLOWING THIS 'FRA' MUST BE INITIAL- 2224 /IZED SO THAT THE NECESSARY POINTERS CAN BE TRANSFERRED AND 2225 /THE DATA FORMAT SELECTED. THE FOLLOWING TYPES OF CALLS ARE 2226 /PERMITTED: (I IS NON-NEGATIVE, V IS ANY EXPRESSION) 2227 2228 / FRA(I) READ THE I-TH VALUE 2229 / FRA(I,V) STORE V IN THIS LOCATION 2230 / FRA(-1) UPDATE THE LAST BLOCK 2231 / FRA(-1,M) INITIALIZE AND SET THE DATA MODE 2232 2233 /THE VALUE OF 'M' DETERMINES THE DATA MODE: 2234 2235 / M=0 UNSIGNED INTEGERS 2236 / M=1 SIGNED INTEGERS 2237 / M=2 DOUBLE PRECISION 2238 / M=4 4-WORD FLOATING-POINT 2239 2240 /'FRA' RETURNS 0 WHEN CALLED WITH A NEGATIVE INDEX. 2241 2242 /'FRA' USES ITS OWN ROUTINES FOR MODES 0-1, AND THE 'FCOM' 2243 /ROUTINES FOR MODES 2 & 4. BOTH FUNCTIONS ARE COMPLETELY 2244 /RECURSIVE, I.E. THEY MAY BE USED AS ARGUMENTS OF THEMSELVES. 2245 2246 PAGE 21 /PRECEEDING THE 8K FUNCTIONS 2247 014200 1045 FRA, TAD HORD /CHECK SIGN OF THE INDEX 2248 014201 7710 SPA CLA /INITIALIZATION? 2249 014202 5264 JMP INITL /YES, OR UPDATE 2250 014203 4560 FIXIT 2251 014204 7306 R3, CLA CLL RTL /=7306 2252 014205 4524 PUSHF /SAVE THE INDEX 2253 014206 0044 FLAC 2254 014207 4543 TSTCMA /READ OR WRITE? 2255 014210 5214 JMP .+4 /READ 2256 014211 4522 PUSHJ /WRITE 2257 014212 1610 EVAL /EVALUATE THE EXPRESSION 2258 014213 1074 TAD P13 /ALTER THE INSTRUCTION 2259 2260 014214 3262 DCA REED 2261 014215 4525 POPF /RECALL THE INDEX 2262 014216 0050 FLOP 2263 014217 1356 TAD SHIFTS 2264 014220 3335 DCA LAST1 2265 014221 4604 JMS I R3 /SHIFT RIGHT ONE BIT 2266 014222 2335 ISZ LAST1 2267 014223 5221 JMP .-2 2268 014224 1377 TAD (BLKNO&0 /FIRST BLOCK OF THIS FILE 2269 014225 7450 SNA 2270 014226 4576 ERROR2 /FILE NOT AVAILABLE 2271 014227 1052 TAD AC1L /THIS IS NOW THE RELATIVE BLOCK # 2272 014230 7041 CIA 2273 014231 1331 TAD ARG3 /IS IT THE SAME AS THE LAST ONE? 2274 014232 7650 SNA CLA 2275 014233 5246 JMP CORE /YES, DATA IS IN CORE 2276 014234 4335 JMS LAST1 /CHECK FOR ANY UPDATES 2277 014235 1376 TAD (FLNGTH /FILE SIZE 2278 014236 7161 STL CIA 2279 014237 1052 TAD AC1L 2280 014240 7620 SNL CLA /IS THIS A LEGAL INDEX? 2281 014241 4576 ERROR2 /NO, IT'S TOO LARGE 2282 014242 1052 TAD AC1L 2283 014243 1377 TAD (BLKNO&0 2284 014244 3331 DCA ARG3 /SET THE NEW BLOCK NUMBER 2285 014245 4321 JMS DISK /AND READ IT IN 2286 2287 014246 1262 CORE, TAD REED /R OR W? 2288 014247 7640 SZA CLA 2289 014250 3321 DCA DISK /SET THE 'CHANGE' FLAG 2290 014251 1262 TAD REED 2291 014252 1263 TAD WRIT /SET UP THE PROPER EXIT 2292 014253 3262 DCA REED 2293 014254 1053 TAD OVR1 /DEVELOP THE BUFFER ADDRESS 2294 014255 7112 CLL RTR 2295 014256 7112 CLL RTR 2296 014257 1375 TAD (3200-1 /BUFFER ADDRESS 2297 014260 6201 CDF 2298 014261 3014 DCA XRT 2299 014262 5357 REED, JMP W0 /NOW FOR THE EASY PART! 2300 2301 014263 5344 WRIT, JMP R0 /OR ELSEWHERE... 2302 014264 4543 INITL, TSTCMA /UPDATE OR INITIALIZE? 2303 014265 5316 JMP FINAL /UPDATE 2304 014266 4522 PUSHJ 2305 014267 1610 EVAL 2306 014270 4560 FIXIT /GET THE DATA MODE 2307 014271 1105 TAD M4 2308 014272 7450 SNA 2309 014273 7100 CLL 2310 014274 7001 IAC 2311 014275 7430 SZL /0-4? (EXCLUDING 3) 2312 014276 4576 ERROR2 /MODE ERROR 2313 014277 1374 TAD (-15 2314 014300 7130 STL RAR /DETERMINE THE SHIFT COUNT 2315 014301 3356 DCA SHIFTS 2316 014302 1046 TAD LORD 2317 014303 7124 STL RAL 2318 014304 1340 TAD JMPR0 /AND THE PROPER R/W ROUTINE 2319 014305 3263 DCA WRIT 2320 014306 6201 CDF /NOW GET THE POINTERS 2321 014307 1537 TAD I ATSW /=BLKNO 2322 014310 3377 DCA (BLKNO&0 2323 014311 1773 TAD I (ILNGTH 2324 014312 3376 DCA (FLNGTH 2325 014313 1760 TAD I W0+1 /=INHND 2326 014314 3372 DCA (HANDLR 2327 014315 6211 CDF P 2328 014316 4335 FINAL, JMS LAST1 /UPDATE THE LAST BLOCK 2329 014317 3331 DCA ARG3 2330 014320 5553 FLOATR 2331 2332 014321 7000 DISK, NOP /READ/WRITE SUBROUTINE 2333 014322 1102 TAD C200 /= 1 BLOCK IN FIELD 0 2334 014323 3327 DCA ARG1 2335 014324 6202 CIF /GO BELOW 2336 014325 6002 I0F /OR 'NOP' 2337 014326 4772 JMS I (HANDLR /CALL THE (INPUT) HANDLER 2338 014327 0200 ARG1, 200 2339 014330 3200 3200 2340 014331 0000 ARG3, 0 2341 014332 5365 JMP W3 /DEVICE ERROR 2342 014333 6001 I0N 2343 014334 5721 JMP I DISK 2344 2345 014335 0000 LAST1, 0 /CHECK FOR CHANGES & UPDATE 2346 014336 1321 TAD DISK /HAVE WE WRITTEN ANYTHING? 2347 014337 7640 SZA CLA 2348 014340 5343 JMPR0, JMP .+3 /NO 2349 014341 7330 SM0 /YES 2350 014342 4321 JMS DISK /RESET THE FLAG 2351 014343 5735 JMP I LAST1 /AND REALLY DO IT 2352 /HERE ARE ALL THE READ AND WRITE ROUTINES: 2353 2354 014344 1414 R0, TAD I XRT /UNSIGNED INTEGERS 2355 014345 5554 FL0ATR 2356 2357 014346 1414 R1, TAD I XRT /SIGNED INTEGERS 2358 014347 5553 FLOATR 2359 2360 014350 1357 R2, TAD W0 /DOUBLE PRECISION 2361 014351 3044 DCA EXP 2362 2363 014352 5753 JMP I .+1 2364 014353 4431 GET+6 2365 2366 014354 5755 R4, JMP I .+1 /FLOATING POINT 2367 014355 4425 GET+2 2368 2369 014356 0000 SHIFTS, 0 /SEPARATES THE LISTS BY 13 2370 2371 014357 0027 W0, 27 /SINGLE PRECISION 2372 014360 0125 INHND /<1000(8) 2373 2374 014361 4560 W1, FIXIT /SIGNED OR UNSIGNED 2375 014362 5771 JMP I (GET-2 2376 2377 014363 5764 W2, JMP I .+1 2378 014364 4416 PUT+6 2379 2380 014365 6202 W3, CIF /GENERATE ?29.70 2381 014366 5604 JMP I R3 2382 2383 014367 5770 W4, JMP I .+1 2384 014370 4410 PUT 2385 2386 014371 4421 PAGE 014372 6323 014373 6002 014374 7763 014375 3177 014376 0057 014377 0000 2387 /FCOM: STORAGE FUNCTION FOR DATA ARRAYS 2388 2389 014400 4560 FCOM, FIXIT /FIX INDEX AND SET EXP, OVER 2390 014401 4520 PUSHA /SAVE INDEX ON THE STACK 2391 014402 4543 TSTCMA /CHECK FOR A SECOND ARGUMENT 2392 014403 5223 JMP GET 2393 014404 4522 PUSHJ /GET THE ARGUMENT 2394 014405 1610 EVAL 2395 014406 4237 JMS INDEX /COMPUTE THE INDEX 2396 014407 5216 JMP .+7 /IT WAS NEGATIVE 2397 2398 014410 1044 PUT, TAD EXP /FLOATING STORAGE 2399 014411 3414 DCA I XRT 2400 014412 1047 TAD OVER 2401 014413 3414 DCA I XRT 2402 014414 1046 TAD LORD 2403 014415 7410 SKP 2404 014416 4560 FIXIT /INTEGER STORAGE 2405 014417 3414 DCA I XRT 2406 014420 1045 TAD HORD 2407 014421 3414 DCA I XRT 2408 014422 5555 RETURN /FUNCTION RETURN 2409 2410 014423 4237 GET, JMS INDEX /FIGURE IT OUT 2411 014424 5231 JMP .+5 /NOTE: EXP=27, OVER=0 2412 014425 1414 TAD I XRT /FLOATING RETRIEVAL 2413 014426 3044 DCA EXP 2414 014427 1414 TAD I XRT 2415 014430 3047 DCA OVER 2416 014431 1414 TAD I XRT /INTEGER RETRIEVAL 2417 014432 3046 DCA LORD 2418 014433 1414 TAD I XRT 2419 014434 3045 DCA HORD 2420 014435 5555 RETURN /'RETURN' FLOATS INTEGERS 2421 014436 7000 NOP 2422 2423 014437 0000 INDEX, 0 /COMPUTE INDEX AND BRANCH 2424 014440 4521 POPA /EXAMINE THE ARGUMENT 2425 014441 7510 SPA /FLOATING 2426 014442 5245 JMP .+3 /INTEGER 2427 014443 2237 ISZ INDEX /SET POSITIVE RETURN 2428 014444 7144 CMA CLL RAL /-(I+1)*4 FOR FLOATING 2429 014445 7104 CLL RAL /*2 FOR INTEGER STORAGE 2430 014446 7160 STL CMA 2431 014447 1027 TAD BUFEND /'IAC' IF LAST PAGE FREE 2432 014450 1060 TAD BUFR /'NOP' FOR 20K SYSTEM 2433 014451 7460 SNL SZA /CHECK TEXT LIMIT 2434 014452 4576 ERROR2 /FCOM INDEX EXCEEDED RANGE 2435 014453 7040 CMA /SUBTRACT ONE 2436 014454 1060 TAD BUFR /'NOP' FOR 20K SYSTEM 2437 014455 3014 DCA XRT /LOAD INDEX REGISTER 2438 014456 6221 CDF T /'CDF 40' FOR 20K 2439 014457 5637 JMP I INDEX 2440 2441 /NOTE: 'INDEX' IS EASILY CHANGED TO STORE IN FIELDS 4-7. 2442 /THIS PATCH MODIFIES THE 'INDEX' ROUTINE SO THAT POSITIVE 2443 /INDICES FROM 0-2047 MAY BE USED TO ADDRESS ALL LOCATIONS 2444 /IN FIELDS 4 & 5. THE 'NEGATIVE INDEX' FEATURE HAS BEEN 2445 /ELIMINATED: ONLY FLOATING-POINT STORAGE IS AVAILABLE. 2446 2447 NOPUNCH 2448 *PUT-1 2449 014407 7000 NOP /ELIMINATE THE 'NEG.' RETURN 2450 *GET 2451 014423 6241 CDF 40 /USE THIS LOC. FOR A CONSTANT 2452 014424 4237 JMS INDEX /AND MOVE THIS DOWN ONE 2453 2454 *INDEX+2 2455 014441 7510 SPA /CHECK STORAGE LIMIT 2456 014442 5252 JMP .+10 /KEEP THE SAME ERROR CODE 2457 014443 7106 CLL RTL /MULTIPLY THE INDEX BY 4 2458 014444 7440 SZA /LEAVING THE FIELD INFO 2459 014445 7041 CIA /IN THE LINK 2460 014446 7040 CMA /SUBTRACT ONE 2461 014447 3014 DCA XRT /AND SAVE THE INDEX 2462 014450 7006 RTL /SHIFT THE FIELD BIT OVER 2463 014451 7410 SKP 2464 014452 4576 ERROR2 /INDEX GREATER THAN 2047(10) 2465 014453 7006 RTL 2466 014454 1223 TAD GET /ADD THE 'CDF' INSTRUCTION 2467 014455 3256 DCA .+1 2468 2469 /THIS PATCH MODIFIES THE 'INDEX' ROUTINE SO THAT POSITIVE 2470 /INDICES FROM 0-4095 MAY BE USED TO ADDRESS ALL LOCATIONS 2471 /IN FIELDS 4-7. THE 'NEGATIVE INDEX' FEATURE HAS BEEN 2472 /ELIMINATED: ONLY FLOATING-POINT STORAGE IS AVAILABLE. 2473 2474 *PUT-1 2475 014407 7000 NOP /ELIMINATE THE 'NEG.' RETURN 2476 *GET 2477 014423 6241 CDF 40 /USE THIS LOC. FOR A CONSTANT 2478 014424 4237 JMS INDEX /AND MOVE THIS DOWN ONE 2479 2480 *INDEX+2 2481 014441 7106 CLL RTL /MULTIPLY THE INDEX BY 4 2482 014442 3014 DCA XRT /LEAVING THE FIELD INFO 2483 014443 7001 IAC /IN BIT 11 AND THE LINK 2484 014444 0014 AND XRT 2485 014445 7006 RTL /SHIFT THE FIELD BITS OVER 2486 014446 7006 RTL 2487 014447 1223 TAD GET /ADD THE 'CDF' INSTRUCTION 2488 014450 3256 DCA .+6 /AND SAVE FOR LATER 2489 014451 7344 SM2 /=7776 2490 014452 0014 AND XRT /CLEAN UP THE INDEX 2491 014453 7041 CIA 2492 014454 7040 CMA /SUBTRACT ONE 2493 ENPUNCH;*.+3 2494 2495 /THE CHANGES ARE CONSTRUCTED SO THAT THEY DO NOT INTER- 2496 /FERE WITH 'FRA' WHICH USES SOME OF THE 'FCOM' ROUTINES. 2497 /THE 'HESITATE' COMMAND PROVIDES A PROGRAMMABLE PAUSE TO 2498 /BE USED WHENEVER IT IS NECESSARY TO SYNCHRONIZE THE PRO- 2499 /GRAM WITH AN EXTERNAL DEVICE. THE TIMING IS PROVIDED BY 2500 /A SOFTWARE LOOP WHICH MUST BE ADJUSTED FOR DIFFERENT MA- 2501 /CHINES. ASSEMBLY OPTIONS ARE PROVIDED FOR THE 8/E AND 2502 /8/I AND OTHERS ARE EASILY PATCHED. TIMES ARE EXPRESSED 2503 /IN MILLISECONDS, SO 'H 1000' PROVIDES A 1 SECOND DELAY. 2504 2505 014460 4522 HESI, PUSHJ /PARAMETER = DELAY TIME 2506 014461 1610 EVAL / (IN MILLISECONDS) 2507 014462 4557 NEGATE 2508 014463 7430 SZL /ZERO OR MISSING ARGUMENT? 2509 014464 5434 CONTINUE /AVOID A 4HR 40MIN DELAY ! 2510 014465 4560 FIXIT /CONVERT TO DOUBLE PRECISION 2511 014466 7450 SNA /1ST CYCLE MAY BE A BIT OFF 2512 014467 1277 TAD TATE /GET LOOP CONSTANT 2513 014470 7001 IAC /COUNT DOWN 2514 014471 7450 SNA /DONE? 2515 014472 2046 ISZ LORD /1.003 MS PER MAJOR CYCLE 2516 014473 5266 JMP .-5 /TIMES THE NUMBER OF CYCLES 2517 014474 2045 ISZ HORD 2518 014475 5267 JMP .-6 2519 014476 5434 CONTINUE /RETURN TO MAINLINE 2520 TATE, 2521 IFDEF TFLI <-320> /1.2 USEC (8/E) 2522 014477 7544 IFNDEF TFLI <-234> /1.6 USEC (8/I) 2523 ///// 2524 / FUNCTION PACKAGE FOR 8K U/W-FOCAL: -JVZ- 2525 2526 /THESE FUNCTIONS ARE BASED ON THE SERIES APPROXIMATIONS DE- 2527 /VELOPED BY D.A. DALBY AND D.E. WELLS OF THE BEDFORD INSTI- 2528 /TUTE OF OCEANOGRAPHY, DARTMOUTH, NOVA SCOTIA (DECUS 8-103) 2529 /WHILE EXHAUSTIVE TESTING HAS NOT BEEN CARRIED OUT, TYPI- 2530 /CALLY THE RESULTS ARE CORRECT TO CA. 3 IN THE TENTH DIGIT. 2531 2532 *4600-12 2533 2534 /EXPONENTIAL CONSTANTS: 2535 2536 014566 0000 E1, +0;4000;0000;0275 014567 4000 014570 0000 014571 0275 2537 014572 7777 E2, -1;3777;7775;1652 014573 3777 014574 7775 014575 1652 2538 014576 7776 E3, -2;5252;5353;1521 014577 5252 014600 5353 014601 1521 2539 014602 7774 E4, -4;2524;7613;5106 014603 2524 014604 7613 014605 5106 2540 014606 7772 E5, -6;5700;2131;0200 014607 5700 014610 2131 014611 0200 2541 014612 7767 E6, -11;2560;3573;7333 014613 2560 014614 3573 014615 7333 2542 014616 7764 E7, -14;5542;5227;4775 014617 5542 014620 5227 014621 4775 2543 /BASE E EXPONENTIAL FUNCTION: 2544 2545 014622 4562 FEXP, CHKSGN /TAKE THE ABSOLUTE VALUE 2546 014623 0001 1 2547 014624 4407 FENT 2548 014625 3312 FDIV LN2 /FORM N+F 2549 014626 6504 FPUT I FLARGP 2550 014627 0000 FEXT 2551 014630 4557 NEGATE 2552 014631 4560 FIXIT /FORM -N 2553 014632 3042 DCA T2 2554 014633 4435 NORMALIZE 2555 ///// 2556 014634 4407 FENT 2557 014635 1504 FADD I FLARGP /FORM F 2558 014636 4312 FMUL LN2 2559 014637 6504 FPUT I FLARGP 2560 014640 4216 FMUL E7 2561 014641 1212 FADD E6 2562 014642 4504 FMUL I FLARGP 2563 014643 1206 FADD E5 2564 014644 4504 FMUL I FLARGP 2565 014645 1202 FADD E4 2566 014646 4504 FMUL I FLARGP 2567 014647 1666 FADD I X3 2568 014650 4504 FMUL I FLARGP 2569 014651 1667 FADD I X2 2570 014652 4504 FMUL I FLARGP 2571 014653 1670 FADD I X1 2572 014654 4504 FMUL I FLARGP 2573 014655 1671 FADD I X0 2574 014656 0000 FEXT 2575 ///// 2576 014657 1042 TAD T2 /DIVIDE THE SUM BY 2^N 2577 014660 1044 TAD EXP 2578 014661 3044 DCA EXP 2579 014662 1155 TAD FINISH /POINT TO 'RETURN' 2580 014663 3272 DCA CHKARG 2581 014664 1043 TAD T3 2582 014665 5302 JMP EXPX /FEXP(X)=1/FEXP(-X) 2583 ///// 2584 2585 014666 4576 X3, E3 2586 014667 4572 X2, E2 2587 014670 4566 X1, E1 2588 014671 5116 X0, E0 2589 014672 0000 CHKARG, 0 /ARGUMENT CHECK FOR 'FLOG', 'FATN' 2590 014673 3042 DCA T2 /SET THE FLIP-FLOP 2591 014674 4562 CHKSGN /LOOK AT THE SIGN FIRST 2592 014675 5672 JMP I CHKARG /ZERO 2593 014676 2272 ISZ CHKARG /NON-ZERO 2594 014677 7240 CLA CMA /COMPARE WITH UNITY 2595 014700 1044 TAD EXP 2596 014701 1042 TAD T2 /.LT. OR .GT. ONE? 2597 014702 7710 EXPX, SPA CLA 2598 014703 5672 JMP I CHKARG /YOUR CHOICE 2599 014704 4407 FENT 2600 014705 5223 FPWR FEXP+1 /= -1.7427... 2601 014706 6504 FPUT I FLARGP /SAVE THE RECIPROCAL 2602 014707 0000 FEXT 2603 014710 1306 TAD .-2 2604 014711 5672 JMP I CHKARG /T3=SIGN FLAG, AC=INVERSION FLAG 2605 ///// 2606 2607 /LOGARITHM CONSTANTS: 2608 2609 014712 0000 LN2, +0;2613;4413;7676 014713 2613 014714 4413 014715 7676 2610 014716 7766 L12, -12;4132;5467;5141 014717 4132 014720 5467 014721 5141 2611 014722 7771 L11, -7;3467;0413;5110 014723 3467 014724 0413 014725 5110 2612 014726 7773 L10, -5;4633;3721;5500 014727 4633 014730 3721 014731 5500 2613 014732 7774 L9, -4;3470;0312;3507 014733 3470 014734 0312 014735 3507 2614 014736 7775 L8, -3;4770;3123;3611 014737 4770 014740 3123 014741 3611 2615 014742 7776 L7, -2;2050;7523;5173 014743 2050 014744 7523 014745 5173 2616 /NAPERIAN LOGARITHM 2617 2618 014746 7330 FLOG, SM0 /CHECK OUT THE ARGUMENT 2619 014747 4272 JMS CHKARG 2620 014750 4576 ERROR2 /CAN'T TAKE THE LN OF ZERO 2621 014751 3043 DCA T3 2622 014752 7040 CMA 2623 014753 1044 TAD EXP 2624 014754 4552 FLOAT /FLOAT THE EXPONENT 2625 014755 7001 IAC 2626 014756 3504 DCA I FLARGP /REPLACE IT WITH 1 2627 014757 4435 NORMALIZE 2628 ///// 2629 014760 4407 FENT /DO THE SERIES 2630 014761 4312 FMUL LN2 2631 014762 6577 FPUT I BUFFPT 2632 014763 0504 FGET I FLARGP /JUST THE MANTISSA NOW 2633 014764 2511 FSUB I FP1 2634 014765 6504 FPUT I FLARGP /BACK AGAIN! 2635 014766 4316 FMUL L12 2636 014767 1322 FADD L11 2637 014770 4504 FMUL I FLARGP 2638 014771 1326 FADD L10 2639 014772 4504 FMUL I FLARGP 2640 014773 1332 FADD L9 2641 014774 4504 FMUL I FLARGP 2642 014775 1336 FADD L8 2643 014776 4504 FMUL I FLARGP 2644 014777 1342 FADD L7 2645 / PAGE BOUNDARY 2646 015000 4504 FMUL I FLARGP 2647 015001 1345 FADD L6 2648 015002 4504 FMUL I FLARGP 2649 015003 1351 FADD L5 2650 015004 4504 FMUL I FLARGP 2651 015005 1355 FADD L4 2652 015006 4504 FMUL I FLARGP 2653 015007 1361 FADD L3 2654 015010 4504 FMUL I FLARGP 2655 015011 1365 FADD L2 2656 015012 4504 FMUL I FLARGP 2657 015013 1371 FADD L1 2658 015014 4504 FMUL I FLARGP 2659 015015 1577 FADD I BUFFPT /ADD N*LN2 2660 015016 0000 FEXT 2661 015017 5777 JMP I (EXIT2 /NEGATE RESULT IF NECESSARY 2662 /ARCTANGENT FUNCTION FOR ANGLES IN RADIANS 2663 2664 015020 4776 FATN, JMS I (CHKARG 2665 015021 5555 RETURN /ATN(0)=0 2666 015022 3255 DCA INVRS /SET THE EXIT 2667 015023 4407 FENT 2668 015024 4044 FMUL FLAC 2669 015025 6577 FPUT I BUFFPT /SAVE THE SQUARE 2670 015026 4262 FMUL A23 2671 015027 1266 FADD A21 2672 015030 4577 FMUL I BUFFPT 2673 015031 1272 FADD A19 2674 015032 4577 FMUL I BUFFPT 2675 015033 1276 FADD A17 2676 015034 4577 FMUL I BUFFPT 2677 015035 1302 FADD A15 2678 015036 4577 FMUL I BUFFPT 2679 015037 1306 FADD A13 2680 015040 4577 FMUL I BUFFPT 2681 015041 1312 FADD A11 2682 015042 4577 FMUL I BUFFPT 2683 015043 1321 FADD A9 2684 015044 4577 FMUL I BUFFPT 2685 015045 1325 FADD A7 2686 015046 4577 FMUL I BUFFPT 2687 015047 1331 FADD A5 2688 015050 4577 FMUL I BUFFPT 2689 015051 1335 FADD A3 2690 015052 4577 FMUL I BUFFPT 2691 015053 1341 FADD A1 2692 015054 4504 FMUL I FLARGP /CONVERT TO ODD POWERS 2693 015055 6504 INVRS, FPUT I FLARGP /OR 'FEXT' 2694 015056 0775 FGET I (PIOV2 2695 015057 2504 FSUB I FLARGP /ATN(X)=PI/2-ATN(1/X) 2696 015060 0000 FEXT 2697 015061 5777 JMP I (EXIT2 /TAKE CARE OF THE SIGN 2698 ///// 2699 /ARCTANGENT CONSTANTS 2700 2701 015062 7766 A23, -12;5457;4432;1701 015063 5457 015064 4432 015065 1701 2702 015066 7771 A21, -7;2145;4241;4605 015067 2145 015070 4241 015071 4605 2703 015072 7772 A19, -6;4166;3357;4120 015073 4166 015074 3357 015075 4120 2704 015076 7774 A17, -4;2040;1626;5457 015077 2040 015100 1626 015101 5457 2705 015102 7774 A15, -4;4507;1221;3170 015103 4507 015104 1221 015105 3170 2706 015106 7775 A13, -3;2222;2557;0167 015107 2222 015110 2557 015111 0167 2707 015112 7775 A11, -3;5107;0475;7567 015113 5107 015114 0475 015115 7567 2708 015116 0000 E0, +0;3777;7777/7775 015117 3777 015120 7777 2709 015121 7775 A9, -3;3427;7472;2175 015122 3427 015123 7472 015124 2175 2710 015125 7776 A7, -2;5555;7621;6402 015126 5555 015127 7621 015130 6402 2711 015131 7776 A5, -2;3146;3041;1767 015132 3146 015133 3041 015134 1767 2712 015135 7777 A3, -1;5252;5253;5611 015136 5252 015137 5253 015140 5611 2713 015141 0000 A1, +0;3777;7777;7755 015142 3777 015143 7777 015144 7755 2714 /LOGARITHM CONSTANTS 2715 2716 015145 7776 L6, -2;5312;1653;0406 015146 5312 015147 1653 015150 0406 2717 015151 7776 L5, -2;3137;6765;6402 015152 3137 015153 6765 015154 6402 2718 015155 7776 L4, -2;4000;7041;0031 015156 4000 015157 7041 015160 0031 2719 015161 7777 L3, -1;2525;2301;7431 015162 2525 015163 2301 015164 7431 2720 015165 7777 L2, -1;4000;0006;2241 015166 4000 015167 0006 015170 2241 2721 015171 0000 L1, +0;3777;7777;7445 015172 3777 015173 7777 015174 7445 2722 2723 015175 5277 PAGE 015176 4672 015177 5252 2724 /EXTENDED PRECISION SIN & COS - TAKEN FROM DEC'S FLOATING- 2725 /POINT PACKAGE (R. BEAN) & FOCAL8-231 (DR. H.B. THOMPSON). 2726 /THE COEFFICIENTS HAVE BEEN OPTIMIZED FOR U/W-FOCAL (JVZ). 2727 2728 015200 7330 FCOS, SM0 /ONLY NEGATE IF POSITIVE 2729 015201 4436 JMS I ABSOL /(SUGGESTED BY G. CHASE) 2730 015202 4407 FENT 2731 015203 1277 FADD PIOV2 /COS(X)=SIN(PI/2-X) 2732 015204 0000 FEXT 2733 2734 015205 4562 FSIN, CHKSGN /CHECK THE SIGN 2735 015206 5226 JMP QUAD1 /ARGUMENT WAS 0 2736 015207 4407 FENT 2737 015210 3277 FDIV PIOV2 /CONVERT TO QUADRANTS 2738 015211 6504 FPUT I FLARGP 2739 015212 0000 FEXT 2740 2741 015213 4560 FIXIT /GET THE INTEGER PART 2742 015214 0254 AND SC3 /MODULO 4 2743 015215 1206 TAD FSIN+1 2744 015216 3220 DCA QUAD0 /SET UP THE BRANCH 2745 015217 4316 JMS FRCT /GET THE FRACTION 2746 2747 015220 0000 QUAD0, 0 /AND PROCESS IT 2748 015221 4407 FENT 2749 015222 2511 FSUB I FP1 /SUBTRACT 1.0 2750 015223 0000 FEXT 2751 015224 5620 JMP I QUAD0 2752 2753 015225 4557 NEGATE 2754 015226 5232 QUAD1, JMP QUAD5 /USE X 2755 015227 4220 QUAD2, JMS QUAD0 /USE 1-X 2756 015230 5225 QUAD3, JMP QUAD1-1 /USE -X 2757 015231 4220 QUAD4, JMS QUAD0 /USE X-1 2758 2759 015232 4407 QUAD5, FENT /SIX TERM POLYNOMIAL 2760 015233 6504 FPUT I FLARGP /SAVE THE ARGUMENT 2761 015234 4044 FMUL FLAC 2762 015235 6577 FPUT I BUFFPT /SAVE THE SQUARE 2763 015236 4255 FMUL C11 2764 015237 1260 FADD C9 2765 015240 4577 FMUL I BUFFPT 2766 015241 1263 FADD C7 2767 015242 4577 FMUL I BUFFPT 2768 015243 1267 FADD C5 2769 015244 4577 FMUL I BUFFPT 2770 015245 1273 FADD C3 2771 015246 4577 FMUL I BUFFPT 2772 015247 1277 FADD PIOV2 2773 015250 4504 FMUL I FLARGP /CONVERT TO ODD POWERS 2774 015251 0000 FEXT 2775 /COMMON EXIT ROUTINE FOR EXTENDED FUNCTIONS 2776 2777 015252 1043 EXIT2, TAD T3 /CHECK SIGN 2778 015253 5373 JMP FABS+1 2779 2780 /SINE AND COSINE CONSTANTS 2781 2782 015254 0003 SC3, 3 2783 015255 7756 C11, -22;4313;2133 015256 4313 015257 2133 2784 015260 7764 C9, -14;2500;3207 015261 2500 015262 3207 2785 015263 7771 C7, -7;5464;5650;4204 015264 5464 015265 5650 015266 4204 2786 015267 7775 C5, -3;2431;5360;3221 015270 2431 015271 5360 015272 3221 2787 015273 0000 C3, +0;5325;0414;3240 015274 5325 015275 0414 015276 3240 2788 015277 0001 PIOV2, +1;3110;3755;2421 015300 3110 015301 3755 015302 2421 2789 2790 /COMMON ROUTINES FOR EXTENDED FUNCTIONS 2791 2792 015303 0000 SGNCHK, 0 /ALSO CALLED BY 'GETLN' 2793 015304 4436 JMS I ABSOL /TAKE THE ABSOLUTE VALUE 2794 015305 4407 FENT 2795 015306 6504 FPUT I FLARGP /AND PUT IT BACK AGAIN 2796 015307 0000 FEXT 2797 015310 1040 TAD SIGN /'FPUT' LEAVES L=1 2798 015311 7440 SZA 2799 015312 2303 ISZ SGNCHK /FIRST RETURN = ZERO 2800 015313 3043 DCA T3 2801 015314 1043 TAD T3 2802 015315 5703 JMP I SGNCHK /AC,T3 = SIGN OF THE ARGUMENT 2803 2804 015316 0000 FRCT, 0 /CALLED BY 'FSIN', 'FRAC' 2805 015317 4407 FENT 2806 015320 7270 FIXER /='FNOR' 2807 015321 2504 FSUB I FLARGP 2808 015322 0000 FEXT 2809 015323 4557 NEGATE 2810 015324 5716 JMP I FRCT 2811 /REVISED SQUARE ROOT FUNCTION 2812 2813 015325 7614 FSR, LAS SKP /READ THE SWITCH REGISTER 2814 015326 4562 FSQT, CHKSGN /BETTER CHECK THE SIGN 2815 015327 5553 FLOATR /0 OR SWITCHES 2816 015330 7710 SPA CLA /WAS THE ARGUMENT NEGATIVE? 2817 015331 4576 ERROR2 /CAN'T TAKE IMAGINARY ROOTS 2818 015332 1044 TAD EXP /'CHKSGN' SETS L=1 2819 015333 7500 SMA 2820 015334 7100 CLL /USE AN ARITHMETIC SHIFT 2821 015335 7010 RAR /DIVIDE EXPONENT BY TWO 2822 015336 7430 SZL /TEST IF IT WAS ODD OR EVEN 2823 015337 7001 IAC /ODD - ADD ONE 2824 015340 3044 DCA EXP 2825 015341 1106 TAD M5 /INITIALIZE ITERATION COUNTER 2826 015342 3043 DCA T3 2827 2828 015343 4407 SQRT, FENT /NEWTON'S METHOD IS USED 2829 015344 6577 FPUT I BUFFPT /SAVE APPROXIMATION 2830 015345 0504 FGET I FLARGP /GET BACK THE ARGUMENT 2831 015346 3577 FDIV I BUFFPT 2832 015347 1577 FADD I BUFFPT 2833 015350 4777 FMUL I (FLP5 /DIVIDE BY 2 2834 015351 0000 FEXT 2835 015352 2043 ISZ T3 /5 ITERATIONS ARE SUFFICIENT 2836 015353 5343 JMP SQRT 2837 015354 5555 RETURN 2838 2839 015355 4560 FRAC, FIXIT /FIND THE FRACTIONAL PART 2840 015356 4316 JMS FRCT 2841 015357 5555 RETURN 2842 2843 015360 4560 FOUT, FIXIT /SINGLE-CHARACTER OUTPUT 2844 015361 7450 SNA 2845 015362 7330 SM0 /IN CASE IT'S ZERO 2846 015363 4534 PRINTC 2847 2848 015364 1045 FSGN, TAD HORD /REAL SIGNUM FUNCTION 2849 015365 7640 SZA CLA 2850 015366 7001 IAC 2851 015367 4552 FLOAT /PREPARE 1.0 2852 2853 015370 1076 FITR, TAD P43 /IMPROVED INTEGER FUNCTION 2854 015371 4720 JMS I FRCT+2 /REPLACES 'FIXIT;CLA' (6D) 2855 2856 015372 1776 FABS, TAD I (FLARG+1 /CHECK THE ORIGINAL SIGN 2857 015373 7710 SPA CLA 2858 015374 4557 NEGATE 2859 015375 5555 RETURN /ALSO USED BY OTHER FUNCTIONS 2860 2861 015376 7601 PAGE 36 /MORE AFTER THE F.P. PACKAGE 015377 0363 2862 /THE 'Y' COMMAND ADDS OR SUBTRACTS ONE TO A LIST OF VARI- 2863 /ABLES DEPENDING UPON WHETHER THE NAME IS PRECEEDED BY A 2864 /MINUS SIGN OR NOT. THUS 'Y I' IS THE SAME AS 'S I=I+1', 2865 /WHILE 'Y -I' IS LIKE 'S I=I-1'. SPACES, COMMAS OR MINUS 2866 /SIGNS MAY BE USED TO SEPARATE THE NAMES: 'Y N-O,P Q- R' 2867 /WILL ADD ONE TO 'N,P,Q' AND SUBTRACT ONE FROM 'O,R'. 2868 2869 017400 4541 DECR, GETC /PASS THE MINUS SIGN 2870 017401 1222 TAD YNCR+2 /MODIFY THE INSTRUCTION 2871 017402 3215 DCA YNCR-3 /'FADD/FSUB I FP1' 2872 017403 4542 SPNOR 2873 017404 4526 SORTJ /CHECK ON WHAT TO DO 2874 017405 1220 YLST-1 2875 017406 0037 YGO-YLST 2876 017407 4522 PUSHJ /ERRORS WILL BE TRAPPED HERE 2877 017410 1400 GETARG 2878 017411 4543 TSTCMA /REMOVE SEPARATORS 2879 017412 1511 FADD I FP1 /NOP 2880 017413 4407 FENT 2881 017414 0400 FGETIPT1 /LOAD THE VARIABLE 2882 017415 1511 FADD I FP1 /ADD OR SUBTRACT ONE 2883 017416 6400 FPUTIPT1 /STORE IT AWAY AGAIN 2884 017417 0000 FEXT 2885 017420 1212 YNCR, TAD .-6 /'Y' DO WE HAVE THIS COMMAND? 2886 017421 5202 JMP DECR+2 /REPEAT? 2887 017422 2511 FSUB I FP1 /BECAUSE THE USERS DEMAND IT! 2888 2889 / 'FMIN' & 'FMAX' COMPARE TWO ARGUMENTS, RETURNING THE 2890 /LARGER OR SMALLER OF THE TWO. THANKS TO R. MAZUR OF 2891 /THE HOCHSHULE DER BUNDESWEHR IN MUENCHEN FOR THE IDEA. 2892 2893 017423 7330 FMIN, SM0 /AC=4000 2894 017424 4520 FMAX, PUSHA /REMEMBER THE ENTRY POINT 2895 017425 4524 PUSHF /SAVE THE FIRST ARGUMENT 2896 017426 0044 FLAC 2897 017427 4522 PUSHJ /GET THE SECOND ARGUMENT 2898 017430 1605 EVAL-3 2899 017431 4525 POPF /RECALL ARGUMENT NO. 1 2900 017432 7610 BUFFER 2901 017433 4407 FENT 2902 017434 2577 FSUB I BUFFPT /MAKE THE COMPARISON 2903 017435 0000 FEXT 2904 017436 4521 POPA /GET THE SWITCH 2905 017437 1045 TAD HORD /CHECK THE SIGN 2906 017440 7710 SPA CLA 2907 017441 1243 TAD .+2 2908 017442 5303 JMP FSFX /GET THE RIGHT ONE & RETURN 2909 017443 0073 BUFFPT-FLARGP 2910 ///// 2911 2912 017444 4533 FIN, READC /SINGLE CHARACTER INPUT 2913 017445 1066 TAD CHAR 2914 017446 4552 FLOAT /'FLOATR' 2915 017447 5555 RETURN 2916 ///// 2917 /FOCAL STATEMENT FUNCTIONS: F(N,ARG1,ARG2,...) 2918 2919 /N IS A LINE OR GROUP NO. (USE A CONVENIENT VARIABLE TO 2920 /LABEL THE FUNCTION) AND THE ARGUMENTS REPLACE THE VALUE 2921 /OF THE SECRET VARIABLES, BEGINNING WITH '#'. FSF'S ARE 2922 /NOT FULLY RECURSIVE SINCE THEY ALL USE THE SAME SECRET 2923 /VARIABLES. THE VALUE RETURNED BY THE FUNCTION IS JUST 2924 /THE LAST EXPRESSION EVALUATED. 2925 2926 *SNA 2927 017450 4522 FSF, PUSHJ /EVALUATE THE LINE NUMBER 2928 017451 0317 MODEPT /(ARG. IS ALREADY IN FLAC) 2929 017452 4524 PUSHF /SAVE LINENO, NAGSW, AND LASTC 2930 017453 0067 LINENO 2931 017454 1311 TAD FSFP 2932 2933 017455 3071 ARG, DCA LASTC 2934 017456 4543 TSTCMA /MORE ARGUMENTS? 2935 017457 5272 JMP DOF /NO 2936 017460 4522 PUSHJ 2937 017461 1610 EVAL /GET THE NEXT ONE 2938 017462 1071 TAD LASTC 2939 017463 3062 DCA PT1 /MUST USE THE VAR. PTR. 2940 017464 4407 FENT 2941 017465 6400 FPUTIPT1 2942 017466 0000 FEXT 2943 017467 1112 TAD GINC 2944 017470 1071 TAD LASTC /POINT TO THE NEXT 2945 017471 5255 JMP ARG 2946 2947 017472 4521 DOF, POPA /RESTORE LINENO & NAGSW 2948 017473 3067 DCA LINENO 2949 017474 4521 POPA 2950 017475 3070 DCA NAGSW 2951 017476 4522 PUSHJ /EXECUTE A 'DO' CALL 2952 017477 0662 DO+2 2953 017500 4521 POPA /RECALL PREVIOUS POINTER 2954 017501 3071 DCA LASTC 2955 017502 2013 ISZ PDLXR /DUMP 'FISW' 2956 017503 1375 FSFX, TAD (FGET I FLARGP 2957 017504 3306 DCA .+2 2958 017505 4407 FENT 2959 017506 0504 FGET I FLARGP /GET THE RESULT AGAIN IN CASE 2960 017507 0000 FEXT /A 'FOR' COMMAND WIPED IT OUT 2961 017510 5555 RETURN 2962 ///// 2963 017511 0024 FSFP, WORDS^3+STVAR+10/# 2964 2965 017512 4545 GETL, GETLN /READ LINE NUMBER FOR 'GTNAME' 2966 017513 6203 CDI L 2967 017514 5367 JMP NAMEND+2 2968 ///// 2969 /IMPROVED RANDOM NUMBER FUNCTION (OMSI) USES A TTY WAIT 2970 /LOOP TO INITIALLY SET A RANDOM VALUE. AFTER THE FIRST 2971 /INPUT SUCCESSIVE NUMBERS ARE GENERATED FROM THE POWER 2972 /RESIDUE ALGORITHM DUE TO P.T. BRADY (DECUS 5-25). SEE 2973 /THE DISCUSSION BY G.A. GRIFFITH IN DECUS FOCAL8-1. 2974 2975 017515 4407 FRAN, FENT / X(1)=(2^17+3)*X(0) MOD 2^35 2976 017516 7424 FNOR I LEVEL0 / GET PREVIOUS VALUE 2977 017517 0774 FGET I (RANDOM+1/ SHIFT LEFT TWELVE 2978 017520 0000 FEXT 2979 017521 3044 DCA EXP / ZERO THE EXPONENT 2980 017522 4556 SHIFTL 2981 017523 4556 SHIFTL / SHIFT LEFT FOUR MORE 2982 017524 4556 SHIFTL 2983 017525 4556 SHIFTL 2984 017526 4773 JMS I (DUBLAD / PLUS 3 TIMES ORIGINAL 2985 017527 4556 SHIFTL 2986 017530 4773 JMS I (DUBLAD 2987 017531 4407 FENT 2988 017532 6424 FPUT I LEVEL0 / SAVE FOR THE NEXT CALL 2989 017533 0000 FEXT 2990 017534 7150 CMA CLL RAR /=3777 2991 017535 0045 AND HORD 2992 017536 3045 DCA HORD /BE POSITIVE IT'S POSITIVE 2993 017537 5555 RETURN 2994 ///// 2995 2996 017540 1046 VFN, TAD LORD /+HORD /GENERATE A NUMERIC FILE NAME 2997 017541 7640 SZA CLA /IS THE ARGUMENT ZERO? 2998 017542 7330 SM0 /ROUND UP 2999 017543 3047 DCA OVER 3000 017544 4435 NORMALIZE 3001 017545 7164 SM1 3002 017546 4537 PRINTN /CONVERT TO ASCII 3003 017547 6202 CIF L 3004 017550 5342 JMP VFR /RETURN WITH STRING ADDRESS 3005 ///// 3006 3007 017551 7420 LGETC, SNL /'GETC' FOR THE LIBRARY ROUTINES 3008 017552 4541 GETC 3009 017553 1066 TAD CHAR 3010 017554 6203 CDI L 3011 017555 5315 JMP MGETC+3 /SAME PAGE, DOWN BELOW 3012 ///// 3013 3014 017556 4522 GETA, PUSHJ /CALLED BY 'GTNAME', 'O A' & 'O C' 3015 017557 1610 EVAL /EVALUATE AN EXPRESSION 3016 017560 4560 FIXIT 3017 017561 6202 CIF L 3018 017562 5317 JMP MGETA-1 /DF=P, L=0 3019 ///// 3020 017573 6244 PAGE 017574 7643 017575 0504 3021 /FLOATING POINT INPUT/OUTPUT ROUTINES: 3022 / 8XFPP.PA 3023 / FOR PDP8I OR PDP12 WITH EAE 3024 / REVISIONS: 3025 / PRINTC CHANGED TO CLA AT 15666 TO DELETE LEADING SPACE 3026 / 3027 3028 /NOTE: THESE ROUTINES HAVE BEEN EXTENSIVELY REVISED! 3029 3030 *5400 /AFTER THE FUNCTIONS 3031 015400 0000 FLINTP, 0 /CONVERT ASCII TO BINARY - 'READN' 3032 015401 4273 JMS FIGO5 /CHECK LEADING CHARACTERS 3033 015402 4254 JMS FIGO4 /READ FIRST DIGIT GROUP 3034 015403 7420 SNL /ENDED BY A PERIOD? 3035 015404 4312 JMS FETCH /SKIP IT & READ 2ND GROUP 3036 015405 4326 JMS FIGO7 /AND SET NEW DIGIT COUNT 3037 015406 4437 JMS I RESOL /FIX UP THE SIGN 3038 015407 1066 TAD CHAR 3039 015410 1377 TAD (-"E /DID WE READ AN 'E'? 3040 015411 7640 SZA CLA 3041 015412 5230 JMP FIGO2 /NO 3042 3043 015413 4312 FIGO1, JMS FETCH /YES, PASS THE 'E' 3044 015414 4407 FENT 3045 015415 6504 FPUT I FLARGP /SAVE THE MANTISSA & DEC. PT. 3046 015416 0000 FEXT 3047 015417 4254 JMS FIGO4 /READ THE DECIMAL EXPONENT 3048 015420 1047 TAD OVER 3049 015421 2040 ISZ SIGN /CHECK THE SIGN 3050 015422 7041 CIA 3051 015423 3254 DCA FIGO4 /SAVE THE RESULT 3052 015424 4407 FENT 3053 015425 0504 FGET I FLARGP /RESTORE WHAT WE HAD 3054 015426 0000 FEXT 3055 015427 1254 TAD FIGO4 /COMBINE THE SCALE FACTORS 3056 3057 015430 1044 FIGO2, TAD EXP /SET UP THE LOOP COUNTER 3058 015431 7100 CLL 3059 015432 7510 SPA 3060 015433 7161 STL CIA /WITH -(ABS. VALUE+1) 3061 015434 7040 CMA 3062 015435 3254 DCA FIGO4 3063 015436 7430 SZL /TEST DIRECTION 3064 015437 1364 TAD FL10 3065 015440 1376 TAD (FMUL FLP1 /OR 'FMUL FL10' 3066 015441 3247 DCA FIGO3+1 3067 015442 1076 TAD P43 /INSERT THE PROPER EXPONENT 3068 015443 3044 DCA EXP 3069 015444 4435 NORMALIZE 3070 015445 5251 JMP FIGO3+3 3071 3072 015446 4407 FIGO3, FENT /SCALE LEFT OR RIGHT 3073 015447 4364 FMUL FL10 3074 015450 0000 FEXT 3075 015451 2254 ISZ FIGO4 3076 015452 5246 JMP FIGO3 3077 015453 5600 JMP I FLINTP /***RETURN*** 3078 015454 0000 FIGO4, 0 /READ A GROUP OF DIGITS 3079 015455 4303 JMS FIGO6 /START WITH ZERO 3080 015456 7164 SM1 3081 015457 3040 DCA SIGN /INITIALIZE SIGN 3082 015460 1066 TAD CHAR 3083 015461 1375 TAD (-"- 3084 015462 7440 SZA 3085 015463 2040 ISZ SIGN /RESET IF POSITIVE 3086 015464 7144 CMA CLL RAL /SET CODE FOR "+" 3087 015465 7150 CMA CLL RAR /"+" -> 0000(1) 3088 015466 7650 SNA CLA /NOT "+" OR "-" 3089 015467 7001 IAC /SKIP THE SIGN 3090 015470 4273 JMS FIGO5 /AND IGNORE SPACES 3091 015471 4326 JMS FIGO7 /DO ALL THE WORK 3092 015472 5654 JMP I FIGO4 3093 ///// 3094 3095 015473 0000 FIGO5, 0 /PROCESS LEADING CHARACTERS 3096 015474 7540 SMA SZA /-240, ONLY 'SZA' OCCURS 3097 015475 4312 JMS FETCH /GET FIRST OR NEXT 3098 015476 1066 TAD CHAR 3099 015477 1274 TAD .-3 /IS IT A SPACE? 3100 015500 7650 SNA CLA 3101 015501 5275 JMP .-4 /IGNORE LEADING SPACES 3102 015502 5673 JMP I FIGO5 3103 ///// 3104 3105 015503 0000 FIGO6, 0 /'FLOAT' 3106 015504 3045 DCA HORD 3107 015505 3046 DCA LORD 3108 015506 3047 DCA OVER 3109 015507 1074 TAD P13 3110 015510 3044 DCA EXP 3111 015511 5703 JMP I FIGO6 3112 ///// 3113 3114 /READ A CHARACTER FROM TEXT OR THE INPUT DEVICE: 3115 3116 015512 0000 FETCH, 0 3117 015513 1600 TAD I FLINTP /CHECK THE NEXT INSTRUCTION 3118 015514 7700 SMA CLA 3119 015515 5321 JMP ACCEPT 3120 015516 4541 GETC /READ FROM THE TEXT BUFFER 3121 015517 5712 JMP I FETCH 3122 ///// 3123 015520 4534 PRINTC /IN CASE WE WANT TO ECHO FF 3124 015521 4533 ACCEPT, READC /READ FROM THE INPUT DEVICE 3125 015522 4526 SORTJ /TEST FOR SPECIAL ACTION 3126 015523 0167 SPECIAL-1 3127 015524 6401 ACTION-SPECIAL 3128 015525 5712 JMP I FETCH 3129 ///// 3130 015526 0000 FIGO7, 0 /DECIMAL-TO-BINARY CONVERSION 3131 015527 3044 DCA EXP /CLEAR DIGIT COUNTER 3132 015530 4532 TESTN 3133 015531 5726 JMP I FIGO7 /PERIOD, L=0 3134 015532 5345 JMP FIGO9 /OTHER, L=0 3135 015533 1065 TAD SORTCN /GET THE NUMBER 3136 015534 4561 FIGO8, MULT10 /ADD IT IN 3137 015535 7640 SZA CLA 3138 015536 5341 JMP .+3 3139 015537 1045 TAD HORD /CHECK FOR OVERFLOW 3140 015540 7710 SPA CLA 3141 015541 4576 ERROR2 /INPUT OVERFLOW ERROR 3142 015542 2044 ISZ EXP /COUNT THE DIGITS 3143 015543 4312 JMS FETCH /GET ANOTHER ONE 3144 015544 5330 JMP FIGO7+2 3145 ///// 3146 015545 1066 FIGO9, TAD CHAR /ALLOW A-Z 3147 015546 1377 TAD (-"E 3148 015547 7450 SNA 3149 015550 5726 JMP I FIGO7 /'E' IS SPECIAL AND L=1 3150 015551 1374 TAD ("E-"Z-1 3151 015552 7121 STL IAC 3152 015553 1373 TAD ("Z-"A+1 3153 015554 7460 SNL SZA 3154 015555 5334 JMP FIGO8 /TREAT A-Z LIKE NUMBERS 3155 015556 7320 STL CLA 3156 015557 5726 JMP I FIGO7 /L=1 3157 ///// 3158 3159 /THESE TWO CONSTANTS MUST NOT BE SEPARATED 3160 3161 015560 7775 FLP1, -3;3146;3146;3147 015561 3146 015562 3146 015563 3147 3162 015564 0004 FL10, +4;2400;0000;0000 015565 2400 015566 0000 015567 0000 3163 3164 ECHOGO=. /BRANCH LIST FOR 'READC' 3165 015570 6273 IECHO-2 /FF 3166 015571 6276 IECHO+1 /LF 3167 015572 6276 IECHO+1 /RO 3168 3169 015573 0032 *PRODUCT 015574 7752 015575 7523 015576 4360 015577 7473 3170 010170 0233 SPECIAL,233 /ESCAPE 3171 010171 0375 375 /ALTMODE 3172 010172 0337 "_ /RESTART 3173 010173 0214 ECHOLST,FF /IGNORE (KEYBOARD ONLY) 3174 010174 0212 LF /IGNORE 3175 010175 0377 RO /IGNORE 3176 /THIS ROUTINE EXTENDS THE FORMAT SPECIFICATIONS (%W.DD) TO 3177 /ALLOW THE NUMBER OF DIGITS PRINTED IN SCIENTIFIC NOTATION 3178 /TO BE CONTROLLED. A FORMAT OF '0' MEANS 'ALL SIGNIFICANT 3179 /DIGITS' WHILE '.05' MEANS 'JUST PRINT 5' WITH APPROPRIATE 3180 /ROUNDING. THIS FORMAT PRINTS A LEADING DIGIT FOLLOWED BY 3181 /A DECIMAL POINT, MORE DIGITS AND THEN THE EXPONENT. 3182 3183 /ANOTHER IMPROVEMENT IS THAT THE MINUS SIGN IS ALWAYS OUT- 3184 /PUT JUST AHEAD OF THE FIRST SIGNIFICANT DIGIT. 3185 3186 *5600 /A RATHER SPECIAL LOCATION! 3187 015600 0012 PD, DIGITS /DEFAULT 3188 3189 015601 0000 TGO, 0 /CALLED BY 'PRINTN' 3190 015602 3015 DCA XRT2 /SAVE BUFFER ADDRESS 3191 015603 1072 TAD FISW /GET FORMAT SAVED BY % TRAP 3192 015604 0104 AND P7600 /ISOLATE THE FIELD LENGTH 3193 015605 4563 RTL6 3194 015606 7161 STL CIA /NEGATE AND TEST FOR ZERO 3195 015607 3044 DCA FLAC /SAVE MINUS FIELD LENGTH 3196 3197 015610 1072 TAD FISW /GET NO. OF DECIMAL PLACES 3198 015611 7450 SNA 3199 015612 1200 TAD PD /USE DEFAULT IF NONE SPEC. 3200 015613 0075 ESGN, AND P177 /A REASONABLE LIMIT! 3201 015614 7420 SNL /SCIENTIFIC? 3202 015615 5224 JMP SPM0+1 /YES, ROUND TO D PLACES 3203 3204 015616 1044 TAD FLAC /COMPARE FIELD SIZE 3205 015617 7420 SNL / D-F < 0 ? 3206 015620 7360 STA STL /NO, TAKE D = F-1 3207 015621 1043 TAD T3 /COMPARE DECIMAL EXPONENT 3208 015622 7560 SNL SMA SZA / E > F-D ? 3209 015623 7760 SPM0, SNL SMA SZA CLA /ROUND OFF TO F PLACES 3210 015624 7041 CIA /ENTER HERE FOR SCI. NOT. 3211 015625 3042 DCA T2 /SAVE F-D-E (OR 0 OR -D) 3212 3213 015626 1042 TAD T2 /THIS IS TRICKY BUSINESS! 3214 015627 7120 STL /EXTEND THE SIGN 3215 015630 1044 TAD FLAC / -(E+D), -F OR -D (-D-F) 3216 015631 1200 TAD PD /COMPARE WITH LIMIT 3217 015632 7430 SZL /SKIPS FOR 0 < AC < PD+1 3218 015633 7200 CLA /LIMIT ROUNDOFF TO DIGITS+1 3219 015634 1050 TAD EX1 /ADD -PD-1 (MDM1) TO RESTORE 3220 015635 7161 STL CIA /(E+D), F, D, DIGITS (+1) 3221 3222 015636 1015 BUMP, TAD XRT2 /SET UP BUFFER ADDRESS 3223 015637 3340 DCA OUTA 3224 015640 2740 ISZ I OUTA /INCREMENT THIS DIGIT 3225 015641 1740 TAD I OUTA /NOW TEST IT 3226 015642 7420 SNL /LITTLE EXTRA THE FIRST TIME 3227 015643 1105 TAD M4 3228 015644 1106 TAD M5 3229 015645 7750 SPA SNA CLA /CARRY REQUIRED? 3230 015646 5263 JMP RNDC+4 /NO: GO TO OUTPUT 3231 015647 3740 DCA I OUTA /YES: MAKE CURRENT DIGIT ZERO 3232 015650 7121 STL IAC /SET UP LINK FOR NEXT CYCLE & 3233 015651 3577 DCA I START /ANTICIPATE CARRY FROM 999... 3234 015652 1340 TAD OUTA /DECR AND CHECK THE POINTER 3235 015653 1257 TAD RNDC /-(START OF BUFFER) 3236 015654 7440 SZA /BEGINNING OF BUFFER REACHED? 3237 015655 5236 JMP BUMP /NO: BUMP THE NEXT DIGIT 3238 3239 015656 2043 ISZ T3 /YES: INCR. DECIMAL EXPONENT 3240 015657 0167 RNDC, -BUFFER-1 /'NOP' 3241 015660 7040 CMA /AND SET THE MANTISSA TO 0.1 3242 015661 1015 TAD XRT2 /BY DECREMENTING THE POINTER 3243 015662 5202 JMP TGO+1 /RECOMPUTE THE DECIMAL POINT 3244 3245 015663 7164 SM1 /SET SIGN COUNTER 3246 015664 3041 DCA T1 3247 015665 1103 TAD C240 /'TAD ESGN' IF YOU WISH 3248 015666 7200 CLA /PRINTC TO PRINT A LEADING SPACE BEFORE # 3249 3250 015667 1044 TAD FLAC /GET FIELD SIZE 3251 015670 7450 SNA /FLOATING OUTPUT ? 3252 015671 5317 JMP FLOUT /YES 3253 015672 1043 TAD T3 /COMPARE WITH EXPONENT 3254 015673 7740 SMA SZA CLA / E > F ? 3255 015674 5321 JMP FLOUT+2 /YES: USE FLOATING FORMAT 3256 015675 1042 TAD T2 / F-D-E (OR 0 IF E > F-D) 3257 015676 1043 TAD T3 / F-D OR E 3258 015677 7041 CIA /CALCULATE -NO. OF POSITIONS 3259 015700 3042 DCA T2 /TO PRINT BEFORE DECIMAL PT. 3260 3261 015701 1042 BACK, TAD T2 /PRINT DD.DDD 3262 015702 1043 TAD T3 3263 015703 7650 SNA CLA / P = E ? 3264 015704 5324 JMP DIG /YES: PRINT DIGIT 3265 015705 7001 IAC /NO ('376' TO SUPPRESS 1ST ZERO) 3266 015706 1042 TAD T2 3267 015707 7710 SPA CLA / P < 1 ? 3268 015710 1223 TAD SPM0 /YES: PRINT SPACE 3269 015711 4340 AGAIN, JMS OUTA /PRINT CHARACTER 3270 015712 2042 ISZ T2 /P CHARACTERS PRINTED? 3271 015713 5301 JMP BACK /NO 3272 015714 7344 SM2 /YES ('TAD 376') 3273 015715 4535 PRINTD /PRINT DECIMAL POINT 3274 015716 5301 JMP BACK 3275 3276 015717 1042 FLOUT, TAD T2 /SET FIELD SIZE 3277 015720 3044 DCA FLAC / -D 3278 015721 7164 SM1 /SET FLAG 3279 015722 3340 DCA OUTA 3280 015723 2201 ISZ TGO /SET SECOND RETURN 3281 015724 7364 DIG, CLA SM1 /POINTS TO 'TERM' 3282 015725 1043 TAD T3 /REDUCE E BY 1 3283 015726 3043 DCA T3 3284 015727 4345 JMS GETD /GET NEXT DIGIT 3285 015730 2340 ISZ OUTA /TEST FLAG 3286 015731 5311 JMP AGAIN /NORMAL RETURN 3287 3288 015732 4535 PRINTD /PRINT FIRST FLOATING DIGIT 3289 015733 7344 SM2 /CREATE A PERIOD (256-260) 3290 015734 7410 SKP /DON'T FETCH & DON'T COUNT 3291 015735 4345 JMS GETD /FETCH NEXT DIGIT 3292 015736 4340 JMS OUTA /PRINT IT 3293 015737 5335 JMP .-2 /AND REPEAT 3294 3295 015740 0000 OUTA, 0 3296 015741 4535 PRINTD /PRINT CHARACTER 3297 015742 2044 ISZ FLAC /F CHARACTERS PRINTED? 3298 015743 5740 JMP I OUTA /NO: RETURN 3299 015744 5601 JMP I TGO /YES: NUMBER FINISHED 3300 ///// 3301 3302 015745 0000 GETD, 0 /ROUTINE TO UNLOAD BUFFER 3303 015746 1415 TAD I XRT2 /AUTO-INDEX REG. SETUP UPON ENTRY 3304 015747 2050 ISZ EX1 /TEST FOR END OF SIGNIFICANT FIG. 3305 015750 5745 JMP I GETD 3306 015751 7240 CLA CMA /FORCE -1 IN ORDER TO 3307 015752 3050 DCA EX1 /OUTPUT EXTRA ZEROS 3308 015753 5745 JMP I GETD /LEAVE C(AC)=0 3309 ///// 3310 015754 1724 FTRM, TAD I DIG /GET THE INPUT TERMINATOR 3311 015755 5553 FLOATR 3312 ///// 3313 3314 015756 0000 DBLSUB, 0 /CHECK FOR A SECOND SUBSCRIPT 3315 015757 4543 TSTCMA 3316 015760 5756 JMP I DBLSUB /ONLY ONE 3317 015761 4524 PUSHF 3318 015762 0044 FLAC /SAVE THE FIRST ONE 3319 015763 4522 PUSHJ 3320 015764 1610 EVAL /GET THE SECOND ONE 3321 015765 4525 POPF 3322 015766 7600 FLARG /TEMPORARY STORAGE 3323 015767 1377 TAD DIMEN 3324 015770 3062 DCA PT1 /SET THE VARIABLE POINTER 3325 015771 4407 FENT 3326 015772 2511 FSUB I FP1 /THE SECOND MINUS ONE 3327 015773 4400 FMULIPT1 /TIMES THE DIMENSION 3328 015774 1504 FADD I FLARGP /PLUS OFFSET OF FIRST 3329 015775 0000 FEXT 3330 015776 5756 JMP I DBLSUB /CALLED BY 'GETARG' 3331 015777 0010 DIMEN, STVAR+2+WORDS+2 /DATA POINTER FOR (!) 3332 PAGE 3333 3334 LNFEED= (0&(1&(2 /RESERVE 3 LOCATIONS 3335 XLIST; NOPUNCH; PAGE 30; ENPUNCH; XLIST 3336 /FLOATING POINT OUTPUT CONVERSION: 'PRINTN' 3337 3338 /REWRITTEN TO PROVIDE THREE NEW FEATURES: (1) A 'FLOATING' 3339 /MINUS SIGN WHICH APPEARS BEFORE THE FIRST DIGIT; (2) A 3340 /MEANS FOR 'TDUMP' TO OUTPUT 3-DIGIT SUBSCRIPTS (+/-999); 3341 /(3) A PROVISION FOR NON-PRINTING CALLS WHICH JUST SET UP 3342 /THE OUTPUT BUFFER BUT DO NOT DO ANY PRINTING. 3343 3344 /THANKS TO JIM CRAPUCHETTES FOR TWELVE LOCATIONS! 3345 3346 016000 7765 MDM1, -DIGITS-1 /START FLOUTP AT PAGE+1 3347 3348 016001 0000 FLOUTP, 0 /CONVERT BINARY TO ASCII 3349 016002 3042 DCA T2 /SET THE NON-PRINT FLAG 3350 016003 7121 STL IAC 3351 016004 3043 DCA T3 /INITIALIZE THE EXPONENT 3352 016005 4436 JMS I ABSOL /TAKE THE ABSOLUTE VALUE 3353 016006 7050 CMA RAR /LINK WILL BE ZERO IF NEGATIVE 3354 016007 3304 DCA FGO6 /SET THE SIGN FLAG 3355 016010 1040 TAD SIGN 3356 016011 7650 SNA CLA /ZERO? 3357 016012 5233 JMP FGO3 3358 3359 016013 4407 FGO1, FENT /NUMBER TOO LARGE 3360 016014 4774 FMUL I (FLP1 /MULTIPLY BY .1 3361 016015 0000 FEXT 3362 016016 2043 ISZ T3 /INCREASE DECIMAL EXPONENT 3363 016017 1044 TAD EXP 3364 016020 7740 SMA SZA CLA /CHECK THE BINARY EXPONENT 3365 016021 5213 JMP FGO1 3366 3367 016022 4407 FGO2, FENT /NUMBER TOO SMALL 3368 016023 4773 FMUL I (FL10 /MULTIPLY BY 10 3369 016024 0000 FEXT 3370 016025 7040 CMA /DECREASE DECIMAL EXPONENT 3371 016026 1043 TAD T3 3372 016027 3043 DCA T3 3373 016030 1044 TAD EXP /CHECK THE BINARY EXPONENT 3374 016031 7550 SPA SNA 3375 016032 5222 JMP FGO2 3376 3377 016033 7040 FGO3, CMA /NEGATE THE BIT COUNT 3378 016034 3044 DCA EXP 3379 016035 1200 TAD MDM1 /INITIALIZE DIGIT COUNT 3380 016036 3266 DCA OUTDG 3381 016037 1177 TAD START /INITIALIZE BUFFER POINTER 3382 016040 3015 DCA XRT2 3383 3384 016041 3050 FGO4, DCA EX1 /SHIFT OUT THE FIRST DIGIT 3385 016042 4556 SHIFTL 3386 016043 1050 TAD EX1 3387 016044 7004 RAL 3388 016045 2044 ISZ EXP 3389 016046 5241 JMP FGO4 3390 016047 7410 SKP 3391 016050 4561 FGO5, MULT10 /IE. 0.672 X 10 = 6 + 0.72.. ETC. 3392 016051 3415 DCA I XRT2 3393 016052 2266 ISZ OUTDG /ALL DIGITS OUTPUT? 3394 016053 5250 JMP FGO5 /NO: CONTINUE 3395 3396 016054 1200 TAD MDM1 3397 016055 3050 DCA EX1 /SAVE NO. OF DIGITS 3398 016056 1177 TAD START /GET BUFFER POINTER 3399 016057 2042 ISZ T2 /TEST PRINT FLAG 3400 016060 4661 JMS I .+1 /OUTPUT MANTISSA 3401 016061 5601 JMP I FLOUTP /FIXED POINT DONE 3402 3403 016062 1372 TAD ("E /PRINT 'E' 3404 016063 4534 PRINTC 3405 016064 4304 JMS FGO6 /OUTPUT THE EXPONENT 3406 016065 5601 JMP I FLOUTP /FLOATING POINT DONE 3407 ///// 3408 3409 016066 0000 OUTDG, 0 /MULTI-PURPOSE ROUTINE - 'PRINTD' 3410 016067 7500 SMA /IGNORE SPACES AND THE LIKE OR 3411 016070 2041 ISZ T1 /DIGITS OTHER THAN THE FIRST ! 3412 016071 5300 JMP DGOUT 3413 016072 3041 DCA T1 /SAVE THE FIRST DIGIT 3414 016073 2304 ISZ FGO6 /CHECK THE SIGN FLAG 3415 016074 1303 TAD C255 /MAKE A '-' 3416 016075 1103 TAD C240 /'SZA' TO OMIT THIS SPACE 3417 016076 4534 PRINTC 3418 016077 1041 TAD T1 /RESTORE AC 3419 3420 016100 1371 DGOUT, TAD ("0 /FORM ASCII 3421 016101 4534 PRINTC 3422 016102 5666 JMP I OUTDG 3423 016103 0015 C255, 15 /'255' 3424 ///// 3425 3426 016104 0000 FGO6, 0 /ALSO CALLED BY 'TDUMP' 3427 016105 1043 TAD T3 /GET EXPONENT 3428 016106 7710 SPA CLA /TEST SIGN 3429 016107 7326 SP2 /+2 -> -3 3430 016110 1106 TAD M5 3431 016111 4266 JMS OUTDG /PRINT SIGN 3432 016112 1043 TAD T3 3433 016113 7510 SPA 3434 016114 7041 CIA 3435 016115 7427 MQL DVI /DIVIDE BY ONE HUNDRED 3436 016116 0144 144 3437 016117 3042 DCA T2 3438 016120 7521 SWP /PRINT QUOTIENT 3439 016121 7440 SZA /UNLESS IT'S ZERO 3440 016122 4266 JMS OUTDG 3441 016123 1042 TAD T2 /NOW PRINT REMAINDER 3442 016124 4326 JMS PRNT 3443 016125 5704 JMP I FGO6 3444 016126 0000 PRNT, 0 /PRINT TWO DECIMAL DIGITS 3445 016127 0075 AND P177 3446 016130 7427 MQL DVI /DIVIDE BY TEN 3447 016131 0012 12 3448 016132 3042 DCA T2 3449 016133 7521 SWP /GET QUOTIENT 3450 016134 4266 JMS OUTDG 3451 016135 1042 TAD T2 /GET REMAINDER 3452 016136 4266 JMS OUTDG 3453 016137 3041 DCA T1 /RESET SWITCH 3454 016140 5726 JMP I PRNT /CALLED BY 'FGO6' & 'PRNTLN' 3455 ///// 3456 3457 016141 0000 MPLY, 0 /CONTINUATION OF EAE MULTIPLY 3458 016142 1046 TAD LORD 3459 016143 3346 DCA .+3 3460 016144 1052 TAD AC1L /B*E 3461 016145 7525 SWP MUY 3462 016146 0000 0 3463 016147 1050 TAD EX1 3464 016150 7421 MQL /DISCARD FOUR 3465 016151 7004 RAL 3466 016152 3050 DCA EX1 /INITIALIZE TWO 3467 3468 016153 1045 TAD HORD 3469 016154 3357 DCA .+3 3470 016155 1052 TAD AC1L /A*E 3471 016156 7525 SWP MUY 3472 016157 0000 0 3473 016160 1050 TAD EX1 /ADD TO TWO 3474 016161 3050 DCA EX1 3475 3476 016162 1046 TAD LORD 3477 016163 3366 DCA .+3 3478 016164 1051 TAD AC1H /B*D 3479 016165 7525 SWP MUY 3480 016166 0000 0 3481 016167 1050 TAD EX1 /BUILD UP TWO 3482 016170 5741 JMP I MPLY /FINISH ONE & TWO 3483 3484 016171 0260 FIELD 1 /FORGET LITERALS 016172 0305 016173 5564 016174 5560 016175 0000 016176 0001 016177 0002 3485 3486 *LNFEED 3487 016175 1576 TAD I TABCNT /WHERE ARE WE? 3488 016176 7650 SNA CLA 3489 016177 5403 JMP I CFF /IGNORE THE LF AFTER A CR 3490 016200 1071 TAD LASTC 3491 016201 4551 DCAIAXIN /SAVE THE LAST CHARACTER 3492 016202 5603 JMP I .+1 3493 016203 7100 LFCONT-7 /RETYPE THE INPUT LINE 3494 /THIS IS A VERY HANDY ROUTINE FOR CONVERTING BCD DATA TO 3495 /BINARY FLOATING POINT FORM. JUST SET EXP=43 AT THE END. 3496 3497 *6204 3498 016204 0000 XTEN, 0 /MULTIPLY THE FLAC BY 10 (DECIMAL) 3499 016205 7521 SWP /AND ADD IN C(AC) 3500 016206 3354 DCA CPRNT /SAVE THE MQ 3501 016207 1047 TAD OVER 3502 016210 7525 SWP MUY /THANKS TO REV. GEOFFREY CHASE 3503 016211 0012 12 /FOR SUGGESTING AN EAE VERSION 3504 016212 7521 SWP 3505 016213 3047 DCA OVER 3506 016214 1046 TAD LORD 3507 016215 7525 SWP MUY 3508 016216 0012 12 3509 016217 7521 SWP 3510 016220 3046 DCA LORD 3511 016221 1045 TAD HORD 3512 016222 7525 SWP MUY 3513 016223 0012 12 3514 016224 7521 SWP 3515 016225 3045 DCA HORD 3516 016226 1354 TAD CPRNT /RESTORE MQ 3517 016227 7521 SWP /AC=OVERFLOW 3518 016230 5604 JMP I XTEN /EXECUTION TIME = 60 MICROSECONDS 3519 ///// 3520 3521 016231 0000 MULT2, 0 /MULTIPLY FLAC BY 2 - 'SHIFTL' 3522 016232 1047 TAD OVER 3523 016233 7104 CLL RAL 3524 016234 3047 DCA OVER 3525 016235 1046 TAD LORD 3526 016236 7004 RAL 3527 016237 3046 DCA LORD 3528 016240 1045 TAD HORD 3529 016241 7004 RAL 3530 016242 3045 DCA HORD 3531 016243 5631 JMP I MULT2 /DOES NOT CHANGE 'EXP' 3532 ///// 3533 3534 016244 0000 DUBLAD, 0 /TRIPLE PRECISION ADDITION 3535 016245 7100 CLL 3536 016246 1053 TAD OVR1 3537 016247 1047 TAD OVER 3538 016250 3047 DCA OVER 3539 016251 7004 RAL 3540 016252 1052 TAD AC1L 3541 016253 1046 TAD LORD 3542 016254 3046 DCA LORD 3543 016255 7004 RAL 3544 016256 1051 TAD AC1H 3545 016257 1045 TAD HORD 3546 016260 3045 DCA HORD 3547 016261 5644 JMP I DUBLAD 3548 /CHARACTER INPUT/OUTPUT ROUTINES: 'READC' AND 'PRINTC' 3549 3550 /THE INPUT ROUTINE MAY ALSO BE USED TO ECHO A CHARACTER. 3551 3552 016262 0000 CHIN, 0 /INPUT A CHARACTER 3553 016263 6211 CDF P 3554 016264 7450 SNA /'ECHOC' IF AC#0 3555 016265 4456 JMS I INDEV /'READC' IF AC=0 3556 016266 3066 DCA CHAR 3557 016267 4526 SORTJ /TAKE CARE OF SPECIAL CHARACTERS 3558 016270 0172 ECHOLST-1 3559 016271 5375 ECHOGO-ECHOLST 3560 016272 5275 JMP IECHO 3561 016273 1056 TAD INDEV /ONLY ECHO FF TO A FILE 3562 016274 7710 SPA CLA 3563 016275 4534 IECHO, PRINTC /'ZERO' IF NOT ECHOING 3564 016276 5662 JMP I CHIN 3565 ///// 3566 3567 016277 0000 CHOUT, 0 /OUTPUT A CHARACTER - 'PRINTC' 3568 016300 7450 SNA /USE AC IF NON-ZERO 3569 016301 1066 TAD CHAR /OTHERWISE USE CHAR 3570 016302 1110 TAD MCR 3571 016303 6202 CIF L 3572 016304 5205 JMP TAB /ADJUST TAB COUNTER 3573 016305 1005 CROUT, TAD CCR 3574 016306 4457 JMS I OUTDEV /CARRIAGE RETURNS 3575 016307 1004 TAD CLF 3576 016310 4457 JMS I OUTDEV /NORMAL RETURNS 3577 016311 5677 JMP I CHOUT 3578 ///// 3579 3580 /CALLS TO AND FROM THE TAB ROUTINES IN FIELD 0: 3581 3582 016312 4522 TABX, PUSHJ /EVALUATE THE COLUMN NO. 3583 016313 1605 EVAL-3 3584 016314 4560 FIXIT 3585 016315 6202 CIF L 3586 016316 5221 JMP ZER+1 /SAME PAGE, FIELD 0 3587 3588 016317 4262 SKPX, JMS CHIN /NEGATIVE COL. NO. 3589 016320 6202 CIF L 3590 016321 5227 JMP NEG+2 /RETURN TO LOWER FIELD 3591 ///// 3592 3593 016322 6114 FILIN, ICHAR0 /FILE INPUT 3594 016323 3021 ECODEV, XOUTL /DEFAULT OUTPUT 3595 /FILE INPUT/OUTPUT ROUTINES: 3596 3597 016324 0000 ICHAR, 0 /FILE INPUT VIA (INDEV) 3598 016325 6203 CDI L 3599 016326 5722 JMP I FILIN /CALL LOWER FIELD 3600 016327 5724 JMP I ICHAR 3601 3602 016330 7201 FLEN, CLA IAC /CHECK THE FILE LENGTH 3603 016331 0044 AND EXP /0=OUTPUT, 1=INPUT 3604 016332 7106 CLL RTL /*4 3605 016333 1377 TAD (XLEN 3606 016334 3354 DCA CPRNT 3607 016335 5356 JMP CPRNT+2 /OFF TO THE LOWER FIELD 3608 3609 016336 0000 OCHAR, 0 /FILE OUTPUT VIA (OUTDEV) 3610 016337 6203 CDI L 3611 016340 4776 JMS I (OCHAR0 3612 016341 4723 JMS I ECODEV /ECHO RETURN 3613 016342 5736 JMP I OCHAR /NO-ECHO RETURN 3614 3615 016343 0000 EOF, 0 /TRAPS ATTEMPT TO READ BEYOND 3616 016344 1375 TAD (XI33 /THE 'END-OF-FILE' CHARACTER 3617 016345 3056 DCA INDEV /RESETS POINTERS TO THE TTY: 3618 016346 1323 TAD ECODEV 3619 016347 3057 DCA OUTDEV 3620 016350 1355 TAD CPRNT+1 /AND TURNS ON THE ECHO, TOO 3621 016351 3275 DCA IECHO 3622 016352 1002 TAD P337 /RETURN A '_' TO CLEAR THE '^Z' 3623 016353 5743 JMP I EOF /'EOF' IS ALSO USED BY 'RECOVR' 3624 3625 016354 0000 CPRNT, 0 /'PRINTC' FOR DOWN BELOW 3626 016355 4534 PRINTC 3627 016356 6203 CDI L 3628 016357 5754 JMP I CPRNT 3629 3630 016360 6201 FBLK, CDF L /READ THE INPUT BLOCK NUMBER 3631 016361 1537 TAD I ATSW /SAME PLACE! 3632 016362 5554 FL0ATR 3633 3634 016363 4560 FIND, FIXIT /CHARACTER SEARCH FUNCTION 3635 016364 3530 DCA I TESTC&177 /SAVE IN 'CTEST' 3636 016365 4456 JMS I INDEV /READ A CHARACTER 3637 016366 3066 DCA CHAR 3638 016367 4526 SORTJ /CHECK FOR EOF, MATCH 3639 016370 2033 C232-1 3640 016371 6120 FINISH-CTEST 3641 016372 1066 TAD CHAR /AND ECHO AS DIRECTED 3642 016373 4533 ECHOC 3643 016374 5365 JMP FIND+2 /EOF->0, MATCH->CHAR 3644 3645 016375 3007 PAGE 016376 6076 016377 5746 3646 /FLOATING POINT PACKAGE FOR U/W-FOCAL 3647 3648 *FPUTIPT1 3649 016400 0000 FPNT, 0 /VIA 'FENT' 3650 016401 7200 CLA /= PAGE 35 3651 016402 6211 CDF P /RESET DATA FIELD 3652 016403 1600 TAD I FPNT 3653 016404 7450 SNA 3654 016405 5600 JMP I FPNT /EXIT 3655 016406 7106 CLL RTL /SHIFT PAGE BITS OVER AND 3656 016407 7006 RTL /PUT OPERATION CODE IN 9-11 3657 016410 3255 DCA LSORT 3658 016411 1255 TAD LSORT /PAGE 0? 3659 016412 7710 SPA CLA 3660 016413 1200 TAD FPNT /GET CURRENT PAGE 3661 016414 0104 AND P7600 3662 016415 3041 DCA T1 /SAVE PAGE, GET RELATIVE 3663 016416 1600 TAD I FPNT 3664 016417 0075 AND P177 3665 016420 1041 TAD T1 /MERGE 3666 016421 7420 SNL /IS IT INDIRECT? 3667 016422 5227 JMP NOTID /NO 3668 016423 7450 SNA /IS IT OUT-OF-FIELD? 3669 016424 5265 JMP CDFV /YES 3670 016425 3041 DCA T1 3671 016426 1441 TAD I T1 /GET THE INDIRECT ADDRESS 3672 016427 7041 NOTID, CIA 3673 016430 7140 CMA CLL /BACKUP ONE 3674 016431 3015 DCA XRT2 /LOAD THE INDEX REGISTER 3675 3676 016432 2200 ISZ FPNT /ADVANCE PROGRAM COUNTER 3677 016433 1255 TAD LSORT /GET BACK THE INSTRUCTION 3678 016434 0073 AND P7 /MASK THE OP CODE 3679 016435 7450 SNA 3680 016436 5300 JMP FLGT 3681 016437 1276 TAD M6 /TEST IT 3682 016440 7450 SNA 3683 016441 5311 JMP FLPT 3684 016442 1270 TAD JUMPX /SOMETHING ELSE 3685 016443 3255 DCA LSORT 3686 016444 1415 TAD I XRT2 /LOAD THE OPERAND 3687 016445 3050 DCA EX1 3688 016446 1415 TAD I XRT2 3689 016447 3051 DCA AC1H 3690 016450 1415 TAD I XRT2 3691 016451 3052 DCA AC1L 3692 016452 1415 TAD I XRT2 /'DCA OVER' FOR 3-WORD VERSION 3693 016453 3053 DCA OVR1 3694 016454 6211 CDF P 3695 016455 0000 LSORT, 0 /BRANCH TO THE PROPER ROUTINE 3696 016456 7610 SKP CLA /LOWER FIELD COMMAND SCANNER 3697 016457 4541 GETC 3698 016460 4527 SORTX /SEARCH FOR END OF THE 2ND WORD 3699 016461 5257 JMP .-2 3700 016462 4542 SPNOR /SKIP TO THE START OF THE THIRD 3701 016463 6202 CIF L 3702 016464 5655 JMP I LSORT /NOTE: 'CHAR' PRESERVED BELOW ! 3703 3704 016465 6231 CDFV, CDF V /CHANGE TO THE VARIABLES FIELD 3705 016466 1062 TAD PT1 /GET THE DATA POINTER 3706 016467 5227 JMP NOTID 3707 3708 016470 5676 JUMPX, JMP I M6 /BRANCH TABLE FOR 'FPNT' 3709 016471 7352 FLAD 3710 016472 7351 FLSB 3711 016473 6766 FLDV 3712 016474 6623 FMPY 3713 016475 6526 FLEX 3714 016476 7772 M6, -6 3715 016477 7362 FLNR 3716 3717 /HERE ARE THE FLOATING POINT OPERATIONS: 3718 3719 016500 1415 FLGT, TAD I XRT2 /FGET=0 3720 016501 3044 DCA EXP 3721 016502 1415 TAD I XRT2 3722 016503 3045 DCA HORD 3723 016504 1415 TAD I XRT2 3724 016505 3046 DCA LORD 3725 016506 1415 TAD I XRT2 /'NOP' FOR 3-WORD VERSION 3726 016507 3047 DCA OVER 3727 016510 5202 JMP FPNT+2 /L=0 3728 3729 016511 1044 FLPT, TAD EXP /FPUT=6 3730 016512 3415 DCA I XRT2 3731 016513 1045 TAD HORD 3732 016514 3415 DCA I XRT2 3733 016515 1046 TAD LORD 3734 016516 3415 DCA I XRT2 3735 016517 1047 TAD OVER /'JMP FPNT+2' FOR 3-WORD VERSION 3736 016520 3415 DCA I XRT2 3737 016521 5202 JMP FPNT+2 /L=1 3738 ///// 3739 3740 016522 0001 FLTONE, 1;2000;0;0 /USED BY 'FOR' 'Y' 'FLOG' & 'FSIN' 016523 2000 016524 0000 016525 0000 3741 016526 4524 FLEX, PUSHF /FPWR=5 3742 016527 0044 FLAC 3743 016530 4601 JMS I FPNT+1 /SAVE FLAC AND MOVE EXPONENT 3744 016531 4560 FIXIT /ONLY HANDLES INTEGER POWERS 3745 016532 7500 SMA 3746 016533 7040 CMA /BUT THEY MAY BE EITHER 3747 016534 3255 DCA LSORT /POSITIVE -OR- NEGATIVE! 3748 016535 1045 TAD HORD 3749 016536 3040 DCA SIGN /SAVE SIGN OF EXPONENT 3750 016537 7001 IAC 3751 016540 4552 FLOAT /START WITH UNITY 3752 016541 4435 NORMALIZE 3753 3754 016542 4525 IBLE, POPF /RECALL THE ARGUMENT 3755 016543 0050 FLOP 3756 016544 1377 TAD (.+4-FPNT-3 /LOAD THE RETURN ADDRESS 3757 016545 2040 ISZ SIGN /CHECK THE DIRECTION 3758 016546 5353 JMP .+5 3759 016547 5673 JMP I M6-3 /TAKE THE INVERSE (ONCE) 3760 016550 4524 PUSHF /SAVE THE RECIPROCAL 3761 016551 0044 FLAC 3762 016552 5342 JMP IBLE 3763 3764 016553 1073 TAD P7 /ADVANCE THE RETURN 3765 016554 2255 ISZ LSORT /CHECK THE LOOP COUNT 3766 016555 5674 JMP I M6-2 /ACCUMULATE THE PRODUCT 3767 016556 5201 JMP FPNT+1 /DONE 3768 016557 1105 TAD M4 3769 016560 1013 TAD PDLXR /REUSE THE SAME DATA 3770 016561 3013 DCA PDLXR 3771 016562 5342 JMP IBLE 3772 ///// 3773 3774 016563 4560 FMQ, FIXIT /DISPLAY A NUMBER IN THE MQ 3775 016564 7421 MQL 3776 016565 5555 RETURN /LINC-MODE VERSION IS LONGER 3777 ///// 3778 3779 IFZERO T-20 < 3780 016566 4560 FDAY, FIXIT /READ OR CHANGE THE SYSTEM DATE 3781 016567 6222 CIF T 3782 016570 5055 JMP DAY > 3783 3784 *.!177-6 /BRANCH LIST FOR 'FETCH' 3785 016571 1227 ACTION, ENDFI /ESCAPE = RETAIN CURRENT 3786 016572 1227 ENDFI /ALTMODE = DITTO 3787 016573 1217 READ /BA = RESTART INPUT 3788 016574 5521 ACCEPT /FF = IGNORE IT 3789 016575 5521 ACCEPT /LF = IGNORE IT 3790 016576 5521 ACCEPT /RO = IGNORE IT 3791 3792 016577 0145 PAGE 3793 /THIS ROUTINE COMBINES THE EXPONENTS FOR MULTIPLY AND 3794 /DIVIDE AND DETERMINES THE SIGN OF THE RESULT; IF THE 3795 /RESULT IS ZERO IT EXITS IMMEDIATELY. 3796 3797 016600 0000 SGNTST, 0 /TEST AND SAVE SIGN OF THE RESULT 3798 016601 7001 IAC /ADD ONE TO EXPONENT 3799 016602 1044 TAD EXP 3800 016603 3044 DCA EXP 3801 016604 4322 JMS ABSOLV /TAKE THE ABSOLUTE VALUE 3802 016605 1040 TAD SIGN 3803 016606 7450 SNA 3804 016607 5313 JMP MDXIT+6 /QUICK RETURN 3805 016610 0320 AND P4000 /STRIP THE SIGN BIT 3806 016611 1051 TAD AC1H /DO AN EXCLUSIVE OR 3807 016612 3040 DCA SIGN /AND SAVE THE RESULT 3808 016613 7521 SWP 3809 016614 3322 DCA ABSOLV /CLEAR & SAVE THE MQ 3810 016615 1051 TAD AC1H 3811 016616 7440 SZA 3812 016617 2200 ISZ SGNTST 3813 016620 7710 SPA CLA /TEST SIGN OF OPERAND 3814 016621 4351 JMS REVERS /FOR BOTH MULTIPLY AND DIVIDE 3815 016622 5600 JMP I SGNTST 3816 ///// 3817 3818 3819 /THREE-WORD BY THREE-WORD MULTIPLICATION: 3820 /THE ANSWER IS ROUNDED OFF TO THREE WORDS 3821 3822 / (A+B+C)*(D+E+F) = NINE PARTIAL PRODUCTS 3823 3824 016623 3041 FMPY, DCA T1 /SAVE THE RETURN ADDRESS 3825 016624 1050 TAD EX1 /ADD THE EXPONENTS (PLUS 1) 3826 016625 4200 JMS SGNTST /AND DETERMINE THE SIGN OF RESULT 3827 016626 5277 JMP MDONE /THE RESULT IS ZERO! 3828 3829 016627 1047 TAD OVER /C*F 3830 016630 3233 DCA .+3 3831 016631 1053 TAD OVR1 3832 016632 7425 MQL MUY 3833 016633 0000 0 3834 016634 7421 MQL /SAVE HIGH ORDER & ERASE SIX 3835 3836 016635 1046 TAD LORD /B*F 3837 016636 3241 DCA .+3 3838 016637 1053 TAD OVR1 3839 016640 7525 SWP MUY /USE PREVIOUS HIGH ORDER AS 3840 016641 0000 0 /REMAINDER IN THIS POSITION 3841 016642 1320 TAD P4000 /ROUND UP 3842 016643 3200 DCA SGNTST /SAVE FOUR 3843 016644 7004 RAL 3844 016645 3050 DCA EX1 /SAVE CARRY 3845 016646 1047 TAD OVER /C*E 3846 016647 3252 DCA .+3 3847 016650 1052 TAD AC1L 3848 016651 7525 SWP MUY /ADD IN PREVIOUS 3849 016652 0000 0 /PARTIAL PRODUCT 3850 016653 1200 TAD SGNTST /SUM HIGH ORDER PARTS 3851 016654 7421 MQL /DISCARD FIVE 3852 016655 7430 SZL 3853 016656 2050 ISZ EX1 /ACCUMULATE CARRIES 3854 3855 016657 1045 TAD HORD /A*F 3856 016660 3263 DCA .+3 3857 016661 1053 TAD OVR1 3858 016662 7525 SWP MUY 3859 016663 0000 0 3860 016664 1050 TAD EX1 /BUILD UP THREE 3861 016665 3050 DCA EX1 3862 3863 016666 1047 TAD OVER /C*D 3864 016667 3272 DCA .+3 3865 016670 1051 TAD AC1H 3866 016671 7525 SWP MUY 3867 016672 0000 0 3868 016673 1050 TAD EX1 3869 016674 3050 DCA EX1 /ADD TO THREE 3870 3871 016675 4717 JMS I MEND /DO 'B*E', 'A*E', AND 'B*D' 3872 016676 7521 SWP 3873 016677 3047 MDONE, DCA OVER /SAVE THREE 3874 3875 016700 1045 TAD HORD /A*D 3876 016701 3304 DCA .+3 3877 016702 1051 TAD AC1H 3878 016703 7525 SWP MUY 3879 016704 0000 0 3880 016705 3045 MDXIT, DCA HORD /SAVE ONE 3881 016706 7521 SWP 3882 016707 3046 DCA LORD /SAVE TWO 3883 016710 1322 DVXIT, TAD ABSOLV 3884 016711 7421 MQL 3885 016712 1041 TAD T1 3886 016713 1321 TAD FPNTP3 /COMPUTE THE RETURN POINT 3887 016714 3327 DCA RESOLV 3888 016715 4435 NORMALIZE 3889 016716 5330 JMP RESOLV+1 /EXIT FROM MULTIPLY / DIVIDE 3890 ///// 3891 016717 6141 MEND, MPLY /SOFTWARE MULTIPLY AREA 3892 016720 4000 P4000, 4000 3893 016721 6403 FPNTP3, FPNT+3 3894 ///// 3895 016722 0000 ABSOLV, 0 /TAKE THE ABSOLUTE VALUE 3896 016723 1045 TAD HORD 3897 016724 3040 DCA SIGN /BUT REMEMBER WHAT IT WAS 3898 016725 4327 JMS RESOLV 3899 016726 5722 JMP I ABSOLV 3900 3901 016727 0000 RESOLV, 0 /RESTORE THE PROPER SIGN 3902 016730 1040 TAD SIGN 3903 016731 7710 SPA CLA 3904 016732 4334 JMS INVERT 3905 016733 5727 JMP I RESOLV 3906 3907 016734 0000 INVERT, 0 /COMPLEMENT FLAC - 'NEGATE' 3908 016735 1047 TAD OVER 3909 016736 7141 CLL CIA 3910 016737 3047 DCA OVER 3911 016740 7024 CML RAL 3912 016741 1046 TAD LORD 3913 016742 7041 CIA 3914 016743 3046 DCA LORD 3915 016744 7024 CML RAL 3916 016745 1045 TAD HORD 3917 016746 7041 CIA 3918 016747 3045 DCA HORD 3919 016750 5734 JMP I INVERT 3920 3921 016751 0000 REVERS, 0 /NEGATE THE OPERAND 3922 016752 1053 TAD OVR1 3923 016753 7141 CLL CIA 3924 016754 3053 DCA OVR1 3925 016755 7024 CML RAL 3926 016756 1052 TAD AC1L 3927 016757 7041 CIA 3928 016760 3052 DCA AC1L 3929 016761 7024 CML RAL 3930 016762 1051 TAD AC1H 3931 016763 7041 CIA 3932 016764 3051 DCA AC1H 3933 016765 5751 JMP I REVERS 3934 3935 /EAE INSTRUCTIONS: 3936 3937 MUY=7405 3938 DVI=7407 3939 NMI=7411 3940 SHL=7413 3941 MQL=7421 3942 SCA=7441 3943 CAM=7621 3944 /THREE-WORD BY THREE-WORD EAE DIVIDE ROUTINE 3945 3946 *6766 3947 016766 3041 FLDV, DCA T1 /SAVE THE RETURN POINT 3948 016767 1050 TAD EX1 /SUBTRACT THE EXPONENTS 3949 016770 7040 CMA /COMPENSATE FOR SHIFT 3950 016771 4200 JMS SGNTST 3951 016772 4576 ERROR2 /THE DIVISOR IS ZERO! 3952 016773 7346 SM3 3953 016774 3327 DCA RESOLV /SET THE COUNTER 3954 016775 1074 TAD P13 /'XRT-1' 3955 016776 3015 DCA XRT2 /INITIALIZE QUOTIENT POINTER 3956 016777 1053 TAD OVR1 3957 017000 7104 CLL RAL 3958 017001 3053 DCA OVR1 /SHIFT THE OPERAND TO THE LEFT 3959 017002 1052 TAD AC1L 3960 017003 7004 RAL 3961 017004 3052 DCA AC1L 3962 017005 1051 TAD AC1H 3963 017006 7004 RAL 3964 017007 3331 DCA DVSR /SAVE THE TRIAL DIVISOR 3965 017010 5325 JMP DVLP+1 3966 ///// 3967 3968 017011 3046 DADJ, DCA LORD /RESTORE THE OVERDRAUGHT 3969 017012 7366 STA STL RTL /POINTS TO 'AND EX1' 3970 017013 1234 TAD QUOT /REDUCE THE QUOTIENT 3971 017014 3234 DCA QUOT 3972 017015 1053 TAD OVR1 /NOW ADD IN THE DIVISOR 3973 017016 1050 TAD EX1 3974 017017 3050 DCA EX1 /THE LEAST-SIGNIFICANT WORD 3975 017020 7004 RAL 3976 017021 1052 TAD AC1L 3977 017022 1047 TAD OVER 3978 017023 3047 DCA OVER 3979 017024 7004 RAL 3980 017025 1331 TAD DVSR 3981 017026 5350 JMP DVCK /CHECK FOR SUCCESS AGAIN 3982 ///// 3983 3984 017027 0000 DVSB, 0 /MULTIPLY QUOTIENT*DIVISOR 3985 017030 7521 SWP /AND SUBTRACT FROM DIVIDEND 3986 017031 7420 SNL 3987 017032 7001 IAC /ADD IN THE PREVIOUS CARRY 3988 017033 7405 MUY 3989 017034 0000 QUOT, 0 3990 017035 7521 SWP /GET BITS FOR THIS POSITION 3991 017036 7141 CLL CIA 3992 017037 1645 TAD I NORM /SUBTRACT FROM THE DIVIDEND 3993 017040 3645 DCA I NORM 3994 017041 7060 CMA CML 3995 017042 1245 TAD NORM /BACKUP AND REVERSE THE LINK 3996 017043 3245 DCA NORM 3997 017044 5627 JMP I DVSB /CALLED TWELVE TIMES 3998 /THIS NORMALIZE ROUTINE WORKS FOR BOTH POSITIVE & NEGATIVE 3999 /NUMBERS, PRESERVING THE VALUE OF 'SIGN' FOR USE LATER ON. 4000 4001 017045 0000 NORM, 0 /NORMALIZE THE FLAC - 'NORMALIZE' 4002 017046 7330 SM0 /=4000 4003 017047 0045 AND HORD 4004 017050 3015 DCA XRT2 /SIGN BIT 4005 017051 1045 TAD HORD 4006 017052 7450 SNA 4007 017053 1046 TAD LORD 4008 017054 7450 SNA 4009 017055 1047 TAD OVER 4010 017056 7640 SZA CLA /MANTISSA=0 ? 4011 017057 5266 JMP NORGO 4012 017060 3044 DCA EXP 4013 017061 5645 JMP I NORM /YES 4014 4015 017062 4556 NORML, SHIFTL /ONE BIT AT A TIME 4016 017063 7040 CMA 4017 017064 1044 TAD EXP 4018 017065 3044 DCA EXP 4019 017066 1045 NORGO, TAD HORD 4020 017067 7004 RAL 4021 017070 1015 TAD XRT2 /COMPARE SIGN & BIT 1 4022 017071 7700 SMA CLA /ARE THEY DIFFERENT ? 4023 017072 5262 JMP NORML /NOT YET 4024 4025 017073 7330 SM0 /CHECK FOR 4000 ..... 4026 017074 1045 TAD HORD 4027 / SNA 4028 / TAD OVER 4029 017075 7650 SNA CLA 4030 017076 4646 JMS I NORM+1 /SHIFT IT BACK A BIT 4031 017077 5645 JMP I NORM 4032 ///// 4033 017100 1060 TAD BUFR 4034 017101 3017 DCA AXOUT /SET 'TEXTP' 4035 017102 3021 DCA XCT /CONTINUE LINEFEED 4036 017103 1005 TAD CCR /START WITH A CR 4037 017104 4534 PRINTC 4038 017105 1502 TAD I C200 /THEN PRINT A STAR 4039 017106 2547 ISZ I DMPSW /PREVENT STUTTERING 4040 017107 4534 LFCONT, PRINTC /RETYPE THE INPUT LINE 4041 017110 4541 GETC 4042 017111 1016 TAD AXIN 4043 017112 7041 CIA /THROUGH THE CURRENT POSITION 4044 017113 1017 TAD AXOUT 4045 017114 7710 SPA CLA 4046 017115 5307 JMP LFCONT 4047 017116 1043 TAD T3 /CHECK FOR AN EXTRA CHARACTER 4048 017117 7710 SPA CLA 4049 017120 4534 PRINTC 4050 017121 7040 CMA 4051 017122 1016 TAD AXIN 4052 017123 5405 JMP I CCR /RESET PACKING POINTERS 4053 017124 3415 DVLP, DCA I XRT2 /ONLY 2 TIMES: XRT, THEN XRT2!! 4054 017125 1046 TAD LORD 4055 017126 7421 MQL /LOAD 24 BITS OF THE DIVIDEND 4056 017127 1045 TAD HORD 4057 017130 7407 DVI /CALLED THREE TIMES 4058 017131 0000 DVSR, 0 /THE TRIAL DIVISOR 4059 017132 7240 STA /SET TO THE MAXIMUM 4060 017133 7420 SNL /DIVIDE CHECK? 4061 017134 7521 SWP /GET THE ANSWER 4062 017135 3234 DCA QUOT /SAVE THE PARTIAL QUOTIENT 4063 4064 017136 3050 DCA EX1 /CLEAR THE GUARD WORD 4065 017137 1612 TAD I DADJ+1 /INITIALIZE THE WORD POINTER 4066 017140 3245 DCA NORM 4067 017141 1053 TAD OVR1 /FORM: DIVIDEND-QUOT*DIVISOR 4068 017142 4227 JMS DVSB 4069 017143 1052 TAD AC1L 4070 017144 4227 JMS DVSB 4071 017145 1331 TAD DVSR 4072 017146 4227 JMS DVSB 4073 017147 4227 JMS DVSB /FINISH PROCESSING DVSR 4074 4075 017150 1046 DVCK, TAD LORD /CHECK FOR SUCCESS 4076 017151 7420 SNL 4077 017152 5211 JMP DADJ /TOO BIG, CORRECT QUOTIENT 4078 017153 3045 DCA HORD /SHIFT THE REMAINDER LEFT 4079 017154 1047 TAD OVER 4080 017155 3046 DCA LORD 4081 017156 1050 TAD EX1 /THE 'GUARD WORD' 4082 017157 3047 DCA OVER 4083 017160 1234 TAD QUOT 4084 017161 2437 ISZ I RESOL /CHECK THE LOOP COUNTER 4085 017162 5324 JMP DVLP 4086 4087 017163 3047 DCA OVER /SAVE THE FULL QUOTIENT 4088 017164 1015 TAD XRT2 4089 017165 3046 DCA LORD 4090 017166 1014 TAD XRT 4091 017167 7500 SMA /CHECK THE 'SIGN' BIT 4092 017170 5375 JMP .+5 /OK, SAVE HORD 4093 017171 3045 DCA HORD 4094 017172 4773 JMS I .+1 /SHIFT RIGHT A BIT 4095 017173 7330 SM0 /POINTS TO 'DIV2' 4096 017174 1045 TAD HORD /CLEAR THE SIGN BIT 4097 017175 3045 DCA HORD 4098 017176 5777 JMP I (DVXIT /CONCLUDE EAE DIVIDE 4099 4100 017177 6710 PAGE 4101 *CLA / FOR 'FLEX' 4102 017200 0000 0 / FLOP -> FLAC 4103 017201 1050 TAD EX1 4104 017202 3044 DCA EXP 4105 017203 1051 TAD AC1H 4106 017204 3045 DCA HORD 4107 017205 1052 TAD AC1L 4108 017206 3046 DCA LORD 4109 017207 1053 TAD OVR1 4110 017210 3047 DCA OVER 4111 017211 5600 JMP I CLA 4112 ///// 4113 4114 017212 0000 ALIGN, 0 /SUBROUTINE TO LINE THINGS UP 4115 017213 1051 TAD AC1H /IS THE OPERAND ZERO? 4116 017214 7650 SNA CLA 4117 017215 5612 JMP I ALIGN /DON'T WASTE ANY TIME 4118 4119 017216 1045 TAD HORD /IS FLAC ZERO ? 4120 017217 7450 SNA 4121 017220 1046 TAD LORD 4122 017221 7650 SNA CLA 4123 017222 5375 JMP OSHFT /YES, FLOP -> FLAC 4124 4125 017223 1050 TAD EX1 /ARE THE EXPONENTS EQUAL? 4126 017224 7041 CIA 4127 017225 1044 TAD EXP 4128 017226 7450 SNA 4129 017227 5250 JMP AOK /YES, SO THERE'S NOTHING TO DO 4130 017230 3200 DCA CLA 4131 017231 1200 TAD CLA /SAVE AND CHECK THE DIFFERENCE 4132 017232 7500 SMA 4133 017233 7041 CIA /NEGATE FOR LOOPING 4134 017234 3041 DCA T1 4135 017235 1041 TAD T1 /CAN THEY BE ALIGNED? 4136 017236 1076 ALC, TAD P43 /'P27' FOR 3-WORD VERSION 4137 017237 7710 SPA CLA 4138 017240 5365 JMP NOWAY /NO, USE THE BIGGEST ONE 4139 4140 017241 1200 TAD CLA /YES, WHICH ONE IS BIGGER? 4141 017242 7500 SMA 4142 017243 4306 JMS DIV1 /FLAC 4143 017244 7510 SPA 4144 017245 4330 JMS DIV2 /FLOP 4145 017246 2041 ISZ T1 4146 017247 5241 JMP .-6 /REPEAT 4147 017250 2212 AOK, ISZ ALIGN 4148 017251 5612 JMP I ALIGN 4149 ///// 4150 017252 4330 JMS DIV2 /OPERANDS HAVE THE SAME SIGN 4151 017253 4306 JMS DIV1 /SO SHIFT THEM RIGHT ONCE AND 4152 017254 7010 RAR 4153 017255 1330 TAD DIV2 /ADD THE LEAST-SIGNIFICANT BITS 4154 017256 7204 CLA RAL 4155 017257 5361 JMP FLNR-1 /THEN ADD THE REST 4156 /TURN THE FLOATING ACCUMULATOR INTO A 24-BIT INTEGER WITH 4157 /THE LEAST MOST SIGNIFICANT 12 BITS IN THE AC UPON RETURN 4158 4159 4160 017260 0000 INTEGER,0 /'FIXIT' 4161 017261 1301 TAD P27 4162 017262 4270 JMS FIXER /CONVERT TO A 24-BIT INTEGER 4163 017263 3047 DCA OVER /CLEAR THE FRACTION 4164 017264 4437 JMS I RESOL 4165 017265 7100 CLL /VERY USEFUL! 4166 017266 1046 TAD LORD 4167 017267 5660 JMP I INTEGER 4168 ///// 4169 4170 017270 0000 FIXER, 0 /FIX UP A FLOATING POINT NUMBER 4171 017271 3050 DCA EX1 /SAVE THE DESIRED BINARY POINT 4172 017272 1044 TAD EXP 4173 017273 7750 SPA SNA CLA /IS IT GREATER THAN ONE? 4174 017274 5303 JMP NOFIX /NO, RETURN ZERO 4175 017275 4436 JMS I ABSOL /NECESSARY FOR NEG. VALUES 4176 017276 3051 DCA AC1H 4177 017277 1045 TAD HORD /IGNORE UNNORMALIZED NUMBERS 4178 017300 4212 JMS ALIGN /DO IT... 4179 017301 0027 P27, 27 4180 017302 5670 JMP I FIXER /DONE 4181 4182 017303 4552 NOFIX, FLOAT /STUFF WITH ZEROS 4183 017304 3044 DCA EXP 4184 017305 5670 JMP I FIXER 4185 ///// 4186 4187 *CLA CLL RTL /FOR 'FRA' 4188 4189 017306 0000 DIV1, 0 /SHIFT FLOP RIGHT 4190 017307 7210 CLA RAR 4191 017310 3330 DCA DIV2 4192 017311 1051 TAD AC1H 4193 017312 7510 SPA 4194 017313 7020 CML 4195 017314 7010 RAR 4196 017315 3051 DCA AC1H 4197 017316 1052 TAD AC1L 4198 017317 7010 RAR 4199 017320 3052 DCA AC1L 4200 017321 1053 TAD OVR1 4201 017322 7010 RAR 4202 017323 3053 DCA OVR1 4203 017324 2050 ISZ EX1 4204 017325 5706 JMP I DIV1 4205 017326 5706 JMP I DIV1 4206 ///// 4207 017327 6403 FP3, FPNT+3 4208 *SM0 /FOR NORMALIZE, DIVIDE 4209 017330 0000 DIV2, 0 /SHIFT FLAC RIGHT 4210 017331 7300 CLA CLL 4211 017332 1045 TAD HORD 4212 017333 7510 SPA 4213 017334 7020 CML 4214 017335 7010 RAR 4215 017336 3045 DCA HORD 4216 017337 1046 TAD LORD 4217 017340 7010 RAR 4218 017341 3046 DCA LORD 4219 017342 1047 TAD OVER 4220 017343 7010 RAR 4221 017344 3047 DCA OVER 4222 017345 2044 ISZ EXP 4223 017346 5730 JMP I DIV2 4224 017347 5730 JMP I DIV2 4225 ///// 4226 4227 017350 6751 REVERS 4228 017351 4750 FLSB, JMS I .-1 /FSUB=2 - NEGATE THE OPERAND 4229 017352 4212 FLAD, JMS ALIGN /FADD=1 - ALIGN EXPONENTS 4230 017353 5727 JMP I FP3 /NOT POSSIBLE 4231 017354 7330 SM0 4232 017355 0045 AND HORD /COMPARE SIGNS 4233 017356 1051 TAD AC1H 4234 017357 7700 SMA CLA 4235 017360 5252 JMP AOK+2 /SIMILAR: SHIFT RIGHT ONCE 4236 017361 4777 JMS I (DUBLAD 4237 017362 4435 FLNR, NORMALIZE /FNOR=7 - CALL NORMALIZE 4238 017363 5727 JMP I FP3 4239 ///// 4240 *CLA SM1 /FOR 'ASK' AND EAE DIVIDE 4241 017364 0000 TERM, 0 /INPUT TERMINATOR 4242 4243 017365 7330 NOWAY, SM0 /MISSION IMPOSSIBLE 4244 017366 0050 AND EX1 /POINTER FOR EAE DIVIDE 4245 017367 1044 TAD EXP /FIND OUT WHO'S BIGGEST 4246 017370 7710 SPA CLA 4247 017371 1044 TAD EXP /SIGNS DIFFER: TEST 'EXP' 4248 017372 7450 SNA 4249 017373 1200 TAD CLA /SIGNS EQUAL: CHECK DIFF. 4250 017374 7710 SPA CLA 4251 017375 4200 OSHFT, JMS CLA /EX1 > EXP 4252 017376 5612 JMP I ALIGN /EXP > EX1 4253 4254 017377 6244 PAGE 4255 /LIBRARY AND FILE COMMAND PROCESSOR: 4256 4257 /****** STORAGE ALLOCATION MAP ****** 4258 /***** ***** 4259 /* 1200 2ND INPUT BUFFER 4260 /* 1600 THE OUTPUT BUFFER 4261 /* 2200 STACK LIVES HERE 4262 /* 3000 PUSHDOWN ROUTINES 4263 /* 3200 MAIN INPUT BUFFER 4264 /* 3600 MAIN INPUT HANDLER 4265 /* 4200 THE LIBRARY HANDLER 4266 /* 4600 THE OUTPUT HANDLER 4267 /* 5200 2ND INPUT HANDLER 4268 /* 4269 /* 5600 FILE OUTPUT, CLOSE & ABORT 4270 /* 6000 OPEN, RESTORE & FILE INPUT 4271 /* 6200 TABULATE, HANDLER & SETDHT 4272 /* 6400 DECODER, DATER, SAVER, GOSUB 4273 /* 6600 RUN,CALL,BRANCH,RETURN,LJUMP 4274 /* 7000 LIBRARIAN, IOWAIT 4275 /* 7200 OPEN, DISMISS & COMPARE 4276 /* 7400 GTNAME 4277 /***** ***** 4278 /************************************ 4279 4280 / INITIAL TEXT FOR U/W-FOCAL 4281 4282 FIELD 2 4283 PAGE 1 4284 020200 0000 0 /PROGRAM LENGTH 4285 020201 5051 5051 /'()' FOR TDUMP 4286 020202 0000 LINE0, 0 /POINTER TO NEXT 4287 020203 0000 0 /LINE NO. ZERO 4288 020204 0340 TEXT "C U/W-FOCAL:" 020205 2557 020206 2755 020207 0617 020210 0301 020211 1472 020212 0000 4289 020213 2605 TITLE, TEXT "VER-4E" /'?M'=CODED CR 020214 2255 020215 6405 020216 0000 4290 020217 6165 DATE, TEXT "15.10.78?M" 020220 5661 020221 6056 020222 6770 020223 7715 020224 0000 4291 LINE1= DATE+5 /NULLS BECOME SPACES 4292 4293 *100 4294 020100 0000 ZBLOCK 2 /PC0 FOR COMMAND MODE 020101 0000 4295 /PAGE ZERO STORAGE HAS BEEN CAREFULLY ARRANGED ! 4296 4297 FIELD 0 4298 PAGE 0 4299 4300 000000 5400 INITLZ /INTERRUPT SERVICE ROUTINE 4301 000001 6212 CIF P 4302 000002 5577 JMP I [INTRPT /PATCH 177 FOR POWER FAIL 4303 4304 000003 6244 PRNTC, RMF /RETURN FROM THE INTERRUPT 4305 000004 6001 I0N 4306 000005 5600 CL0SE, 5600 /'JMP I 0' 4307 4308 000006 7700 USR, 7700 //POINTER TO MONITOR (200 IF IN CORE) 4309 000007 0077 K77, 77 //LOCATION 7 FOR PLOTTER ROUTINES 4310 4311 000010 0000 AUTO, ZBLOCK 4 /AUTO-INDEX REGISTERS 000011 0000 000012 0000 000013 0000 4312 4313 000014 6114 ICHARX, ICHAR0 /USE THE REMAINING ONES 4314 000015 3315 OFFSET, ICHAR-XI33 /FOR THE EXTRA FEATURES 4315 000016 2114 SCHARX, SCHAR0-ICHAR0 4316 4317 *20 4318 000020 4552 NONAME, LPUSHF /INSERT VERSION NO. AFTER 'ERASE' 4319 000021 0045 H0RD, VERSION 4320 000022 4551 LPOPF 4321 000023 0066 XCHAR, NAMLOC-1 /STRATEGICALLY LOCATED! 4322 000024 7324 IOWAIT, SP1 /POINTER TOO! 4323 000025 3036 DCA GOSW /SET RETURN POINTER 4324 000026 4106 JMS TEMP /THEN UPDATE HEADER 4325 000027 3077 DCA LIBFLG /ZAP 'PROGRAM SAVED' FLAG 4326 000030 1036 TAD GOSW /RETURN FOR LOAD CALLS 4327 000031 1044 EXIT, TAD GOJUMP /NORMAL RETURNS='JMP I (PROC' 4328 000032 3036 DCA GOSW 4329 000033 4545 DISMISS /REMOVE THE USR 4330 000034 6213 CDI P 4331 000035 6001 I0N 4332 4333 000036 0176 GOSW, [DERR /LOWER FIELD ERROR ROUTINE 4334 000037 4545 DISMISS /CLEARS AC (JMP 135) 4335 000040 1036 TAD GOSW /(RELOCATE FOR LINC INTERRUPTS) 4336 000041 6213 CDI P 4337 000042 3575 DCA I [ERROR /SIMULATE A 'JMS' 4338 000043 5574 JMP I [ERROR+1 4339 000044 5452 GOJUMP, JMP I K177-1 /PLUS (GOSW) 4340 4341 *HORD 4342 000045 6166 VERSION,TEXT "16K-V4" 000046 1355 000047 2664 000050 0000 4343 000051 0647 LGOSUB /-1 4344 000052 0755 CONT / 0 4345 000053 0177 K177, START /+1 4346 000054 0611 GOTO+1 /+2 4347 4348 000055 0000 NEWDEV, ZBLOCK 4 /'NEWDEV-1'='TELSW' 000056 0000 000057 0000 000060 0000 4349 FLNGTH= .-2 4350 STBLK= .-1 /'LIBBLK-1'='BUFR' 4351 4352 000061 0000 LIBBLK, ZBLOCK 2 /FOR DEVICE NAME 000062 0000 4353 000063 4201 4201 /LOAD POINT 4354 000064 0000 DEVNO, 0 /FOR DEVICE # 4355 000065 2546 LIBHND, ERTRAP /HANDLER ENTRY 4356 4357 000066 0173 CHAR, [7200 /LOWER FIELD COPY 4358 000067 0000 NAMLOC, ZBLOCK 4 /(MUST BE 'CHAR+1') 000070 0000 000071 0000 000072 0000 4359 EXTENSION=.-1 4360 000073 5723 DSK, 5723 /HASH CODE FOR DEFAULT DEVICE 4361 4362 000074 0000 LIBDEV, ZBLOCK 4 000075 0000 000076 0000 000077 0000 4363 LIBFLG= .-1 /REFERENCE VIA P77 4364 4365 *100 4366 000100 0000 PC0, 0 /ENTRY AND RESTART POINT 4367 000101 5400 JMP I 0 /INITIALIZE (ONCE ONLY) 4368 000102 7301 SWAP, CLA CLL IAC /POINTER TO SWAP ROUTINE 4369 000103 5031 JMP EXIT 4370 *.+2 /FOR COMPATIBILITY 4371 000106 0172 TEMP, [7400 /UPDATE THE HEADER 4372 000107 6222 CIF T 4373 000110 5021 JMP NUHEAD+1 4374 4375 000111 0000 SINBLK, ZBLOCK 2 000112 0000 4376 000113 5201 5201 /4201 PATCHED BY PLOT 4377 000114 0000 0 4378 000115 0000 SINHND, 0 4379 000116 0000 SPOINT, 0 4380 000117 0216 D, DATE-1 4381 000120 0067 XNAME, NAMLOC 4382 4383 000121 0000 INBLK, ZBLOCK 2 000122 0000 4384 000123 3601 3601 4385 000124 0000 0 4386 000125 0036 INHND, GOSW /REREAD TRAP 4387 4388 000126 0000 OUTBLK, ZBLOCK 2 000127 0000 4389 000130 4601 4601 4390 000131 0000 FILDEV, 0 4391 000132 0000 OUTHND, 0 4392 000133 0000 OUTFLG, 0 4393 4394 *PRINTC&177 4395 ERROR0= JMS I . /='PRINTC' 4396 000134 3137 TRAP 4397 ERROR1= JMS GOSW 4398 /SECONDARY INPUT ROUTINES: THE 'O S' AND 'O R S' COMMANDS 4399 4400 /IN THE ABSENCE OF THE PLOTTER ROUTINES THERE ARE NO RE- 4401 /STRICTIONS ON THE SECOND INPUT FILE, BUT THE ADDITION OF 4402 /THESE ROUTINES LIMITS THE 'L' COMMANDS TO THE USE OF THE 4403 / DEVICE - OR ANY HANDLER CO-RESIDENT WITH THE SYS- 4404 /TEM DEVICE, SUCH AS 'RKB0', OR 'DTA1' IN A 'TD8E' SYSTEM. 4405 4406 *200 4407 000200 7140 SINPUT, CLL CMA /USE THE REGULAR LOOKUP ROUTINE 4408 000201 4573 JMS I [OPEN 4409 000202 0110 SINBLK-1 4410 000203 4534 ERROR0 /FILE MISSING 4411 000204 5623 JMP I CRT /PATCHED BY SCOPE OVERLAY 4412 000205 1060 TAD STBLK 4413 000206 3236 DCA SBLK 4414 000207 7164 SM1 4415 000210 3227 DCA SINFLG 4416 4417 000211 1227 SRST, TAD SINFLG 4418 000212 7650 SNA CLA 4419 000213 4534 ERROR0 /NOTHING LEFT 4420 000214 1016 TAD SCHARX 4421 *CR 4422 000215 1014 TAD ICHARX /ENTRY POINT FOR 'O I', 'O R I' 4423 000216 6211 CDF P 4424 000217 3621 DCA I INP /CHANGE THE FILE INPUT POINTER 4425 000220 5622 JMP I TTY 4426 4427 000221 6322 INP, FILIN 4428 000222 6066 TTY, TTYIN-1 4429 000223 6067 CRT, TTYIN /OR 'OSCOPE' 4430 000224 6160 END, ENDCHK 4431 4432 000225 0000 SEND, 0 /POINTS TO NEXT STEP 4433 000226 4624 JMS I END /CHECK FOR THE EOF 4434 000227 0000 SINFLG, 0 /'FILE OPEN' FLAG 4435 4436 000230 2227 SCHAR0, ISZ SINFLG /BUFFER EMPTY? 4437 000231 5625 JMP I SEND /NO, GET THE NEXT CHARACTER 4438 000232 6002 I0F 4439 000233 4515 JMS I SINHND /READ ANOTHER BLOCK 4440 000234 0200 0200 4441 000235 1200 1200 /2200 PATCHED BY PLOT 4442 000236 0000 SBLK, 0 4443 000237 7700 SMA CLA /FATAL ERROR? 4444 000240 7610 SKP CLA 4445 000241 5576 JMP I [DERR 4446 000242 1173 TAD [-600 4447 000243 3227 DCA SINFLG /RESET THE WORD COUNTER 4448 000244 2236 ISZ SBLK /ADVANCE THE BLOCK NO. 4449 000245 1235 TAD SBLK-1 4450 000246 3116 DCA SPOINT /AND RESTART FROM THE TOP 4451 000247 6001 I0N 4452 000250 1516 SCHAR1, TAD I SPOINT /UNPACK THE BUFFER 4453 000251 4225 JMS SEND 4454 4455 000252 1516 TAD I SPOINT /SAVE UPPER 4 BITS 4456 000253 0172 AND [7400 4457 000254 3635 DCA I SBLK-1 4458 000255 2116 ISZ SPOINT /POINT TO THE NEXT 4459 000256 1516 TAD I SPOINT 4460 000257 4225 JMS SEND 4461 4462 000260 1516 TAD I SPOINT /NOW TO PUT THE PIECES 4463 000261 2116 ISZ SPOINT /ALL TOGETHER AGAIN 4464 000262 0172 AND [7400 4465 000263 7112 CLL RTR 4466 000264 7012 RTR 4467 000265 1635 TAD I SBLK-1 4468 000266 7012 RTR 4469 000267 7012 RTR 4470 000270 4225 JMS SEND 4471 000271 5250 JMP SCHAR1 /ROUND & ROUND & ROUND WE GO 4472 ///// 4473 4474 000272 3021 LPTDEV, XOUTL; ZBLOCK 2 /CHANGE THESE 3 LOCATIONS TO THE 000273 0000 000274 0000 4475 /DEVICE LPT /ENTRY POINT AND THE DEVICE NAME 4476 4477 000275 0171 LPTCHK, [PDLXR /CHECK FOR CALLS TO 'LPT:' 4478 000276 7344 SM2 4479 000277 4547 COMPAR /NOW CHECK IT 4480 000300 0272 LPTDEV 4481 000301 0054 NEWDEV-1 4482 000302 5675 JMP I LPTCHK /NOT WHAT WE'RE LOOKING FOR 4483 000303 2275 ISZ LPTCHK /RETURN WITH THE ENTRY POINT 4484 000304 1272 TAD LPTDEV /(INSERT OTHER CODE HERE - FOR EX: 4485 000305 5675 JMP I LPTCHK /A CHECK FOR THE ',E' OPTION,ETC.) 4486 /THE STACK, TTY BUFFER & ERROR TRAP ALL LIVE HERE 4487 4488 *3024 /BEGINNING OF THE STACK 4489 4490 003024 0170 PCHK, ["0 /STACK OVERFLOW CHECK 4491 003025 6211 CDF P 4492 003026 1571 TAD I [PDLXR /ADJUST FIELD 1 X-REGISTER 4493 003027 3013 DCA PDLXR /BACKUP & COPY 4494 003030 1013 TAD PDLXR 4495 003031 3571 DCA I [PDLXR 4496 003032 1013 TAD PDLXR /CHECK FOR OVERFLOW 4497 003033 7161 STL CIA 4498 003034 1377 TAD (2200 /2600 PATCHED BY PLOT 4499 003035 6203 CDI L 4500 003036 7770 SPA SNA SZL CLA /-10 = L-P 4501 003037 5624 JMP I PCHK 4502 003040 1235 PDERR, TAD .-3 /TOO BAD! 4503 003041 5032 JMP EXIT+1 /USE 'CDI L' AS THE ERROR CODE 4504 4505 003042 0000 MPUSHF, 0 /PUSH 4 WORDS ON THE STACK 4506 003043 1236 TAD PDERR-2 /LOWER FIELD ENTRY 4507 003044 1225 TAD PCHK+1 /UPPER FIELD ENTRY 4508 003045 3256 DCA FCDF 4509 003046 7140 CLL CMA 4510 003047 1642 TAD I MPUSHF /BACKUP POINTER 4511 003050 2242 ISZ MPUSHF 4512 003051 3010 DCA AUTO 4513 003052 1167 TAD [-4 4514 003053 4224 JMS PCHK 4515 003054 1167 TAD [-4 4516 003055 3224 DCA PCHK 4517 003056 6211 FCDF, CDF L P /CHANGE TO CALLING FIELD 4518 003057 1410 TAD I AUTO 4519 003060 6201 CDF S 4520 003061 3413 DCA I PDLXR /LOAD STACK 4521 003062 2224 ISZ PCHK 4522 003063 5256 JMP FCDF /WITH FOUR WORDS 4523 003064 7326 SP2 4524 003065 1256 TAD FCDF /CHANGE 'CDF' TO 'CDI' 4525 003066 3267 DCA .+1 4526 003067 6213 CDI L P 4527 003070 5642 JMP I MPUSHF 4528 4529 003071 3320 APUSHX, DCA MPOPF /PUSH THE AC ON THE STACK 4530 003072 7164 SM1 4531 003073 4224 JMS PCHK 4532 003074 1320 TAD MPOPF 4533 003075 3413 DCA I PDLXR 4534 003076 6213 CDI P 4535 003077 5776 JMP I (XPUSHA+3 /ONLY USED BY FIELD 1 4536 *.&7757 4537 003100 0000 TBUF, ZBLOCK 20 /TELETYPE OUTPUT BUFFER 003101 0000 003102 0000 003103 0000 003104 0000 003105 0000 003106 0000 003107 0000 003110 0000 003111 0000 003112 0000 003113 0000 003114 0000 003115 0000 003116 0000 003117 0000 4538 4539 003120 0000 MPOPF, 0 /POP 4 WORDS 4540 003121 1720 TAD I MPOPF 4541 003122 3010 DCA AUTO 4542 003123 4224 JMS PCHK /COPY THE PDLXR 4543 003124 1167 TAD [-4 4544 003125 3224 DCA PCHK 4545 003126 1413 TAD I PDLXR 4546 003127 3410 DCA I AUTO 4547 003130 6211 CDF P 4548 003131 2571 ISZ I [PDLXR /FAKE A FIELD 1 USE 4549 003132 6201 CDF L 4550 003133 2224 ISZ PCHK 4551 003134 5326 JMP .-6 4552 003135 2320 ISZ MPOPF 4553 003136 5720 JMP I MPOPF 4554 4555 003137 0000 TRAP, 0 /RECOVER FROM SELETED ERRORS 4556 003140 4545 DISMISS 4557 003141 1337 TAD TRAP 4558 003142 3036 DCA GOSW /ASSUME NORMAL ERROR EXIT 4559 003143 7326 SP2 4560 003144 6211 CDF P 4561 003145 2775 ISZ I (NAGSW /WAS A LINE NUMBER GIVEN? 4562 003146 5031 JMP EXIT /YES, FALL INTO THE TRAP 4563 003147 5037 JMP GOSW+1 /NO, DO THE USUAL STUFF 4564 4565 003150 0000 REKOVR, 0 /CONTINUATION OF ERROR ROUTINE 4566 003151 6032 KCC 4567 003152 1374 TAD (-17 4568 003153 3300 DCA TBUF 4569 003154 1373 TAD (TBUF 4570 003155 3013 DCA PDLXR 4571 003156 3413 DCA I PDLXR /CLEAR OUT THE TTY BUFFER 4572 003157 2300 ISZ TBUF 4573 003160 5356 JMP .-2 4574 003161 1502 TAD I SWAP /CHECK CORE-SWAP FLAG 4575 003162 7650 SNA CLA 4576 003163 4502 JMS I SWAP /RESTORE THE SCRATCH AREA 4577 003164 1166 TAD [CR /PRINT A CR AHEAD OF ERROR MESSAGE 4578 003165 7200 CLA /OR 'JMS I PRNTC' 4579 003166 1350 TAD REKOVR /LET 'EOF' RESTORE THE TTY 4580 003167 6213 CDI P 4581 003170 3565 DCA I [EOF 4582 003171 5772 JMP I (EOF+1 /THEN GO PRINT THE ERROR MESSAGE 4583 4584 003172 6344 PAGE 26 003173 3100 003174 7761 003175 0070 003176 1336 003177 2200 4585 /INITIALIZE THE VARIABLES AND THE DATE 4586 4587 005400 0000 INITLZ, ZBLOCK 20 /CLEAR ANNOYING FLAGS 005401 0000 005402 0000 005403 0000 005404 0000 005405 0000 005406 0000 005407 0000 005410 0000 005411 0000 005412 0000 005413 0000 005414 0000 005415 0000 005416 0000 005417 0000 4588 4589 005420 6254 SM8 /PATCH FOR MULTI-8 4590 005421 5225 JMP .+4 4591 005422 6770 6770 /GET THE TIME-OF-DAY 4592 005423 4653 JMS I MV1 /REVERSE HRS, MINUTES 4593 005424 3247 DCA MV1-4 /INITIALIZE RANDOM NO. 4594 4595 005425 1230 TAD .+3 4596 005426 4353 JMS MOVE /LOAD COMMAND DECODER AREA 4597 005427 7755 .+1-MV1 4598 RELOC RANDOM-16 4599 4600 007624* 7623 PUTV, .-1 /SUBROUTINE TO LOCATE VARIABLES 4601 007625* 3063 DCA THISOP /SAVE THE NAME 4602 007626* 3046 DCA LORD /CLEAR SUBSCRIPT 4603 007627* 4522 PUSHJ 4604 007630* 1434 GS1 /DO THE LOOKUP 4605 007631* 4525 POPF 4606 007632* 0044 FLAC /GET THE VALUE 4607 007633* 4407 FENT 4608 007634* 6400 FPUTIPT1 /STORE IT 4609 007635* 0000 FEXT 4610 007636* 1061 TAD LASTV /ADVANCE THE POINTER 4611 007637* 3031 DCA FIRSTV 4612 007640* 6202 CIF L 4613 007641* 5624 JMP I PUTV /RETURN 4614 4615 007642* 0000 RANDOM, 0;4421;3040;1;0 /RANDOM ENOUGH? 007643* 4421 007644* 3040 007645* 0001 007646* 0000 4616 RELOC 4617 4618 0015453 7164 MV1, SM1 /SET THE ADDRESS POINTERS 4619 005454 1777 TAD I (FIRSTV /USING THE VALUE HERE 4620 005455 3776 DCA I (SECRTV 4621 005456 1777 TAD I (FIRSTV 4622 005457 3775 DCA I (LASTV 4623 005460 4337 JMS SETV /CALL OUR FIELD 1 ROUTINE 4624 005461 5533 PI;2011 005462 2011 4625 005463 7326 SP2 4626 005464 1775 TAD I (LASTV 4627 005465 3774 DCA I (DIMEN /FOR DOUBLE SUBSCRIPTING 4628 005466 4337 JMS SETV 4629 005467 3100 FPZ;4100 /! 005470 4100 4630 005471 4337 JMS SETV 4631 005472 3100 FPZ;4200 /" 005473 4200 4632 005474 7326 SP2 4633 005475 1775 TAD I (LASTV 4634 005476 3773 DCA I (FSFP /FOR FSF'S 4635 005477 4337 JMS SETV 4636 005500 3100 FPZ;4300 /# 005501 4300 4637 005502 4337 JMS SETV 4638 005503 3100 FPZ;4400 /$ 005504 4400 4639 005505 4337 JMS SETV 4640 005506 3100 FPZ;4500 /% 005507 4500 4641 005510 5325 JMP FINALZ /'NOP' FOR MORE 4642 005511 4337 JMS SETV 4643 005512 3100 FPZ;4600 /& 005513 4600 4644 005514 4337 JMS SETV 4645 005515 3100 FPZ;7200 /: 005516 7200 4646 005517 4337 JMS SETV 4647 005520 3100 FPZ;3400 /\ 005521 3400 4648 005522 5325 JMP .+3 /SINGLE QUOTE IS OUT 4649 005523 3100 FPZ;4700 /' 005524 4700 4650 4651 005525 6222 FINALZ, CIF T 4652 005526 4772 JMS I (DATA /SET THE DATE WORDS 4653 005527 4771 JMS I (ENVIR /CHECK THE ENVIRONMENT 4654 005530 6031 KSF /KEYBOARD INPUT? 4655 005531 5020 JMP NONAME /NO 4656 005532 5102 JMP SWAP /YES: LEAVE VERSION ID 4657 4658 FPZ= TBUF /FLOATING POINT ZERO 4659 005533 0002 PI, 2;3110;3755;2421 005534 3110 005535 3755 005536 2421 4660 005537 0000 SETV, 0 /CROSS-FIELD CALL 4661 005540 6201 CDF L 4662 005541 1737 TAD I SETV /GET THE DATA VALUE 4663 005542 2337 ISZ SETV 4664 005543 3345 DCA .+2 4665 005544 4552 LPUSHF /SAVE IT ON THE STACK 4666 005545 0000 0 4667 005546 1737 TAD I SETV /NOW GET THE NAME 4668 005547 2337 ISZ SETV 4669 005550 6213 CDI P 4670 005551 4770 JMS I (PUTV /AND INSERT IT 4671 005552 5737 JMP I SETV /DF=P 4672 4673 005553 0000 MOVE, 0 /CLEVER LITTLE ROUTINE 4674 005554 3010 DCA AUTO 4675 005555 1753 TAD I MOVE 4676 005556 3101 DCA PC0+1 4677 005557 2353 ISZ MOVE 4678 005560 6201 CDF L 4679 005561 1753 TAD I MOVE /WHERE ITS AT 4680 005562 6211 CDF P 4681 005563 3410 DCA I AUTO /WHERE ITS GOING 4682 005564 2101 ISZ PC0+1 /COVER OUR TRACKS 4683 005565 5357 JMP MOVE+4 4684 005566 2353 ISZ MOVE 4685 005567 5753 JMP I MOVE /DF=P 4686 4687 005570 7624 PAGE 15 005571 3202 005572 0126 005573 7511 005574 5777 005575 0061 005576 0032 005577 0031 4688 4689 /CHECK THE RUN-TIME ENVIRONMENT: 4690 4691 003200 7777 7777 /BIPCCL POINTER 4692 003201 3010 XI33+1 /RELOCATION POINTER 4693 003202 0000 ENVIR, 0 4694 003203 1600 TAD I ENVIR-2 /ARE WE RUNNING UNDER SOMETHING? 4695 003204 7006 RTL /2000=BATCH, 1000=RTS8 4696 003205 7720 SNL SMA CLA /EITHER BATCH OR RTS8? 4697 003206 5342 JMP VIDEO /NO, CHECK SCOPE MODE 4698 003207 1201 TAD ENVIR-1 /GET RELOCATION POINTER 4699 003210 4622 JMS I .+12 /CHANGE TO NON-INTERRUPT I/O 4700 003211 7732 .+1-MV2 4701 RELOC XI33+2 4702 /XI33, 0 4703 / KSF /ANY INPUT? 4704 003011* 5210 JMP .-1 /WAIT UNTIL THERE IS 4705 003012* 4237 JMS KCHK 4706 003013* 1055 TAD INBUF /HERE IT IS 4707 003014* 3221 DCA XOUTL 4708 003015* 6032 KCC 4709 003016* 3055 DCA INBUF /CLEAR INPUT FLAG 4710 003017* 1221 TAD XOUTL 4711 003020* 5607 JMP I XI33 4712 4713 003021* 5553 XOUTL, MOVE 4714 003022* 6046 TLS /THIS IS ALL WE NEED! 4715 003023* 7600 7600 /'CLA' = MONITOR EXIT 4716 003024* 4237 JMS KCHK /CHECK FOR INPUT 4717 003025* 6041 TSF /BUFFER FULL? 4718 003026* 5225 JMP .-1 4719 003027* 5621 JMP I XOUTL 4720 4721 003030* 6203 BYEBYE, CDI /RETURN TO OS/8 4722 003031* 5623 JMP I XOUTL+2 /OR TO BATCH... 4723 003032* 0015 "P-"C 4724 4725 003033* 4237 POPX, JMS KCHK /CHECK INPUT AFTER A 'POPJ' 4726 003034* 5635 JMP I .+1 4727 003035* 1337 XPOPJ 4728 003036* 0203 "C&277 4729 4730 003037* 3033 KCHK, POPX /KEYBOARD CHECK 4731 003040* 6031 KSF 4732 003041* 5637 JMP I KCHK /NOTHING WAITING 4733 003042* 6034 KRS 4734 003043* 0075 AND P177 4735 003044* 7450 SNA 4736 003045* 5637 JMP I KCHK /IGNORE NULLS 4737 003046* 1345 TAD M20 4738 003047* 7450 SNA /CTRL P? 4739 003050* 5347 JMP M20+2 4740 003051* 1232 TAD POPX-1 4741 003052* 7450 SNA /CTRL C? 4742 003053* 5230 JMP BYEBYE 4743 003054* 1236 TAD KCHK-1 /SET PARITY 4744 003055* 3055 DCA INBUF /SAVE THE INPUT 4745 003056* 5637 JMP I KCHK 4746 RELOC 4747 4748 003260 1240 MV2, TAD .-20 /PATCH 'POPJ' 4749 003261 3777 DCA I (POPJ&177 4750 003262 1241 TAD .-21 /MOVE 'KSF' 4751 003263 3601 DCA I ENVIR-1 /INTO PLACE 4752 / DISABLE ALL THE 'IONS' 4753 4754 003264 3574 DCA I [ERROR+1 4755 003265 3776 DCA I (4333 /FRA 4756 003266 6201 CDF L 4757 003267 3035 DCA GOSW-1 4758 003270 3775 DCA I (247 /SINPUT 4759 003271 3774 DCA I (OECHO-1 4760 003272 3773 DCA I (ICHAR1-1 4761 003273 1323 TAD MV3-5 /NOP 4762 003274 3772 DCA I (TAB+10 4763 003275 3771 DCA I (IOWATE+2 4764 4765 / CHECK FOR BATCH 4766 4767 003276 1600 TAD I ENVIR-2 /IS BATCH RUNNING? 4768 003277 7004 RAL 4769 003300 7700 SMA CLA 4770 003301 5342 JMP VIDEO /NO, CHECK SCOPE MODE 4771 003302 1600 TAD I ENVIR-2 4772 003303 0321 AND .+16 /GET THE BATCH FIELD 4773 003304 1322 TAD .+16 /ADD 'CIF' 4774 003305 3322 DCA .+15 /SET UP THE INSTRUCTION 4775 003306 1201 TAD ENVIR-1 /CHANGE TTY TO BATCH I/O 4776 003307 4622 JMS I ENVIR+20 /=MOVE 4777 003310 7761 .+1-MV3 4778 4779 003371 7326 RELOC XI33+2 003372 6215 003373 6133 003374 6102 003375 0247 003376 4333 003377 0123 4780 4781 /XI33, 0 4782 / CIF BF /CHANGE TO THE BATCH FIELD 4783 003011* 4626 JMS I BATIN /READ FROM THE BATCH STREAM 4784 003012* 4576 ERROR2 /NOTHING LEFT! 4785 003013* 1220 TAD XOUTL-1 /CAST OUT LINEFEEDS 4786 003014* 7450 SNA 4787 003015* 5210 JMP XI33+1 4788 003016* 1004 TAD CLF 4789 003017* 5607 JMP I XI33 4790 003020* 7566 -LF 4791 4792 003021* 0070 XOUTL, 70 /OUTPUT TO THE BATCH LOG 4793 003022* 6202 CIF /'PATCHED FOR BATCH' 4794 003023* 7000 7000 /'NOP' = BATCH EXIT 4795 003024* 4627 JMS I BATOUT 4796 003025* 5621 JMP I XOUTL 4797 003026* 5400 BATIN, 5400 4798 003027* 7400 BATOUT, 7400 4799 RELOC 4800 MEMSIZ= CDI T V /SELECT THE HIGHEST FIELD 4801 4802 003330 1322 MV3, TAD .-6 /MOVE THE 'CDI' INSTR 4803 003331 3601 DCA I ENVIR-1 /TO 'XI33+1' 4804 003332 1322 TAD .-10 /AND THEN TO 'BYEBYE' 4805 003333 3770 DCA I (BYEBYE /TO CATCH CTRL/C'S 4806 003334 1254 TAD MV2-4 4807 003335 3767 DCA I (BATXIT /FIX UP THE ERROR ROUTINE 4808 003336 1322 TAD .-14 4809 003337 1366 TAD (-MEMSIZ /CHECK MEMORY SIZE 4810 003340 7750 SPA SNA CLA 4811 003341 4036 ERROR1 /NOT ENOUGH MEMORY! 4812 4813 003342 6211 VIDEO, CDF 10 4814 003343 1765 TAD I (17726 /DO WE HAVE A VIDEO TERMINAL? 4815 003344 0164 AND [200 4816 003345 7650 SNA CLA 4817 003346 5354 JMP .+6 /NO, LEAVE RUBOUT ALONE 4818 003347 1364 TAD (TAD START 4819 003350 3763 DCA I (RUB1+3 4820 003351 1362 TAD (ECHOC /YES, USE 'BS', 'SP', 'BS' 4821 003352 3761 DCA I (RUB1+4 4822 003353 7410 SKP 4823 003354 3760 DCA I (MODLN /REMOVE LINENO PRINTOUT 4824 003355 6201 CDF L 4825 003356 5602 JMP I ENVIR 4826 4827 003360 0402 PAGE 003361 2472 003362 4533 003363 2471 003364 1177 003365 7726 003366 1545 003367 3174 003370 3030 4828 / FILE CLOSING AND OUTPUT ROUTINES 4829 4830 PAGE 27 /'JMP I 0' 4831 4832 005600 0000 CLOSER, 0 /CLOSE OR REMOVE THE FILE 4833 005601 3106 DCA TEMP /SET THE 'CALL' FLAG 4834 005602 1133 TAD OUTFLG /IS THERE AN OPEN FILE? 4835 005603 7650 SNA CLA 4836 005604 5600 JMP I CLOSER /NO, IGNORE THE COMMAND 4837 005605 1312 TAD O2 /WHICH COMMAND? 4838 005606 7650 SNA CLA 4839 005607 5216 JMP REMOVE /'ABORT' 4840 005610 1163 TAD [232 /'CLOSE' 4841 005611 4255 JMS NOCHAR /INSERT A 'CTRL/Z' 4842 005612 7520 GETSIZ, SNL SMA /POINTS TO 'MGETA' 4843 005613 5211 JMP .-2 /AND PAD WITH ZEROS 4844 005614 2106 ISZ TEMP /CHECK CALLING FLAG 4845 005615 5226 JMP NOSIZE 4846 4847 005616 4612 REMOVE, JMS I GETSIZ /GET THE CLOSING LENGTH, IF ANY 4848 005617 7120 STL /ONLY 'O A' & 'O C' HAVE SIZES 4849 005620 1242 TAD OLNGTH /COMPARE WITH THAT AVAILABLE 4850 005621 7660 SNL SZA CLA 4851 005622 4036 ERROR1 /BETTER LUCK NEXT TIME 4852 005623 1562 TAD I [LORD /GET THE SIZE BACK 4853 005624 7440 SZA /ZERO MEANS 'AS IS' 4854 005625 3241 DCA BLKCNT /ENTRY POINT FOR OVERFLOW ERROR 4855 4856 005626 6211 NOSIZE, CDF P /RESTORE OUTPUT TO THE ECHO DEVICE 4857 005627 1561 TAD I [ECODEV 4858 005630 3560 DCA I [OUTDEV /THE USR MUST NOT BE IN CORE! 4859 005631 4424 JMS I IOWAIT /WAIT FOR TELETYPE (RESETS DF) 4860 005632 4565 JMS I [SETDHT /SET THE ENTRY POINT FOR 'CLOSE' 4861 005633 0130 FILDEV-1 / POINTER TO DEVICE # AND ENTRY 4862 005634 6212 CIF 10 4863 005635 1131 TAD FILDEV /SAVED DEVICE NO. 4864 005636 4406 JMS I USR 4865 005637 0004 4 4866 005640 6711 ONMTMP /FILE NAME POINTER 4867 005641 0000 BLKCNT, 0 /CURRENT FILE LENGTH 4868 005642 0000 OLNGTH, 0 /MAXIMUM " " 4869 005643 1133 TAD OUTFLG 4870 005644 7650 SNA CLA 4871 005645 4036 ERROR1 /FILE WAS TOO LONG 4872 005646 3133 DCA OUTFLG /CLEAR THE 'FILE OPEN' FLAG 4873 005647 5600 JMP I CLOSER /ALSO CALLED BY 'SAVE' & 'DELETE' 4874 4875 005650 3312 ABORT, DCA O2 /'OUTPUT ABORT' COMMAND 4876 005651 3241 DCA BLKCNT 4877 4878 005652 7164 CLOSE, SM1 /'OUTPUT CLOSE' COMMAND 4879 005653 4200 JMS CLOSER /L=1 4880 005654 5031 JMP EXIT /SIMPLE - ONCE YOU KNOW HOW! 4881 005655 0000 NOCHAR, 0 /OS/8 3/2 BUFFERED CHARACTER OUTPUT 4882 005656 0377 AND (377 /MASK OUT GARBAGE 4883 005657 2312 ISZ O2 /WHICH CHAR OF THREE? 4884 005660 5306 JMP O1 /STRAIGHT PACKING 4885 005661 4312 JMS O2 /HALF WORD PACKING - PACK 1ST HALF 4886 005662 1324 TAD O3 /GET SAVED ARG 4887 005663 4312 JMS O2 /PACK SECOND HALF 4888 005664 7346 SM3 /RESET 3-WAY SWITCH 4889 005665 3312 DCA O2 /BUFFER CAN ONLY BE FILLED WITH 4890 005666 2133 ISZ OUTFLG /THE 3RD CHARACTER OF 3 4891 005667 5310 JMP O1+2 /NOT FULL YET 4892 005670 1242 TAD OLNGTH /CHECK THE FILE SIZE 4893 005671 1241 TAD BLKCNT /AMOUNT USED SO FAR 4894 005672 7620 SNL CLA /HAVE WE GONE TOO FAR? 4895 005673 5225 JMP NOSIZE-1 /YES, DELETE THE FILE 4896 005674 6002 I0F 4897 005675 4532 JMS I OUTHND /WRITE ONE BLOCK BUFFER 4898 005676 4200 4200 4899 005677 1600 1600 /5200 PATCHED BY PLOT 4900 005700 0000 OBLK, 0 4901 005701 5576 JMP I [DERR /DEVICE ERROR 4902 005702 2300 ISZ OBLK /BUMP OUTPUT BLOCK 4903 005703 2241 ISZ BLKCNT /AND COUNT OF BLOCKS SO FAR 4904 005704 4324 JMS O3 /RESET POINTERS FOR NEXT BUFFER 4905 005705 5655 JMP I NOCHAR /L=1 4906 4907 005706 3736 O1, DCA I OPTR1 /NORMAL PACKING IS EASY! 4908 005707 2336 ISZ OPTR1 /BUMP POINTER 4909 005710 7100 CLL 4910 005711 5655 JMP I NOCHAR /L=0 4911 4912 005712 0000 O2, 0 /HALF-WORD PACK ROUTINE 4913 005713 7106 CLL RTL 4914 005714 7006 RTL 4915 005715 3324 DCA O3 /SAVE FOR SECOND HALF 4916 005716 1324 TAD O3 4917 005717 0172 AND [7400 4918 005720 1737 TAD I OPTR2 /ADD IN CHARACTER IN RIGHT HALF 4919 005721 3737 DCA I OPTR2 /PACK IT 4920 005722 2337 ISZ OPTR2 /BUMP POINTER AGAIN 4921 005723 5712 JMP I O2 4922 4923 005724 0000 O3, 0 /RESET THE OUTPUT POINTERS 4924 005725 7346 SM3 4925 005726 3312 DCA O2 4926 005727 1277 TAD OBLK-1 4927 005730 3336 DCA OPTR1 4928 005731 1336 TAD OPTR1 4929 005732 3337 DCA OPTR2 4930 005733 1157 TAD [-200 /X3 = 384 CHARACTERS/BUFFER 4931 005734 3133 DCA OUTFLG 4932 005735 5724 JMP I O3 /'SM3' SETS THE LINK 4933 4934 005736 0000 OPTR1, 0 /PACKING POINTERS 4935 005737 0000 OPTR2, 0 4936 005740 4255 JMS NOCHAR /'OUTPUT BUFFER' COMMAND 4937 005741 1133 DUMPER, TAD OUTFLG /DUMPS THE OUTPUT BUFFER 4938 005742 7660 SNL SZA CLA /L=0 INITIALLY 4939 005743 5340 JMP DUMPER-1 4940 005744 5031 JMP EXIT /PAD WITH ZEROS AND EXIT 4941 4942 005745 6002 ILNGTH 4943 005746 1242 XLEN, TAD OLNGTH /FUNCTION TO CHECK FILE LENGTH 4944 005747 1241 TAD BLKCNT /(MINUS THE AMOUNT USED SO FAR) 4945 005750 7041 CIA 4946 005751 7410 SKP 4947 005752 1745 TAD I XLEN-1 /FUNCTION TO CHECK INPUT SIZE 4948 005753 6213 CDI P 4949 005754 5755 JMP I .+1 4950 005755 2021 FL0AT 4951 4952 /THIS IS THE 'OPEN OUTPUT' COMMAND: 4953 4954 005756 6007 TTYOUT 4955 005757 7160 OUTPUT, STL CMA /SET ECHO FLAG AND CALL=3 4956 005760 4573 JMS I [OPEN /CALL USR, HANDLER; ENTER FILE 4957 005761 0125 OUTBLK-1 /OUTPUT HANDLER BLOCK 4958 005762 4534 ERROR0 /ENTER ERROR: CLOSE FILE & RETRY? 4959 005763 5756 JMP I OUTPUT-1 /'OPEN OUTPUT TTY:' (OR JUST 'O O') 4960 005764 1057 TAD FLNGTH /MAXIMUM ALLOWABLE LENGTH 4961 005765 7041 CIA 4962 005766 3242 DCA OLNGTH 4963 005767 1060 TAD STBLK /STARTING BLOCK 4964 005770 3300 DCA OBLK 4965 005771 4324 JMS O3 /SET UP PACKING POINTERS 4966 005772 3241 DCA BLKCNT 4967 005773 4552 LPUSHF /SAVE THE FILE NAME FOR CLOSING 4968 005774 0067 NAMLOC 4969 005775 4551 LPOPF 4970 005776 6710 ONMTMP-1 /CODE SPILLS ACROSS THE PAGE 4971 005777 0377 *FLOUTP-1 /FUDGE TO SAVE A WORD OR TWO 4972 006000 5203 JMP ORST 4973 006001 0000 BLKNO, 0 4974 006002 0000 ILNGTH, 0 4975 4976 006003 1133 ORST, TAD OUTFLG /'OPEN RESTORE OUTPUT' COMMAND 4977 006004 7650 SNA CLA /FLAG IS CHARACTER COUNT 4978 006005 4534 ERROR0 /NO OUTPUT FILE TO RESTORE 4979 006006 1015 TAD OFFSET /POINTER TO FILE OUTPUT ROUTINE 4980 006007 1156 TTYOUT, TAD [XOUTL /SWITCH OUTPUT TO THE TELETYPE 4981 006010 6211 CDF P /ENTRY POINT FOR INTERNAL HANDLERS 4982 006011 3560 DCA I [OUTDEV 4983 006012 2036 ISZ GOSW /SKIP IF NO ECHO 4984 006013 1300 TAD OCHAR0+2 /'TAD ENDCHK' 4985 006014 3303 DCA OECHO /SET OUTPUT ROUTINE 4986 006015 5031 JMP EXIT /FINISH THE LINE 4987 4988 006016 3007 TTYP, XI33 /TTY INPUT 4989 006017 0056 INDEV 4990 /THE 'OPEN' AND 'RESTORE' COMMANDS AND FILE INPUT/OUTPUT 4991 4992 006020 6410 SCANER 4993 006021 4620 OCMND, JMS I .-1 /'O' COMMAND ENTRY - SKIP TO NEXT 4994 006022 1244 TAD DOTDA 4995 006023 3072 DCA EXTENSION /SET '.DA' 4996 006024 7040 CMA 4997 006025 3036 DCA GOSW /INITIALIZE THE ECHO SWITCH 4998 006026 4550 LJUMP /GO DO COMMAND 4999 006027 6364 FILIST-1 5000 006030 0302 FILEGO-FILIST 5001 006031 4036 ERROR1 /OOPS - BAD 'O' COMMAND 5002 5003 006032 6211 RESTOR, CDF P /'O R' COMMANDS - GET NEXT LETTER 5004 006033 1423 TAD I XCHAR 5005 006034 3106 DCA TEMP /SAVE COMMAND LETTER 5006 006035 4572 GTNAME /CHECK FOR ECHO AND LINE NUMBER 5007 006036 1106 TAD TEMP 5008 006037 3066 DCA CHAR 5009 006040 4550 LJUMP /SORT OUT "I", "O", OR "R" 5010 006041 6372 ORLIST-1 5011 006042 0306 ORGO-ORLIST 5012 006043 4036 ERROR1 /BAD 'RESTORE' COMMAND 5013 006044 0401 DOTDA, 401 /WAS 604 FOR '.FD' 5014 5015 /THE 'OPEN INPUT' COMMAND: 5016 5017 006045 7140 INPUT, CLL CMA /INITIALIZE ECHO AND SET 'CALL'=2 5018 006046 4573 JMS I [OPEN /CALL THAT AMAZING 5019 006047 0120 INBLK-1 /GENERAL-PURPOSE SUBROUTINE 5020 006050 4534 ERROR0 /WHOOPS - FILE NOT FOUND 5021 006051 5267 JMP TTYIN /'OPEN INPUT TTY:' (OR JUST 'O I') 5022 006052 1057 TAD FLNGTH 5023 006053 3202 DCA ILNGTH /FOR 'FLEN' AND 'FRA' 5024 006054 1060 TAD STBLK 5025 006055 3201 DCA BLKNO 5026 5027 006056 1201 RERD, TAD BLKNO /'OPEN RE READ' COMMAND 5028 006057 3322 DCA IBLK /FIRST BLOCK NO. 5029 006060 7164 SM1 /RESET FILE POINTERS 5030 006061 3313 DCA INFLG /CHARACTER COUNTER 5031 5032 006062 1313 IRST, TAD INFLG /'OPEN RESTORE INPUT' COMMAND 5033 006063 7650 SNA CLA /CHECK CHARACTER COUNT 5034 006064 4534 ERROR0 /NO INPUT FILE TO RESTORE 5035 006065 5566 JMP I [CR /SET POINTER TO 'ICHAR0' (12K) 5036 006066 1015 TAD OFFSET /=ICHAR-XI33 5037 006067 1216 TTYIN, TAD TTYP /'OPEN INPUT TTY:' 5038 006070 6211 CDF P 5039 006071 3617 DCA I TTYP+1 /= 'INDEV' 5040 006072 2036 ISZ GOSW /CHECK ECHO MODE 5041 006073 1264 TAD IRST+2 /= 'PRINTC' 5042 006074 3757 DCA I ECHOP 5043 006075 5031 JMP EXIT /RETURN 5044 /OFFSET,OCHAR-XOUTL /8K CONSTANT 5045 006076 0000 OCHAR0, 0 /FILE OUTPUT VIA 'PRINTC' 5046 006077 3360 DCA ENDCHK /SAVE CHARACTER FOR ECHO 5047 006100 1360 TAD ENDCHK 5048 006101 4710 JMS I FILOUT /WRITE IT 5049 006102 6001 I0N 5050 006103 1360 OECHO, TAD ENDCHK /=0000 IF NO ECHO 5051 006104 7450 SNA 5052 006105 2276 ISZ OCHAR0 /SET NO ECHO RETURN 5053 006106 6213 CDI P 5054 006107 5676 JMP I OCHAR0 5055 006110 5655 FILOUT, NOCHAR 5056 5057 006111 0000 RDPTR, 0 /THIS IS A COROUTINE ! 5058 006112 4360 JMS ENDCHK /ISN'T THAT AMAZING ? 5059 006113 0000 INFLG, 0 5060 5061 006114 2313 ICHAR0, ISZ INFLG /DO WE NEED ANOTHER BUFFER? 5062 006115 5711 JMP I RDPTR /NO, UNPACK THE CHARACTER 5063 5064 006116 6002 I0F 5065 006117 4525 JMS I INHND /YES, GO GET IT 5066 006120 0200 0200 5067 006121 3200 3200 5068 006122 0000 IBLK, 0 5069 006123 7700 SMA CLA /ONLY BOTHER WITH FATAL ERRORS 5070 006124 7610 SKP CLA 5071 006125 5576 JMP I [DERR /WE'VE GOT ONE 5072 006126 1173 TAD [-600 /=384 CHARACTERS/BUFFER 5073 006127 3313 DCA INFLG 5074 006130 2322 ISZ IBLK /BUMP TO NEXT BLOCK 5075 006131 1321 TAD IBLK-1 /AND RESTORE POINTERS 5076 006132 3356 DCA IPNTR 5077 006133 6001 I0N 5078 5079 006134 1756 ICHAR1, TAD I IPNTR /STRAIGHT-FORWARD UNPACK ROUTINE 5080 006135 4311 JMS RDPTR /DO COMMON STUFF 5081 5082 006136 1756 TAD I IPNTR /SAVE LEFT HALF FOR LATER 5083 006137 0172 AND [7400 5084 006140 3721 DCA I IBLK-1 5085 006141 2356 ISZ IPNTR /INCREMENT TO NEXT WORD 5086 006142 1756 TAD I IPNTR /ANOTHER EASY ONE 5087 006143 4311 JMS RDPTR 5088 5089 006144 1756 TAD I IPNTR /THIS IS THE TRICKY ONE! 5090 006145 2356 ISZ IPNTR /GET LOW-ORDER HALF 5091 006146 0172 AND [7400 5092 006147 7112 CLL RTR /SHIFT RIGHT 5093 006150 7012 RTR 5094 006151 1721 TAD I IBLK-1 /GET HIGH-ORDER HALF (REMEMBER?) 5095 006152 7012 RTR /SHIFT SOME MORE 5096 006153 7012 RTR 5097 006154 4311 JMS RDPTR /GOT IT! 5098 006155 5334 JMP ICHAR1 /1-2-3-1-2-3-1-2-3 ... 5099 006156 0000 IPNTR, 0 5100 006157 6275 ECHOP, IECHO 5101 5102 /PROCESS THE CHARACTERS FROM EITHER INPUT FILE: 5103 5104 006160 0000 ENDCHK, 0 /CALLED BY 'RDPTR' AND 'SEND' 5105 006161 0053 AND K177 /IGNORE PARITY 5106 006162 7440 SZA /NULL? 5107 006163 5367 JMP .+4 /NO 5108 006164 2360 ISZ ENDCHK /YES, TAKE THE 2ND EXIT AND 5109 006165 5760 JMP I ENDCHK /RETURN TO THE INPUT ROUTINE 5110 006166 7746 -32 5111 006167 1366 TAD .-1 /END OF FILE? (^Z) 5112 006170 7440 SZA 5113 006171 5376 JMP .+5 /NO 5114 006172 3760 DCA I ENDCHK /YES, CLEAR 'FILE OPEN' FLAG 5115 006173 6211 CDF P /AND SET UP A CLEVER RETURN 5116 006174 1165 TAD [EOF /TO RESTORE THE KEYBOARD FOR 5117 006175 3617 DCA I TTYP+1 /INPUT AND FLAG THE ERROR AT 5118 006176 1163 TAD [232 /THE SAME TIME! THIS -ALSO- 5119 006177 6213 CDI P /REMOVES THE ^Z SO YOU DON'T 5120 006200 5327 JMP ICHAR+3 /GET A SECOND ERROR MESSAGE! 5121 5122 *CDF L 5123 006201 3021 PLTDEV, XOUTL; ZBLOCK 2 /COULD BE USEFUL! 006202 0000 006203 0000 5124 /TABULATE ROUTINES: CALLED FROM THE UPPER FIELD 5125 5126 006204 7755 CR-SP 5127 006205 6213 TAB, CDI P /'PRINTC' TAB COUNTER 5128 006206 7450 SNA /TEST FOR CR 5129 006207 3575 DCA I [ERROR /RESET COUNTER 5130 006210 7450 SNA 5131 006211 5305 JMP CROUT 5132 006212 1204 TAD TAB-1 /CR-SP 5133 006213 7500 SMA /NON-PRINTING CHARACTERS 5134 006214 2575 ISZ I [ERROR /ADD 1 TO TAB COUNT (FIELD 1) 5135 006215 6001 I0N /TURN ON AFTER AN ERROR 5136 006216 1155 TAD [SP 5137 006217 5310 JMP CROUT+3 5138 5139 006220 1203 ZER, TASK 5140 006221 7700 SMA CLA /INITIAL ENTRY POINT 5141 006222 5233 JMP POS 5142 006223 1423 TAD I XCHAR /SAVE THE CURRENT CHARACTER 5143 006224 3066 DCA CHAR 5144 006225 6213 NEG, CDI P 5145 006226 5317 JMP SKPX /SKIP OVER ONE (OR MORE) 5146 006227 2562 ISZ I [LORD 5147 006230 5225 JMP NEG 5148 006231 1066 TAD CHAR 5149 006232 3423 DCA I XCHAR /RESTORE THE ORIGINAL ONE 5150 5151 006233 6213 POS, CDI P 5152 006234 1562 TAD I [LORD /FIND OUT WHERE WE'RE GOING 5153 006235 7161 STL CIA 5154 006236 1575 TAD I [ERROR /SUBTRACT FROM WHERE WE ARE 5155 006237 7620 SNL CLA 5156 006240 5620 JMP I ZER /FORGET IT... 5157 006241 1155 TAD [SP 5158 006242 4354 JMS CPRNT /PRINT SPACES 5159 006243 5233 JMP POS 5160 5161 *RMF 5162 006244 0000 0 /'PRINTC' FOR LISTING AND DATE 5163 006245 6213 CDI P 5164 006246 4354 JMS CPRNT 5165 006247 5644 JMP I RMF 5166 /LOAD A HANDLER INTO THE PROPER SLOT: (ENTRY AT 'HANDLR') 5167 5168 006250 2327 NOTEQ, ISZ SLOT /BUMP POINTER TO SAVE NAME 5169 006251 1055 TAD NEWDEV /MOVE NEW DEVICE NAME TO TABLE 5170 006252 3727 DCA I SLOT 5171 006253 2327 ISZ SLOT 5172 006254 1056 TAD NEWDEV+1 5173 006255 3727 DCA I SLOT 5174 006256 2327 ISZ SLOT 5175 006257 4546 GETMON /NEED USR, MIGHT AS WELL LOCK IT IN 5176 5177 006260 1055 RETRY, TAD NEWDEV /MOVE DEVICE NAME FOR MONITOR CALL 5178 006261 3271 DCA DEVC 5179 006262 1056 TAD NEWDEV+1 5180 006263 3272 DCA DEVC+1 5181 006264 1727 TAD I SLOT /MOVE LOAD POINT 5182 006265 3273 DCA DLOAD 5183 006266 6212 CIF 10 5184 006267 4406 JMS I USR /CALL MONITOR (ALREADY IN CORE) 5185 006270 0001 1 5186 006271 0000 DEVC, 0 5187 006272 0000 0 /DEVICE NO. 5188 006273 0000 DLOAD, 0 /ENTRY POINT 5189 006274 4534 ERROR0 /DEVICE NOT AVAILABLE 5190 5191 006275 1273 TAD DLOAD /CHECK IF THE HANDLER HAS BEEN 5192 006276 0157 AND [7600 /LOADED INTO THE PROPER PAGE 5193 006277 7040 CMA /'CIA' FOR 1-PAGE HANDLERS 5194 006300 1727 TAD I SLOT /DESIRED PAGE 5195 006301 7640 SZA CLA 5196 006302 1273 TAD DLOAD /WRONG PAGE! 5197 006303 1164 TAD [200 /IS IT THE SYSTEM HANDLER? 5198 006304 7710 SPA CLA /IF .GT. 7600 WE'RE OK 5199 006305 5317 JMP NOGOOD /SORRY, TRY IT AGAIN 5200 5201 006306 2327 ISZ SLOT /BUMP POINTER TO DEVICE # 5202 006307 1272 TAD DEVC+1 /SAVE IT 5203 006310 3727 DCA I SLOT 5204 006311 2327 ISZ SLOT /MOVE TO ENTRY POINT 5205 006312 1273 TAD DLOAD 5206 006313 3727 DCA I SLOT /SAVE ENTRY 5207 006314 1272 TAD DEVC+1 5208 006315 3106 HANDX, DCA TEMP /DEVICE NO. 5209 006316 5723 JMP I HANDLR 5210 5211 006317 3273 NOGOOD, DCA DLOAD /CLEAR ENTRY POINT 5212 006320 4343 JMS SETDHT /TELL USR THE HANDLER 5213 006321 6271 DLOAD-2 /IS NOT IN CORE ANYMORE 5214 006322 5260 JMP RETRY /LOAD IT THIS TIME 5215 *ECODEV 5216 006323 0000 HANDLR, 0 /AC = BLOCK POINTER 5217 006324 3327 DCA SLOT 5218 006325 7344 SM2 /IF THE HANDLER HAS THE SAME NAME, 5219 006326 4547 COMPARE /DON'T LOAD IT AGAIN 5220 006327 0000 SLOT, 0 5221 006330 0054 NEWDEV-1 5222 006331 5250 JMP NOTEQ /DIFFERENT NAMES, LOAD NEW HANDLER 5223 006332 2012 ISZ AUTO 2 /BUMP PAST LOAD POINT 5224 006333 1012 TAD AUTO 2 /(SET BY 'COMPARE') 5225 006334 3336 DCA .+2 5226 006335 4343 JMS SETDHT /IN CASE USR RESET THE TABLE 5227 006336 0000 0 5228 006337 1412 TAD I AUTO 2 5229 006340 5315 JMP HANDX /SAVE THE DEVICE NO. 5230 5231 006341 2424 TTYDEV, DEVICE TTY /FOR COMPARISON PURPOSES 006342 3100 5232 5233 *EOF 5234 006343 0000 SETDHT, 0 /SET THE DEVICE HANDLER TABLE 5235 006344 1743 TAD I SETDHT / (TO FAKE OUT THE USR) 5236 006345 3013 DCA PDLXR /POINTER TO DEVICE # AND ENTRY 5237 006346 1377 TAD (17646 /TABLE LOCATION 5238 006347 1413 TAD I PDLXR /PLUS DEVICE NUMBER 5239 006350 3271 DCA DEVC /POINTS TO 'HANDLER-IN-CORE' FLAG 5240 006351 1413 TAD I PDLXR 5241 006352 6211 CDF 10 5242 006353 3671 DCA I DEVC /FLAG IS SIMPLY HANDLER ENTRY 5243 006354 6201 CDF L 5244 006355 2343 ISZ SETDHT 5245 006356 5743 JMP I SETDHT /ALSO CALLED BY 'CLOSER' 5246 5247 /CHARACTER TABLE FOR LOWER-FIELD COMMANDS: 5248 5249 006357 0015 KOMLST, CR-200 /RETURN 5250 006360 0073 ";-200 /DITTO 5251 006361 0332 "Z /ZERO 5252 006362 0316 "N /NAME 5253 006363 0307 "G /GOSUB 5254 006364 0320 "P /P??? 5255 006365 0314 FILIST, "L /LIST 5256 006366 0301 "A /ALL OR ABORT 5257 006367 0303 "C /CALL OR CLOSE 5258 006370 0304 "D /DATE OR DELETE 5259 006371 0302 "B /BR. OR BUFFER 5260 006372 0305 "E /EXIT OR EVERY 5261 006373 0323 ORLIST, "S /SAVE OR SECOND 5262 006374 0322 "R /RUN OR RESTORE 5263 006375 0311 "I /INPUT OR INITIAL 5264 006376 0317 "O /OUTPUT OR ONLY 5265 5266 006377 7646 PAGE 32 5267 /LIBRARY COMMANDS: SAVER, DELETR, CALLER, RUNNER, GOSUB 5268 5269 *FPNT /ENTER VIA 'JMP I 7' 5270 5271 006400 4210 LCMND, JMS SCANER /SAVE CHAR AND MOVE TO THE NEXT 5272 006401 1377 TAD (603 /SET '.FC' 5273 006402 3072 DCA EXTENSION 5274 006403 3036 DCA GOSW /POINT TO 'PROC' 5275 006404 4550 LJUMP /BRANCH TO THE APPROPRIATE ROUTINE 5276 006405 6356 KOMLST-1 5277 006406 0271 KOMGO-KOMLST 5278 006407 4036 ERROR1 /SORRY, TRY AGAIN 5279 5280 006410 6576 SCANER, (CALL /COMMAND WORD SCANNER 5281 006411 6213 CDI P 5282 006412 1423 TAD I XCHAR /SAVE CURRENT CHARACTER 5283 006413 3066 DCA CHAR 5284 006414 4255 JMS LSORT /SCAN TO THE END 5285 006415 5610 JMP I SCANER 5286 5287 006416 4572 SAVER, GTNAME /'LIBRARY SAVE' COMMAND 5288 006417 4106 JMS TEMP /FILL IN THE HEADER 5289 006420 4315 JMS SAVE /DO IT 5290 006421 5031 JMP EXIT /DONE 5291 5292 006422 4405 DELETR, JMS I CL0SE /'LIBRARY DELETE' COMMAND 5293 006423 4572 GTNAME 5294 006424 1266 TAD LBUFR /'LIBBLK-1' 5295 006425 4561 GETHND 5296 006426 4230 JMS LCLOSE 5297 006427 5027 JMP EXIT-2 5298 5299 006430 6575 LCLOSE, (OPENUP /SAVE OR DELETE A FILE 5300 006431 3237 DCA SAVBLK 5301 006432 1064 TAD DEVNO 5302 006433 6212 CIF 10 5303 006434 4406 JMS I USR 5304 006435 0004 4 5305 006436 0067 NAMLOC 5306 006437 6574 SAVBLK, (20 5307 006440 4534 ERROR0 /NOT THERE 5308 006441 5630 JMP I LCLOSE 5309 5310 006442 0617 FOCLTM, FILENAME FOCAL.TM 006443 0301 006444 1400 006445 2415 5311 006446 4552 GOSUB, LPUSHF /'LIBRARY GOSUB' COMMAND 5312 006447 6442 FOCLTM 5313 006450 4551 LPOPF /MOVE 'FOCAL.TM' TO NAME AREA 5314 006451 0066 NAMLOC-1 5315 006452 1073 TAD DSK /IN CASE WE NEED TO SAVE IT 5316 006453 3055 DCA NEWDEV 5317 006454 3056 DCA NEWDEV+1 5318 006455 1077 TAD LIBFLG /ARE WE ALREADY SAVED? 5319 006456 7650 SNA CLA 5320 006457 4315 JMS SAVE /NO 5321 006460 1377 TAD (603 5322 006461 3072 DCA EXTENSION /RESET EXTENSION TO 'FC' 5323 5324 /LOOKUP AND LOAD ROUTINES: 5325 5326 006462 7346 SUBBER, SM3 /THESE ALL DO THE SAME THING AND 5327 006463 7101 RUNNER, CLL IAC /THEN BRANCH TO DIFFERENT PLACES 5328 006464 7101 CALLER, CLL IAC /LOAD HAS 5 POSSIBLE EXITS ! 5329 006465 4573 JMS I [OPEN /CALL THE HANDLER AND LOCATE FILE 5330 006466 0060 LBUFR, LIBBLK-1 /= 'BUFR' TOO 5331 006467 0003 LIB3, 3 /NOT THERE, NO NAME, OR 5332 006470 4036 ERROR1 /SOMETHING JUST AS STUPID 5333 5334 006471 4773 JMS I (DEVCHK /FILE STRUCTURED? 5335 006472 1036 TAD GOSW /CHECK FOR GOSUB 5336 006473 7710 SPA CLA 5337 006474 4552 LPUSHF /SAVE CURRENT PROGRAM INFO. 5338 006475 0074 LIBDEV 5339 006476 5303 JMP LOADGO /'JMP I (LCHECK+2' FOR 8K 5340 5341 006477 4551 GOBACK, LPOPF /RESTORE CALLING PROGRAM POINTERS 5342 006500 0054 NEWDEV-1 5343 006501 1266 TAD LBUFR 5344 006502 4561 GETHND /GET THE HANDLER BACK 5345 5346 006503 4350 LOADGO, JMS LOADER /READ THE PROGRAM 5347 006504 6221 CDF T /'CDI T' FOR INITIAL DIALOG 5348 006505 1517 TAD I D /CHECK PROGRAM I.D. 5349 006506 7640 SZA CLA 5350 / JMP I D /ENTER SPECIAL PROGRAM 5351 006507 4036 INITIAL,ERROR1 /(NONE RIGHT NOW) 5352 006510 1564 TAD I [200 /MOVE PROGRAM LENGTH 5353 006511 6211 CDF P 5354 006512 3666 DCA I LBUFR 5355 006513 6203 CDI L /RETURN TO: 5356 006514 5030 JMP EXIT-1 /PROC, START, GOTO, OR DO 5357 006515 0000 SAVE, 0 /CALLED BY 'SAVER' AND 'GOSUB' 5358 006516 4405 JMS I CL0SE /AVOID TROUBLE 5359 006517 6211 CDF P 5360 006520 1666 TAD I LBUFR /GET PROGRAM LENGTH 5361 006521 6221 CDF T 5362 006522 3564 DCA I [200 /SAVE IT WITH THE PROGRAM 5363 006523 7164 LSHFT, SM1 5364 006524 1564 TAD I [200 /COMPUTE FILE SIZE 5365 006525 6201 CDF L 5366 006526 0157 AND [7600 /MASK PAGE COUNT 5367 006527 4723 JMS I LSHFT /SHIFT IT 5368 006530 7001 IAC /ROUND UP TO BLOCKS 5369 006531 7110 CLL RAR 5370 006532 3057 DCA FLNGTH /SAVE 5371 006533 4546 GETMON /CALL THE MONITOR 5372 006534 1266 TAD LBUFR 5373 006535 4561 GETHND /GET THE HANDLER 5374 006536 4773 JMS I (DEVCHK /CHECK FOR STUPIDITY 5375 006537 1267 TAD LIB3 5376 006540 3776 DCA I (CALL /SET UP OUR SUBROUTINE 5377 006541 4775 JMS I (OPENUP 5378 006542 4036 ERROR1 /NO ROOM OR WRITE-LOCKED 5379 006543 1057 TAD FLNGTH 5380 006544 4230 JMS LCLOSE /UPDATE DIRECTORY IN ADVANCE! 5381 006545 1374 TAD (20 /SET THE 'WRITE' BIT 5382 006546 4350 JMS LOADER /SAVE THE PROGRAM 5383 006547 5715 JMP I SAVE 5384 ///// 5385 006550 0000 LOADER, 0 /READ (OR WRITE) A PROGRAM 5386 006551 1057 TAD FLNGTH /COMPUTE FUNCTION WORD 5387 006552 4723 JMS I LSHFT /'SHFTL6' 5388 006553 7124 STL RAL /SET TO SEARCH FORWARD 5389 006554 1374 IFNZRO T < TAD (T > /ADD FIELD BITS (12K) 5390 006555 3361 DCA .+4 5391 006556 1060 TAD STBLK 5392 006557 3363 DCA .+4 5393 006560 4465 JMS I LIBHND /GET THE PROGRAM 5394 006561 0000 0 5395 006562 0200 200 /LOADS FROM 200 UP 5396 006563 0000 0 /STARTING BLOCK NO. 5397 006564 5576 JMP I [DERR 5398 006565 4545 DISMISS /SO WE CAN USE THE STACK 5399 006566 4552 LPUSHF 5400 006567 0055 NEWDEV /SAVE NEW POINTERS 5401 006570 4551 LPOPF 5402 006571 0073 LIBDEV-1 /IN CASE WE 'GOSUB' 5403 006572 5750 JMP I LOADER 5404 5405 006573 6612 PAGE 006574 0020 006575 7257 006576 7271 006577 0603 5406 /THE 'OUTPUT DATE' COMMAND 5407 5408 006600 1171 DATER, TAD [NODATE-1 5409 006601 3010 DCA AUTO 5410 006602 1167 TAD [-4 5411 006603 3036 DCA GOSW 5412 006604 6221 CDF T 5413 006605 1410 TAD I AUTO /GET DATE 5414 006606 4771 JMS I ZEROER-1 /OUTPUT IT 5415 006607 2036 ISZ GOSW 5416 006610 5204 JMP .-4 5417 006611 5031 JMP EXIT /RETURN 5418 ///// 5419 5420 006612 0000 DEVCHK, 0 /CHECK THE DEVICE TYPE 5421 006613 1064 TAD DEVNO 5422 006614 1224 TAD P17757 5423 006615 3225 DCA JUMPER 5424 006616 6211 CDF 10 5425 006617 1625 TAD I JUMPER 5426 006620 6201 CDF L 5427 006621 7700 SMA CLA 5428 006622 4036 ERROR1 /DEVICE IS NOT FILE STRUCTURED 5429 006623 5612 JMP I DEVCHK 5430 006624 7757 P17757, 17757 /DEVICE CONTROL WORD TABLE 5431 ///// 5432 5433 006625 0000 JUMPER, 0 /SORT AND BRANCH SUBROUTINE 5434 006626 4424 JMS I IOWAIT /CLEAR AC, RESET DF, TURN IOF 5435 006627 1625 TAD I JUMPER /GET LIST ADDRESS 5436 006630 2225 ISZ JUMPER 5437 006631 3010 DCA AUTO 5438 006632 1410 TAD I AUTO 5439 006633 7510 SPA /END OF LIST ? 5440 006634 5246 JMP ERR 5441 006635 7161 STL CIA 5442 006636 1066 TAD CHAR 5443 006637 7640 SZA CLA /FOUND IT ? 5444 006640 5232 JMP .-6 /NO 5445 006641 1010 TAD AUTO 5446 006642 1625 TAD I JUMPER /ADD OFFSET 5447 006643 3225 DCA JUMPER 5448 006644 1625 TAD I JUMPER /POINT TO ENTRY 5449 006645 3225 DCA JUMPER 5450 006646 7300 ERR, CLA CLL /FALL THROUGH OFFSET 5451 006647 5625 JMP I JUMPER /L=0 5452 ///// 5453 /LIBRARY COMMAND LIST: 5454 5455 006650 6477 KOMGO, GOBACK /CR 5456 006651 6477 GOBACK /; 5457 006652 6772 ZEROER /Z 5458 006653 7571 NAMER /N 5459 006654 6446 GOSUB /G 5460 006655 6407 SCANER-1 /P 5461 006656 6766 LLIST /L 5462 006657 6770 LISTAL /A 5463 006660 6464 CALLER /C 5464 006661 6422 DELETR /D 5465 006662 6705 BRANCH /B 5466 006663 7600 7600 /E 5467 006664 6416 SAVER /S 5468 006665 6463 RUNNER /R 5469 006666 6507 INITIAL /I 5470 5471 /FILE COMMAND LIST 5472 5473 006667 6767 FILEGO, LIST1 /O,L 5474 006670 5650 ABORT /A 5475 006671 5652 CLOSE /C 5476 006672 6600 DATER /D 5477 006673 5741 DUMPER /B 5478 006674 6715 ECOSET /E 5479 006675 0200 SINPUT /S 5480 006676 6032 RESTOR /R 5481 006677 6045 INPUT /I 5482 006700 5757 OUTPUT /O 5483 5484 /RESTORE COMMAND LIST 5485 5486 006701 0211 ORGO, SRST /S 5487 006702 6056 RERD /R 5488 006703 6062 IRST /I 5489 006704 6003 ORST /O 5490 5491 /THE 'LOGICAL BRANCH' COMMAND ALLOWS PROGRAMS TO TEST THE 5492 /TELETYPE WITHOUT READING A CHARACTER. THE BRANCH OCCURS 5493 /IF THERE IS -NO- INPUT: 1.1 T PI;L B .1;C A KEY WAS HIT 5494 /'FIN()' MAY THEN BE USED TO READ AND TEST THE CHARACTER. 5495 5496 /THIS HAS NOW BEEN REPLACED BY THE 'JUMP' COMMAND (V4D). 5497 5498 006705 6213 BRANCH, CDI P /'LOGICAL BRANCH' COMMAND 5499 006706 6001 I0N 5500 006707 5710 JMP I .+1 /USES THE 'JUMP' COMMAND! 5501 006710 2601 PACLST+3 5502 ///// 5503 006711 0000 ONMTMP, ZBLOCK 4 /SAVED FILE NAME 006712 0000 006713 0000 006714 0000 5504 /THE 'OUTPUT EVERYTHING' COMMAND SWITCHES TO A DIFFERENT 5505 /INTERNAL HANDLER FOR ALL OUTPUT, INCLUDING THE ECHO AND 5506 /ERRORS; THIS DEVICE IS RESTORED FOLLOWING AN 'O C' OR 5507 /'O A' COMMAND. THE HANDLER MAY ALSO BE CALLED BY 'O O' 5508 5509 006715 4572 ECOSET, GTNAME /THE 'O E' COMMAND 5510 006716 4730 JMS I INTCHK /WAS IT 'O E LPT:'? 5511 006717 1156 TAD [XOUTL /NO, EVERYTHING ELSE = 'TTY:' 5512 006720 5323 JMP OSCOPE+1 /SAVE ENTRY POINT 5513 5514 006721 0000 ZBLOCK 1 /PATCHED BY LAB OVERLAY 5515 006722 1321 OSCOPE, TAD .-1 /THE 'O S' COMMAND 5516 006723 6211 CDF P 5517 006724 3561 DCA I [ECODEV /AFFECTS BOTH 'OCHAR' AND 'EOF' 5518 006725 1561 TAD I [ECODEV 5519 006726 5727 JMP I .+1 /INSERT ENTRY PT. INTO 'OUTDEV' 5520 006727 6010 TTYOUT+1 5521 ///// 5522 5523 006730 0275 INTCHK, LPTCHK /CHECK FOR INTERNAL HANDLERS 5524 006731 7223 INTRNL+1 /RETURN POINT 5525 006732 4730 JMS I INTCHK /CHECK FOR 'LPT:' 5526 006733 7410 SKP /TRY AGAIN 5527 006734 5727 JMP I INTCHK-1 /PUT ENTRY POINT INTO 'OUTDEV' 5528 006735 7344 SM2 5529 006736 4547 COMPARE /CHECK FOR 'PLTR' 5530 006737 6201 PLTDEV 5531 006740 0054 NEWDEV-1 5532 006741 5731 JMP I INTCHK+1 /NEITHER OF THESE 5533 006742 1737 TAD I .-3 5534 006743 5727 JMP I INTCHK-1 /MOVE THE ENTRY POINT 5535 ////// 5536 5537 006744 6320 LZERO, HANDLR-3 /THE 'LIBRARY ZERO' COMMAND 5538 006745 7164 SM1 /DANGEROUS - BUT USEFUL! 5539 006746 3761 DCA I FILCNT /RESET THE FILE COUNT 5540 006747 3554 DCA I [HANDLR-2 /CLEAR THE LINK WORD 5541 006750 3410 DCA I AUTO /CREATE AN 'EMPTY' WITH 5542 006751 1057 TAD FLNGTH / THE SPECIFIED LENGTH 5543 006752 7450 SNA /IF NO LENGTH, PROBABLY 5544 006753 4036 ERROR1 /DIDN'T WANT TO DO THIS! 5545 006754 7041 LZXIT, CIA 5546 006755 1744 TAD I LZERO /SUBTRACT SYSTEM BLOCKS 5547 006756 3410 DCA I AUTO 5548 006757 4465 JMS I LIBHND /PUT IT BACK 5549 006760 4200 4200 5550 006761 6317 FILCNT, HANDLR-4 5551 006762 0001 1 5552 006763 5576 JMP I [DERR /OH DEAR! 5553 006764 5754 JMP I LZXIT /RESTORE THINGS AND EXIT 5554 ///// 5555 /THE 'LIBRARY LIST' COMMAND SHOWS ONLY FILES WITH ONE EX- 5556 /TENSION. 'LIST ALL' SHOWS EVERYTHING, 'LIST ONLY' JUST 1. 5557 006765 0060 LIBBLK-1 5558 006766 7152 LLIST, CMA CLL RTR /'LIBRARY LIST' COMMAND 5559 006767 7164 LIST1, CMA STL RAL /'LIST ONLY' / 'ONLY LIST' 5560 006770 3573 LISTAL, DCA I [OPEN /'LIST ALL' COMMAND 5561 006771 7346 SM3 /CLEAR THE 'L Z' SWITCH 5562 006772 3000 ZEROER, DCA 0 /'LIBRARY ZERO' COMMAND 5563 006773 3036 DCA GOSW /= NO EMPTIES 5564 006774 4572 GTNAME /GET DEVICE TO LIST 5565 006775 1365 TAD LLIST-1 5566 006776 4561 GETHND /GET THE HANDLER 5567 006777 4212 JMS DEVCHK /CHECK DEVICE TYPE 5568 007000 4545 DISMISS /REMOVE THE USR 5569 007001 4553 JMS I [7607 /SWAP OUT CORE TO MAKE ROOM 5570 007002 4200 4200 /FOR DIRECTORY 5571 007003 6317 HANDLR-4 5572 007004 0040 40 /SYSTEM SCRATCH AREA 5573 007005 5576 JMP I [DERR /WHOOPS! 5574 007006 3502 DCA I SWAP /SET THE FLAG TO SWAP BACK IN 5575 007007 7001 IAC /DIRECTORY BEGINS WITH BLOCK 1 5576 007010 3214 BLOKLP, DCA LBLOCK 5577 007011 4465 JMS I LIBHND 5578 007012 0200 0200 5579 007013 6317 HANDLR-4 /POSITIONED FOR OUR CONVENIENCE! 5580 007014 0001 LBLOCK, 1 5581 007015 5576 JMP I [DERR 5582 007016 1161 TAD [HANDLR /FIRST 5 WORDS ARE INFORMATION 5583 007017 3010 DCA AUTO 5584 007020 1000 TAD 0 /CHECK FOR 'L Z' 5585 007021 7650 SNA CLA 5586 007022 5777 JMP I (LZERO+1 /OR 'EMPTY-2' TO DISABLE 'L Z' 5587 007023 1010 LOOP2, TAD AUTO /SAVE NAME POINTER FOR PRINTING 5588 007024 3254 DCA LIBX 5589 007025 1410 TAD I AUTO 5590 007026 7650 SNA CLA 5591 007027 5335 JMP EMPTY /CHECK IF WE SHOULD LIST EMPTIES 5592 007030 2010 ISZ AUTO 5593 007031 2010 ISZ AUTO 5594 007032 1410 TAD I AUTO /PICK UP EXTENSION 5595 007033 3214 DCA LBLOCK 5596 007034 1561 TAD I [HANDLR /WASTE WORDS (NEGATIVE) 5597 007035 7041 CIA 5598 007036 1010 TAD AUTO /SKIP TO LENGTH 5599 007037 3010 DCA AUTO 5600 007040 1410 TAD I AUTO /ZERO LENGTH MEANS TEMPORARY FILE 5601 *CIA 5602 007041 7450 SNA /LZERO RETURN 5603 007042 5325 JMP LOOP3 /IGNORE SUCH THINGS 5604 007043 3057 DCA FLNGTH 5605 007044 1067 TAD NAMLOC /WAS A NAME GIVEN ? 5606 007045 7650 SNA CLA 5607 007046 5264 JMP CKEXTN /NO 5608 007047 1072 TAD EXTENSION /CHECK THIS TOO? 5609 007050 7650 SNA CLA 5610 007051 7001 IAC /NO, ONLY CHECK THE NAME 5611 007052 1167 TAD [-4 5612 007053 4547 COMPARE /COMPARE THIS NAME WITH ARG 5613 007054 0007 LIBX, AUTO-1 5614 007055 0066 NAMLOC-1 5615 007056 5325 JMP LOOP3 /NON-MATCHING 5616 007057 2573 ISZ I [OPEN /TEST FOR ONLY ONE 5617 007060 1072 TAD EXTENSION /OR A NULL EXTENSION 5618 007061 7640 SZA CLA 5619 007062 3067 DCA NAMLOC /DON'T CHECK ANY MORE 5620 007063 5273 JMP DIRLST 5621 5622 007064 1072 CKEXTN, TAD EXTENSION /DO WE WANT THIS ONE? 5623 007065 7041 CIA 5624 007066 1214 TAD LBLOCK 5625 007067 7640 SZA CLA 5626 007070 1573 TAD I [OPEN /TEST FOR 'ALL' 5627 007071 7710 SPA CLA 5628 007072 5325 JMP LOOP3 /GUESS NOT 5629 007073 7346 DIRLST, SM3 /PRINT 3 WORDS 5630 007074 3106 DCA TEMP 5631 007075 2254 ISZ LIBX 5632 007076 1654 TAD I LIBX 5633 007077 4673 JMS I DIRLST /PRINT 2 CHARS 5634 007100 2106 ISZ TEMP 5635 007101 5275 JMP .-4 5636 007102 1374 TAD DOT 5637 007103 4403 JMS I PRNTC 5638 007104 1214 TAD LBLOCK /PRINT EXTENSION 5639 007105 4673 JMS I DIRLST 5640 007106 1356 TAD NPRNT+2 /SET UP FOR DECIMAL LENGTH PRINT 5641 007107 3055 DCA NEWDEV 5642 007110 3056 NLOOP, DCA NEWDEV+1 /INITIALIZE LEADING-ZERO FLAG 5643 007111 3364 DCA SHFTL6 /CLEAR QUOTIENT 5644 5645 007112 1455 TAD I NEWDEV /FINISHED ALL POWERS OF 10? 5646 007113 7450 SNA 5647 007114 5323 JMP LOOP3-2 /YES, ALL DONE 5648 007115 1057 TAD FLNGTH /NO, ADD THIS POWER 5649 007116 7540 SMA SZA /OVERFLOW? 5650 007117 5343 JMP DIDJET /YES, PRINT THIS DIGIT 5651 007120 3057 DCA FLNGTH /NO, GO THROUGH THE LOOP AGAIN 5652 007121 2364 ISZ SHFTL6 /ADD ONE TO THIS DIGIT 5653 007122 5312 JMP NLOOP+2 /ANOTHER DIVIDE CYCLE 5654 5655 007123 1166 TAD [CR /DONE WITH THIS LINE (WHEW!) 5656 007124 4403 JMS I PRNTC 5657 007125 2613 LOOP3, ISZ I LBLOCK-1 /DONE WITH THIS BLOCK? 5658 007126 5223 JMP LOOP2 /NO, KEEP GOING 5659 007127 4424 JMS I IOWAIT /WAIT FOR I/O 5660 007130 1554 TAD I [HANDLR-2 /LINK TO NEXT BLOCK 5661 007131 7440 SZA /LAST BLOCK? 5662 007132 5210 JMP BLOKLP /NO, GET THE NEXT 5663 007133 4502 JMS I SWAP /YES, RESTORE SWAPPED CORE 5664 007134 5031 JMP EXIT /(JMS RESETS THE FLAG) 5665 /MANY THANKS TO STEVE L. GILLETT FOR FIGURING OUT 5666 /HOW TO MAKE ROOM FOR THE 'LIST EMPTIES' OPTION!! 5667 5668 007135 1410 EMPTY, TAD I AUTO /LIST THE EMPTIES! 5669 007136 3057 DCA FLNGTH /GET THE LENGTH 5670 007137 1036 TAD GOSW /ARE WE SUPPOSED TO? 5671 007140 7740 SMA SZA CLA /',E' TESTED BY 'GTNAME' 5672 007141 5305 JMP NLOOP-3 /YES, INDENT SLIGHTLY 5673 007142 5325 JMP LOOP3 /FORGET IT 5674 5675 007143 7300 DIDJET, CLA CLL /CLEAN UP THE AC 5676 007144 2055 ISZ NEWDEV /NEXT POWER OF TEN 5677 007145 1364 TAD SHFTL6 /IF THIS DIGIT IS ZERO, AND NO 5678 007146 2056 ISZ NEWDEV+1 /OTHER DIGITS HAVE BEEN NON-ZERO, 5679 007147 7440 SZA /PRINT A SPACE INSTEAD 5680 007150 5354 JMP NPRNT 5681 007151 1155 TAD [SP 5682 007152 4403 JMS I PRNTC 5683 007153 5310 JMP NLOOP 5684 5685 007154 1170 NPRNT, TAD ["0 /CHANGE TO ASCII 5686 007155 4403 JMS I PRNTC 5687 007156 7160 CMA STL /SET ZERO SWITCH 5688 007157 5310 JMP NLOOP 5689 5690 DECIMAL;*CMA STL /TRICKY, HUH? 5691 007160 1750 1000 5692 007161 0144 100 5693 007162 0012 10 5694 007163 0001 1 5695 OCTAL; *SM1 /MORE TRICKS! 5696 5697 007164 0000 SHFTL6, 0 /CLEVER USE TERMINATES TABLE 5698 007165 7106 CLL RTL 5699 007166 7006 RTL 5700 007167 7006 RTL 5701 007170 5764 JMP I SHFTL6 /CONSIDER 'BSW' FOR THE 8/E 5702 5703 007171 0274 NAMLST, "< /BLOCK 5704 007172 0272 ": /DEVICE 5705 007173 0250 "( /VARIABLE DATA 5706 007174 0256 DOT, ". /EXTENSION 5707 007175 0333 "[ /SIZE 5708 007176 0254 ", /ECHO 5709 5710 007177 6745 PAGE 35 5711 /ROUTINE TO ENTER OR FIND A FILE FOR 'O O', 'O I' & 'LIB' 5712 5713 007200 0000 OPEN, 0 /LOOKUP AND ENTER ROUTINE 5714 007201 3036 DCA GOSW /SET ECHO/LOAD SWITCH 5715 007202 7001 IAC 5716 007203 7004 RAL /SET CALL CODE (2 OR 3) 5717 007204 3271 DCA CALL 5718 007205 4572 GTNAME /GET DEVICE AND FILENAME 5719 5720 007206 1335 TAD MDSK /CALLING SEQUENCE: 5721 007207 1055 TAD NEWDEV / AC=GOSW, L=1 FOR ENTER 5722 007210 7450 SNA / JMS I [OPEN 5723 007211 1067 TAD NAMLOC / HANDLER BLOCK (-1) 5724 007212 7650 SNA CLA / ERROR RETURN 5725 007213 5244 JMP SHUT+1 / 'TTY' RETURN 5726 007214 7344 SM2 / REGULAR RETURN 5727 007215 4547 COMPAR /CHECK FOR CALLS TO 'TTY:' 5728 007216 6340 TTYDEV-1 /'TTY:' IS ALSO THE DEFAULT 5729 007217 0054 TLSW, NEWDEV-1 /WHEN NO OTHER NAME IS FOUND 5730 007220 5622 JMP I INTRNL /CHECK FOR OTHER INTERNAL DEV. 5731 007221 5244 JMP SHUT+1 /'TTY:' 5732 007222 6732 INTRNL, INTCHK+2 /'.+1' FOR 8K 5733 5734 007223 1600 TAD I OPEN /GET HANDLER BLOCK TO USE 5735 007224 4561 GETHND /LOAD THE HANDLER 5736 007225 1067 TAD NAMLOC /CHECK FOR A DIRECT ACCESS CALL 5737 007226 7164 SHFT, CMA STL RAL /POINTS TO 'SHFTL6' 5738 007227 1271 TAD CALL /'NAMLOC'=1, 'CALL'=2 (ONLY) 5739 007230 7450 SNA 5740 007231 4036 ERROR1 /CANNOT USE '<>' WITH 'OPEN OUTPUT' 5741 007232 7001 IAC 5742 007233 7650 SNA CLA 5743 007234 5242 JMP SHUT-1 /OK: 'STBLK' & 'FLNGTH' ARE SET 5744 5745 007235 4257 JMS OPENUP /DO WHAT WE CAME FOR 5746 007236 5245 JMP SHUT+2 /ERROR RETURN 5747 007237 1273 TAD CALL+2 5748 007240 7041 CIA 5749 007241 3057 DCA FLNGTH /SAVE POSITIVE LENGTH 5750 007242 2200 ISZ OPEN 5751 007243 4545 SHUT, DISMISS /REMOVE THE USR 5752 007244 2200 ISZ OPEN 5753 007245 2200 ISZ OPEN 5754 007246 5600 JMP I OPEN /NORMAL RETURN 5755 ///// 5756 5757 007247 0000 USRIN, 0 /LOCK THE USR IN CORE - 'GETMON' 5758 007250 6002 I0F 5759 007251 6212 CIF 10 5760 007252 4406 JMS I USR 5761 007253 0010 10 5762 007254 1164 TAD [200 5763 007255 3006 DCA USR 5764 007256 5647 JMP I USRIN 5765 007257 0000 OPENUP, 0 /CALLED BY 'SAVE' AND 'OPEN' 5766 007260 1120 TAD XNAME 5767 007261 3272 DCA CALL+1 /INITIALIZE USR CALL 5768 007262 1057 TAD FLNGTH /REQUESTED SIZE FROM 'GTNAME' 5769 007263 7106 CLL RTL 5770 007264 7006 RTL 5771 007265 0274 AND O7760 /SIZE 5772 007266 1106 TAD TEMP /DEVICE NO. 5773 007267 6212 CIF 10 5774 007270 4406 JMS I USR /'ENTER' OR 'FETCH' 5775 007271 0000 CALL, 0 5776 007272 0067 NAMLOC /BECOMES THE BLOCK NO. 5777 007273 0000 0 / AND THE FILE LENGTH 5778 007274 7760 O7760, SNL SMA SZA CLA /ERROR RETURN 5779 007275 2257 ISZ OPENUP 5780 007276 1272 TAD CALL+1 /SAVE STARTING BLOCK 5781 007277 3060 DCA STBLK 5782 007300 5657 JMP I OPENUP 5783 5784 *CLA CLL IAC 5785 007301 7000 SWAPIN, NOP /RESTORE CORE AFTER DIRECTORY LIST 5786 007302 4553 JMS I [7607 /SYSTEM HANDLER 5787 007303 0200 200 5788 007304 6317 HANDLR-4 5789 007305 0040 40 5790 007306 4036 DERR, ERROR1 /DEVICE ERROR = 'CLA CLL RTL' 5791 007307 5701 JMP I SWAPIN 5792 5793 007310 0000 USROUT, 0 /REMOVE THE USR - 'DISMISS' 5794 007311 7330 SM0 5795 007312 1006 TAD USR /CHECK POINTER TO FIND OUT 5796 007313 7700 SMA CLA 5797 007314 5710 JMP I USROUT /ALREADY GONE 5798 007315 1313 TAD .-2 /RESET THE POINTER 5799 007316 3006 DCA USR 5800 007317 6002 I0F 5801 007320 6212 CIF 10 5802 007321 4564 JMS I [200 5803 007322 0011 11 5804 007323 5710 JMP I USROUT 5805 5806 *SP1 5807 007324 0000 IOWATE, 0 /WAIT FOR TELETYPE TO FINISH 5808 007325 6211 CDF P 5809 007326 6001 I0N 5810 007327 1617 TAD I TLSW 5811 007330 7640 SZA CLA 5812 007331 5326 JMP .-3 5813 007332 6002 I0F 5814 007333 6201 CDF L 5815 007334 5724 JMP I IOWATE /THEN TURN THE INTERRUPT OFF 5816 5817 007335 2055 MDSK, -5723 5818 007336 0000 XFORM, 0 5819 007337 0007 AND K77 5820 007340 7540 SMA SZA 5821 007341 1155 TAD [240 5822 007342 0007 AND K77 5823 007343 1155 TAD [240 5824 007344 4403 JMS I PRNTC 5825 007345 5736 JMP I XFORM 5826 5827 *SM3 5828 007346 0000 NPACK, 0 /STANDARD 6-BIT UNPACK ROUTINE 5829 007347 3357 DCA CMPR 5830 007350 1357 TAD CMPR 5831 007351 4626 JMS I SHFT /'BSW' 5832 007352 7004 RAL 5833 007353 4336 JMS XFORM 5834 007354 1357 TAD CMPR 5835 007355 4336 JMS XFORM 5836 007356 5746 JMP I NPACK /CALLED BY 'DIRLST' & 'DATER' 5837 5838 007357 0000 CMPR, 0 /COMPARE TWO BLOCKS OF ANY LENGTH 5839 007360 3336 DCA XFORM /CALLING SEQUENCE: 5840 007361 1757 TAD I CMPR / AC= -# OF WORDS 5841 007362 2357 ISZ CMPR / COMPARE 5842 007363 3012 DCA AUTO 2 / FIRST-1 5843 007364 1757 TAD I CMPR / SECOND-1 5844 007365 2357 ISZ CMPR / RETURN IF NO MATCH 5845 007366 3013 DCA AUTO 3 / RETURN IF MATCH 5846 007367 1412 TAD I AUTO 2 /COMPARE TWO WORDS 5847 007370 7041 CIA 5848 007371 1413 TAD I AUTO 3 5849 007372 7640 SZA CLA 5850 007373 5757 JMP I CMPR /NO MATCH 5851 007374 2336 ISZ XFORM /DONE ? 5852 007375 5367 JMP .-6 /NO, CHECK TWO MORE 5853 007376 2357 ISZ CMPR /YES, BUMP RETURN POINTER 5854 007377 5757 JMP I CMPR 5855 ///// 5856 PAGE 36 5857 /READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV' 5858 5859 007400 0000 NAME, 0 5860 007401 7164 SM1 /POINTER TO 'SHFTL6' 5861 007402 3011 DCA AUTO 1 /PERIOD COUNTER 5862 007403 3320 DCA MGETA /DIGIT COUNTER 5863 007404 1073 TAD DSK 5864 007405 3055 DCA NEWDEV 5865 007406 3056 DEVNAM, DCA NEWDEV+1 5866 007407 3067 DCA NAMLOC /CLEAR NAME AREA 5867 007410 3070 DCA NAMLOC+1 5868 007411 3071 DCA NAMLOC+2 /BUT NOT THE EXTENSION! 5869 007412 1120 TAD XNAME 5870 007413 3060 DCA STBLK 5871 007414 3012 DCA AUTO 2 /CHAR. COUNTER 5872 007415 3057 DCA FLNGTH 5873 007416 4312 NAMLUP, JMS MGETC /'SM1' SETS L=1 5874 007417 4550 LJUMP /'LJUMP' CLEARS IT 5875 007420 7170 NAMLST-1 /TRAP '< : ( . [ ,' 5876 007421 0341 NAMGO-NAMLST 5877 007422 0012 PLUS10, "9-"0+1 /'NOP' 5878 5879 007423 1066 TAD CHAR /CHECK FOR A-Z, 0-9 5880 007424 1333 TAD MINUS9 5881 007425 7100 CLL 5882 007426 1222 TAD PLUS10 5883 007427 7430 SZL 5884 007430 5234 JMP .+4 /OK 5885 007431 1240 TAD K7760 /"0-"@ = -20 5886 007432 7120 STL 5887 007433 1377 TAD ("@-"Z-1 5888 007434 7620 SNL CLA 5889 007435 5365 JMP NAMEND /ILLEGAL CHARACTER 5890 5891 007436 1012 TAD AUTO 2 5892 007437 1376 TAD (-5 5893 007440 7760 K7760, SNL SMA SZA CLA /TOO MANY? 5894 007441 5262 JMP IGNORE 5895 007442 1012 TAD AUTO 2 5896 007443 7110 CLL RAR 5897 007444 1060 TAD STBLK 5898 007445 3312 DCA MGETC /NAME POINTER 5899 007446 2012 ISZ AUTO 2 5900 007447 1066 TAD CHAR 5901 007450 0007 AND K77 5902 007451 7420 SNL 5903 007452 4601 JMS I NAME+1 /'SHFTL6' 5904 007453 6201 CDF L 5905 007454 1712 TAD I MGETC 5906 007455 3712 DCA I MGETC 5907 007456 6211 NXTNUM, CDF P 5908 007457 1413 TAD I PDLXR /MAY BE GARBAGE 5909 007460 1170 TAD ["0 5910 007461 3066 DCA CHAR 5911 007462 2320 IGNORE, ISZ MGETA 5912 007463 1320 TAD MGETA 5913 007464 7750 SPA SNA CLA /END OF THE STRING? 5914 007465 5217 JMP NAMLUP+1 5915 007466 1423 TAD I XCHAR /YES, IS THERE MORE? 5916 007467 1335 TAD MCOMMA 5917 007470 7100 CLL 5918 007471 7640 SZA CLA /CHECK FOR A COMMA 5919 007472 5216 JMP NAMLUP 5920 5921 *-"E 5922 007473 4320 VARBL, JMS MGETA /PROCESS A VARIABLE FILE NAME 5923 007474 7141 CLL CIA 5924 007475 3066 DCA CHAR /ASSUME ITS A LETTER 5925 007476 1421 TAD I H0RD /NOW CHECK THE SIGN 5926 007477 7510 SPA 5927 007500 5347 JMP VLETR /IT WAS, USE -1 AS THE COUNT 5928 007501 6213 CDI P 5929 007502 5340 JMP VFN /CONVERT POS. NUM. TO ASCII 5930 5931 007503 4320 BLKNUM, JMS MGETA /READ THE BLOCK NUMBER 5932 007504 2067 ISZ NAMLOC /SET THE BLOCK FLAG 5933 007505 5213 JMP NAMLUP-3 5934 5935 *-"9-1 5936 007506 1067 COLON, TAD NAMLOC /MOVE NAME TO 'NEWDEV' 5937 007507 3055 DCA NEWDEV 5938 007510 1070 TAD NAMLOC+1 5939 007511 5206 JMP DEVNAM 5940 5941 007512 0000 MGETC, 0 /CROSS-FIELD CALL 5942 007513 6213 CDI P 5943 007514 5351 JMP LGETC /L=1 TO SKIP 'GETC' 5944 007515 3066 DCA CHAR 5945 007516 5712 JMP I MGETC 5946 5947 *SNL SMA-1 5948 007517 5720 JMP I .+1 /TRY TO FIGURE THIS OUT! 5949 007520 0000 MGETA, 0 /EVALUATE AN EXPRESSION 5950 007521 4312 JMS MGETC /SKIP THE DELIMITER 5951 007522 6213 CDI P 5952 007523 5356 JMP GETA /CALL 'EVAL' 5953 5954 *-", 5955 007524 2011 PERIOD, ISZ AUTO 1 /DOUBLE PERIODS? 5956 007525 5365 JMP NAMEND /APPARENTLY 5957 007526 3072 DCA EXTENSION /CLEAR OUT THE ASSUMED ONE 5958 007527 2060 ISZ STBLK /ADVANCE STORAGE POINTER 5959 007530 1375 TAD (4 /ALLOW FOR TWO MORE CHARACTERS 5960 007531 5214 JMP NAMLUP-2 5961 007532 7503 NAMGO, BLKNUM /BLOCK 5962 007533 7506 MINUS9, COLON /DEVICE 5963 007534 7473 MINUSE, VARBL /LETTERS & NUMBERS 5964 007535 7524 MCOMMA, PERIOD /EXTENSION 5965 007536 7540 SQBRKT /SIZE 5966 007537 7553 ECHCHK /ECHO 5967 5968 *SMA SZA 5969 007540 4320 SQBRKT, JMS MGETA /READ REQUESTED FILE SIZE 5970 007541 5215 JMP NAMLUP-1 5971 5972 007542 3013 VFR, DCA PDLXR /SAVE STARTING ADDRESS 5973 007543 1774 TAD I (T3 5974 007544 7550 SPA SNA /CHECK DECIMAL EXPONENT 5975 007545 7201 CLA IAC /FORCE 1 IF .LE. ZERO 5976 007546 7161 STL CIA 5977 007547 3320 VLETR, DCA MGETA /EXPONENT=NUMBER OF DIGITS 5978 007550 7420 SNL 5979 007551 5262 JMP IGNORE /LETTERS 5980 007552 5256 JMP NXTNUM /NUMBERS 5981 5982 007553 1155 ECHCHK, TAD [SP /REPLACE THE COMMA WITH A SPACE 5983 007554 7410 SKP 5984 007555 2036 ISZ GOSW /CLEAR THE SWITCH & REMOVE THE 'E' 5985 007556 6211 CDF P 5986 007557 3423 DCA I XCHAR 5987 007560 4773 JMS I (SCANER /SKIP TO THE 'ECHO' OR LINE NO. 5988 007561 1423 TAD I XCHAR 5989 007562 1334 TAD MINUSE /DOES IT BEGIN WITH AN 'E'? 5990 007563 7650 SNA CLA 5991 007564 5355 JMP ECHCHK+2 /YES, MARK IT AND CONTINUE 5992 5993 007565 6213 NAMEND, CDI P /EVALUATE THE LINE NUMBER 5994 007566 5312 JMP GETL 5995 007567 4424 JMS I IOWAIT /AND WAIT FOR THE TERMINAL 5996 007570 5600 JMP I NAME /***RETURN*** 5997 5998 007571 4572 NAMER, GTNAME /'LIBRARY NAME' COMMAND 5999 007572 5025 JMP IOWAIT+1 /JUST UPDATES THE HEADER 6000 6001 007573 6410 PAGE 37 007574 0043 007575 0004 007576 7773 007577 7745 6002 /PAGE ZERO (FIELD 0) LITERALS: 6003 6004 LPUSHF= JMS I [MPUSHF 6005 LPOPF= JMS I [MPOPF 6006 LJUMP= JMS I [JUMPER 6007 COMPAR= JMS I [CMPR 6008 GTNAME= JMS I [NAME 6009 GETHND= JMS I [HANDLR 6010 GETMON= JMS I [USRIN 6011 DISMIS= JMS I [USROUT 6012 6013 000145 7310 FIELD 0 000146 7247 000147 7357 000150 6625 000151 3120 000152 3042 000153 7607 000154 6321 000155 0240 000156 3021 000157 7600 000160 0057 000161 6323 000162 0046 000163 0232 000164 0200 000165 6343 000166 0215 000167 7774 000170 0260 000171 0013 000172 7400 000173 7200 000174 2555 000175 2554 000176 7306 000177 3045 6014 /READ AND STORE THE OS/8 DATE WORD: 6015 6016 FIELD 2 6017 6018 *14 6019 020014 1617 NODATE, TEXT "NO/DA/TE" /BECOMES THE CURRENT DATE 020015 5704 020016 0157 020017 2405 020020 0000 6020 6021 *20 6022 020020 0000 NUHEAD, 0 /MOVE THE NAME UP FROM FIELD L 6023 020021 1423 TAD I .+2 6024 020022 3020 DCA NUHEAD 6025 020023 0106 TEMP 6026 020024 1026 TAD .+2 6027 020025 3013 DCA PDLXR 6028 020026 0066 NAMLOC-1 6029 020027 1031 TAD .+2 6030 020030 3010 DCA AUTO 6031 020031 0212 TITLE-1 6032 020032 7346 SM3 6033 020033 3132 DCA DATUM 6034 6035 020034 6201 CDF L 6036 020035 1413 TAD I PDLXR 6037 020036 6221 CDF T 6038 020037 3410 DCA I AUTO 6039 020040 2132 ISZ DATUM 6040 020041 5034 JMP .-5 6041 6042 020042 3410 DCA I AUTO /CLEAR THE I.D. 6043 6044 020043 1014 TAD NODATE+0 /MOVE THE DATE INTO PLACE 6045 020044 3410 DCA I AUTO 6046 020045 1015 TAD NODATE+1 6047 020046 3410 DCA I AUTO 6048 020047 1016 TAD NODATE+2 6049 020050 3410 DCA I AUTO 6050 020051 1017 TAD NODATE+3 6051 020052 3410 DCA I AUTO 6052 020053 6203 CDI L 6053 020054 5420 JMP I NUHEAD 6054 6055 020055 7440 DAY, SZA /ZERO = READ CURRENT DATE 6056 020056 5061 JMP NIGHT /NON-ZERO = SET NEW DATE 6057 TAD I (17666 page zero ^ page zero ^ 020057 1577 6058 020060 5063 JMP NIGHT+2 6059 6060 NIGHT, DCA I (17666 page zero ^ page zero ^ 020061 3577 6061 020062 4132 JMS DATUM 6062 020063 6213 CDI P 6063 020064 5465 JMP I .+1 /'FL0ATR' 6064 020065 2021 FL0AT 6065 020066 0000 PACK1, 0 /HALF-WORD PACK ROUTINE 6066 TAD (60 /ADD OFFSET page zero ^ page zero ^ 020067 1176 6067 AND (77 page zero ^ page zero ^ 020070 0175 6068 ISZ (-1 /TEST THE SWITCH page zero ^ page zero ^ 020071 2174 6069 020072 5000 JMP PACK0 6070 020073 7106 CLL RTL 6071 020074 7006 RTL 6072 020075 7006 RTL 6073 020076 3013 DCA PDLXR /SAVE LEFT HALF 6074 020077 5466 JMP I PACK1 6075 6076 *0 6077 020000 1013 PACK0, TAD PDLXR /MERGE THE PIECES 6078 020001 6221 CDF T 6079 020002 3410 DCA I AUTO 6080 020003 6211 CDF 10 6081 020004 7164 SM1 6082 DCA (-1 /RESET THE SWITCH page zero ^ page zero ^ 020005 3174 6083 020006 5466 JMP I PACK1 6084 6085 *7 6086 020007 0600 600 /EXTENDED DATE MASK 6087 020010 0000 ZBLOCK 4 /INDICATE USAGE 020011 0000 020012 0000 020013 0000 6088 6089 *104 /LEAVE ROOM FOR 'PC0' 6090 020104 0000 PACK2, 0 6091 020105 3012 DCA AUTO 2 /SAVE DIGITS 6092 020106 3011 DCA AUTO 1 /CLEAR QUOT. 6093 020107 5112 JMP .+3 6094 020110 2011 ISZ AUTO 1 /DIVIDE BY TEN 6095 020111 3012 DCA AUTO 2 6096 020112 1012 TAD AUTO 2 6097 TAD (-12 page zero ^ page zero ^ 020113 1173 6098 020114 7500 SMA 6099 020115 5110 JMP .-5 6100 6101 020116 7200 CLA /CLEAR OVERDRAW 6102 020117 1011 TAD AUTO 1 /FIRST DIGIT 6103 020120 4066 JMS PACK1 6104 020121 1012 TAD AUTO 2 /SECOND DIGIT 6105 020122 4066 JMS PACK1 6106 020123 7344 SM2 /"0"-2="." 6107 020124 4066 JMS PACK1 6108 020125 5504 JMP I PACK2 6109 /ROUTINE TO UNPACK THE DATE - USED BY 'FDAY' 6110 6111 020126 0000 DATA, 0 /CALLED FROM 'INITLZ' 6112 020127 4132 JMS DATUM 6113 020130 6203 CDI L 6114 020131 5526 JMP I DATA 6115 6116 020132 0000 DATUM, 0 /UNPACK THE DATE WORD 6117 020133 7164 SM1 6118 DCA (-1 /INITIALIZE page zero ^ page zero ^ 020134 3174 6119 TAD (NODATE-1 page zero ^ page zero ^ 020135 1172 6120 020136 3010 DCA AUTO 6121 020137 6211 CDF 10 6122 TAD I (17666 page zero ^ page zero ^ 020140 1577 6123 020141 7450 SNA 6124 020142 5532 JMP I DATUM /SKIP NULL DATE 6125 020143 7012 RTR 6126 AND (77 page zero ^ page zero ^ 020144 0175 6127 020145 7110 CLL RAR 6128 020146 4104 JMS PACK2 /DAY 6129 TAD I (17666 page zero ^ page zero ^ 020147 1577 6130 020150 7006 RTL 6131 020151 7006 RTL 6132 020152 0162 AND K7 6133 020153 7004 RAL 6134 020154 4104 JMS PACK2 /MONTH 6135 TAD I (17666 page zero ^ page zero ^ 020155 1577 6136 020156 0162 AND K7 6137 020157 3013 DCA PDLXR 6138 020160 6201 CDF 0 6139 TAD I (7777 /WILL BE -1! page zero ^ page zero ^ 020161 1574 6140 020162 0007 K7, AND 7 6141 020163 7112 CLL RTR 6142 020164 7012 RTR 6143 TAD (106 /1970 page zero ^ page zero ^ 020165 1171 6144 020166 1013 TAD PDLXR 6145 020167 4104 JMS PACK2 /YEAR 6146 020170 5532 JMP I DATUM 6147 6148 020171 0106 FIELD 2 020172 0013 020173 7766 020174 7777 020175 0077 020176 0060 020177 7666 6149 $ A1 5141 A11 5112 A13 5106 A15 5102 A17 5076 A19 5072 A21 5066 A23 5062 A3 5135 A5 5131 A7 5125 A9 5121 ABORT 5650 ABSOL 0036 ABSOLV 6722 AC1H 0051 AC1L 0052 ACCEPT 5521 ACTION 6571 AGAIN 5711 AGO 1246 ALC 7236 unreferenced ALIGN 7212 ALIST 1263 ALL 0356 AOK 7250 APUSHX 3071 ARG 7455 ARG1 4327 ARG3 4331 ARGNXT 1605 ASK 1233 ATSW 0137 AUTO 0010 AXIN 0016 AXIND 1320 AXOUT 0017 BACK 5701 BASE 1667 BATIN 3026 BATOUT 3027 BATXIT 3174 BELL 0001 BETA 0163 unreferenced BKSW 0141 BLKCNT 5641 BLKNO 6001 BLKNUM 7503 BLOKLP 7010 BOTTOM 0023 BRANCH 6705 BREAK 1130 BUFEND 0027 BUFFER 7610 BUFFPT 0177 BUFR 0060 BUMP 5636 BYEBYE 3030 C100 0100 C11 5255 C200 0102 C232 2034 C240 0103 C255 6103 C3 5273 C5 5267 C7 5263 C9 5260 CALL 7271 CALLER 6464 CAM 7621 unreferenced CCR 0005 CDFV 6465 CDI 6203 CERR 0636 CFF 0003 CHAR 0066 CHIN 6262 CHKARG 4672 CHKSGN 4562 CHOUT 6277 CKEXTN 7064 CL0SE 0005 CLF 0004 CLOSE 5652 CLOSER 5600 CMATST 0763 CMPR 7357 COLON 7506 COMGO 0722 COMPAR 4547 CONT 0755 CONTIN 5434 CORE 4246 CPRNT 6354 CR 0215 CROUT 6305 CRT 0223 CRTEST 0641 CTEST 2035 CTRLF 3064 unreferenced D 0117 DADJ 7011 DATA 0126 DATE 0217 DATER 6600 DATUM 0132 DAY 0055 DBLSUB 5756 DCAIAX 4551 DCAT1 2736 DCAT2 2666 DCMA 6601 DECR 7400 DELETE 4550 DELETR 6422 DERR 7306 DEVC 6271 DEVCHK 6612 DEVNAM 7406 DEVNO 0064 DGOUT 6100 DIDJET 7143 DIG 5724 DIGITS 0012 DIMEN 5777 DIRLST 7073 DISK 4321 DISMIS 4545 DIV1 7306 DIV2 7330 DLOAD 6273 DMPNO 2715 DMPSW 0147 DO 0660 DOERR 0716 DOF 7472 DOGRP 0664 DORTN 0700 DOT 7174 DOTDA 6044 DOXIT 0654 DSK 0073 DUBLAD 6244 DUMPER 5741 DUMPT 2650 DUMPX 2716 DVCK 7150 DVI 7407 DVLP 7124 DVSB 7027 DVSR 7131 DVXIT 6710 E0 5116 E1 4566 E2 4572 E3 4576 E4 4602 E5 4606 E6 4612 E7 4616 ECALL 1600 ECHCHK 7553 ECHOC 4533 ECHOFF 0253 unreferenced ECHOGO 5570 ECHOLS 0173 ECHOP 6157 ECHR 1773 ECODEV 6323 ECOSET 6715 EFUN 1731 EFUN2 1742 EFUN3 2026 ELPAR 1753 EMINUS 1657 EMPTY 7135 END 0224 ENDCHK 6160 ENDFI 1227 ENUM 1771 ENVIR 3202 EOF 6343 EPAR2 1755 EQLS 1007 EQLSPT 1716 EQUALS 1714 ERA 0513 ERASE 0501 ERG 0505 ERR 6646 ERROR 2554 ERROR0 4534 ERROR1 4036 ERROR2 4576 ERROR3 1754 ERTRAP 2546 ERX 0517 ESGN 5613 unreferenced ESTACK 1720 ETERM1 1631 ETERM2 1661 ETERMN 1651 EVAL 1610 EX1 0050 EXIT 0031 EXIT2 5252 EXP 0044 EXPX 4702 EXTENS 0072 EXTR 2223 F2 1200 F3 5200 FABS 5372 FADD 1000 FADDIP 1400 FATN 5020 FBLK 6360 FCDF 3056 FCOM 4400 FCONT 1053 FCOS 5200 FDAY 6566 FDIV 3000 FENT 4407 FETCH 5512 FEXIT 1101 FEXP 4622 FEXT 0000 FF 0214 FGET 0000 FGETIP 0400 FGO 1256 FGO1 6013 FGO2 6022 FGO3 6033 FGO4 6041 FGO5 6050 FGO6 6104 FIGO1 5413 unreferenced FIGO2 5430 FIGO3 5446 FIGO4 5454 FIGO5 5473 FIGO6 5503 FIGO7 5526 FIGO8 5534 FIGO9 5545 FILCNT 6761 FILDEV 0131 FILEGO 6667 FILIN 6322 FILIST 6365 FILOUT 6110 FIN 7444 FINAL 4316 FINALZ 5525 FINCR 1030 FIND 6363 FINDLN 4546 FINDN 1152 FINDX 1171 FINFIN 1044 FINISH 0155 FIRSTV 0031 FISW 0072 FITR 5370 FIXER 7270 FIXIT 4560 FL0AT 2021 FL0ATR 5554 FL10 5564 FL100 0360 FLAC 0044 FLAD 7352 FLARG 7600 FLARGP 0104 FLDV 6766 FLEN 6330 FLEX 6526 FLGT 6500 FLIMIT 1047 FLINTP 5400 FLIST 2154 FLNGTH 0057 FLNR 7362 FLOAT 4552 FLOATR 5553 FLOG 4746 FLOP 0050 FLOUT 5717 FLOUTP 6001 FLP1 5560 FLP5 0363 FLPT 6511 FLSB 7351 FLTONE 6522 FMAX 7424 FMIN 7423 FMPY 6623 FMQ 6563 FMUL 4000 FMULIP 4400 FNOR 7000 FNTABF 2357 FNTABL 2157 FOCLTM 6442 FOR 1000 FORLVL 0025 FOUT 5360 FP1 0111 FP3 7327 FPNT 6400 FPNTP3 6721 FPROC 1066 FPUT 6000 FPUTIP 6400 FPWR 5000 FPZ 3100 FRA 4200 FRAC 5355 FRAN 7515 FRCT 5316 FSF 7450 unreferenced FSFP 7511 FSFX 7503 FSGN 5364 FSIN 5205 FSQT 5326 FSR 5325 FSUB 2000 FTEST 1111 FTRM 5754 GEND 2266 GET 4423 GET1 2262 GET3 2304 GETA 7556 GETARG 1400 GETC 4541 GETD 5745 GETHND 4561 GETL 7512 GETLN 4545 GETLP 1412 GETMON 4546 GETSIZ 5612 GETVAR 1404 GEXIT 1464 GINC 0112 GLOOP 1445 GOBACK 6477 GOJUMP 0044 GOSUB 6446 GOSW 0036 GOTO 0610 GRPCHK 0541 GRPXIT 0571 GS1 1434 GSERCH 1423 GTEM 0020 GTNAME 4572 H0RD 0021 HANDLR 6323 HANDX 6315 HEADER 0026 HESI 4460 HORD 0045 I0F 6002 I0N 6001 IBAR 0213 IBLE 6542 IBLK 6122 ICHAR 6324 ICHAR0 6114 ICHAR1 6134 ICHARX 0014 IECHO 6275 IF 1557 IGNOR 0220 IGNORE 7462 IGO 1257 ILIST 1274 ILNGTH 6002 INBLK 0121 INBUF 0055 INDEV 0056 INDEX 4437 INFLG 6113 INHND 0125 INITIA 6507 INITL 4264 INITLN 0434 INITLZ 5400 INLIST 0226 INP 0221 INPUT 6045 INPUTX 0300 INTCHK 6730 INTEGE 7260 INTRNL 7222 INTRPT 3045 INVERT 6734 INVRS 5055 IOWAIT 0024 IOWATE 7324 IPNTR 6156 IRETN 0232 IRST 6062 JM 1551 JMPR0 4340 JUMP 2574 JUMPER 6625 JUMPX 6470 K177 0053 K7 0162 K77 0007 K7760 7440 KCHK 3037 KEYCK 3000 KINT 3066 KOMGO 6650 KOMLST 6357 L 0000 L1 5171 L10 4726 L11 4722 L12 4716 L2 5165 L3 5161 L4 5155 L5 5151 L6 5145 L7 4742 L8 4736 L9 4732 LAST1 4335 LASTC 0071 LASTLN 0064 LASTOP 0064 LASTV 0061 LBLOCK 7014 LBUFR 6466 LCLOSE 6430 LCMND 6400 unreferenced LCMNDS 0651 LEVEL0 0024 LF 0212 LFCONT 7107 LGETC 7551 LGOSUB 0647 LIB3 6467 LIBBLK 0061 LIBDEV 0074 LIBFLG 0077 LIBHND 0065 LIBX 7054 LINE0 0202 LINE1 0224 LINENO 0067 LIST1 6767 LISTAL 6770 LISTGO 0432 LJUMP 4550 LLIST 6766 LN2 4712 LNFEED 6175 LOADER 6550 LOADGO 6503 LOOP2 7023 LOOP3 7125 LORD 0046 LPOPF 4551 LPRTST 1760 LPTCHK 0275 LPTDEV 0272 LPUSHF 4552 LSHFT 6523 LSORT 6455 LZERO 6744 LZXIT 6754 M10 1675 M14 0107 M20 3145 M240 2344 M336 2151 M4 0105 M40 2235 M5 0106 M6 6476 M77 2274 MAKVAR 1467 MCOMMA 7535 MCP 3020 unreferenced MCR 0110 MDM1 6000 MDONE 6677 MDSK 7335 MDXIT 6705 MEMSIZ 6233 MEND 6717 MEQ 1006 MF 2033 MGETA 7520 MGETC 7512 MINT 3043 MINUS9 7533 MINUSE 7534 MODEPT 0317 MODIFY 0367 MODLN 0402 MOVE 5553 MPER 2146 MPLY 6141 MPOPF 3120 MPUSHF 3042 MQL 7421 MSC 2353 MULT10 4561 MULT2 6231 MUY 7405 MV1 5453 MV2 3260 MV3 3330 NAGSW 0070 NAME 7400 NAMEND 7565 NAMER 7571 NAMGO 7532 NAMLOC 0067 NAMLST 7171 NAMLUP 7416 NEG 6225 NEGATE 4557 NEWDEV 0055 NEXT 1132 NEXTLN 0237 NEXTP 7604 NIGHT 0061 NLOOP 7110 NMI 7411 unreferenced NO 2102 NOCHAR 5655 NODATE 0014 NOFIX 7303 NOGOOD 6317 NONAME 0020 NORGO 7066 NORM 7045 NORMAL 4435 NORML 7062 NOSIZE 5626 NOTEQ 6250 NOTID 6427 NOWAY 7365 NPACK 7346 NPRNT 7154 NTEST 2117 NUHEAD 0020 NXTNUM 7456 O1 5706 O2 5712 O3 5724 O7760 7274 OBLK 5700 OCHAR 6336 OCHAR0 6076 OCMND 6021 OECHO 6103 OFFSET 0015 OLNGTH 5642 ON 1542 ONMTMP 6711 OPEN 7200 OPENUP 7257 OPER 1707 OPNEXT 1624 OPTR1 5736 OPTR2 5737 OPTRI 3142 OPTRO 3143 ORGO 6701 ORLIST 6373 ORST 6003 OSCOPE 6722 OSHFT 7375 OUTA 5740 OUTBLK 0126 OUTDEV 0057 OUTDG 6066 OUTFLG 0133 OUTHND 0132 OUTPUT 5757 OVER 0047 OVR1 0053 P 0010 P11 2140 P12 2150 P13 0074 P134 0000 P14 2141 P17 0101 P177 0075 P17757 6624 P23 2144 P27 7301 P3 2143 P337 0002 P34 2133 P4 2145 P4000 6720 P43 0076 P6 2142 P7 0073 P7600 0104 P77 0077 P7757 3006 PACBUF 2423 PACEND 0150 PACGO 2354 PACK0 0000 PACK1 0066 PACK2 0104 PACKC 4540 PACLST 2576 PACX 2441 PARTES 2001 PC 0022 PC0 0100 PC1 0625 PCAT 2435 PCHK 3024 PCK1 2444 PCK2 2453 PCLF 6662 PD 5600 PDERR 3040 PDLXR 0013 PERIOD 7524 PI 5533 PIOV2 5277 PLTDEV 6201 PLUS10 7422 POPA 4521 POPF 4525 POPJ 5523 POPX 3033 POS 6233 PQST 2464 PRINTC 4534 PRINTD 4535 PRINTN 4537 PRNT 6126 PRNTC 0003 PRNTLN 4547 PRNTX 2336 PROC 0616 PRODUC 0170 PROMPT 1271 PT1 0062 PUSHA 4520 PUSHF 4524 PUSHJ 4522 PUT 4410 PUTV 7624 QUAD0 5220 QUAD1 5226 QUAD2 5227 unreferenced QUAD3 5230 unreferenced QUAD4 5231 unreferenced QUAD5 5232 QUIT 2535 QUOT 7034 R0 4344 R1 4346 unreferenced R2 4350 unreferenced R3 4204 R4 4354 unreferenced RANDOM 7642 RANK 2063 RCTF 6677 RDPTR 6111 READ 1217 READC 4533 READN 4536 REED 4262 REKOVR 3150 REMOVE 5616 RERD 6056 RESOL 0037 RESOLV 6727 RESTOR 6032 RETRN 0574 RETRY 6260 RETURN 5555 REVERS 6751 RNDC 5657 RO 0377 RTL6 4563 RUB1 2466 RUB2 2512 RUB3 2525 RUNNER 6463 S 0000 SAVAC 0011 SAVBLK 6437 SAVE 6515 SAVER 6416 SAVLK 0012 SAVMQ 0010 unreferenced SBAR 0416 SBLK 0236 SC3 5254 SCA 7441 unreferenced SCANER 6410 SCHAR 0406 SCHAR0 0230 SCHAR1 0250 SCHARX 0016 SCONT 0404 SECRTV 0032 SEND 0225 SET 1174 SETDHT 6343 SETV 5537 SEX 2630 SFOUND 0417 SGNCHK 5303 SGNTST 6600 SGOT 0423 SHFT 7226 SHFTL6 7164 SHIFTL 4556 SHIFTS 4356 SHL 7413 unreferenced SHUT 7243 SIGN 0040 SINBLK 0111 SINFLG 0227 SINHND 0115 SINPUT 0200 SKPX 6317 SLOT 6327 SM0 7330 SM1 7164 SM2 7344 SM3 7346 SM8 6254 SORTB 2605 SORTCN 0065 SORTJ 4526 SORTX 4527 SP 0240 SP1 7324 SP2 7326 SPAC 2507 SPECIA 0170 SPM0 5623 SPNOR 4542 SPOINT 0116 SQBRKT 7540 SQRT 5343 SRETN 0256 SRNLST 0426 SRST 0211 START 0177 STBLK 0060 STVAR 0000 SUBBER 6462 unreferenced SWAP 0102 SWAPIN 7301 T 0020 T1 0041 T2 0042 T3 0043 TAB 6205 TABCNT 0176 TABEND 0033 TABX 6312 TASK 1203 TASK4 1244 TATE 4477 TBACK 1236 TBUF 3100 TCRLF 1242 TDUMP 2633 TELSW 0054 TEMP 0106 TERM 7364 unreferenced TESTC 4530 TESTCR 4544 TESTN 4532 TESTX 4531 TEXTP 0017 TFRMT 1277 TGO 5601 THEN 1570 THISLN 0063 THISOP 0063 TINT 3050 unreferenced TITLE 0213 TLIST 1273 TLIST2 1626 TLIST3 1540 TLSW 7217 TOGL 2232 TQUOT 1310 TRACE 0006 TRAP 3137 TSTCMA 4543 TTY 0222 TTYDEV 6341 TTYIN 6067 TTYOUT 6007 TTYP 6016 TXTEND 0030 TYPE 1234 TYPEPT 0325 TYPSET 1200 UINT 3112 USR 0006 USRIN 7247 USROUT 7310 UTE 2242 UTRA 2236 UTX 2253 V 0030 VARBL 7473 VERSIO 0045 VFN 7540 VFR 7542 VIDEO 3342 VLETR 7547 W0 4357 W1 4361 unreferenced W2 4363 unreferenced W3 4365 W4 4367 unreferenced WCONT 0463 WEND 0445 WORDS 0004 WRIT 4263 WRITE 0456 WTESTG 0473 X0 4671 X1 4670 X2 4667 X3 4666 XCHAR 0023 XCT 0021 XDELET 2721 XFIND 1145 XFORM 7336 XGETLN 0312 XI33 3007 XINC 1402 XINT 3127 XLEN 5746 XLOOP 2746 XNAME 0120 XOUTL 3021 XOUTN 3001 XPOPA 1343 XPOPF 1356 XPOPJ 1337 XPRNT 2317 XPUSHA 1333 XPUSHF 1350 XPUSHJ 1325 XRT 0014 XRT2 0015 XRTL6 2014 XSORT 2337 XSPNOR 2275 XT3 2051 XTEN 6204 XTEST 2053 YES 2106 YGO 1260 YLST 1221 YNCR 7420 ZALL 0536 ZER 6220 ZERO 0521 ZEROER 6772 ZFOUND 1521 ZGO 1255 ZINITL 1513 ZLIST 1272 ZLOOP 1504 ZSERCH 1501