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 / 8NFIO.PA 3023 / FOR PDP8I OR PDP12 WITHOUT EAE 3024 / BASED ON 8XFIO.PA NEW NON-EAE EMULATION 2025-10 3025 / BY BILL CATTEY AND CHATGPT 3026 3027 /=============================================================== 3028 / NON-EAE EMULATION SUPPORT FOR U/W FOCAL 4E 3029 / TARGET RANGE: 13200-14177 3030 /--------------------------------------------------------------- 3031 / THIS MODULE HOLDS LONGER NON-EAE ROUTINES SO 8NFPP/8NFIO 3032 / CAN REMAIN FOOTPRINT-IDENTICAL TO THE ORIGINAL 8X MODULES. 3033 / 3034 / THE EMULATION IS HERE IN THE FIO MODULE TO STAY COMPATIBLE 3035 / WITH THE LEGACY LAYOUT OF U/W FOCAL V4E OF 1978 3036 / AS BEST WE COULD FIND IT. 3037 / 3038 / CURRENTLY IMPLEMENTED EMULATIONS: 3039 / MUY - MULTIPLY (AC × MQ → 24-BIT PRODUCT) 3040 / DVI - DIVIDE (MQ:AC ÷ OPERAND → QUOTIENT/REMAINDER) 3041 / SWP - SWAP AC ↔ MQ (VIA PAGE-ZERO JUMP TABLE) 3042 /--------------------------------------------------------------- 3043 / NOTES: 3044 / MQL IS REDEFINED INLINE AS "DCA SAVMQ" 3045 / ALL OTHER EAE OPS (MQA, MQR, ACL, CAM, SCA, ETC.) 3046 / WERE VERIFIED AS UNUSED IN 8XFPP/8XFIO. 3047 /=============================================================== 3048 3049 / THIS MODULE INCORPORATES TWO LEVELS SELF-TEST LOGIC 3050 / 3051 / DEFINE "EMTEST=1" IF YOU WANT A POST-HOC 3052 / REPEAT EVERY EMULATION WITH THE EAE AND HALT 3053 / ON ANY DISCREPENCY. 3054 / 3055 / THERE IS ALSO A STAND-ALONE TEST MODE. 3056 / WHEN 8NFIO IS ASSEMBLED WITHOUT U/W FOCAL, 3057 / THE VIRTUAL MQ SAVMQ STORED IN 10010 ISN'T DEFINED. 3058 / WE DETECT THAT AND DEFINE TESTME=1. 3059 / 3060 / TESTME IS A SHORT PROGRAM THAT PERFORMS 3061 / TESTS RECORDED IN THE TABLE APTLY NAMED 3062 / "TABLE". HERE AGAIN, THE EMULATION AND 3063 / THE EAE PERFORM BOTH TESTS AND HALTS 3064 / ON ANY DISCREPANCY. 3065 3066 /--------------------------------------------------------------- 3067 / PAGE-ZERO “INSTRUCTION” VECTORS. APPENDING TO THOSE DEFINED 3068 / IN 16KCPR.PA IN SPACE LEFT FOR "FOR SOFTWARE MULTIPLY" 3069 3070 /EMTEST=1 / DEFINE IF WE WANT IN-LINE EMULATION TEST. 3071 3072 / IF WE HAVE EMTEST, AND ARE INSIDE U/W FOCAL 3073 / SAVMQ IS DEFINED. WE NEED TO DEFINE 3074 / THE EAE OPS FOR TESTING THEY NORMALLY 3075 / DONT GET DEFINED IN NON-EAE U/W FOCAL 3076 3077 IFDEF SAVMQ < 3078 MUY=7405 3079 DVI=7407 3080 > 3081 3082 / TESTME CONTROLS STAND ALONE TESTING 3083 / 1 FOR ENABLE 3084 / 0 FOR NORMAL 3085 3086 IFNDEF SAVMQ < 3087 *10 3088 SAVMQ, 0 3089 3090 TESTME=1 3091 3092 IFNDEF EMTEST < 3093 EMTEST=1 / WE USE EMTEST STAND ALONE 3094 > 3095 > 3096 3097 IFDEF TESTME < 3098 /================================================================ 3099 / PAL-8 TEST HARNESS — EAE vs EMULATION (MODE A) 3100 / 8 TEST CASES, HALT AFTER EACH SUBTEST 3101 / Inspect AC & MQ (hardware) vs AC & SAVMQ (emulation) at each HLT 3102 /================================================================ 3103 3104 / Combined instructions 3105 3106 L0001=CLL CLA IAC 3107 L0002=CLL CLA CML RTL 3108 L0003=CLL CLA CML IAC RAL 3109 L0006=CLL CLA CML IAC RTL 3110 L2000=CLL CLA CML RTR 3111 3112 /EAE INSTRUCTIONS TO BE EMULATED 3113 3114 MUY=7405 3115 DVI=7407 3116 MQL=7421 3117 3118 *0200 / origin for harness (pick a safe page 3119 3120 / TABLE OF TESTS: 3121 / EMUOP, OPERAND, MQ, AC 3122 3123 START, CLA CLL 3124 TAD TSTART 3125 DCA TABLEP 3126 DCA TNUM 3127 REP, TAD I TABLEP 3128 SNA 3129 HLT 3130 DCA EMUOP 3131 ISZ TABLEP 3132 TAD I TABLEP 3133 DCA EMUOP+1 3134 ISZ TABLEP 3135 TAD I TABLEP 3136 DCA SAVMQ 3137 ISZ TABLEP 3138 TAD I TABLEP 3139 EMUOP, 0 3140 0 3141 ISZ TABLEP 3142 ISZ TNUM 3143 CLA CLL 3144 JMP REP 3145 3146 TABLEP, 0 3147 TNUM, 0 3148 3149 TSTART, TABLE 3150 3151 / EM: OP; MQ; AC. SWP: AC and MQ swap 3152 3153 PAGE 3154 3155 TABLE, EMMUY; 5; 3; 0 / T0: 3 * 5; AC=0 MQ=17 3156 EMMUY; 12; 0; 3 / T1: 0 * 12 + 3: AC=0 MQ=3 3157 EMMUY; 2; 7777; 0 / T2: 7777 * 2: AC=1 MQ=7776 3158 EMMUY; 7; 6; 0 / T3: 6 * 7: AC=0 MQ=52 3159 EMDVI; 3; 2000; 1 / T4: 12000 / 3: AC=2 MQ=3252 3160 EMDVI; 4; 14; 0 / T5: 14 / 4: AC=2 MQ=3 3161 EMDVI; 400; 0; 2000 /T6: 20000000 / 400:AC=2000;MQ=1;L=1 3162 EMDVI; 4; 12; 0 / T7: 12 / 4: AC=2 MQ=2 3163 EMDVI; 6; 5; 0 / T10: 6 /5: AC=5 MQ=0 3164 SWPMUY; 0; 0; 3146 / T11: 0 * 3146 + 0 = 0 NO ADD 3165 SWPMUY; 0; 1000; 3146 / T12: 0 * 3146 + 1000 AC=1147 MQ=1000 3166 SWPMUY; 6316; 4000; 2400 / T13: 6316 * 2400 + 4000 AC=2000 MQ=7000 3167 EMMUY; 0; 0; 3 / T14 0 * 0 + 3 AC=0 MQ=3 3168 EMMUY; 3110; 2400; 0 / T 15 3110 * 2400 AC=766 MQ=0 3169 EMMUY; 6650; 2400; 0 / T 16 6650 * 2400 AC=2104 MQ=4000 3170 SWPMUY; 3000; 4000; 3147 /T 17: 3000 * 3147 + 4000: AC=1147 MQ=1000 3171 SWPMUY; 3000; 1000; 3146 /T 20 3000 * 3146 + 1000 AC=1146 MQ=3000 3172 SWPMUY; 6316; 7000; 2400 / T 21 6316 * 2400 + 7000 AC=2001 MQ=2000 3173 EMDVI; 6000; 0; 2400 /T 22 24000000 / 6000 AC=4000 MQ=3252 3174 EMDVI; 6000; 0; 2200 /T 23 22000000 / 6000 AC=0 MQ=3000 3175 EMDVI; 5000; 0; 0 /T24 0 / 6000 AC=0 MQ=0 ZERO DIVIDEND IS NOT OVERFLOW. 3176 0 3177 3178 / END OF HARNESS 3179 3180 > 3181 3182 /FLOATING POINT INPUT/OUTPUT ROUTINES: 3183 / 8NFIO.PA 3184 / FOR PDP8I OR PDP12 WITHOUT EAE 3185 / BASED ON 8XFIO.PA NEW NON-EAE EMULATION 2025-09 3186 / BY BILL CATTEY AND CHATGPT 3187 3188 /=============================================================== 3189 / NON-EAE EMULATION SUPPORT FOR U/W FOCAL 4E 3190 / TARGET RANGE: 13200-14177 3191 /--------------------------------------------------------------- 3192 / THIS MODULE HOLDS LONGER NON-EAE ROUTINES SO 8NFPP/8NFIO 3193 / CAN REMAIN FOOTPRINT-IDENTICAL TO THE ORIGINAL 8X MODULES. 3194 / 3195 / THE EMULATION IS HERE IN THE FIO MODULE TO STAY COMPATIBLE 3196 / WITH THE LEGACY LAYOUT OF U/W FOCAL V4E OF 1978 3197 / AS BEST WE COULD FIND IT. 3198 / 3199 / CURRENTLY IMPLEMENTED EMULATIONS: 3200 / MUY - MULTIPLY (AC × MQ → 24-BIT PRODUCT) 3201 / DVI - DIVIDE (MQ:AC ÷ OPERAND → QUOTIENT/REMAINDER) 3202 / SWP - SWAP AC ↔ MQ (VIA PAGE-ZERO JUMP TABLE) 3203 /--------------------------------------------------------------- 3204 / NOTES: 3205 / MQL IS REDEFINED INLINE AS "DCA SAVMQ" 3206 / ALL OTHER EAE OPS (MQA, MQR, ACL, CAM, SCA, ETC.) 3207 / WERE VERIFIED AS UNUSED IN 8XFPP/8XFIO. 3208 /=============================================================== 3209 3210 /--------------------------------------------------------------- 3211 / PAGE-ZERO “INSTRUCTION” VECTORS. APPENDING TO THOSE DEFINED 3212 / IN 16KCPR.PA IN SPACE LEFT FOR "FOR SOFTWARE MULTIPLY" 3213 3214 IFDEF EMTEST < 3215 3216 IFNDEF TESTME < 3217 *PRODUCT-2 / EAT 2ND FROM LAST LOC FOR AUTO TEST 3218 > 3219 3220 IFDEF TESTME < 3221 *100 3222 > 3223 3224 CMPEAE= JMS I . 3225 EAECMP 3226 > 3227 3228 IFNDEF TESTME < 3229 *PRODUCT-1 / EAT LAST PATCH LOC 3230 > 3231 3232 IFDEF TESTME < 3233 *101 3234 > 3235 3236 EMSWP= JMS I . / EMULATE EAE SWP 3237 010167 3200 SWPEM 3238 3239 IFNDEF TESTME < 3240 *GINC+1 / CONSUME ALL USER CONSTANTS 3241 > 3242 3243 EMMUY= JMS I . / EMULATE EAE MUY 3244 010113 3217 MUYEM 3245 MQLMUY= JMS I . / EMULATE EAE MQL MUY 3246 010114 3230 MUYMQL 3247 SWPMUY= JMS I . / EMULATE EAE SWP MUY 3248 010115 3210 MUYSWP 3249 EMDVI= JMS I . / EMULATE EAE DVI 3250 010116 3311 DVIEM 3251 MQLDVI= JMS I . / EMULATE EAE DVI 3252 010117 3304 DVIMQL 3253 3254 /--------------------------------------------------------------- 3255 3256 3257 /========================================================== 3258 / EAE MODE A EMULATORS FOR U/W FOCAL 4E (PAL-8) 3259 / 5 ROUTINES: SWPEM, MUYEM, MUYMQL, DVIEM, DVIMQL 3260 / TEMP LOCS: EMOP..EMAC 3261 3262 / SAVMQ USED AS SOFTWARE MQ 3263 /========================================================== 3264 3265 IFNDEF TESTME < 3266 *14500 3267 > 3268 3269 IFDEF TESTME < 3270 *700 3271 > 3272 3273 / ONE COMBINED INSTRUCTION NOT DEFINED IN UWF 3274 3275 L0002=CLL CLA CML RTL 3276 L4000=CLL CLA CML RAR 3277 L7777=CLL CLA CMA 3278 3279 IFNDEF TESTME < 3280 *13200 3281 > 3282 3283 IFDEF TESTME < 3284 *1000 3285 > 3286 3287 /--------------------- SWPEM -------------------------------- 3288 / SWP EMULATOR (SINGLE WORD ENTRY) 3289 / SWP: SWAP AC and SAVMQ 3290 013200 0000 SWPEM, 0 3291 013201 3300 DCA RMDPHI / SAVE AC to SWPET1 3292 013202 1010 TAD SAVMQ 3293 013203 3301 DCA EMAC / SAVE OLD MQ to SWPET2 3294 013204 1300 TAD RMDPHI 3295 013205 3010 DCA SAVMQ / NEW MQ := OLD AC 3296 013206 1301 TAD EMAC 3297 013207 5600 JMP I SWPEM / RETURN (AC := OLD MQ) 3298 3299 013210 0000 MUYSWP, 0 / RELIES ON USE OF EMAC TO DO THE SWAP 3300 013211 3301 DCA EMAC / SAVE AC 3301 013212 1210 TAD MUYSWP / FIX RETURN ADDRESS 3302 013213 3217 DCA MUYEM 3303 013214 1301 TAD EMAC / RESTORE AC AND SWAP 3304 013215 4567 EMSWP / CALL OUT TO DISTANT EMSWP 3305 013216 5220 JMP MUYEM+1 / JUMP INTO MUYEM 3306 3307 /============================================================ 3308 / MUY EMULATION FAMILY (MODE A) 3309 / MUYEM - MUY (PLAIN) : MULTIPLICAND IS SAVMQ (MQ EMULATED) 3310 / IF AC NON-ZERO ON ENTRY, ADD IT TO PRODUCT 3311 / MUYMQL - MQL + MUY : MULTIPLICAND IS AC (MQL STORES AC IN SAVMQ) 3312 / MULTIPLICAND IS IN NEXT WORD AFTER CALL 3313 / MUYCORE - COMMON KERNEL : 12-ITER SHIFT/ADD to 24-BIT PRODUCT 3314 / RESULTS: AC = HIGH 12 BITS, SAVMQ = LOW 12 BITS 3315 / TEMPS: MDCNT, EMOP, EMAC, AND RMDPHI, 3316 / ALGORITHM: REUSE SAVMQ AS BOTH MULTIPLIER AND LO RESULT 3317 / INITIALIZATION: LINK IS CLEAR; MULTIPLIER IN MQ; 3318 / MDCNT -14; MULTIPLICAND IN EMOP; HI PROD IN RMDPHI 3319 / IF LSB OF PRODUCT IS 1 ADD EMOP TO SAVMQ 3320 / CONSTANTS: NEG14 -14 OCTAL FOR 12 WAY SHIFT 3321 /============================================================ 3322 3323 /---------------- MUYEM (PLAIN MUY) ------------------------- 3324 013217 0000 MUYEM, 0 3325 013220 3301 DCA EMAC / SAVE ORIGINAL AC to EMAC 3326 013221 3300 DCA RMDPHI / IN CASE WE DO FAST EXIT 3327 013222 1217 TAD MUYEM 3328 013223 3230 DCA MUYMQL 3329 IFDEF EMTEST < 3330 TAD SAVMQ / PRESERVE MQ ACROSS QUICK EXIT 3331 MQL 3332 > 3333 013224 1010 TAD SAVMQ / TEST MULTIPLIER (MQ EMULATED IN SAVMQ) 3334 013225 7640 SZA CLA / MUYMQL WILL FETCH SAVMQ WHEN NEEDED. 3335 013226 5233 JMP MUYMQL+3 / IF NONZERO MULTIPLICAND, DO FETCH PATH 3336 013227 5262 JMP MPEXIT / IF ZERO, ADD TO MQ AND EXIT 3337 3338 /---------------- MUYMQL (MQL + MUY) ----------------------- 3339 013230 0000 MUYMQL, 0 3340 013231 3010 DCA SAVMQ / MOVE AC to SAVMQ (MQL EFFECT) 3341 013232 3301 DCA EMAC / MQL MUY CLEARS AC 3342 013233 3300 DCA RMDPHI / PRODUCT HIGH := 0 3343 IFDEF EMTEST < / PRESERVE ORIGINAL SAVMQ 3344 TAD SAVMQ 3345 MQL 3346 > 3347 013234 1630 TAD I MUYMQL / FETCH MULTIPLIER (LITERAL) 3348 013235 7450 SNA 3349 013236 5274 JMP EXMQ0 / FAST EXIT IF MULTIPLIER = 0 3350 013237 3277 DCA EMOP / EMOP := MULTIPLIER NEVER CHANGES 3351 013240 1303 TAD NEG14 3352 013241 3276 DCA MDCNT / MDCNT := -14 (COUNT FOR 12 ITERATIONS) 3353 013242 7100 MPLOOP, CLL 3354 013243 1010 TAD SAVMQ 3355 013244 7010 RAR / SHIFT MULTIPLIER RIGHT, LSB to LINK 3356 013245 3010 DCA SAVMQ 3357 013246 7430 SZL / IF LINK = 1 (LSB WAS 1) DO ADD 3358 013247 1277 TAD EMOP 3359 013250 7100 CLL / ADD MAY HAVE SIGNIFICANT CARRY 3360 013251 1300 TAD RMDPHI 3361 013252 7010 RAR / AND ROTATE IT 3362 / PROD LO HAS MULTIPLIER RIGHT SHIFTED 3363 / PROD HI IS RIGHT SHIFTED 3364 / MAYBE WITH MULTIPLICAND ADDED 3365 013253 3300 DCA RMDPHI 3366 / IF HI SHIFTED A RIGHT BIT 3367 / ADD IT TO HI BIT OF SAVMQ 3368 013254 7430 SZL 3369 013255 7330 L4000 3370 013256 1010 TAD SAVMQ 3371 013257 3010 DCA SAVMQ 3372 013260 2276 ISZ MDCNT 3373 013261 5242 JMP MPLOOP 3374 / --- ADD ORIGINAL AC (EMAC) INTO PRODUCT LOW, PROPAGATE CARRY --- 3375 013262 7300 MPEXIT, CLA CLL / LINK MIGHT HAVE BEEN SET ON ENTRY. 3376 IFDEF EMTEST < 3377 TAD I MUYMQL / FAST EXIT NEEDS TO INITIALIZE 3378 DCA EMOP / OP FOR TESTING. 3379 > 3380 013263 1301 TAD EMAC / GET SAVED AC 3381 013264 1010 TAD SAVMQ / ADD TO PRODUCT 3382 013265 3010 DCA SAVMQ / AND SAVE IT 3383 013266 7430 SZL 3384 013267 7001 IAC / IF ADDING TO SAVMQ OVERFLOWED 3385 013270 1300 TAD RMDPHI / PUT PRODUCT INTO AC 3386 013271 2230 ISZ MUYMQL 3387 013272 7100 CLL 3388 IFDEF EMTEST < 3389 CMPEAE 3390 > 3391 013273 5630 MPRET, JMP I MUYMQL / RETURN TO CALLER (MUYEM OR MUYMQL) 3392 013274 3010 EXMQ0, DCA SAVMQ 3393 013275 5262 JMP MPEXIT 3394 3395 /---------------- TEMP & CONSTS ----------------------------- 3396 013276 0000 MDCNT, 0 / COUNTER 3397 013277 0000 EMOP, 0 / OPERAND -- MULTIPLIER OR DIVISOR 3398 013300 0000 RMDPHI, 0 / PROD HIGH OR DIVIDEND HI 3399 013301 0000 EMAC, 0 / SAVE OF AC AT ENTRY 3400 013302 0000 MINDIV, 0 / NEGATED DIVISOR 3401 013303 7764 NEG14, -14 3402 3403 /============================================================= 3404 / DVIEM - MODE A DVI NONRESTORING UNSIGNED DIVIDE 3405 / ENTRY: EMDVI, NEXT WORD = DIVISOR LITERAL 3406 / INPUT: AC = HIGH 12 BITS OF DIVIDEND 3407 / SAVMQ = LOW 12 BITS OF DIVIDEND 3408 / OUTPUT: NORMAL: AC = REMAINDER, SAVMQ = QUOTIENT, LINK = 0 3409 / OVERFLOW: AC UNCHANGED, SAVMQ = (SAVMQ LEFT SHIFT 1)+1, LINK=1 3410 /============================================================= 3411 3412 / EMULATE COMBINATION OF MQL DVI 3413 / WHICH FILLS SAVMQ WITH AC AND CLEARS AC 3414 3415 013304 0000 DVIMQL, 0 3416 013305 3010 DCA SAVMQ 3417 013306 1304 TAD DVIMQL 3418 013307 3311 DCA DVIEM 3419 013310 7410 SKP 3420 3421 / REGULAR DVI 3422 013311 0000 DVIEM, 0 3423 / SAVE DIVIDEND 3424 013312 3300 DCA RMDPHI / RMDPHI := AC 3425 3426 / FETCH DIVISOR 3427 013313 1711 TAD I DVIEM 3428 013314 7041 CIA 3429 013315 3302 DCA MINDIV 3430 IFDEF EMTEST < 3431 TAD SAVMQ / PRESERVE ORIGINAL SAVMQ 3432 MQL 3433 TAD RMDPHI / PRESERVE AC ORIGINALLY CALLED 3434 DCA EMAC 3435 TAD I DVIEM 3436 DCA EMOP 3437 > 3438 013316 2311 ISZ DVIEM 3439 3440 / TEST FOR OVERFLOW: IF AC GREATER OR EQUAL TO EMOP 3441 013317 7100 CLL 3442 013320 1302 TAD MINDIV 3443 013321 1300 TAD RMDPHI / AC = EMOP - RMDPHI 3444 013322 7620 SNL CLA 3445 013323 5332 JMP DVNORM 3446 3447 /---------------- OVERFLOW CASE ------------------------------ 3448 013324 1010 DVIOVF, TAD SAVMQ / MQ = (MQ LEFT SHIFT 1) + 1 3449 013325 7004 RAL 3450 013326 3010 DCA SAVMQ 3451 013327 1300 TAD RMDPHI / RESTORE AC = ORIGINAL HIGH HALF 3452 013330 7120 STL / SET LINK 3453 IFDEF EMTEST < 3454 CMPEAE 3455 > 3456 013331 5711 JMP I DVIEM 3457 3458 / DIVISION ALGORITHM FROM DECUS 8-436 3459 / WITH A BIT MORE OPTIMIZATION 3460 3461 /---------------- NORMAL DIVISION ---------------------------- 3462 3463 013332 7340 DVNORM, L7777 3464 013333 1303 TAD NEG14 3465 013334 3276 DCA MDCNT / 13 ITERATIONS 15 OCTAL 3466 3467 013335 7300 DVIS1, CLA CLL 3468 013336 7410 SKP 3469 013337 3300 DVIS2, DCA RMDPHI 3470 013340 1010 TAD SAVMQ 3471 013341 7004 RAL 3472 013342 3010 DCA SAVMQ 3473 013343 1300 TAD RMDPHI 3474 013344 2276 ISZ MDCNT 3475 013345 7410 SKP 3476 013346 5356 JMP DVDONE 3477 013347 7004 RAL 3478 013350 3300 DCA RMDPHI 3479 013351 1300 TAD RMDPHI 3480 013352 1302 TAD MINDIV 3481 013353 7420 SNL 3482 013354 5335 JMP DVIS1 3483 013355 5337 JMP DVIS2 / COMMIT THE SUBTRACTION 3484 013356 7100 DVDONE, CLL 3485 IFDEF EMTEST < 3486 CMPEAE 3487 > 3488 013357 5711 JMP I DVIEM 3489 3490 IFDEF EMTEST < 3491 3492 PAGE 3493 3494 / IN-LINE EMULATION TESTING 3495 / HALT IF THE EAE ACTION IS DIFFERENT 3496 / MQ SET TO PRE EMULATION SAVMQ BY CALLER 3497 / FROM THE EMULATED ACTION 3498 3499 EAECMP, 0 3500 DCA ACEM / SAVE AC EMULATION RETURN 3501 RAR 3502 DCA LINKEM / SAVE LINK EMULATION RETURN 3503 TAD I EMOPPT / FETCH EMOP (MULTIPLICAND/DIVISOR) 3504 DCA EMOPCP 3505 TAD I EMACPT / FETCH EMAC (ORIGINAL AC) 3506 DCA EMACP 3507 MQA / FETCH MQ FROM BEFORE ACTION 3508 DCA MQSAVE 3509 TAD MULPTR / CALLED FROM MULTIPLY? 3510 CIA 3511 TAD EAECMP 3512 SZA CLA / OR ONE OF THE DIV CALLS 3513 L0002 / DVI = MUL + 2 3514 TAD KMUY 3515 DCA TESTOP 3516 DOTEST, TAD EMOPCP 3517 DCA EAEARG 3518 TAD MQSAVE 3519 MQL 3520 TAD EMACP 3521 TESTOP, 0 3522 EAEARG, 0 / THE OPERATION TO TEST 3523 DCA ACREPL 3524 RAR / FIRST TEST THE LINK REPLY 3525 TAD LINKEM 3526 SZA CLA 3527 HLT / LINK DOESN'T MATCH. HALT 3528 TAD ACREPL 3529 CIA 3530 TAD ACEM 3531 SZA CLA 3532 HLT / AC DOESN'T MATCH HALT 3533 MQA / COMPARE EAE MQ WITH EMULATION 3534 CIA 3535 TAD SAVMQ 3536 SZA CLA 3537 HLT 3538 TAD LINKEM 3539 RAL / RESTORE LINK REPLY 3540 TAD ACEM / RESTORE AC REPLY 3541 JMP I EAECMP / TAKE IT ON HOME! 3542 3543 / ARGS TO THE EMULATION 3544 / HERE IN ORDER OF PLACEMENT IN THE TEST TABLE 3545 / OP, MQ, AC 3546 3547 EMOPCP, 0 / COPY OF EMOP FROM EMULATION 3548 MQSAVE, 0 / COPY OF PRESERVED MQ BEFORE EMULATION 3549 EMACP, 0 / COPY OF EMAC FROM EMULATION 3550 3551 / RESULTS TO COMPARE: 3552 / AC FROM EMULATION THEN AC FROM EAE 3553 / LINK FROM EMULATION THEN LINKL FROM EAE 3554 / WE COMPARE SAVEMQ WITH MQ REGISTER. 3555 3556 ACEM, 0 / COPY OF AC REPLY FROM EMULATION 3557 ACREPL, 0 / AC REPLY FROM EAE 3558 LINKEM, 0 / COPY OF LINK REPLY FROM EMULATION 3559 LREPL, 0 / LINK REPLY FROM EAE 3560 3561 / POINTERS TO STUFF IN THE EMULATION 3562 3563 EMOPPT, EMOP 3564 EMACPT, EMAC 3565 MULPTR, MPRET / WHERE WE WOULD REURN TO IF MPY 3566 KMUY, MUY 3567 3568 3569 > 3570 IFNDEF TESTME < 3571 / CODE IMPORTED FROM 8XFIO.PA 3572 3573 *5400 /AFTER THE FUNCTIONS 3574 015400 0000 FLINTP, 0 /CONVERT ASCII TO BINARY - 'READN' 3575 015401 4273 JMS FIGO5 /CHECK LEADING CHARACTERS 3576 015402 4254 JMS FIGO4 /READ FIRST DIGIT GROUP 3577 015403 7420 SNL /ENDED BY A PERIOD? 3578 015404 4312 JMS FETCH /SKIP IT & READ 2ND GROUP 3579 015405 4326 JMS FIGO7 /AND SET NEW DIGIT COUNT 3580 015406 4437 JMS I RESOL /FIX UP THE SIGN 3581 015407 1066 TAD CHAR 3582 015410 1377 TAD (-"E /DID WE READ AN 'E'? 3583 015411 7640 SZA CLA 3584 015412 5230 JMP FIGO2 /NO 3585 3586 015413 4312 FIGO1, JMS FETCH /YES, PASS THE 'E' 3587 015414 4407 FENT 3588 015415 6504 FPUT I FLARGP /SAVE THE MANTISSA & DEC. PT. 3589 015416 0000 FEXT 3590 015417 4254 JMS FIGO4 /READ THE DECIMAL EXPONENT 3591 015420 1047 TAD OVER 3592 015421 2040 ISZ SIGN /CHECK THE SIGN 3593 015422 7041 CIA 3594 015423 3254 DCA FIGO4 /SAVE THE RESULT 3595 015424 4407 FENT 3596 015425 0504 FGET I FLARGP /RESTORE WHAT WE HAD 3597 015426 0000 FEXT 3598 015427 1254 TAD FIGO4 /COMBINE THE SCALE FACTORS 3599 3600 015430 1044 FIGO2, TAD EXP /SET UP THE LOOP COUNTER 3601 015431 7100 CLL 3602 015432 7510 SPA 3603 015433 7161 STL CIA /WITH -(ABS. VALUE+1) 3604 015434 7040 CMA 3605 015435 3254 DCA FIGO4 3606 015436 7430 SZL /TEST DIRECTION 3607 015437 1364 TAD FL10 3608 015440 1376 TAD (FMUL FLP1 /OR 'FMUL FL10' 3609 015441 3247 DCA FIGO3+1 3610 015442 1076 TAD P43 /INSERT THE PROPER EXPONENT 3611 015443 3044 DCA EXP 3612 015444 4435 NORMALIZE 3613 015445 5251 JMP FIGO3+3 3614 3615 015446 4407 FIGO3, FENT /SCALE LEFT OR RIGHT 3616 015447 4364 FMUL FL10 3617 015450 0000 FEXT 3618 015451 2254 ISZ FIGO4 3619 015452 5246 JMP FIGO3 3620 015453 5600 JMP I FLINTP /***RETURN*** 3621 015454 0000 FIGO4, 0 /READ A GROUP OF DIGITS 3622 015455 4303 JMS FIGO6 /START WITH ZERO 3623 015456 7164 SM1 3624 015457 3040 DCA SIGN /INITIALIZE SIGN 3625 015460 1066 TAD CHAR 3626 015461 1375 TAD (-"- 3627 015462 7440 SZA 3628 015463 2040 ISZ SIGN /RESET IF POSITIVE 3629 015464 7144 CMA CLL RAL /SET CODE FOR "+" 3630 015465 7150 CMA CLL RAR /"+" to 0000(1) 3631 015466 7650 SNA CLA /NOT "+" OR "-" 3632 015467 7001 IAC /SKIP THE SIGN 3633 015470 4273 JMS FIGO5 /AND IGNORE SPACES 3634 015471 4326 JMS FIGO7 /DO ALL THE WORK 3635 015472 5654 JMP I FIGO4 3636 ///// 3637 3638 015473 0000 FIGO5, 0 /PROCESS LEADING CHARACTERS 3639 015474 7540 SMA SZA /-240, ONLY 'SZA' OCCURS 3640 015475 4312 JMS FETCH /GET FIRST OR NEXT 3641 015476 1066 TAD CHAR 3642 015477 1274 TAD .-3 /IS IT A SPACE? 3643 015500 7650 SNA CLA 3644 015501 5275 JMP .-4 /IGNORE LEADING SPACES 3645 015502 5673 JMP I FIGO5 3646 ///// 3647 3648 015503 0000 FIGO6, 0 /'FLOAT' 3649 015504 3045 DCA HORD 3650 015505 3046 DCA LORD 3651 015506 3047 DCA OVER 3652 015507 1074 TAD P13 3653 015510 3044 DCA EXP 3654 015511 5703 JMP I FIGO6 3655 ///// 3656 3657 /READ A CHARACTER FROM TEXT OR THE INPUT DEVICE: 3658 3659 015512 0000 FETCH, 0 3660 015513 1600 TAD I FLINTP /CHECK THE NEXT INSTRUCTION 3661 015514 7700 SMA CLA 3662 015515 5321 JMP ACCEPT 3663 015516 4541 GETC /READ FROM THE TEXT BUFFER 3664 015517 5712 JMP I FETCH 3665 ///// 3666 015520 4534 PRINTC /IN CASE WE WANT TO ECHO FF 3667 015521 4533 ACCEPT, READC /READ FROM THE INPUT DEVICE 3668 015522 4526 SORTJ /TEST FOR SPECIAL ACTION 3669 015523 0167 SPECIAL-1 3670 015524 6401 ACTION-SPECIAL 3671 015525 5712 JMP I FETCH 3672 ///// 3673 015526 0000 FIGO7, 0 /DECIMAL-TO-BINARY CONVERSION 3674 015527 3044 DCA EXP /CLEAR DIGIT COUNTER 3675 015530 4532 TESTN 3676 015531 5726 JMP I FIGO7 /PERIOD, L=0 3677 015532 5345 JMP FIGO9 /OTHER, L=0 3678 015533 1065 TAD SORTCN /GET THE NUMBER 3679 015534 4561 FIGO8, MULT10 /ADD IT IN 3680 015535 7640 SZA CLA 3681 015536 5341 JMP .+3 3682 015537 1045 TAD HORD /CHECK FOR OVERFLOW 3683 015540 7710 SPA CLA 3684 015541 4576 ERROR2 /INPUT OVERFLOW ERROR 3685 015542 2044 ISZ EXP /COUNT THE DIGITS 3686 015543 4312 JMS FETCH /GET ANOTHER ONE 3687 015544 5330 JMP FIGO7+2 3688 ///// 3689 015545 1066 FIGO9, TAD CHAR /ALLOW A-Z 3690 015546 1377 TAD (-"E 3691 015547 7450 SNA 3692 015550 5726 JMP I FIGO7 /'E' IS SPECIAL AND L=1 3693 015551 1374 TAD ("E-"Z-1 3694 015552 7121 STL IAC 3695 015553 1373 TAD ("Z-"A+1 3696 015554 7460 SNL SZA 3697 015555 5334 JMP FIGO8 /TREAT A-Z LIKE NUMBERS 3698 015556 7320 STL CLA 3699 015557 5726 JMP I FIGO7 /L=1 3700 ///// 3701 3702 /THESE TWO CONSTANTS MUST NOT BE SEPARATED 3703 3704 015560 7775 FLP1, -3;3146;3146;3147 015561 3146 015562 3146 015563 3147 3705 015564 0004 FL10, +4;2400;0000;0000 015565 2400 015566 0000 015567 0000 3706 3707 ECHOGO=. /BRANCH LIST FOR 'READC' 3708 015570 6273 IECHO-2 /FF 3709 015571 6276 IECHO+1 /LF 3710 015572 6276 IECHO+1 /RO 3711 3712 015573 0032 *PRODUCT 015574 7752 015575 7523 015576 4360 015577 7473 3713 010170 0233 SPECIAL,233 /ESCAPE 3714 010171 0375 375 /ALTMODE 3715 010172 0337 "_ /RESTART 3716 010173 0214 ECHOLST,FF /IGNORE (KEYBOARD ONLY) 3717 010174 0212 LF /IGNORE 3718 010175 0377 RO /IGNORE 3719 /THIS ROUTINE EXTENDS THE FORMAT SPECIFICATIONS (%W.DD) TO 3720 /ALLOW THE NUMBER OF DIGITS PRINTED IN SCIENTIFIC NOTATION 3721 /TO BE CONTROLLED. A FORMAT OF '0' MEANS 'ALL SIGNIFICANT 3722 /DIGITS' WHILE '.05' MEANS 'JUST PRINT 5' WITH APPROPRIATE 3723 /ROUNDING. THIS FORMAT PRINTS A LEADING DIGIT FOLLOWED BY 3724 /A DECIMAL POINT, MORE DIGITS AND THEN THE EXPONENT. 3725 3726 /ANOTHER IMPROVEMENT IS THAT THE MINUS SIGN IS ALWAYS OUT- 3727 /PUT JUST AHEAD OF THE FIRST SIGNIFICANT DIGIT. 3728 3729 *5600 /A RATHER SPECIAL LOCATION! 3730 015600 0012 PD, DIGITS /DEFAULT 3731 3732 015601 0000 TGO, 0 /CALLED BY 'PRINTN' 3733 015602 3015 DCA XRT2 /SAVE BUFFER ADDRESS 3734 015603 1072 TAD FISW /GET FORMAT SAVED BY % TRAP 3735 015604 0104 AND P7600 /ISOLATE THE FIELD LENGTH 3736 015605 4563 RTL6 3737 015606 7161 STL CIA /NEGATE AND TEST FOR ZERO 3738 015607 3044 DCA FLAC /SAVE MINUS FIELD LENGTH 3739 3740 015610 1072 TAD FISW /GET NO. OF DECIMAL PLACES 3741 015611 7450 SNA 3742 015612 1200 TAD PD /USE DEFAULT IF NONE SPEC. 3743 015613 0075 ESGN, AND P177 /A REASONABLE LIMIT! 3744 015614 7420 SNL /SCIENTIFIC? 3745 015615 5224 JMP SPM0+1 /YES, ROUND TO D PLACES 3746 3747 015616 1044 TAD FLAC /COMPARE FIELD SIZE 3748 015617 7420 SNL / D-F LESS THAN 0 ? 3749 015620 7360 STA STL /NO, TAKE D = F-1 3750 015621 1043 TAD T3 /COMPARE DECIMAL EXPONENT 3751 015622 7560 SNL SMA SZA / E GREATER THAN F-D ? 3752 015623 7760 SPM0, SNL SMA SZA CLA /ROUND OFF TO F PLACES 3753 015624 7041 CIA /ENTER HERE FOR SCI. NOT. 3754 015625 3042 DCA T2 /SAVE F-D-E (OR 0 OR -D) 3755 3756 015626 1042 TAD T2 /THIS IS TRICKY BUSINESS! 3757 015627 7120 STL /EXTEND THE SIGN 3758 015630 1044 TAD FLAC / -(E+D), -F OR -D (-D-F) 3759 015631 1200 TAD PD /COMPARE WITH LIMIT 3760 015632 7430 SZL /SKIPS FOR 0 LESS THAN AC LESS THAN PD+1 3761 015633 7200 CLA /LIMIT ROUNDOFF TO DIGITS+1 3762 015634 1050 TAD EX1 /ADD -PD-1 (MDM1) TO RESTORE 3763 015635 7161 STL CIA /(E+D), F, D, DIGITS (+1) 3764 3765 015636 1015 BUMP, TAD XRT2 /SET UP BUFFER ADDRESS 3766 015637 3340 DCA OUTA 3767 015640 2740 ISZ I OUTA /INCREMENT THIS DIGIT 3768 015641 1740 TAD I OUTA /NOW TEST IT 3769 015642 7420 SNL /LITTLE EXTRA THE FIRST TIME 3770 015643 1105 TAD M4 3771 015644 1106 TAD M5 3772 015645 7750 SPA SNA CLA /CARRY REQUIRED? 3773 015646 5263 JMP RNDC+4 /NO: GO TO OUTPUT 3774 015647 3740 DCA I OUTA /YES: MAKE CURRENT DIGIT ZERO 3775 015650 7121 STL IAC /SET UP LINK FOR NEXT CYCLE & 3776 015651 3577 DCA I START /ANTICIPATE CARRY FROM 999... 3777 015652 1340 TAD OUTA /DECR AND CHECK THE POINTER 3778 015653 1257 TAD RNDC /-(START OF BUFFER) 3779 015654 7440 SZA /BEGINNING OF BUFFER REACHED? 3780 015655 5236 JMP BUMP /NO: BUMP THE NEXT DIGIT 3781 3782 015656 2043 ISZ T3 /YES: INCR. DECIMAL EXPONENT 3783 015657 0167 RNDC, -BUFFER-1 /'NOP' 3784 015660 7040 CMA /AND SET THE MANTISSA TO 0.1 3785 015661 1015 TAD XRT2 /BY DECREMENTING THE POINTER 3786 015662 5202 JMP TGO+1 /RECOMPUTE THE DECIMAL POINT 3787 3788 015663 7164 SM1 /SET SIGN COUNTER 3789 015664 3041 DCA T1 3790 015665 1103 TAD C240 /'TAD ESGN' IF YOU WISH 3791 015666 7200 CLA /PRINTC TO PRINT A LEADING SPACE BEFORE # 3792 3793 015667 1044 TAD FLAC /GET FIELD SIZE 3794 015670 7450 SNA /FLOATING OUTPUT ? 3795 015671 5317 JMP FLOUT /YES 3796 015672 1043 TAD T3 /COMPARE WITH EXPONENT 3797 015673 7740 SMA SZA CLA / E GREATER THAN F ? 3798 015674 5321 JMP FLOUT+2 /YES: USE FLOATING FORMAT 3799 015675 1042 TAD T2 / F-D-E (OR 0 IF E GREATER THAN F-D) 3800 015676 1043 TAD T3 / F-D OR E 3801 015677 7041 CIA /CALCULATE -NO. OF POSITIONS 3802 015700 3042 DCA T2 /TO PRINT BEFORE DECIMAL PT. 3803 3804 015701 1042 BACK, TAD T2 /PRINT DD.DDD 3805 015702 1043 TAD T3 3806 015703 7650 SNA CLA / P = E ? 3807 015704 5324 JMP DIG /YES: PRINT DIGIT 3808 015705 7001 IAC /NO ('376' TO SUPPRESS 1ST ZERO) 3809 015706 1042 TAD T2 3810 015707 7710 SPA CLA / P LESS THAN 1 ? 3811 015710 1223 TAD SPM0 /YES: PRINT SPACE 3812 015711 4340 AGAIN, JMS OUTA /PRINT CHARACTER 3813 015712 2042 ISZ T2 /P CHARACTERS PRINTED? 3814 015713 5301 JMP BACK /NO 3815 015714 7344 SM2 /YES ('TAD 376') 3816 015715 4535 PRINTD /PRINT DECIMAL POINT 3817 015716 5301 JMP BACK 3818 3819 015717 1042 FLOUT, TAD T2 /SET FIELD SIZE 3820 015720 3044 DCA FLAC / -D 3821 015721 7164 SM1 /SET FLAG 3822 015722 3340 DCA OUTA 3823 015723 2201 ISZ TGO /SET SECOND RETURN 3824 015724 7364 DIG, CLA SM1 /POINTS TO 'TERM' 3825 015725 1043 TAD T3 /REDUCE E BY 1 3826 015726 3043 DCA T3 3827 015727 4345 JMS GETD /GET NEXT DIGIT 3828 015730 2340 ISZ OUTA /TEST FLAG 3829 015731 5311 JMP AGAIN /NORMAL RETURN 3830 3831 015732 4535 PRINTD /PRINT FIRST FLOATING DIGIT 3832 015733 7344 SM2 /CREATE A PERIOD (256-260) 3833 015734 7410 SKP /DON'T FETCH & DON'T COUNT 3834 015735 4345 JMS GETD /FETCH NEXT DIGIT 3835 015736 4340 JMS OUTA /PRINT IT 3836 015737 5335 JMP .-2 /AND REPEAT 3837 3838 015740 0000 OUTA, 0 3839 015741 4535 PRINTD /PRINT CHARACTER 3840 015742 2044 ISZ FLAC /F CHARACTERS PRINTED? 3841 015743 5740 JMP I OUTA /NO: RETURN 3842 015744 5601 JMP I TGO /YES: NUMBER FINISHED 3843 ///// 3844 3845 015745 0000 GETD, 0 /ROUTINE TO UNLOAD BUFFER 3846 015746 1415 TAD I XRT2 /AUTO-INDEX REG. SETUP UPON ENTRY 3847 015747 2050 ISZ EX1 /TEST FOR END OF SIGNIFICANT FIG. 3848 015750 5745 JMP I GETD 3849 015751 7240 CLA CMA /FORCE -1 IN ORDER TO 3850 015752 3050 DCA EX1 /OUTPUT EXTRA ZEROS 3851 015753 5745 JMP I GETD /LEAVE C(AC)=0 3852 ///// 3853 015754 1724 FTRM, TAD I DIG /GET THE INPUT TERMINATOR 3854 015755 5553 FLOATR 3855 ///// 3856 3857 015756 0000 DBLSUB, 0 /CHECK FOR A SECOND SUBSCRIPT 3858 015757 4543 TSTCMA 3859 015760 5756 JMP I DBLSUB /ONLY ONE 3860 015761 4524 PUSHF 3861 015762 0044 FLAC /SAVE THE FIRST ONE 3862 015763 4522 PUSHJ 3863 015764 1610 EVAL /GET THE SECOND ONE 3864 015765 4525 POPF 3865 015766 7600 FLARG /TEMPORARY STORAGE 3866 015767 1377 TAD DIMEN 3867 015770 3062 DCA PT1 /SET THE VARIABLE POINTER 3868 015771 4407 FENT 3869 015772 2511 FSUB I FP1 /THE SECOND MINUS ONE 3870 015773 4400 FMULIPT1 /TIMES THE DIMENSION 3871 015774 1504 FADD I FLARGP /PLUS OFFSET OF FIRST 3872 015775 0000 FEXT 3873 015776 5756 JMP I DBLSUB /CALLED BY 'GETARG' 3874 015777 0010 DIMEN, STVAR+2+WORDS+2 /DATA POINTER FOR (!) 3875 PAGE 3876 3877 LNFEED= (0&(1&(2 /RESERVE 3 LOCATIONS 3878 XLIST; NOPUNCH; PAGE 30; ENPUNCH; XLIST 3879 /FLOATING POINT OUTPUT CONVERSION: 'PRINTN' 3880 3881 /REWRITTEN TO PROVIDE THREE NEW FEATURES: (1) A 'FLOATING' 3882 /MINUS SIGN WHICH APPEARS BEFORE THE FIRST DIGIT; (2) A 3883 /MEANS FOR 'TDUMP' TO OUTPUT 3-DIGIT SUBSCRIPTS (+/-999); 3884 /(3) A PROVISION FOR NON-PRINTING CALLS WHICH JUST SET UP 3885 /THE OUTPUT BUFFER BUT DO NOT DO ANY PRINTING. 3886 3887 /THANKS TO JIM CRAPUCHETTES FOR TWELVE LOCATIONS! 3888 3889 016000 7765 MDM1, -DIGITS-1 /START FLOUTP AT PAGE+1 3890 3891 016001 0000 FLOUTP, 0 /CONVERT BINARY TO ASCII 3892 016002 3042 DCA T2 /SET THE NON-PRINT FLAG 3893 016003 7121 STL IAC 3894 016004 3043 DCA T3 /INITIALIZE THE EXPONENT 3895 016005 4436 JMS I ABSOL /TAKE THE ABSOLUTE VALUE 3896 016006 7050 CMA RAR /LINK WILL BE ZERO IF NEGATIVE 3897 016007 3304 DCA FGO6 /SET THE SIGN FLAG 3898 016010 1040 TAD SIGN 3899 016011 7650 SNA CLA /ZERO? 3900 016012 5233 JMP FGO3 3901 3902 016013 4407 FGO1, FENT /NUMBER TOO LARGE 3903 016014 4774 FMUL I (FLP1 /MULTIPLY BY .1 3904 016015 0000 FEXT 3905 016016 2043 ISZ T3 /INCREASE DECIMAL EXPONENT 3906 016017 1044 TAD EXP 3907 016020 7740 SMA SZA CLA /CHECK THE BINARY EXPONENT 3908 016021 5213 JMP FGO1 3909 3910 016022 4407 FGO2, FENT /NUMBER TOO SMALL 3911 016023 4773 FMUL I (FL10 /MULTIPLY BY 10 3912 016024 0000 FEXT 3913 016025 7040 CMA /DECREASE DECIMAL EXPONENT 3914 016026 1043 TAD T3 3915 016027 3043 DCA T3 3916 016030 1044 TAD EXP /CHECK THE BINARY EXPONENT 3917 016031 7550 SPA SNA 3918 016032 5222 JMP FGO2 3919 3920 016033 7040 FGO3, CMA /NEGATE THE BIT COUNT 3921 016034 3044 DCA EXP 3922 016035 1200 TAD MDM1 /INITIALIZE DIGIT COUNT 3923 016036 3266 DCA OUTDG 3924 016037 1177 TAD START /INITIALIZE BUFFER POINTER 3925 016040 3015 DCA XRT2 3926 3927 016041 3050 FGO4, DCA EX1 /SHIFT OUT THE FIRST DIGIT 3928 016042 4556 SHIFTL 3929 016043 1050 TAD EX1 3930 016044 7004 RAL 3931 016045 2044 ISZ EXP 3932 016046 5241 JMP FGO4 3933 016047 7410 SKP 3934 016050 4561 FGO5, MULT10 /IE. 0.672 X 10 = 6 + 0.72.. ETC. 3935 016051 3415 DCA I XRT2 3936 016052 2266 ISZ OUTDG /ALL DIGITS OUTPUT? 3937 016053 5250 JMP FGO5 /NO: CONTINUE 3938 3939 016054 1200 TAD MDM1 3940 016055 3050 DCA EX1 /SAVE NO. OF DIGITS 3941 016056 1177 TAD START /GET BUFFER POINTER 3942 016057 2042 ISZ T2 /TEST PRINT FLAG 3943 016060 4661 JMS I .+1 /OUTPUT MANTISSA 3944 016061 5601 JMP I FLOUTP /FIXED POINT DONE 3945 3946 016062 1372 TAD ("E /PRINT 'E' 3947 016063 4534 PRINTC 3948 016064 4304 JMS FGO6 /OUTPUT THE EXPONENT 3949 016065 5601 JMP I FLOUTP /FLOATING POINT DONE 3950 ///// 3951 3952 016066 0000 OUTDG, 0 /MULTI-PURPOSE ROUTINE - 'PRINTD' 3953 016067 7500 SMA /IGNORE SPACES AND THE LIKE OR 3954 016070 2041 ISZ T1 /DIGITS OTHER THAN THE FIRST ! 3955 016071 5300 JMP DGOUT 3956 016072 3041 DCA T1 /SAVE THE FIRST DIGIT 3957 016073 2304 ISZ FGO6 /CHECK THE SIGN FLAG 3958 016074 1303 TAD C255 /MAKE A '-' 3959 016075 1103 TAD C240 /'SZA' TO OMIT THIS SPACE 3960 016076 4534 PRINTC 3961 016077 1041 TAD T1 /RESTORE AC 3962 3963 016100 1371 DGOUT, TAD ("0 /FORM ASCII 3964 016101 4534 PRINTC 3965 016102 5666 JMP I OUTDG 3966 016103 0015 C255, 15 /'255' 3967 ///// 3968 3969 016104 0000 FGO6, 0 /ALSO CALLED BY 'TDUMP' 3970 016105 1043 TAD T3 /GET EXPONENT 3971 016106 7710 SPA CLA /TEST SIGN 3972 016107 7326 SP2 /+2 to -3 3973 016110 1106 TAD M5 3974 016111 4266 JMS OUTDG /PRINT SIGN 3975 016112 1043 TAD T3 3976 016113 7510 SPA 3977 016114 7041 CIA 3978 016115 4517 MQLDVI /DIVIDE BY ONE HUNDRED 3979 016116 0144 144 3980 016117 3042 DCA T2 3981 016120 4567 EMSWP /PRINT QUOTIENT 3982 016121 7440 SZA /UNLESS IT'S ZERO 3983 016122 4266 JMS OUTDG 3984 016123 1042 TAD T2 /NOW PRINT REMAINDER 3985 016124 4326 JMS PRNT 3986 016125 5704 JMP I FGO6 3987 016126 0000 PRNT, 0 /PRINT TWO DECIMAL DIGITS 3988 016127 0075 AND P177 3989 016130 4517 MQLDVI /DIVIDE BY TEN 3990 016131 0012 12 3991 016132 3042 DCA T2 3992 016133 4567 EMSWP /GET QUOTIENT 3993 016134 4266 JMS OUTDG 3994 016135 1042 TAD T2 /GET REMAINDER 3995 016136 4266 JMS OUTDG 3996 016137 3041 DCA T1 /RESET SWITCH 3997 016140 5726 JMP I PRNT /CALLED BY 'FGO6' & 'PRNTLN' 3998 ///// 3999 4000 016141 0000 MPLY, 0 /CONTINUATION OF EAE MULTIPLY 4001 016142 1046 TAD LORD 4002 016143 3346 DCA .+3 4003 016144 1052 TAD AC1L /B*E 4004 016145 4515 SWPMUY 4005 016146 0000 0 4006 016147 1050 TAD EX1 4007 016150 3010 DCA SAVMQ /DISCARD FOUR 4008 016151 7004 RAL 4009 016152 3050 DCA EX1 /INITIALIZE TWO 4010 4011 016153 1045 TAD HORD 4012 016154 3357 DCA .+3 4013 016155 1052 TAD AC1L /A*E 4014 016156 4515 SWPMUY 4015 016157 0000 0 4016 016160 1050 TAD EX1 /ADD TO TWO 4017 016161 3050 DCA EX1 4018 4019 016162 1046 TAD LORD 4020 016163 3366 DCA .+3 4021 016164 1051 TAD AC1H /B*D 4022 016165 4515 SWPMUY 4023 016166 0000 0 4024 016167 1050 TAD EX1 /BUILD UP TWO 4025 016170 5741 JMP I MPLY /FINISH ONE & TWO 4026 4027 016171 0260 FIELD 1 /FORGET LITERALS 016172 0305 016173 5564 016174 5560 016175 0000 016176 0001 016177 0002 4028 4029 *LNFEED 4030 016175 1576 TAD I TABCNT /WHERE ARE WE? 4031 016176 7650 SNA CLA 4032 016177 5403 JMP I CFF /IGNORE THE LF AFTER A CR 4033 016200 1071 TAD LASTC 4034 016201 4551 DCAIAXIN /SAVE THE LAST CHARACTER 4035 016202 5603 JMP I .+1 4036 016203 7100 LFCONT-7 /RETYPE THE INPUT LINE 4037 /THIS IS A VERY HANDY ROUTINE FOR CONVERTING BCD DATA TO 4038 /BINARY FLOATING POINT FORM. JUST SET EXP=43 AT THE END. 4039 4040 *6204 4041 016204 0000 XTEN, 0 /MULTIPLY THE FLAC BY 10 (DECIMAL) 4042 016205 4567 EMSWP /AND ADD IN C(AC) 4043 016206 3354 DCA CPRNT /SAVE THE MQ 4044 016207 1047 TAD OVER 4045 016210 4515 SWPMUY /THANKS TO REV. GEOFFREY CHASE 4046 016211 0012 12 /FOR SUGGESTING AN EAE VERSION 4047 016212 4567 EMSWP 4048 016213 3047 DCA OVER 4049 016214 1046 TAD LORD 4050 016215 4515 SWPMUY 4051 016216 0012 12 4052 016217 4567 EMSWP 4053 016220 3046 DCA LORD 4054 016221 1045 TAD HORD 4055 016222 4515 SWPMUY 4056 016223 0012 12 4057 016224 4567 EMSWP 4058 016225 3045 DCA HORD 4059 016226 1354 TAD CPRNT /RESTORE MQ 4060 016227 4567 EMSWP /AC=OVERFLOW 4061 016230 5604 JMP I XTEN /EXECUTION TIME = 60 MICROSECONDS 4062 ///// 4063 4064 016231 0000 MULT2, 0 /MULTIPLY FLAC BY 2 - 'SHIFTL' 4065 016232 1047 TAD OVER 4066 016233 7104 CLL RAL 4067 016234 3047 DCA OVER 4068 016235 1046 TAD LORD 4069 016236 7004 RAL 4070 016237 3046 DCA LORD 4071 016240 1045 TAD HORD 4072 016241 7004 RAL 4073 016242 3045 DCA HORD 4074 016243 5631 JMP I MULT2 /DOES NOT CHANGE 'EXP' 4075 ///// 4076 4077 016244 0000 DUBLAD, 0 /TRIPLE PRECISION ADDITION 4078 016245 7100 CLL 4079 016246 1053 TAD OVR1 4080 016247 1047 TAD OVER 4081 016250 3047 DCA OVER 4082 016251 7004 RAL 4083 016252 1052 TAD AC1L 4084 016253 1046 TAD LORD 4085 016254 3046 DCA LORD 4086 016255 7004 RAL 4087 016256 1051 TAD AC1H 4088 016257 1045 TAD HORD 4089 016260 3045 DCA HORD 4090 016261 5644 JMP I DUBLAD 4091 /CHARACTER INPUT/OUTPUT ROUTINES: 'READC' AND 'PRINTC' 4092 4093 /THE INPUT ROUTINE MAY ALSO BE USED TO ECHO A CHARACTER. 4094 4095 016262 0000 CHIN, 0 /INPUT A CHARACTER 4096 016263 6211 CDF P 4097 016264 7450 SNA /'ECHOC' IF AC#0 4098 016265 4456 JMS I INDEV /'READC' IF AC=0 4099 016266 3066 DCA CHAR 4100 016267 4526 SORTJ /TAKE CARE OF SPECIAL CHARACTERS 4101 016270 0172 ECHOLST-1 4102 016271 5375 ECHOGO-ECHOLST 4103 016272 5275 JMP IECHO 4104 016273 1056 TAD INDEV /ONLY ECHO FF TO A FILE 4105 016274 7710 SPA CLA 4106 016275 4534 IECHO, PRINTC /'ZERO' IF NOT ECHOING 4107 016276 5662 JMP I CHIN 4108 ///// 4109 4110 016277 0000 CHOUT, 0 /OUTPUT A CHARACTER - 'PRINTC' 4111 016300 7450 SNA /USE AC IF NON-ZERO 4112 016301 1066 TAD CHAR /OTHERWISE USE CHAR 4113 016302 1110 TAD MCR 4114 016303 6202 CIF L 4115 016304 5205 JMP TAB /ADJUST TAB COUNTER 4116 016305 1005 CROUT, TAD CCR 4117 016306 4457 JMS I OUTDEV /CARRIAGE RETURNS 4118 016307 1004 TAD CLF 4119 016310 4457 JMS I OUTDEV /NORMAL RETURNS 4120 016311 5677 JMP I CHOUT 4121 ///// 4122 4123 /CALLS TO AND FROM THE TAB ROUTINES IN FIELD 0: 4124 4125 016312 4522 TABX, PUSHJ /EVALUATE THE COLUMN NO. 4126 016313 1605 EVAL-3 4127 016314 4560 FIXIT 4128 016315 6202 CIF L 4129 016316 5221 JMP ZER+1 /SAME PAGE, FIELD 0 4130 4131 016317 4262 SKPX, JMS CHIN /NEGATIVE COL. NO. 4132 016320 6202 CIF L 4133 016321 5227 JMP NEG+2 /RETURN TO LOWER FIELD 4134 ///// 4135 4136 016322 6114 FILIN, ICHAR0 /FILE INPUT 4137 016323 3021 ECODEV, XOUTL /DEFAULT OUTPUT 4138 /FILE INPUT/OUTPUT ROUTINES: 4139 4140 016324 0000 ICHAR, 0 /FILE INPUT VIA (INDEV) 4141 016325 6203 CDI L 4142 016326 5722 JMP I FILIN /CALL LOWER FIELD 4143 016327 5724 JMP I ICHAR 4144 4145 016330 7201 FLEN, CLA IAC /CHECK THE FILE LENGTH 4146 016331 0044 AND EXP /0=OUTPUT, 1=INPUT 4147 016332 7106 CLL RTL /*4 4148 016333 1377 TAD (XLEN 4149 016334 3354 DCA CPRNT 4150 016335 5356 JMP CPRNT+2 /OFF TO THE LOWER FIELD 4151 4152 016336 0000 OCHAR, 0 /FILE OUTPUT VIA (OUTDEV) 4153 016337 6203 CDI L 4154 016340 4776 JMS I (OCHAR0 4155 016341 4723 JMS I ECODEV /ECHO RETURN 4156 016342 5736 JMP I OCHAR /NO-ECHO RETURN 4157 4158 016343 0000 EOF, 0 /TRAPS ATTEMPT TO READ BEYOND 4159 016344 1375 TAD (XI33 /THE 'END-OF-FILE' CHARACTER 4160 016345 3056 DCA INDEV /RESETS POINTERS TO THE TTY: 4161 016346 1323 TAD ECODEV 4162 016347 3057 DCA OUTDEV 4163 016350 1355 TAD CPRNT+1 /AND TURNS ON THE ECHO, TOO 4164 016351 3275 DCA IECHO 4165 016352 1002 TAD P337 /RETURN A '_' TO CLEAR THE '^Z' 4166 016353 5743 JMP I EOF /'EOF' IS ALSO USED BY 'RECOVR' 4167 4168 016354 0000 CPRNT, 0 /'PRINTC' FOR DOWN BELOW 4169 016355 4534 PRINTC 4170 016356 6203 CDI L 4171 016357 5754 JMP I CPRNT 4172 4173 016360 6201 FBLK, CDF L /READ THE INPUT BLOCK NUMBER 4174 016361 1537 TAD I ATSW /SAME PLACE! 4175 016362 5554 FL0ATR 4176 4177 016363 4560 FIND, FIXIT /CHARACTER SEARCH FUNCTION 4178 016364 3530 DCA I TESTC&177 /SAVE IN 'CTEST' 4179 016365 4456 JMS I INDEV /READ A CHARACTER 4180 016366 3066 DCA CHAR 4181 016367 4526 SORTJ /CHECK FOR EOF, MATCH 4182 016370 2033 C232-1 4183 016371 6120 FINISH-CTEST 4184 016372 1066 TAD CHAR /AND ECHO AS DIRECTED 4185 016373 4533 ECHOC 4186 016374 5365 JMP FIND+2 /EOF to 0, MATCH to CHAR 4187 4188 016375 3007 PAGE 016376 6076 016377 5746 4189 > 4190 /NON-EAE FLOATING POINT PACKAGE FOR U/W-FOCAL 4191 4192 *FPUTIPT1 4193 016400 0000 FPNT, 0 /VIA 'FENT' 4194 016401 7200 CLA /= PAGE 35 4195 016402 6211 CDF P /RESET DATA FIELD 4196 016403 1600 TAD I FPNT 4197 016404 7450 SNA 4198 016405 5600 JMP I FPNT /EXIT 4199 016406 7106 CLL RTL /SHIFT PAGE BITS OVER AND 4200 016407 7006 RTL /PUT OPERATION CODE IN 9-11 4201 016410 3255 DCA LSORT 4202 016411 1255 TAD LSORT /PAGE 0? 4203 016412 7710 SPA CLA 4204 016413 1200 TAD FPNT /GET CURRENT PAGE 4205 016414 0104 AND P7600 4206 016415 3041 DCA T1 /SAVE PAGE, GET RELATIVE 4207 016416 1600 TAD I FPNT 4208 016417 0075 AND P177 4209 016420 1041 TAD T1 /MERGE 4210 016421 7420 SNL /IS IT INDIRECT? 4211 016422 5227 JMP NOTID /NO 4212 016423 7450 SNA /IS IT OUT-OF-FIELD? 4213 016424 5265 JMP CDFV /YES 4214 016425 3041 DCA T1 4215 016426 1441 TAD I T1 /GET THE INDIRECT ADDRESS 4216 016427 7041 NOTID, CIA 4217 016430 7140 CMA CLL /BACKUP ONE 4218 016431 3015 DCA XRT2 /LOAD THE INDEX REGISTER 4219 4220 016432 2200 ISZ FPNT /ADVANCE PROGRAM COUNTER 4221 016433 1255 TAD LSORT /GET BACK THE INSTRUCTION 4222 016434 0073 AND P7 /MASK THE OP CODE 4223 016435 7450 SNA 4224 016436 5300 JMP FLGT 4225 016437 1276 TAD M6 /TEST IT 4226 016440 7450 SNA 4227 016441 5311 JMP FLPT 4228 016442 1270 TAD JUMPX /SOMETHING ELSE 4229 016443 3255 DCA LSORT 4230 016444 1415 TAD I XRT2 /LOAD THE OPERAND 4231 016445 3050 DCA EX1 4232 016446 1415 TAD I XRT2 4233 016447 3051 DCA AC1H 4234 016450 1415 TAD I XRT2 4235 016451 3052 DCA AC1L 4236 016452 1415 TAD I XRT2 /'DCA OVER' FOR 3-WORD VERSION 4237 016453 3053 DCA OVR1 4238 016454 6211 CDF P 4239 016455 0000 LSORT, 0 /BRANCH TO THE PROPER ROUTINE 4240 016456 7610 SKP CLA /LOWER FIELD COMMAND SCANNER 4241 016457 4541 GETC 4242 016460 4527 SORTX /SEARCH FOR END OF THE 2ND WORD 4243 016461 5257 JMP .-2 4244 016462 4542 SPNOR /SKIP TO THE START OF THE THIRD 4245 016463 6202 CIF L 4246 016464 5655 JMP I LSORT /NOTE: 'CHAR' PRESERVED BELOW ! 4247 4248 016465 6231 CDFV, CDF V /CHANGE TO THE VARIABLES FIELD 4249 016466 1062 TAD PT1 /GET THE DATA POINTER 4250 016467 5227 JMP NOTID 4251 4252 016470 5676 JUMPX, JMP I M6 /BRANCH TABLE FOR 'FPNT' 4253 016471 7352 FLAD 4254 016472 7351 FLSB 4255 016473 6766 FLDV 4256 016474 6623 FMPY 4257 016475 6526 FLEX 4258 016476 7772 M6, -6 4259 016477 7362 FLNR 4260 4261 /HERE ARE THE FLOATING POINT OPERATIONS: 4262 4263 016500 1415 FLGT, TAD I XRT2 /FGET=0 4264 016501 3044 DCA EXP 4265 016502 1415 TAD I XRT2 4266 016503 3045 DCA HORD 4267 016504 1415 TAD I XRT2 4268 016505 3046 DCA LORD 4269 016506 1415 TAD I XRT2 /'NOP' FOR 3-WORD VERSION 4270 016507 3047 DCA OVER 4271 016510 5202 JMP FPNT+2 /L=0 4272 4273 016511 1044 FLPT, TAD EXP /FPUT=6 4274 016512 3415 DCA I XRT2 4275 016513 1045 TAD HORD 4276 016514 3415 DCA I XRT2 4277 016515 1046 TAD LORD 4278 016516 3415 DCA I XRT2 4279 016517 1047 TAD OVER /'JMP FPNT+2' FOR 3-WORD VERSION 4280 016520 3415 DCA I XRT2 4281 016521 5202 JMP FPNT+2 /L=1 4282 ///// 4283 4284 016522 0001 FLTONE, 1;2000;0;0 /USED BY 'FOR' 'Y' 'FLOG' & 'FSIN' 016523 2000 016524 0000 016525 0000 4285 016526 4524 FLEX, PUSHF /FPWR=5 4286 016527 0044 FLAC 4287 016530 4601 JMS I FPNT+1 /SAVE FLAC AND MOVE EXPONENT 4288 016531 4560 FIXIT /ONLY HANDLES INTEGER POWERS 4289 016532 7500 SMA 4290 016533 7040 CMA /BUT THEY MAY BE EITHER 4291 016534 3255 DCA LSORT /POSITIVE -OR- NEGATIVE! 4292 016535 1045 TAD HORD 4293 016536 3040 DCA SIGN /SAVE SIGN OF EXPONENT 4294 016537 7001 IAC 4295 016540 4552 FLOAT /START WITH UNITY 4296 016541 4435 NORMALIZE 4297 4298 016542 4525 IBLE, POPF /RECALL THE ARGUMENT 4299 016543 0050 FLOP 4300 016544 1377 TAD (.+4-FPNT-3 /LOAD THE RETURN ADDRESS 4301 016545 2040 ISZ SIGN /CHECK THE DIRECTION 4302 016546 5353 JMP .+5 4303 016547 5673 JMP I M6-3 /TAKE THE INVERSE (ONCE) 4304 016550 4524 PUSHF /SAVE THE RECIPROCAL 4305 016551 0044 FLAC 4306 016552 5342 JMP IBLE 4307 4308 016553 1073 TAD P7 /ADVANCE THE RETURN 4309 016554 2255 ISZ LSORT /CHECK THE LOOP COUNT 4310 016555 5674 JMP I M6-2 /ACCUMULATE THE PRODUCT 4311 016556 5201 JMP FPNT+1 /DONE 4312 016557 1105 TAD M4 4313 016560 1013 TAD PDLXR /REUSE THE SAME DATA 4314 016561 3013 DCA PDLXR 4315 016562 5342 JMP IBLE 4316 ///// 4317 4318 016563 4560 FMQ, FIXIT /DISPLAY A NUMBER IN THE MQ 4319 016564 3010 DCA SAVMQ 4320 016565 5555 RETURN /LINC-MODE VERSION IS LONGER 4321 ///// 4322 4323 IFZERO T-20 < 4324 016566 4560 FDAY, FIXIT /READ OR CHANGE THE SYSTEM DATE 4325 016567 6222 CIF T 4326 016570 5055 JMP DAY > 4327 4328 *.!177-6 /BRANCH LIST FOR 'FETCH' 4329 016571 1227 ACTION, ENDFI /ESCAPE = RETAIN CURRENT 4330 016572 1227 ENDFI /ALTMODE = DITTO 4331 016573 1217 READ /BA = RESTART INPUT 4332 016574 5521 ACCEPT /FF = IGNORE IT 4333 016575 5521 ACCEPT /LF = IGNORE IT 4334 016576 5521 ACCEPT /RO = IGNORE IT 4335 4336 016577 0145 PAGE 4337 /THIS ROUTINE COMBINES THE EXPONENTS FOR MULTIPLY AND 4338 /DIVIDE AND DETERMINES THE SIGN OF THE RESULT; IF THE 4339 /RESULT IS ZERO IT EXITS IMMEDIATELY. 4340 4341 016600 0000 SGNTST, 0 /TEST AND SAVE SIGN OF THE RESULT 4342 016601 7001 IAC /ADD ONE TO EXPONENT 4343 016602 1044 TAD EXP 4344 016603 3044 DCA EXP 4345 016604 4322 JMS ABSOLV /TAKE THE ABSOLUTE VALUE 4346 016605 1040 TAD SIGN 4347 016606 7450 SNA 4348 016607 5313 JMP MDXIT+6 /QUICK RETURN 4349 016610 0320 AND P4000 /STRIP THE SIGN BIT 4350 016611 1051 TAD AC1H /DO AN EXCLUSIVE OR 4351 016612 3040 DCA SIGN /AND SAVE THE RESULT 4352 016613 4567 EMSWP 4353 016614 3322 DCA ABSOLV /CLEAR & SAVE THE MQ 4354 016615 1051 TAD AC1H 4355 016616 7440 SZA 4356 016617 2200 ISZ SGNTST 4357 016620 7710 SPA CLA /TEST SIGN OF OPERAND 4358 016621 4351 JMS REVERS /FOR BOTH MULTIPLY AND DIVIDE 4359 016622 5600 JMP I SGNTST 4360 ///// 4361 4362 4363 /THREE-WORD BY THREE-WORD MULTIPLICATION: 4364 /THE ANSWER IS ROUNDED OFF TO THREE WORDS 4365 4366 / (A+B+C)*(D+E+F) = NINE PARTIAL PRODUCTS 4367 4368 016623 3041 FMPY, DCA T1 /SAVE THE RETURN ADDRESS 4369 016624 1050 TAD EX1 /ADD THE EXPONENTS (PLUS 1) 4370 016625 4200 JMS SGNTST /AND DETERMINE THE SIGN OF RESULT 4371 016626 5277 JMP MDONE /THE RESULT IS ZERO! 4372 4373 016627 1047 TAD OVER /C*F 4374 016630 3233 DCA .+3 4375 016631 1053 TAD OVR1 4376 016632 4514 MQLMUY 4377 016633 0000 0 4378 016634 3010 DCA SAVMQ /SAVE HIGH ORDER & ERASE SIX 4379 4380 016635 1046 TAD LORD /B*F 4381 016636 3241 DCA .+3 4382 016637 1053 TAD OVR1 4383 016640 4515 SWPMUY /USE PREVIOUS HIGH ORDER AS 4384 016641 0000 0 /REMAINDER IN THIS POSITION 4385 016642 1320 TAD P4000 /ROUND UP 4386 016643 3200 DCA SGNTST /SAVE FOUR 4387 016644 7004 RAL 4388 016645 3050 DCA EX1 /SAVE CARRY 4389 016646 1047 TAD OVER /C*E 4390 016647 3252 DCA .+3 4391 016650 1052 TAD AC1L 4392 016651 4515 SWPMUY /ADD IN PREVIOUS 4393 016652 0000 0 /PARTIAL PRODUCT 4394 016653 1200 TAD SGNTST /SUM HIGH ORDER PARTS 4395 016654 3010 DCA SAVMQ /DISCARD FIVE 4396 016655 7430 SZL 4397 016656 2050 ISZ EX1 /ACCUMULATE CARRIES 4398 4399 016657 1045 TAD HORD /A*F 4400 016660 3263 DCA .+3 4401 016661 1053 TAD OVR1 4402 016662 4515 SWPMUY 4403 016663 0000 0 4404 016664 1050 TAD EX1 /BUILD UP THREE 4405 016665 3050 DCA EX1 4406 4407 016666 1047 TAD OVER /C*D 4408 016667 3272 DCA .+3 4409 016670 1051 TAD AC1H 4410 016671 4515 SWPMUY 4411 016672 0000 0 4412 016673 1050 TAD EX1 4413 016674 3050 DCA EX1 /ADD TO THREE 4414 4415 016675 4717 JMS I MEND /DO 'B*E', 'A*E', AND 'B*D' 4416 016676 4567 EMSWP 4417 016677 3047 MDONE, DCA OVER /SAVE THREE 4418 4419 016700 1045 TAD HORD /A*D 4420 016701 3304 DCA .+3 4421 016702 1051 TAD AC1H 4422 016703 4515 SWPMUY 4423 016704 0000 0 4424 016705 3045 MDXIT, DCA HORD /SAVE ONE 4425 016706 4567 EMSWP 4426 016707 3046 DCA LORD /SAVE TWO 4427 016710 1322 DVXIT, TAD ABSOLV 4428 016711 3010 DCA SAVMQ 4429 016712 1041 TAD T1 4430 016713 1321 TAD FPNTP3 /COMPUTE THE RETURN POINT 4431 016714 3327 DCA RESOLV 4432 016715 4435 NORMALIZE 4433 016716 5330 JMP RESOLV+1 /EXIT FROM MULTIPLY / DIVIDE 4434 ///// 4435 016717 6141 MEND, MPLY /SOFTWARE MULTIPLY AREA 4436 016720 4000 P4000, 4000 4437 016721 6403 FPNTP3, FPNT+3 4438 ///// 4439 016722 0000 ABSOLV, 0 /TAKE THE ABSOLUTE VALUE 4440 016723 1045 TAD HORD 4441 016724 3040 DCA SIGN /BUT REMEMBER WHAT IT WAS 4442 016725 4327 JMS RESOLV 4443 016726 5722 JMP I ABSOLV 4444 4445 016727 0000 RESOLV, 0 /RESTORE THE PROPER SIGN 4446 016730 1040 TAD SIGN 4447 016731 7710 SPA CLA 4448 016732 4334 JMS INVERT 4449 016733 5727 JMP I RESOLV 4450 4451 016734 0000 INVERT, 0 /COMPLEMENT FLAC - 'NEGATE' 4452 016735 1047 TAD OVER 4453 016736 7141 CLL CIA 4454 016737 3047 DCA OVER 4455 016740 7024 CML RAL 4456 016741 1046 TAD LORD 4457 016742 7041 CIA 4458 016743 3046 DCA LORD 4459 016744 7024 CML RAL 4460 016745 1045 TAD HORD 4461 016746 7041 CIA 4462 016747 3045 DCA HORD 4463 016750 5734 JMP I INVERT 4464 4465 016751 0000 REVERS, 0 /NEGATE THE OPERAND 4466 016752 1053 TAD OVR1 4467 016753 7141 CLL CIA 4468 016754 3053 DCA OVR1 4469 016755 7024 CML RAL 4470 016756 1052 TAD AC1L 4471 016757 7041 CIA 4472 016760 3052 DCA AC1L 4473 016761 7024 CML RAL 4474 016762 1051 TAD AC1H 4475 016763 7041 CIA 4476 016764 3051 DCA AC1H 4477 016765 5751 JMP I REVERS 4478 4479 /EAE INSTRUCTIONS 4480 4481 / MUY=7405 / EMULATED AS EMMUY 4482 / DVI=7407 / EMULATED AS EMDVI 4483 / NMI=7411 / NOT EMULATED 4484 / SHL=7413 / NOT EMULATED 4485 / MQL=7421 / EMULATE AS DCA SAVMQ 4486 / SCA=7441 / NOT EMULATED 4487 / CAM=7621 / NOT EMULATED 4488 4489 /THREE-WORD BY THREE-WORD EAE DIVIDE ROUTINE 4490 4491 *6766 4492 016766 3041 FLDV, DCA T1 /SAVE THE RETURN POINT 4493 016767 1050 TAD EX1 /SUBTRACT THE EXPONENTS 4494 016770 7040 CMA /COMPENSATE FOR SHIFT 4495 016771 4200 JMS SGNTST 4496 016772 4576 ERROR2 /THE DIVISOR IS ZERO! 4497 016773 7346 SM3 4498 016774 3327 DCA RESOLV /SET THE COUNTER 4499 016775 1074 TAD P13 /'XRT-1' 4500 016776 3015 DCA XRT2 /INITIALIZE QUOTIENT POINTER 4501 016777 1053 TAD OVR1 4502 017000 7104 CLL RAL 4503 017001 3053 DCA OVR1 /SHIFT THE OPERAND TO THE LEFT 4504 017002 1052 TAD AC1L 4505 017003 7004 RAL 4506 017004 3052 DCA AC1L 4507 017005 1051 TAD AC1H 4508 017006 7004 RAL 4509 017007 3331 DCA DVSR /SAVE THE TRIAL DIVISOR 4510 017010 5325 JMP DVLP+1 4511 ///// 4512 4513 017011 3046 DADJ, DCA LORD /RESTORE THE OVERDRAUGHT 4514 017012 7366 STA STL RTL /POINTS TO 'AND EX1' 4515 017013 1234 TAD QUOT /REDUCE THE QUOTIENT 4516 017014 3234 DCA QUOT 4517 017015 1053 TAD OVR1 /NOW ADD IN THE DIVISOR 4518 017016 1050 TAD EX1 4519 017017 3050 DCA EX1 /THE LEAST-SIGNIFICANT WORD 4520 017020 7004 RAL 4521 017021 1052 TAD AC1L 4522 017022 1047 TAD OVER 4523 017023 3047 DCA OVER 4524 017024 7004 RAL 4525 017025 1331 TAD DVSR 4526 017026 5350 JMP DVCK /CHECK FOR SUCCESS AGAIN 4527 ///// 4528 4529 017027 0000 DVSB, 0 /MULTIPLY QUOTIENT*DIVISOR 4530 017030 4567 EMSWP /AND SUBTRACT FROM DIVIDEND 4531 017031 7420 SNL 4532 017032 7001 IAC /ADD IN THE PREVIOUS CARRY 4533 017033 4513 EMMUY 4534 017034 0000 QUOT, 0 4535 017035 4567 EMSWP /GET BITS FOR THIS POSITION 4536 017036 7141 CLL CIA 4537 017037 1645 TAD I NORM /SUBTRACT FROM THE DIVIDEND 4538 017040 3645 DCA I NORM 4539 017041 7060 CMA CML 4540 017042 1245 TAD NORM /BACKUP AND REVERSE THE LINK 4541 017043 3245 DCA NORM 4542 017044 5627 JMP I DVSB /CALLED TWELVE TIMES 4543 /THIS NORMALIZE ROUTINE WORKS FOR BOTH POSITIVE & NEGATIVE 4544 /NUMBERS, PRESERVING THE VALUE OF 'SIGN' FOR USE LATER ON. 4545 4546 017045 0000 NORM, 0 /NORMALIZE THE FLAC - 'NORMALIZE' 4547 017046 7330 SM0 /=4000 4548 017047 0045 AND HORD 4549 017050 3015 DCA XRT2 /SIGN BIT 4550 017051 1045 TAD HORD 4551 017052 7450 SNA 4552 017053 1046 TAD LORD 4553 017054 7450 SNA 4554 017055 1047 TAD OVER 4555 017056 7640 SZA CLA /MANTISSA=0 ? 4556 017057 5266 JMP NORGO 4557 017060 3044 DCA EXP 4558 017061 5645 JMP I NORM /YES 4559 4560 017062 4556 NORML, SHIFTL /ONE BIT AT A TIME 4561 017063 7040 CMA 4562 017064 1044 TAD EXP 4563 017065 3044 DCA EXP 4564 017066 1045 NORGO, TAD HORD 4565 017067 7004 RAL 4566 017070 1015 TAD XRT2 /COMPARE SIGN & BIT 1 4567 017071 7700 SMA CLA /ARE THEY DIFFERENT ? 4568 017072 5262 JMP NORML /NOT YET 4569 4570 017073 7330 SM0 /CHECK FOR 4000 ..... 4571 017074 1045 TAD HORD 4572 / SNA 4573 / TAD OVER 4574 017075 7650 SNA CLA 4575 017076 4646 JMS I NORM+1 /SHIFT IT BACK A BIT 4576 017077 5645 JMP I NORM 4577 ///// 4578 017100 1060 TAD BUFR 4579 017101 3017 DCA AXOUT /SET 'TEXTP' 4580 017102 3021 DCA XCT /CONTINUE LINEFEED 4581 017103 1005 TAD CCR /START WITH A CR 4582 017104 4534 PRINTC 4583 017105 1502 TAD I C200 /THEN PRINT A STAR 4584 017106 2547 ISZ I DMPSW /PREVENT STUTTERING 4585 017107 4534 LFCONT, PRINTC /RETYPE THE INPUT LINE 4586 017110 4541 GETC 4587 017111 1016 TAD AXIN 4588 017112 7041 CIA /THROUGH THE CURRENT POSITION 4589 017113 1017 TAD AXOUT 4590 017114 7710 SPA CLA 4591 017115 5307 JMP LFCONT 4592 017116 1043 TAD T3 /CHECK FOR AN EXTRA CHARACTER 4593 017117 7710 SPA CLA 4594 017120 4534 PRINTC 4595 017121 7040 CMA 4596 017122 1016 TAD AXIN 4597 017123 5405 JMP I CCR /RESET PACKING POINTERS 4598 017124 3415 DVLP, DCA I XRT2 /ONLY 2 TIMES: XRT, THEN XRT2!! 4599 017125 1046 TAD LORD 4600 017126 3010 DCA SAVMQ /LOAD 24 BITS OF THE DIVIDEND 4601 017127 1045 TAD HORD 4602 017130 4516 EMDVI /CALLED THREE TIMES 4603 017131 0000 DVSR, 0 /THE TRIAL DIVISOR 4604 017132 7240 STA /SET TO THE MAXIMUM 4605 017133 7420 SNL /DIVIDE CHECK? 4606 017134 4567 EMSWP /GET THE ANSWER 4607 017135 3234 DCA QUOT /SAVE THE PARTIAL QUOTIENT 4608 4609 017136 3050 DCA EX1 /CLEAR THE GUARD WORD 4610 017137 1612 TAD I DADJ+1 /INITIALIZE THE WORD POINTER 4611 017140 3245 DCA NORM 4612 017141 1053 TAD OVR1 /FORM: DIVIDEND-QUOT*DIVISOR 4613 017142 4227 JMS DVSB 4614 017143 1052 TAD AC1L 4615 017144 4227 JMS DVSB 4616 017145 1331 TAD DVSR 4617 017146 4227 JMS DVSB 4618 017147 4227 JMS DVSB /FINISH PROCESSING DVSR 4619 4620 017150 1046 DVCK, TAD LORD /CHECK FOR SUCCESS 4621 017151 7420 SNL 4622 017152 5211 JMP DADJ /TOO BIG, CORRECT QUOTIENT 4623 017153 3045 DCA HORD /SHIFT THE REMAINDER LEFT 4624 017154 1047 TAD OVER 4625 017155 3046 DCA LORD 4626 017156 1050 TAD EX1 /THE 'GUARD WORD' 4627 017157 3047 DCA OVER 4628 017160 1234 TAD QUOT 4629 017161 2437 ISZ I RESOL /CHECK THE LOOP COUNTER 4630 017162 5324 JMP DVLP 4631 4632 017163 3047 DCA OVER /SAVE THE FULL QUOTIENT 4633 017164 1015 TAD XRT2 4634 017165 3046 DCA LORD 4635 017166 1014 TAD XRT 4636 017167 7500 SMA /CHECK THE 'SIGN' BIT 4637 017170 5375 JMP .+5 /OK, SAVE HORD 4638 017171 3045 DCA HORD 4639 017172 4773 JMS I .+1 /SHIFT RIGHT A BIT 4640 017173 7330 SM0 /POINTS TO 'DIV2' 4641 017174 1045 TAD HORD /CLEAR THE SIGN BIT 4642 017175 3045 DCA HORD 4643 017176 5777 JMP I (DVXIT /CONCLUDE EAE DIVIDE 4644 4645 017177 6710 PAGE 4646 *CLA / FOR 'FLEX' 4647 017200 0000 0 / FLOP -> FLAC 4648 017201 1050 TAD EX1 4649 017202 3044 DCA EXP 4650 017203 1051 TAD AC1H 4651 017204 3045 DCA HORD 4652 017205 1052 TAD AC1L 4653 017206 3046 DCA LORD 4654 017207 1053 TAD OVR1 4655 017210 3047 DCA OVER 4656 017211 5600 JMP I CLA 4657 ///// 4658 4659 017212 0000 ALIGN, 0 /SUBROUTINE TO LINE THINGS UP 4660 017213 1051 TAD AC1H /IS THE OPERAND ZERO? 4661 017214 7650 SNA CLA 4662 017215 5612 JMP I ALIGN /DON'T WASTE ANY TIME 4663 4664 017216 1045 TAD HORD /IS FLAC ZERO ? 4665 017217 7450 SNA 4666 017220 1046 TAD LORD 4667 017221 7650 SNA CLA 4668 017222 5375 JMP OSHFT /YES, FLOP -> FLAC 4669 4670 017223 1050 TAD EX1 /ARE THE EXPONENTS EQUAL? 4671 017224 7041 CIA 4672 017225 1044 TAD EXP 4673 017226 7450 SNA 4674 017227 5250 JMP AOK /YES, SO THERE'S NOTHING TO DO 4675 017230 3200 DCA CLA 4676 017231 1200 TAD CLA /SAVE AND CHECK THE DIFFERENCE 4677 017232 7500 SMA 4678 017233 7041 CIA /NEGATE FOR LOOPING 4679 017234 3041 DCA T1 4680 017235 1041 TAD T1 /CAN THEY BE ALIGNED? 4681 017236 1076 ALC, TAD P43 /'P27' FOR 3-WORD VERSION 4682 017237 7710 SPA CLA 4683 017240 5365 JMP NOWAY /NO, USE THE BIGGEST ONE 4684 4685 017241 1200 TAD CLA /YES, WHICH ONE IS BIGGER? 4686 017242 7500 SMA 4687 017243 4306 JMS DIV1 /FLAC 4688 017244 7510 SPA 4689 017245 4330 JMS DIV2 /FLOP 4690 017246 2041 ISZ T1 4691 017247 5241 JMP .-6 /REPEAT 4692 017250 2212 AOK, ISZ ALIGN 4693 017251 5612 JMP I ALIGN 4694 ///// 4695 017252 4330 JMS DIV2 /OPERANDS HAVE THE SAME SIGN 4696 017253 4306 JMS DIV1 /SO SHIFT THEM RIGHT ONCE AND 4697 017254 7010 RAR 4698 017255 1330 TAD DIV2 /ADD THE LEAST-SIGNIFICANT BITS 4699 017256 7204 CLA RAL 4700 017257 5361 JMP FLNR-1 /THEN ADD THE REST 4701 /TURN THE FLOATING ACCUMULATOR INTO A 24-BIT INTEGER WITH 4702 /THE LEAST MOST SIGNIFICANT 12 BITS IN THE AC UPON RETURN 4703 4704 4705 017260 0000 INTEGER,0 /'FIXIT' 4706 017261 1301 TAD P27 4707 017262 4270 JMS FIXER /CONVERT TO A 24-BIT INTEGER 4708 017263 3047 DCA OVER /CLEAR THE FRACTION 4709 017264 4437 JMS I RESOL 4710 017265 7100 CLL /VERY USEFUL! 4711 017266 1046 TAD LORD 4712 017267 5660 JMP I INTEGER 4713 ///// 4714 4715 017270 0000 FIXER, 0 /FIX UP A FLOATING POINT NUMBER 4716 017271 3050 DCA EX1 /SAVE THE DESIRED BINARY POINT 4717 017272 1044 TAD EXP 4718 017273 7750 SPA SNA CLA /IS IT GREATER THAN ONE? 4719 017274 5303 JMP NOFIX /NO, RETURN ZERO 4720 017275 4436 JMS I ABSOL /NECESSARY FOR NEG. VALUES 4721 017276 3051 DCA AC1H 4722 017277 1045 TAD HORD /IGNORE UNNORMALIZED NUMBERS 4723 017300 4212 JMS ALIGN /DO IT... 4724 017301 0027 P27, 27 4725 017302 5670 JMP I FIXER /DONE 4726 4727 017303 4552 NOFIX, FLOAT /STUFF WITH ZEROS 4728 017304 3044 DCA EXP 4729 017305 5670 JMP I FIXER 4730 ///// 4731 4732 *CLA CLL RTL /FOR 'FRA' 4733 4734 017306 0000 DIV1, 0 /SHIFT FLOP RIGHT 4735 017307 7210 CLA RAR 4736 017310 3330 DCA DIV2 4737 017311 1051 TAD AC1H 4738 017312 7510 SPA 4739 017313 7020 CML 4740 017314 7010 RAR 4741 017315 3051 DCA AC1H 4742 017316 1052 TAD AC1L 4743 017317 7010 RAR 4744 017320 3052 DCA AC1L 4745 017321 1053 TAD OVR1 4746 017322 7010 RAR 4747 017323 3053 DCA OVR1 4748 017324 2050 ISZ EX1 4749 017325 5706 JMP I DIV1 4750 017326 5706 JMP I DIV1 4751 ///// 4752 017327 6403 FP3, FPNT+3 4753 *SM0 /FOR NORMALIZE, DIVIDE 4754 017330 0000 DIV2, 0 /SHIFT FLAC RIGHT 4755 017331 7300 CLA CLL 4756 017332 1045 TAD HORD 4757 017333 7510 SPA 4758 017334 7020 CML 4759 017335 7010 RAR 4760 017336 3045 DCA HORD 4761 017337 1046 TAD LORD 4762 017340 7010 RAR 4763 017341 3046 DCA LORD 4764 017342 1047 TAD OVER 4765 017343 7010 RAR 4766 017344 3047 DCA OVER 4767 017345 2044 ISZ EXP 4768 017346 5730 JMP I DIV2 4769 017347 5730 JMP I DIV2 4770 ///// 4771 4772 017350 6751 REVERS 4773 017351 4750 FLSB, JMS I .-1 /FSUB=2 - NEGATE THE OPERAND 4774 017352 4212 FLAD, JMS ALIGN /FADD=1 - ALIGN EXPONENTS 4775 017353 5727 JMP I FP3 /NOT POSSIBLE 4776 017354 7330 SM0 4777 017355 0045 AND HORD /COMPARE SIGNS 4778 017356 1051 TAD AC1H 4779 017357 7700 SMA CLA 4780 017360 5252 JMP AOK+2 /SIMILAR: SHIFT RIGHT ONCE 4781 017361 4777 JMS I (DUBLAD 4782 017362 4435 FLNR, NORMALIZE /FNOR=7 - CALL NORMALIZE 4783 017363 5727 JMP I FP3 4784 ///// 4785 *CLA SM1 /FOR 'ASK' AND EAE DIVIDE 4786 017364 0000 TERM, 0 /INPUT TERMINATOR 4787 4788 017365 7330 NOWAY, SM0 /MISSION IMPOSSIBLE 4789 017366 0050 AND EX1 /POINTER FOR EAE DIVIDE 4790 017367 1044 TAD EXP /FIND OUT WHO'S BIGGEST 4791 017370 7710 SPA CLA 4792 017371 1044 TAD EXP /SIGNS DIFFER: TEST 'EXP' 4793 017372 7450 SNA 4794 017373 1200 TAD CLA /SIGNS EQUAL: CHECK DIFF. 4795 017374 7710 SPA CLA 4796 017375 4200 OSHFT, JMS CLA /EX1 > EXP 4797 017376 5612 JMP I ALIGN /EXP > EX1 4798 4799 017377 6244 PAGE 4800 /LIBRARY AND FILE COMMAND PROCESSOR: 4801 4802 /****** STORAGE ALLOCATION MAP ****** 4803 /***** ***** 4804 /* 1200 2ND INPUT BUFFER 4805 /* 1600 THE OUTPUT BUFFER 4806 /* 2200 STACK LIVES HERE 4807 /* 3000 PUSHDOWN ROUTINES 4808 /* 3200 MAIN INPUT BUFFER 4809 /* 3600 MAIN INPUT HANDLER 4810 /* 4200 THE LIBRARY HANDLER 4811 /* 4600 THE OUTPUT HANDLER 4812 /* 5200 2ND INPUT HANDLER 4813 /* 4814 /* 5600 FILE OUTPUT, CLOSE & ABORT 4815 /* 6000 OPEN, RESTORE & FILE INPUT 4816 /* 6200 TABULATE, HANDLER & SETDHT 4817 /* 6400 DECODER, DATER, SAVER, GOSUB 4818 /* 6600 RUN,CALL,BRANCH,RETURN,LJUMP 4819 /* 7000 LIBRARIAN, IOWAIT 4820 /* 7200 OPEN, DISMISS & COMPARE 4821 /* 7400 GTNAME 4822 /***** ***** 4823 /************************************ 4824 4825 / INITIAL TEXT FOR U/W-FOCAL 4826 4827 FIELD 2 4828 PAGE 1 4829 020200 0000 0 /PROGRAM LENGTH 4830 020201 5051 5051 /'()' FOR TDUMP 4831 020202 0000 LINE0, 0 /POINTER TO NEXT 4832 020203 0000 0 /LINE NO. ZERO 4833 020204 0340 TEXT "C U/W-FOCAL:" 020205 2557 020206 2755 020207 0617 020210 0301 020211 1472 020212 0000 4834 020213 2605 TITLE, TEXT "VER-4E" /'?M'=CODED CR 020214 2255 020215 6405 020216 0000 4835 020217 6165 DATE, TEXT "15.10.78?M" 020220 5661 020221 6056 020222 6770 020223 7715 020224 0000 4836 LINE1= DATE+5 /NULLS BECOME SPACES 4837 4838 *100 4839 020100 0000 ZBLOCK 2 /PC0 FOR COMMAND MODE 020101 0000 4840 /PAGE ZERO STORAGE HAS BEEN CAREFULLY ARRANGED ! 4841 4842 FIELD 0 4843 PAGE 0 4844 4845 000000 5400 INITLZ /INTERRUPT SERVICE ROUTINE 4846 000001 6212 CIF P 4847 000002 5577 JMP I [INTRPT /PATCH 177 FOR POWER FAIL 4848 4849 000003 6244 PRNTC, RMF /RETURN FROM THE INTERRUPT 4850 000004 6001 I0N 4851 000005 5600 CL0SE, 5600 /'JMP I 0' 4852 4853 000006 7700 USR, 7700 //POINTER TO MONITOR (200 IF IN CORE) 4854 000007 0077 K77, 77 //LOCATION 7 FOR PLOTTER ROUTINES 4855 4856 000010 0000 AUTO, ZBLOCK 4 /AUTO-INDEX REGISTERS 000011 0000 000012 0000 000013 0000 4857 4858 000014 6114 ICHARX, ICHAR0 /USE THE REMAINING ONES 4859 000015 3315 OFFSET, ICHAR-XI33 /FOR THE EXTRA FEATURES 4860 000016 2114 SCHARX, SCHAR0-ICHAR0 4861 4862 *20 4863 000020 4552 NONAME, LPUSHF /INSERT VERSION NO. AFTER 'ERASE' 4864 000021 0045 H0RD, VERSION 4865 000022 4551 LPOPF 4866 000023 0066 XCHAR, NAMLOC-1 /STRATEGICALLY LOCATED! 4867 000024 7324 IOWAIT, SP1 /POINTER TOO! 4868 000025 3036 DCA GOSW /SET RETURN POINTER 4869 000026 4106 JMS TEMP /THEN UPDATE HEADER 4870 000027 3077 DCA LIBFLG /ZAP 'PROGRAM SAVED' FLAG 4871 000030 1036 TAD GOSW /RETURN FOR LOAD CALLS 4872 000031 1044 EXIT, TAD GOJUMP /NORMAL RETURNS='JMP I (PROC' 4873 000032 3036 DCA GOSW 4874 000033 4545 DISMISS /REMOVE THE USR 4875 000034 6213 CDI P 4876 000035 6001 I0N 4877 4878 000036 0176 GOSW, [DERR /LOWER FIELD ERROR ROUTINE 4879 000037 4545 DISMISS /CLEARS AC (JMP 135) 4880 000040 1036 TAD GOSW /(RELOCATE FOR LINC INTERRUPTS) 4881 000041 6213 CDI P 4882 000042 3575 DCA I [ERROR /SIMULATE A 'JMS' 4883 000043 5574 JMP I [ERROR+1 4884 000044 5452 GOJUMP, JMP I K177-1 /PLUS (GOSW) 4885 4886 *HORD 4887 000045 6166 VERSION,TEXT "16K-V4" 000046 1355 000047 2664 000050 0000 4888 000051 0647 LGOSUB /-1 4889 000052 0755 CONT / 0 4890 000053 0177 K177, START /+1 4891 000054 0611 GOTO+1 /+2 4892 4893 000055 0000 NEWDEV, ZBLOCK 4 /'NEWDEV-1'='TELSW' 000056 0000 000057 0000 000060 0000 4894 FLNGTH= .-2 4895 STBLK= .-1 /'LIBBLK-1'='BUFR' 4896 4897 000061 0000 LIBBLK, ZBLOCK 2 /FOR DEVICE NAME 000062 0000 4898 000063 4201 4201 /LOAD POINT 4899 000064 0000 DEVNO, 0 /FOR DEVICE # 4900 000065 2546 LIBHND, ERTRAP /HANDLER ENTRY 4901 4902 000066 0173 CHAR, [7200 /LOWER FIELD COPY 4903 000067 0000 NAMLOC, ZBLOCK 4 /(MUST BE 'CHAR+1') 000070 0000 000071 0000 000072 0000 4904 EXTENSION=.-1 4905 000073 5723 DSK, 5723 /HASH CODE FOR DEFAULT DEVICE 4906 4907 000074 0000 LIBDEV, ZBLOCK 4 000075 0000 000076 0000 000077 0000 4908 LIBFLG= .-1 /REFERENCE VIA P77 4909 4910 *100 4911 000100 0000 PC0, 0 /ENTRY AND RESTART POINT 4912 000101 5400 JMP I 0 /INITIALIZE (ONCE ONLY) 4913 000102 7301 SWAP, CLA CLL IAC /POINTER TO SWAP ROUTINE 4914 000103 5031 JMP EXIT 4915 *.+2 /FOR COMPATIBILITY 4916 000106 0172 TEMP, [7400 /UPDATE THE HEADER 4917 000107 6222 CIF T 4918 000110 5021 JMP NUHEAD+1 4919 4920 000111 0000 SINBLK, ZBLOCK 2 000112 0000 4921 000113 5201 5201 /4201 PATCHED BY PLOT 4922 000114 0000 0 4923 000115 0000 SINHND, 0 4924 000116 0000 SPOINT, 0 4925 000117 0216 D, DATE-1 4926 000120 0067 XNAME, NAMLOC 4927 4928 000121 0000 INBLK, ZBLOCK 2 000122 0000 4929 000123 3601 3601 4930 000124 0000 0 4931 000125 0036 INHND, GOSW /REREAD TRAP 4932 4933 000126 0000 OUTBLK, ZBLOCK 2 000127 0000 4934 000130 4601 4601 4935 000131 0000 FILDEV, 0 4936 000132 0000 OUTHND, 0 4937 000133 0000 OUTFLG, 0 4938 4939 *PRINTC&177 4940 ERROR0= JMS I . /='PRINTC' 4941 000134 3137 TRAP 4942 ERROR1= JMS GOSW 4943 /SECONDARY INPUT ROUTINES: THE 'O S' AND 'O R S' COMMANDS 4944 4945 /IN THE ABSENCE OF THE PLOTTER ROUTINES THERE ARE NO RE- 4946 /STRICTIONS ON THE SECOND INPUT FILE, BUT THE ADDITION OF 4947 /THESE ROUTINES LIMITS THE 'L' COMMANDS TO THE USE OF THE 4948 / DEVICE - OR ANY HANDLER CO-RESIDENT WITH THE SYS- 4949 /TEM DEVICE, SUCH AS 'RKB0', OR 'DTA1' IN A 'TD8E' SYSTEM. 4950 4951 *200 4952 000200 7140 SINPUT, CLL CMA /USE THE REGULAR LOOKUP ROUTINE 4953 000201 4573 JMS I [OPEN 4954 000202 0110 SINBLK-1 4955 000203 4534 ERROR0 /FILE MISSING 4956 000204 5623 JMP I CRT /PATCHED BY SCOPE OVERLAY 4957 000205 1060 TAD STBLK 4958 000206 3236 DCA SBLK 4959 000207 7164 SM1 4960 000210 3227 DCA SINFLG 4961 4962 000211 1227 SRST, TAD SINFLG 4963 000212 7650 SNA CLA 4964 000213 4534 ERROR0 /NOTHING LEFT 4965 000214 1016 TAD SCHARX 4966 *CR 4967 000215 1014 TAD ICHARX /ENTRY POINT FOR 'O I', 'O R I' 4968 000216 6211 CDF P 4969 000217 3621 DCA I INP /CHANGE THE FILE INPUT POINTER 4970 000220 5622 JMP I TTY 4971 4972 000221 6322 INP, FILIN 4973 000222 6066 TTY, TTYIN-1 4974 000223 6067 CRT, TTYIN /OR 'OSCOPE' 4975 000224 6160 END, ENDCHK 4976 4977 000225 0000 SEND, 0 /POINTS TO NEXT STEP 4978 000226 4624 JMS I END /CHECK FOR THE EOF 4979 000227 0000 SINFLG, 0 /'FILE OPEN' FLAG 4980 4981 000230 2227 SCHAR0, ISZ SINFLG /BUFFER EMPTY? 4982 000231 5625 JMP I SEND /NO, GET THE NEXT CHARACTER 4983 000232 6002 I0F 4984 000233 4515 JMS I SINHND /READ ANOTHER BLOCK 4985 000234 0200 0200 4986 000235 1200 1200 /2200 PATCHED BY PLOT 4987 000236 0000 SBLK, 0 4988 000237 7700 SMA CLA /FATAL ERROR? 4989 000240 7610 SKP CLA 4990 000241 5576 JMP I [DERR 4991 000242 1173 TAD [-600 4992 000243 3227 DCA SINFLG /RESET THE WORD COUNTER 4993 000244 2236 ISZ SBLK /ADVANCE THE BLOCK NO. 4994 000245 1235 TAD SBLK-1 4995 000246 3116 DCA SPOINT /AND RESTART FROM THE TOP 4996 000247 6001 I0N 4997 000250 1516 SCHAR1, TAD I SPOINT /UNPACK THE BUFFER 4998 000251 4225 JMS SEND 4999 5000 000252 1516 TAD I SPOINT /SAVE UPPER 4 BITS 5001 000253 0172 AND [7400 5002 000254 3635 DCA I SBLK-1 5003 000255 2116 ISZ SPOINT /POINT TO THE NEXT 5004 000256 1516 TAD I SPOINT 5005 000257 4225 JMS SEND 5006 5007 000260 1516 TAD I SPOINT /NOW TO PUT THE PIECES 5008 000261 2116 ISZ SPOINT /ALL TOGETHER AGAIN 5009 000262 0172 AND [7400 5010 000263 7112 CLL RTR 5011 000264 7012 RTR 5012 000265 1635 TAD I SBLK-1 5013 000266 7012 RTR 5014 000267 7012 RTR 5015 000270 4225 JMS SEND 5016 000271 5250 JMP SCHAR1 /ROUND & ROUND & ROUND WE GO 5017 ///// 5018 5019 000272 3021 LPTDEV, XOUTL; ZBLOCK 2 /CHANGE THESE 3 LOCATIONS TO THE 000273 0000 000274 0000 5020 /DEVICE LPT /ENTRY POINT AND THE DEVICE NAME 5021 5022 000275 0171 LPTCHK, [PDLXR /CHECK FOR CALLS TO 'LPT:' 5023 000276 7344 SM2 5024 000277 4547 COMPAR /NOW CHECK IT 5025 000300 0272 LPTDEV 5026 000301 0054 NEWDEV-1 5027 000302 5675 JMP I LPTCHK /NOT WHAT WE'RE LOOKING FOR 5028 000303 2275 ISZ LPTCHK /RETURN WITH THE ENTRY POINT 5029 000304 1272 TAD LPTDEV /(INSERT OTHER CODE HERE - FOR EX: 5030 000305 5675 JMP I LPTCHK /A CHECK FOR THE ',E' OPTION,ETC.) 5031 /THE STACK, TTY BUFFER & ERROR TRAP ALL LIVE HERE 5032 5033 *3024 /BEGINNING OF THE STACK 5034 5035 003024 0170 PCHK, ["0 /STACK OVERFLOW CHECK 5036 003025 6211 CDF P 5037 003026 1571 TAD I [PDLXR /ADJUST FIELD 1 X-REGISTER 5038 003027 3013 DCA PDLXR /BACKUP & COPY 5039 003030 1013 TAD PDLXR 5040 003031 3571 DCA I [PDLXR 5041 003032 1013 TAD PDLXR /CHECK FOR OVERFLOW 5042 003033 7161 STL CIA 5043 003034 1377 TAD (2200 /2600 PATCHED BY PLOT 5044 003035 6203 CDI L 5045 003036 7770 SPA SNA SZL CLA /-10 = L-P 5046 003037 5624 JMP I PCHK 5047 003040 1235 PDERR, TAD .-3 /TOO BAD! 5048 003041 5032 JMP EXIT+1 /USE 'CDI L' AS THE ERROR CODE 5049 5050 003042 0000 MPUSHF, 0 /PUSH 4 WORDS ON THE STACK 5051 003043 1236 TAD PDERR-2 /LOWER FIELD ENTRY 5052 003044 1225 TAD PCHK+1 /UPPER FIELD ENTRY 5053 003045 3256 DCA FCDF 5054 003046 7140 CLL CMA 5055 003047 1642 TAD I MPUSHF /BACKUP POINTER 5056 003050 2242 ISZ MPUSHF 5057 003051 3010 DCA AUTO 5058 003052 1167 TAD [-4 5059 003053 4224 JMS PCHK 5060 003054 1167 TAD [-4 5061 003055 3224 DCA PCHK 5062 003056 6211 FCDF, CDF L P /CHANGE TO CALLING FIELD 5063 003057 1410 TAD I AUTO 5064 003060 6201 CDF S 5065 003061 3413 DCA I PDLXR /LOAD STACK 5066 003062 2224 ISZ PCHK 5067 003063 5256 JMP FCDF /WITH FOUR WORDS 5068 003064 7326 SP2 5069 003065 1256 TAD FCDF /CHANGE 'CDF' TO 'CDI' 5070 003066 3267 DCA .+1 5071 003067 6213 CDI L P 5072 003070 5642 JMP I MPUSHF 5073 5074 003071 3320 APUSHX, DCA MPOPF /PUSH THE AC ON THE STACK 5075 003072 7164 SM1 5076 003073 4224 JMS PCHK 5077 003074 1320 TAD MPOPF 5078 003075 3413 DCA I PDLXR 5079 003076 6213 CDI P 5080 003077 5776 JMP I (XPUSHA+3 /ONLY USED BY FIELD 1 5081 *.&7757 5082 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 5083 5084 003120 0000 MPOPF, 0 /POP 4 WORDS 5085 003121 1720 TAD I MPOPF 5086 003122 3010 DCA AUTO 5087 003123 4224 JMS PCHK /COPY THE PDLXR 5088 003124 1167 TAD [-4 5089 003125 3224 DCA PCHK 5090 003126 1413 TAD I PDLXR 5091 003127 3410 DCA I AUTO 5092 003130 6211 CDF P 5093 003131 2571 ISZ I [PDLXR /FAKE A FIELD 1 USE 5094 003132 6201 CDF L 5095 003133 2224 ISZ PCHK 5096 003134 5326 JMP .-6 5097 003135 2320 ISZ MPOPF 5098 003136 5720 JMP I MPOPF 5099 5100 003137 0000 TRAP, 0 /RECOVER FROM SELETED ERRORS 5101 003140 4545 DISMISS 5102 003141 1337 TAD TRAP 5103 003142 3036 DCA GOSW /ASSUME NORMAL ERROR EXIT 5104 003143 7326 SP2 5105 003144 6211 CDF P 5106 003145 2775 ISZ I (NAGSW /WAS A LINE NUMBER GIVEN? 5107 003146 5031 JMP EXIT /YES, FALL INTO THE TRAP 5108 003147 5037 JMP GOSW+1 /NO, DO THE USUAL STUFF 5109 5110 003150 0000 REKOVR, 0 /CONTINUATION OF ERROR ROUTINE 5111 003151 6032 KCC 5112 003152 1374 TAD (-17 5113 003153 3300 DCA TBUF 5114 003154 1373 TAD (TBUF 5115 003155 3013 DCA PDLXR 5116 003156 3413 DCA I PDLXR /CLEAR OUT THE TTY BUFFER 5117 003157 2300 ISZ TBUF 5118 003160 5356 JMP .-2 5119 003161 1502 TAD I SWAP /CHECK CORE-SWAP FLAG 5120 003162 7650 SNA CLA 5121 003163 4502 JMS I SWAP /RESTORE THE SCRATCH AREA 5122 003164 1166 TAD [CR /PRINT A CR AHEAD OF ERROR MESSAGE 5123 003165 7200 CLA /OR 'JMS I PRNTC' 5124 003166 1350 TAD REKOVR /LET 'EOF' RESTORE THE TTY 5125 003167 6213 CDI P 5126 003170 3565 DCA I [EOF 5127 003171 5772 JMP I (EOF+1 /THEN GO PRINT THE ERROR MESSAGE 5128 5129 003172 6344 PAGE 26 003173 3100 003174 7761 003175 0070 003176 1336 003177 2200 5130 /INITIALIZE THE VARIABLES AND THE DATE 5131 5132 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 5133 5134 005420 6254 SM8 /PATCH FOR MULTI-8 5135 005421 5225 JMP .+4 5136 005422 6770 6770 /GET THE TIME-OF-DAY 5137 005423 4653 JMS I MV1 /REVERSE HRS, MINUTES 5138 005424 3247 DCA MV1-4 /INITIALIZE RANDOM NO. 5139 5140 005425 1230 TAD .+3 5141 005426 4353 JMS MOVE /LOAD COMMAND DECODER AREA 5142 005427 7755 .+1-MV1 5143 RELOC RANDOM-16 5144 5145 007624* 7623 PUTV, .-1 /SUBROUTINE TO LOCATE VARIABLES 5146 007625* 3063 DCA THISOP /SAVE THE NAME 5147 007626* 3046 DCA LORD /CLEAR SUBSCRIPT 5148 007627* 4522 PUSHJ 5149 007630* 1434 GS1 /DO THE LOOKUP 5150 007631* 4525 POPF 5151 007632* 0044 FLAC /GET THE VALUE 5152 007633* 4407 FENT 5153 007634* 6400 FPUTIPT1 /STORE IT 5154 007635* 0000 FEXT 5155 007636* 1061 TAD LASTV /ADVANCE THE POINTER 5156 007637* 3031 DCA FIRSTV 5157 007640* 6202 CIF L 5158 007641* 5624 JMP I PUTV /RETURN 5159 5160 007642* 0000 RANDOM, 0;4421;3040;1;0 /RANDOM ENOUGH? 007643* 4421 007644* 3040 007645* 0001 007646* 0000 5161 RELOC 5162 5163 005453 7164 MV1, SM1 /SET THE ADDRESS POINTERS 5164 005454 1777 TAD I (FIRSTV /USING THE VALUE HERE 5165 005455 3776 DCA I (SECRTV 5166 005456 1777 TAD I (FIRSTV 5167 005457 3775 DCA I (LASTV 5168 005460 4337 JMS SETV /CALL OUR FIELD 1 ROUTINE 5169 005461 5533 PI;2011 005462 2011 5170 005463 7326 SP2 5171 005464 1775 TAD I (LASTV 5172 005465 3774 DCA I (DIMEN /FOR DOUBLE SUBSCRIPTING 5173 005466 4337 JMS SETV 5174 005467 3100 FPZ;4100 /! 005470 4100 5175 005471 4337 JMS SETV 5176 005472 3100 FPZ;4200 /" 005473 4200 5177 005474 7326 SP2 5178 005475 1775 TAD I (LASTV 5179 005476 3773 DCA I (FSFP /FOR FSF'S 5180 005477 4337 JMS SETV 5181 005500 3100 FPZ;4300 /# 005501 4300 5182 005502 4337 JMS SETV 5183 005503 3100 FPZ;4400 /$ 005504 4400 5184 005505 4337 JMS SETV 5185 005506 3100 FPZ;4500 /% 005507 4500 5186 005510 5325 JMP FINALZ /'NOP' FOR MORE 5187 005511 4337 JMS SETV 5188 005512 3100 FPZ;4600 /& 005513 4600 5189 005514 4337 JMS SETV 5190 005515 3100 FPZ;7200 /: 005516 7200 5191 005517 4337 JMS SETV 5192 005520 3100 FPZ;3400 /\ 005521 3400 5193 005522 5325 JMP .+3 /SINGLE QUOTE IS OUT 5194 005523 3100 FPZ;4700 /' 005524 4700 5195 5196 005525 6222 FINALZ, CIF T 5197 005526 4772 JMS I (DATA /SET THE DATE WORDS 5198 005527 4771 JMS I (ENVIR /CHECK THE ENVIRONMENT 5199 005530 6031 KSF /KEYBOARD INPUT? 5200 005531 5020 JMP NONAME /NO 5201 005532 5102 JMP SWAP /YES: LEAVE VERSION ID 5202 5203 FPZ= TBUF /FLOATING POINT ZERO 5204 005533 0002 PI, 2;3110;3755;2421 005534 3110 005535 3755 005536 2421 5205 005537 0000 SETV, 0 /CROSS-FIELD CALL 5206 005540 6201 CDF L 5207 005541 1737 TAD I SETV /GET THE DATA VALUE 5208 005542 2337 ISZ SETV 5209 005543 3345 DCA .+2 5210 005544 4552 LPUSHF /SAVE IT ON THE STACK 5211 005545 0000 0 5212 005546 1737 TAD I SETV /NOW GET THE NAME 5213 005547 2337 ISZ SETV 5214 005550 6213 CDI P 5215 005551 4770 JMS I (PUTV /AND INSERT IT 5216 005552 5737 JMP I SETV /DF=P 5217 5218 005553 0000 MOVE, 0 /CLEVER LITTLE ROUTINE 5219 005554 3010 DCA AUTO 5220 005555 1753 TAD I MOVE 5221 005556 3101 DCA PC0+1 5222 005557 2353 ISZ MOVE 5223 005560 6201 CDF L 5224 005561 1753 TAD I MOVE /WHERE ITS AT 5225 005562 6211 CDF P 5226 005563 3410 DCA I AUTO /WHERE ITS GOING 5227 005564 2101 ISZ PC0+1 /COVER OUR TRACKS 5228 005565 5357 JMP MOVE+4 5229 005566 2353 ISZ MOVE 5230 005567 5753 JMP I MOVE /DF=P 5231 5232 005570 7624 PAGE 15 005571 3202 005572 0126 005573 7511 005574 5777 005575 0061 005576 0032 005577 0031 5233 5234 /CHECK THE RUN-TIME ENVIRONMENT: 5235 5236 003200 7777 7777 /BIPCCL POINTER 5237 003201 3010 XI33+1 /RELOCATION POINTER 5238 003202 0000 ENVIR, 0 5239 003203 1600 TAD I ENVIR-2 /ARE WE RUNNING UNDER SOMETHING? 5240 003204 7006 RTL /2000=BATCH, 1000=RTS8 5241 003205 7720 SNL SMA CLA /EITHER BATCH OR RTS8? 5242 003206 5342 JMP VIDEO /NO, CHECK SCOPE MODE 5243 003207 1201 TAD ENVIR-1 /GET RELOCATION POINTER 5244 003210 4622 JMS I .+12 /CHANGE TO NON-INTERRUPT I/O 5245 003211 7732 .+1-MV2 5246 RELOC XI33+2 5247 /XI33, 0 5248 / KSF /ANY INPUT? 5249 003011* 5210 JMP .-1 /WAIT UNTIL THERE IS 5250 003012* 4237 JMS KCHK 5251 003013* 1055 TAD INBUF /HERE IT IS 5252 003014* 3221 DCA XOUTL 5253 003015* 6032 KCC 5254 003016* 3055 DCA INBUF /CLEAR INPUT FLAG 5255 003017* 1221 TAD XOUTL 5256 003020* 5607 JMP I XI33 5257 5258 003021* 5553 XOUTL, MOVE 5259 003022* 6046 TLS /THIS IS ALL WE NEED! 5260 003023* 7600 7600 /'CLA' = MONITOR EXIT 5261 003024* 4237 JMS KCHK /CHECK FOR INPUT 5262 003025* 6041 TSF /BUFFER FULL? 5263 003026* 5225 JMP .-1 5264 003027* 5621 JMP I XOUTL 5265 5266 003030* 6203 BYEBYE, CDI /RETURN TO OS/8 5267 003031* 5623 JMP I XOUTL+2 /OR TO BATCH... 5268 003032* 0015 "P-"C 5269 5270 003033* 4237 POPX, JMS KCHK /CHECK INPUT AFTER A 'POPJ' 5271 003034* 5635 JMP I .+1 5272 003035* 1337 XPOPJ 5273 003036* 0203 "C&277 5274 5275 003037* 3033 KCHK, POPX /KEYBOARD CHECK 5276 003040* 6031 KSF 5277 003041* 5637 JMP I KCHK /NOTHING WAITING 5278 003042* 6034 KRS 5279 003043* 0075 AND P177 5280 003044* 7450 SNA 5281 003045* 5637 JMP I KCHK /IGNORE NULLS 5282 003046* 1345 TAD M20 5283 003047* 7450 SNA /CTRL P? 5284 003050* 5347 JMP M20+2 5285 003051* 1232 TAD POPX-1 5286 003052* 7450 SNA /CTRL C? 5287 003053* 5230 JMP BYEBYE 5288 003054* 1236 TAD KCHK-1 /SET PARITY 5289 003055* 3055 DCA INBUF /SAVE THE INPUT 5290 003056* 5637 JMP I KCHK 5291 RELOC 5292 5293 003260 1240 MV2, TAD .-20 /PATCH 'POPJ' 5294 003261 3777 DCA I (POPJ&177 5295 003262 1241 TAD .-21 /MOVE 'KSF' 5296 003263 3601 DCA I ENVIR-1 /INTO PLACE 5297 / DISABLE ALL THE 'IONS' 5298 5299 003264 3574 DCA I [ERROR+1 5300 003265 3776 DCA I (4333 /FRA 5301 003266 6201 CDF L 5302 003267 3035 DCA GOSW-1 5303 003270 3775 DCA I (247 /SINPUT 5304 003271 3774 DCA I (OECHO-1 5305 003272 3773 DCA I (ICHAR1-1 5306 003273 1323 TAD MV3-5 /NOP 5307 003274 3772 DCA I (TAB+10 5308 003275 3771 DCA I (IOWATE+2 5309 5310 / CHECK FOR BATCH 5311 5312 003276 1600 TAD I ENVIR-2 /IS BATCH RUNNING? 5313 003277 7004 RAL 5314 003300 7700 SMA CLA 5315 003301 5342 JMP VIDEO /NO, CHECK SCOPE MODE 5316 003302 1600 TAD I ENVIR-2 5317 003303 0321 AND .+16 /GET THE BATCH FIELD 5318 003304 1322 TAD .+16 /ADD 'CIF' 5319 003305 3322 DCA .+15 /SET UP THE INSTRUCTION 5320 003306 1201 TAD ENVIR-1 /CHANGE TTY TO BATCH I/O 5321 003307 4622 JMS I ENVIR+20 /=MOVE 5322 003310 7761 .+1-MV3 5323 5324 003371 7326 RELOC XI33+2 003372 6215 003373 6133 003374 6102 003375 0247 003376 4333 003377 0123 5325 5326 /XI33, 0 5327 / CIF BF /CHANGE TO THE BATCH FIELD 5328 003011* 4626 JMS I BATIN /READ FROM THE BATCH STREAM 5329 003012* 4576 ERROR2 /NOTHING LEFT! 5330 003013* 1220 TAD XOUTL-1 /CAST OUT LINEFEEDS 5331 003014* 7450 SNA 5332 003015* 5210 JMP XI33+1 5333 003016* 1004 TAD CLF 5334 003017* 5607 JMP I XI33 5335 003020* 7566 -LF 5336 5337 003021* 0070 XOUTL, 70 /OUTPUT TO THE BATCH LOG 5338 003022* 6202 CIF /'PATCHED FOR BATCH' 5339 003023* 7000 7000 /'NOP' = BATCH EXIT 5340 003024* 4627 JMS I BATOUT 5341 003025* 5621 JMP I XOUTL 5342 003026* 5400 BATIN, 5400 5343 003027* 7400 BATOUT, 7400 5344 RELOC 5345 MEMSIZ= CDI T V /SELECT THE HIGHEST FIELD 5346 5347 003330 1322 MV3, TAD .-6 /MOVE THE 'CDI' INSTR 5348 003331 3601 DCA I ENVIR-1 /TO 'XI33+1' 5349 003332 1322 TAD .-10 /AND THEN TO 'BYEBYE' 5350 003333 3770 DCA I (BYEBYE /TO CATCH CTRL/C'S 5351 003334 1254 TAD MV2-4 5352 003335 3767 DCA I (BATXIT /FIX UP THE ERROR ROUTINE 5353 003336 1322 TAD .-14 5354 003337 1366 TAD (-MEMSIZ /CHECK MEMORY SIZE 5355 003340 7750 SPA SNA CLA 5356 003341 4036 ERROR1 /NOT ENOUGH MEMORY! 5357 5358 003342 6211 VIDEO, CDF 10 5359 003343 1765 TAD I (17726 /DO WE HAVE A VIDEO TERMINAL? 5360 003344 0164 AND [200 5361 003345 7650 SNA CLA 5362 003346 5354 JMP .+6 /NO, LEAVE RUBOUT ALONE 5363 003347 1364 TAD (TAD START 5364 003350 3763 DCA I (RUB1+3 5365 003351 1362 TAD (ECHOC /YES, USE 'BS', 'SP', 'BS' 5366 003352 3761 DCA I (RUB1+4 5367 003353 7410 SKP 5368 003354 3760 DCA I (MODLN /REMOVE LINENO PRINTOUT 5369 003355 6201 CDF L 5370 003356 5602 JMP I ENVIR 5371 5372 003360 0402 PAGE 003361 2472 003362 4533 003363 2471 003364 1177 003365 7726 003366 1545 003367 3174 003370 3030 5373 / FILE CLOSING AND OUTPUT ROUTINES 5374 5375 PAGE 27 /'JMP I 0' 5376 5377 005600 0000 CLOSER, 0 /CLOSE OR REMOVE THE FILE 5378 005601 3106 DCA TEMP /SET THE 'CALL' FLAG 5379 005602 1133 TAD OUTFLG /IS THERE AN OPEN FILE? 5380 005603 7650 SNA CLA 5381 005604 5600 JMP I CLOSER /NO, IGNORE THE COMMAND 5382 005605 1312 TAD O2 /WHICH COMMAND? 5383 005606 7650 SNA CLA 5384 005607 5216 JMP REMOVE /'ABORT' 5385 005610 1163 TAD [232 /'CLOSE' 5386 005611 4255 JMS NOCHAR /INSERT A 'CTRL/Z' 5387 005612 7520 GETSIZ, SNL SMA /POINTS TO 'MGETA' 5388 005613 5211 JMP .-2 /AND PAD WITH ZEROS 5389 005614 2106 ISZ TEMP /CHECK CALLING FLAG 5390 005615 5226 JMP NOSIZE 5391 5392 005616 4612 REMOVE, JMS I GETSIZ /GET THE CLOSING LENGTH, IF ANY 5393 005617 7120 STL /ONLY 'O A' & 'O C' HAVE SIZES 5394 005620 1242 TAD OLNGTH /COMPARE WITH THAT AVAILABLE 5395 005621 7660 SNL SZA CLA 5396 005622 4036 ERROR1 /BETTER LUCK NEXT TIME 5397 005623 1562 TAD I [LORD /GET THE SIZE BACK 5398 005624 7440 SZA /ZERO MEANS 'AS IS' 5399 005625 3241 DCA BLKCNT /ENTRY POINT FOR OVERFLOW ERROR 5400 5401 005626 6211 NOSIZE, CDF P /RESTORE OUTPUT TO THE ECHO DEVICE 5402 005627 1561 TAD I [ECODEV 5403 005630 3560 DCA I [OUTDEV /THE USR MUST NOT BE IN CORE! 5404 005631 4424 JMS I IOWAIT /WAIT FOR TELETYPE (RESETS DF) 5405 005632 4565 JMS I [SETDHT /SET THE ENTRY POINT FOR 'CLOSE' 5406 005633 0130 FILDEV-1 / POINTER TO DEVICE # AND ENTRY 5407 005634 6212 CIF 10 5408 005635 1131 TAD FILDEV /SAVED DEVICE NO. 5409 005636 4406 JMS I USR 5410 005637 0004 4 5411 005640 6711 ONMTMP /FILE NAME POINTER 5412 005641 0000 BLKCNT, 0 /CURRENT FILE LENGTH 5413 005642 0000 OLNGTH, 0 /MAXIMUM " " 5414 005643 1133 TAD OUTFLG 5415 005644 7650 SNA CLA 5416 005645 4036 ERROR1 /FILE WAS TOO LONG 5417 005646 3133 DCA OUTFLG /CLEAR THE 'FILE OPEN' FLAG 5418 005647 5600 JMP I CLOSER /ALSO CALLED BY 'SAVE' & 'DELETE' 5419 5420 005650 3312 ABORT, DCA O2 /'OUTPUT ABORT' COMMAND 5421 005651 3241 DCA BLKCNT 5422 5423 005652 7164 CLOSE, SM1 /'OUTPUT CLOSE' COMMAND 5424 005653 4200 JMS CLOSER /L=1 5425 005654 5031 JMP EXIT /SIMPLE - ONCE YOU KNOW HOW! 5426 005655 0000 NOCHAR, 0 /OS/8 3/2 BUFFERED CHARACTER OUTPUT 5427 005656 0377 AND (377 /MASK OUT GARBAGE 5428 005657 2312 ISZ O2 /WHICH CHAR OF THREE? 5429 005660 5306 JMP O1 /STRAIGHT PACKING 5430 005661 4312 JMS O2 /HALF WORD PACKING - PACK 1ST HALF 5431 005662 1324 TAD O3 /GET SAVED ARG 5432 005663 4312 JMS O2 /PACK SECOND HALF 5433 005664 7346 SM3 /RESET 3-WAY SWITCH 5434 005665 3312 DCA O2 /BUFFER CAN ONLY BE FILLED WITH 5435 005666 2133 ISZ OUTFLG /THE 3RD CHARACTER OF 3 5436 005667 5310 JMP O1+2 /NOT FULL YET 5437 005670 1242 TAD OLNGTH /CHECK THE FILE SIZE 5438 005671 1241 TAD BLKCNT /AMOUNT USED SO FAR 5439 005672 7620 SNL CLA /HAVE WE GONE TOO FAR? 5440 005673 5225 JMP NOSIZE-1 /YES, DELETE THE FILE 5441 005674 6002 I0F 5442 005675 4532 JMS I OUTHND /WRITE ONE BLOCK BUFFER 5443 005676 4200 4200 5444 005677 1600 1600 /5200 PATCHED BY PLOT 5445 005700 0000 OBLK, 0 5446 005701 5576 JMP I [DERR /DEVICE ERROR 5447 005702 2300 ISZ OBLK /BUMP OUTPUT BLOCK 5448 005703 2241 ISZ BLKCNT /AND COUNT OF BLOCKS SO FAR 5449 005704 4324 JMS O3 /RESET POINTERS FOR NEXT BUFFER 5450 005705 5655 JMP I NOCHAR /L=1 5451 5452 005706 3736 O1, DCA I OPTR1 /NORMAL PACKING IS EASY! 5453 005707 2336 ISZ OPTR1 /BUMP POINTER 5454 005710 7100 CLL 5455 005711 5655 JMP I NOCHAR /L=0 5456 5457 005712 0000 O2, 0 /HALF-WORD PACK ROUTINE 5458 005713 7106 CLL RTL 5459 005714 7006 RTL 5460 005715 3324 DCA O3 /SAVE FOR SECOND HALF 5461 005716 1324 TAD O3 5462 005717 0172 AND [7400 5463 005720 1737 TAD I OPTR2 /ADD IN CHARACTER IN RIGHT HALF 5464 005721 3737 DCA I OPTR2 /PACK IT 5465 005722 2337 ISZ OPTR2 /BUMP POINTER AGAIN 5466 005723 5712 JMP I O2 5467 5468 005724 0000 O3, 0 /RESET THE OUTPUT POINTERS 5469 005725 7346 SM3 5470 005726 3312 DCA O2 5471 005727 1277 TAD OBLK-1 5472 005730 3336 DCA OPTR1 5473 005731 1336 TAD OPTR1 5474 005732 3337 DCA OPTR2 5475 005733 1157 TAD [-200 /X3 = 384 CHARACTERS/BUFFER 5476 005734 3133 DCA OUTFLG 5477 005735 5724 JMP I O3 /'SM3' SETS THE LINK 5478 5479 005736 0000 OPTR1, 0 /PACKING POINTERS 5480 005737 0000 OPTR2, 0 5481 005740 4255 JMS NOCHAR /'OUTPUT BUFFER' COMMAND 5482 005741 1133 DUMPER, TAD OUTFLG /DUMPS THE OUTPUT BUFFER 5483 005742 7660 SNL SZA CLA /L=0 INITIALLY 5484 005743 5340 JMP DUMPER-1 5485 005744 5031 JMP EXIT /PAD WITH ZEROS AND EXIT 5486 5487 005745 6002 ILNGTH 5488 005746 1242 XLEN, TAD OLNGTH /FUNCTION TO CHECK FILE LENGTH 5489 005747 1241 TAD BLKCNT /(MINUS THE AMOUNT USED SO FAR) 5490 005750 7041 CIA 5491 005751 7410 SKP 5492 005752 1745 TAD I XLEN-1 /FUNCTION TO CHECK INPUT SIZE 5493 005753 6213 CDI P 5494 005754 5755 JMP I .+1 5495 005755 2021 FL0AT 5496 5497 /THIS IS THE 'OPEN OUTPUT' COMMAND: 5498 5499 005756 6007 TTYOUT 5500 005757 7160 OUTPUT, STL CMA /SET ECHO FLAG AND CALL=3 5501 005760 4573 JMS I [OPEN /CALL USR, HANDLER; ENTER FILE 5502 005761 0125 OUTBLK-1 /OUTPUT HANDLER BLOCK 5503 005762 4534 ERROR0 /ENTER ERROR: CLOSE FILE & RETRY? 5504 005763 5756 JMP I OUTPUT-1 /'OPEN OUTPUT TTY:' (OR JUST 'O O') 5505 005764 1057 TAD FLNGTH /MAXIMUM ALLOWABLE LENGTH 5506 005765 7041 CIA 5507 005766 3242 DCA OLNGTH 5508 005767 1060 TAD STBLK /STARTING BLOCK 5509 005770 3300 DCA OBLK 5510 005771 4324 JMS O3 /SET UP PACKING POINTERS 5511 005772 3241 DCA BLKCNT 5512 005773 4552 LPUSHF /SAVE THE FILE NAME FOR CLOSING 5513 005774 0067 NAMLOC 5514 005775 4551 LPOPF 5515 005776 6710 ONMTMP-1 /CODE SPILLS ACROSS THE PAGE 5516 005777 0377 *FLOUTP-1 /FUDGE TO SAVE A WORD OR TWO 5517 006000 5203 JMP ORST 5518 006001 0000 BLKNO, 0 5519 006002 0000 ILNGTH, 0 5520 5521 006003 1133 ORST, TAD OUTFLG /'OPEN RESTORE OUTPUT' COMMAND 5522 006004 7650 SNA CLA /FLAG IS CHARACTER COUNT 5523 006005 4534 ERROR0 /NO OUTPUT FILE TO RESTORE 5524 006006 1015 TAD OFFSET /POINTER TO FILE OUTPUT ROUTINE 5525 006007 1156 TTYOUT, TAD [XOUTL /SWITCH OUTPUT TO THE TELETYPE 5526 006010 6211 CDF P /ENTRY POINT FOR INTERNAL HANDLERS 5527 006011 3560 DCA I [OUTDEV 5528 006012 2036 ISZ GOSW /SKIP IF NO ECHO 5529 006013 1300 TAD OCHAR0+2 /'TAD ENDCHK' 5530 006014 3303 DCA OECHO /SET OUTPUT ROUTINE 5531 006015 5031 JMP EXIT /FINISH THE LINE 5532 5533 006016 3007 TTYP, XI33 /TTY INPUT 5534 006017 0056 INDEV 5535 /THE 'OPEN' AND 'RESTORE' COMMANDS AND FILE INPUT/OUTPUT 5536 5537 006020 6410 SCANER 5538 006021 4620 OCMND, JMS I .-1 /'O' COMMAND ENTRY - SKIP TO NEXT 5539 006022 1244 TAD DOTDA 5540 006023 3072 DCA EXTENSION /SET '.DA' 5541 006024 7040 CMA 5542 006025 3036 DCA GOSW /INITIALIZE THE ECHO SWITCH 5543 006026 4550 LJUMP /GO DO COMMAND 5544 006027 6364 FILIST-1 5545 006030 0302 FILEGO-FILIST 5546 006031 4036 ERROR1 /OOPS - BAD 'O' COMMAND 5547 5548 006032 6211 RESTOR, CDF P /'O R' COMMANDS - GET NEXT LETTER 5549 006033 1423 TAD I XCHAR 5550 006034 3106 DCA TEMP /SAVE COMMAND LETTER 5551 006035 4572 GTNAME /CHECK FOR ECHO AND LINE NUMBER 5552 006036 1106 TAD TEMP 5553 006037 3066 DCA CHAR 5554 006040 4550 LJUMP /SORT OUT "I", "O", OR "R" 5555 006041 6372 ORLIST-1 5556 006042 0306 ORGO-ORLIST 5557 006043 4036 ERROR1 /BAD 'RESTORE' COMMAND 5558 006044 0401 DOTDA, 401 /WAS 604 FOR '.FD' 5559 5560 /THE 'OPEN INPUT' COMMAND: 5561 5562 006045 7140 INPUT, CLL CMA /INITIALIZE ECHO AND SET 'CALL'=2 5563 006046 4573 JMS I [OPEN /CALL THAT AMAZING 5564 006047 0120 INBLK-1 /GENERAL-PURPOSE SUBROUTINE 5565 006050 4534 ERROR0 /WHOOPS - FILE NOT FOUND 5566 006051 5267 JMP TTYIN /'OPEN INPUT TTY:' (OR JUST 'O I') 5567 006052 1057 TAD FLNGTH 5568 006053 3202 DCA ILNGTH /FOR 'FLEN' AND 'FRA' 5569 006054 1060 TAD STBLK 5570 006055 3201 DCA BLKNO 5571 5572 006056 1201 RERD, TAD BLKNO /'OPEN RE READ' COMMAND 5573 006057 3322 DCA IBLK /FIRST BLOCK NO. 5574 006060 7164 SM1 /RESET FILE POINTERS 5575 006061 3313 DCA INFLG /CHARACTER COUNTER 5576 5577 006062 1313 IRST, TAD INFLG /'OPEN RESTORE INPUT' COMMAND 5578 006063 7650 SNA CLA /CHECK CHARACTER COUNT 5579 006064 4534 ERROR0 /NO INPUT FILE TO RESTORE 5580 006065 5566 JMP I [CR /SET POINTER TO 'ICHAR0' (12K) 5581 006066 1015 TAD OFFSET /=ICHAR-XI33 5582 006067 1216 TTYIN, TAD TTYP /'OPEN INPUT TTY:' 5583 006070 6211 CDF P 5584 006071 3617 DCA I TTYP+1 /= 'INDEV' 5585 006072 2036 ISZ GOSW /CHECK ECHO MODE 5586 006073 1264 TAD IRST+2 /= 'PRINTC' 5587 006074 3757 DCA I ECHOP 5588 006075 5031 JMP EXIT /RETURN 5589 /OFFSET,OCHAR-XOUTL /8K CONSTANT 5590 006076 0000 OCHAR0, 0 /FILE OUTPUT VIA 'PRINTC' 5591 006077 3360 DCA ENDCHK /SAVE CHARACTER FOR ECHO 5592 006100 1360 TAD ENDCHK 5593 006101 4710 JMS I FILOUT /WRITE IT 5594 006102 6001 I0N 5595 006103 1360 OECHO, TAD ENDCHK /=0000 IF NO ECHO 5596 006104 7450 SNA 5597 006105 2276 ISZ OCHAR0 /SET NO ECHO RETURN 5598 006106 6213 CDI P 5599 006107 5676 JMP I OCHAR0 5600 006110 5655 FILOUT, NOCHAR 5601 5602 006111 0000 RDPTR, 0 /THIS IS A COROUTINE ! 5603 006112 4360 JMS ENDCHK /ISN'T THAT AMAZING ? 5604 006113 0000 INFLG, 0 5605 5606 006114 2313 ICHAR0, ISZ INFLG /DO WE NEED ANOTHER BUFFER? 5607 006115 5711 JMP I RDPTR /NO, UNPACK THE CHARACTER 5608 5609 006116 6002 I0F 5610 006117 4525 JMS I INHND /YES, GO GET IT 5611 006120 0200 0200 5612 006121 3200 3200 5613 006122 0000 IBLK, 0 5614 006123 7700 SMA CLA /ONLY BOTHER WITH FATAL ERRORS 5615 006124 7610 SKP CLA 5616 006125 5576 JMP I [DERR /WE'VE GOT ONE 5617 006126 1173 TAD [-600 /=384 CHARACTERS/BUFFER 5618 006127 3313 DCA INFLG 5619 006130 2322 ISZ IBLK /BUMP TO NEXT BLOCK 5620 006131 1321 TAD IBLK-1 /AND RESTORE POINTERS 5621 006132 3356 DCA IPNTR 5622 006133 6001 I0N 5623 5624 006134 1756 ICHAR1, TAD I IPNTR /STRAIGHT-FORWARD UNPACK ROUTINE 5625 006135 4311 JMS RDPTR /DO COMMON STUFF 5626 5627 006136 1756 TAD I IPNTR /SAVE LEFT HALF FOR LATER 5628 006137 0172 AND [7400 5629 006140 3721 DCA I IBLK-1 5630 006141 2356 ISZ IPNTR /INCREMENT TO NEXT WORD 5631 006142 1756 TAD I IPNTR /ANOTHER EASY ONE 5632 006143 4311 JMS RDPTR 5633 5634 006144 1756 TAD I IPNTR /THIS IS THE TRICKY ONE! 5635 006145 2356 ISZ IPNTR /GET LOW-ORDER HALF 5636 006146 0172 AND [7400 5637 006147 7112 CLL RTR /SHIFT RIGHT 5638 006150 7012 RTR 5639 006151 1721 TAD I IBLK-1 /GET HIGH-ORDER HALF (REMEMBER?) 5640 006152 7012 RTR /SHIFT SOME MORE 5641 006153 7012 RTR 5642 006154 4311 JMS RDPTR /GOT IT! 5643 006155 5334 JMP ICHAR1 /1-2-3-1-2-3-1-2-3 ... 5644 006156 0000 IPNTR, 0 5645 006157 6275 ECHOP, IECHO 5646 5647 /PROCESS THE CHARACTERS FROM EITHER INPUT FILE: 5648 5649 006160 0000 ENDCHK, 0 /CALLED BY 'RDPTR' AND 'SEND' 5650 006161 0053 AND K177 /IGNORE PARITY 5651 006162 7440 SZA /NULL? 5652 006163 5367 JMP .+4 /NO 5653 006164 2360 ISZ ENDCHK /YES, TAKE THE 2ND EXIT AND 5654 006165 5760 JMP I ENDCHK /RETURN TO THE INPUT ROUTINE 5655 006166 7746 -32 5656 006167 1366 TAD .-1 /END OF FILE? (^Z) 5657 006170 7440 SZA 5658 006171 5376 JMP .+5 /NO 5659 006172 3760 DCA I ENDCHK /YES, CLEAR 'FILE OPEN' FLAG 5660 006173 6211 CDF P /AND SET UP A CLEVER RETURN 5661 006174 1165 TAD [EOF /TO RESTORE THE KEYBOARD FOR 5662 006175 3617 DCA I TTYP+1 /INPUT AND FLAG THE ERROR AT 5663 006176 1163 TAD [232 /THE SAME TIME! THIS -ALSO- 5664 006177 6213 CDI P /REMOVES THE ^Z SO YOU DON'T 5665 006200 5327 JMP ICHAR+3 /GET A SECOND ERROR MESSAGE! 5666 5667 *CDF L 5668 006201 3021 PLTDEV, XOUTL; ZBLOCK 2 /COULD BE USEFUL! 006202 0000 006203 0000 5669 /TABULATE ROUTINES: CALLED FROM THE UPPER FIELD 5670 5671 006204 7755 CR-SP 5672 006205 6213 TAB, CDI P /'PRINTC' TAB COUNTER 5673 006206 7450 SNA /TEST FOR CR 5674 006207 3575 DCA I [ERROR /RESET COUNTER 5675 006210 7450 SNA 5676 006211 5305 JMP CROUT 5677 006212 1204 TAD TAB-1 /CR-SP 5678 006213 7500 SMA /NON-PRINTING CHARACTERS 5679 006214 2575 ISZ I [ERROR /ADD 1 TO TAB COUNT (FIELD 1) 5680 006215 6001 I0N /TURN ON AFTER AN ERROR 5681 006216 1155 TAD [SP 5682 006217 5310 JMP CROUT+3 5683 5684 006220 1203 ZER, TASK 5685 006221 7700 SMA CLA /INITIAL ENTRY POINT 5686 006222 5233 JMP POS 5687 006223 1423 TAD I XCHAR /SAVE THE CURRENT CHARACTER 5688 006224 3066 DCA CHAR 5689 006225 6213 NEG, CDI P 5690 006226 5317 JMP SKPX /SKIP OVER ONE (OR MORE) 5691 006227 2562 ISZ I [LORD 5692 006230 5225 JMP NEG 5693 006231 1066 TAD CHAR 5694 006232 3423 DCA I XCHAR /RESTORE THE ORIGINAL ONE 5695 5696 006233 6213 POS, CDI P 5697 006234 1562 TAD I [LORD /FIND OUT WHERE WE'RE GOING 5698 006235 7161 STL CIA 5699 006236 1575 TAD I [ERROR /SUBTRACT FROM WHERE WE ARE 5700 006237 7620 SNL CLA 5701 006240 5620 JMP I ZER /FORGET IT... 5702 006241 1155 TAD [SP 5703 006242 4354 JMS CPRNT /PRINT SPACES 5704 006243 5233 JMP POS 5705 5706 *RMF 5707 006244 0000 0 /'PRINTC' FOR LISTING AND DATE 5708 006245 6213 CDI P 5709 006246 4354 JMS CPRNT 5710 006247 5644 JMP I RMF 5711 /LOAD A HANDLER INTO THE PROPER SLOT: (ENTRY AT 'HANDLR') 5712 5713 006250 2327 NOTEQ, ISZ SLOT /BUMP POINTER TO SAVE NAME 5714 006251 1055 TAD NEWDEV /MOVE NEW DEVICE NAME TO TABLE 5715 006252 3727 DCA I SLOT 5716 006253 2327 ISZ SLOT 5717 006254 1056 TAD NEWDEV+1 5718 006255 3727 DCA I SLOT 5719 006256 2327 ISZ SLOT 5720 006257 4546 GETMON /NEED USR, MIGHT AS WELL LOCK IT IN 5721 5722 006260 1055 RETRY, TAD NEWDEV /MOVE DEVICE NAME FOR MONITOR CALL 5723 006261 3271 DCA DEVC 5724 006262 1056 TAD NEWDEV+1 5725 006263 3272 DCA DEVC+1 5726 006264 1727 TAD I SLOT /MOVE LOAD POINT 5727 006265 3273 DCA DLOAD 5728 006266 6212 CIF 10 5729 006267 4406 JMS I USR /CALL MONITOR (ALREADY IN CORE) 5730 006270 0001 1 5731 006271 0000 DEVC, 0 5732 006272 0000 0 /DEVICE NO. 5733 006273 0000 DLOAD, 0 /ENTRY POINT 5734 006274 4534 ERROR0 /DEVICE NOT AVAILABLE 5735 5736 006275 1273 TAD DLOAD /CHECK IF THE HANDLER HAS BEEN 5737 006276 0157 AND [7600 /LOADED INTO THE PROPER PAGE 5738 006277 7040 CMA /'CIA' FOR 1-PAGE HANDLERS 5739 006300 1727 TAD I SLOT /DESIRED PAGE 5740 006301 7640 SZA CLA 5741 006302 1273 TAD DLOAD /WRONG PAGE! 5742 006303 1164 TAD [200 /IS IT THE SYSTEM HANDLER? 5743 006304 7710 SPA CLA /IF .GT. 7600 WE'RE OK 5744 006305 5317 JMP NOGOOD /SORRY, TRY IT AGAIN 5745 5746 006306 2327 ISZ SLOT /BUMP POINTER TO DEVICE # 5747 006307 1272 TAD DEVC+1 /SAVE IT 5748 006310 3727 DCA I SLOT 5749 006311 2327 ISZ SLOT /MOVE TO ENTRY POINT 5750 006312 1273 TAD DLOAD 5751 006313 3727 DCA I SLOT /SAVE ENTRY 5752 006314 1272 TAD DEVC+1 5753 006315 3106 HANDX, DCA TEMP /DEVICE NO. 5754 006316 5723 JMP I HANDLR 5755 5756 006317 3273 NOGOOD, DCA DLOAD /CLEAR ENTRY POINT 5757 006320 4343 JMS SETDHT /TELL USR THE HANDLER 5758 006321 6271 DLOAD-2 /IS NOT IN CORE ANYMORE 5759 006322 5260 JMP RETRY /LOAD IT THIS TIME 5760 *ECODEV 5761 006323 0000 HANDLR, 0 /AC = BLOCK POINTER 5762 006324 3327 DCA SLOT 5763 006325 7344 SM2 /IF THE HANDLER HAS THE SAME NAME, 5764 006326 4547 COMPARE /DON'T LOAD IT AGAIN 5765 006327 0000 SLOT, 0 5766 006330 0054 NEWDEV-1 5767 006331 5250 JMP NOTEQ /DIFFERENT NAMES, LOAD NEW HANDLER 5768 006332 2012 ISZ AUTO 2 /BUMP PAST LOAD POINT 5769 006333 1012 TAD AUTO 2 /(SET BY 'COMPARE') 5770 006334 3336 DCA .+2 5771 006335 4343 JMS SETDHT /IN CASE USR RESET THE TABLE 5772 006336 0000 0 5773 006337 1412 TAD I AUTO 2 5774 006340 5315 JMP HANDX /SAVE THE DEVICE NO. 5775 5776 006341 2424 TTYDEV, DEVICE TTY /FOR COMPARISON PURPOSES 006342 3100 5777 5778 *EOF 5779 006343 0000 SETDHT, 0 /SET THE DEVICE HANDLER TABLE 5780 006344 1743 TAD I SETDHT / (TO FAKE OUT THE USR) 5781 006345 3013 DCA PDLXR /POINTER TO DEVICE # AND ENTRY 5782 006346 1377 TAD (17646 /TABLE LOCATION 5783 006347 1413 TAD I PDLXR /PLUS DEVICE NUMBER 5784 006350 3271 DCA DEVC /POINTS TO 'HANDLER-IN-CORE' FLAG 5785 006351 1413 TAD I PDLXR 5786 006352 6211 CDF 10 5787 006353 3671 DCA I DEVC /FLAG IS SIMPLY HANDLER ENTRY 5788 006354 6201 CDF L 5789 006355 2343 ISZ SETDHT 5790 006356 5743 JMP I SETDHT /ALSO CALLED BY 'CLOSER' 5791 5792 /CHARACTER TABLE FOR LOWER-FIELD COMMANDS: 5793 5794 006357 0015 KOMLST, CR-200 /RETURN 5795 006360 0073 ";-200 /DITTO 5796 006361 0332 "Z /ZERO 5797 006362 0316 "N /NAME 5798 006363 0307 "G /GOSUB 5799 006364 0320 "P /P??? 5800 006365 0314 FILIST, "L /LIST 5801 006366 0301 "A /ALL OR ABORT 5802 006367 0303 "C /CALL OR CLOSE 5803 006370 0304 "D /DATE OR DELETE 5804 006371 0302 "B /BR. OR BUFFER 5805 006372 0305 "E /EXIT OR EVERY 5806 006373 0323 ORLIST, "S /SAVE OR SECOND 5807 006374 0322 "R /RUN OR RESTORE 5808 006375 0311 "I /INPUT OR INITIAL 5809 006376 0317 "O /OUTPUT OR ONLY 5810 5811 006377 7646 PAGE 32 5812 /LIBRARY COMMANDS: SAVER, DELETR, CALLER, RUNNER, GOSUB 5813 5814 *FPNT /ENTER VIA 'JMP I 7' 5815 5816 006400 4210 LCMND, JMS SCANER /SAVE CHAR AND MOVE TO THE NEXT 5817 006401 1377 TAD (603 /SET '.FC' 5818 006402 3072 DCA EXTENSION 5819 006403 3036 DCA GOSW /POINT TO 'PROC' 5820 006404 4550 LJUMP /BRANCH TO THE APPROPRIATE ROUTINE 5821 006405 6356 KOMLST-1 5822 006406 0271 KOMGO-KOMLST 5823 006407 4036 ERROR1 /SORRY, TRY AGAIN 5824 5825 006410 6576 SCANER, (CALL /COMMAND WORD SCANNER 5826 006411 6213 CDI P 5827 006412 1423 TAD I XCHAR /SAVE CURRENT CHARACTER 5828 006413 3066 DCA CHAR 5829 006414 4255 JMS LSORT /SCAN TO THE END 5830 006415 5610 JMP I SCANER 5831 5832 006416 4572 SAVER, GTNAME /'LIBRARY SAVE' COMMAND 5833 006417 4106 JMS TEMP /FILL IN THE HEADER 5834 006420 4315 JMS SAVE /DO IT 5835 006421 5031 JMP EXIT /DONE 5836 5837 006422 4405 DELETR, JMS I CL0SE /'LIBRARY DELETE' COMMAND 5838 006423 4572 GTNAME 5839 006424 1266 TAD LBUFR /'LIBBLK-1' 5840 006425 4561 GETHND 5841 006426 4230 JMS LCLOSE 5842 006427 5027 JMP EXIT-2 5843 5844 006430 6575 LCLOSE, (OPENUP /SAVE OR DELETE A FILE 5845 006431 3237 DCA SAVBLK 5846 006432 1064 TAD DEVNO 5847 006433 6212 CIF 10 5848 006434 4406 JMS I USR 5849 006435 0004 4 5850 006436 0067 NAMLOC 5851 006437 6574 SAVBLK, (20 5852 006440 4534 ERROR0 /NOT THERE 5853 006441 5630 JMP I LCLOSE 5854 5855 006442 0617 FOCLTM, FILENAME FOCAL.TM 006443 0301 006444 1400 006445 2415 5856 006446 4552 GOSUB, LPUSHF /'LIBRARY GOSUB' COMMAND 5857 006447 6442 FOCLTM 5858 006450 4551 LPOPF /MOVE 'FOCAL.TM' TO NAME AREA 5859 006451 0066 NAMLOC-1 5860 006452 1073 TAD DSK /IN CASE WE NEED TO SAVE IT 5861 006453 3055 DCA NEWDEV 5862 006454 3056 DCA NEWDEV+1 5863 006455 1077 TAD LIBFLG /ARE WE ALREADY SAVED? 5864 006456 7650 SNA CLA 5865 006457 4315 JMS SAVE /NO 5866 006460 1377 TAD (603 5867 006461 3072 DCA EXTENSION /RESET EXTENSION TO 'FC' 5868 5869 /LOOKUP AND LOAD ROUTINES: 5870 5871 006462 7346 SUBBER, SM3 /THESE ALL DO THE SAME THING AND 5872 006463 7101 RUNNER, CLL IAC /THEN BRANCH TO DIFFERENT PLACES 5873 006464 7101 CALLER, CLL IAC /LOAD HAS 5 POSSIBLE EXITS ! 5874 006465 4573 JMS I [OPEN /CALL THE HANDLER AND LOCATE FILE 5875 006466 0060 LBUFR, LIBBLK-1 /= 'BUFR' TOO 5876 006467 0003 LIB3, 3 /NOT THERE, NO NAME, OR 5877 006470 4036 ERROR1 /SOMETHING JUST AS STUPID 5878 5879 006471 4773 JMS I (DEVCHK /FILE STRUCTURED? 5880 006472 1036 TAD GOSW /CHECK FOR GOSUB 5881 006473 7710 SPA CLA 5882 006474 4552 LPUSHF /SAVE CURRENT PROGRAM INFO. 5883 006475 0074 LIBDEV 5884 006476 5303 JMP LOADGO /'JMP I (LCHECK+2' FOR 8K 5885 5886 006477 4551 GOBACK, LPOPF /RESTORE CALLING PROGRAM POINTERS 5887 006500 0054 NEWDEV-1 5888 006501 1266 TAD LBUFR 5889 006502 4561 GETHND /GET THE HANDLER BACK 5890 5891 006503 4350 LOADGO, JMS LOADER /READ THE PROGRAM 5892 006504 6221 CDF T /'CDI T' FOR INITIAL DIALOG 5893 006505 1517 TAD I D /CHECK PROGRAM I.D. 5894 006506 7640 SZA CLA 5895 / JMP I D /ENTER SPECIAL PROGRAM 5896 006507 4036 INITIAL,ERROR1 /(NONE RIGHT NOW) 5897 006510 1564 TAD I [200 /MOVE PROGRAM LENGTH 5898 006511 6211 CDF P 5899 006512 3666 DCA I LBUFR 5900 006513 6203 CDI L /RETURN TO: 5901 006514 5030 JMP EXIT-1 /PROC, START, GOTO, OR DO 5902 006515 0000 SAVE, 0 /CALLED BY 'SAVER' AND 'GOSUB' 5903 006516 4405 JMS I CL0SE /AVOID TROUBLE 5904 006517 6211 CDF P 5905 006520 1666 TAD I LBUFR /GET PROGRAM LENGTH 5906 006521 6221 CDF T 5907 006522 3564 DCA I [200 /SAVE IT WITH THE PROGRAM 5908 006523 7164 LSHFT, SM1 5909 006524 1564 TAD I [200 /COMPUTE FILE SIZE 5910 006525 6201 CDF L 5911 006526 0157 AND [7600 /MASK PAGE COUNT 5912 006527 4723 JMS I LSHFT /SHIFT IT 5913 006530 7001 IAC /ROUND UP TO BLOCKS 5914 006531 7110 CLL RAR 5915 006532 3057 DCA FLNGTH /SAVE 5916 006533 4546 GETMON /CALL THE MONITOR 5917 006534 1266 TAD LBUFR 5918 006535 4561 GETHND /GET THE HANDLER 5919 006536 4773 JMS I (DEVCHK /CHECK FOR STUPIDITY 5920 006537 1267 TAD LIB3 5921 006540 3776 DCA I (CALL /SET UP OUR SUBROUTINE 5922 006541 4775 JMS I (OPENUP 5923 006542 4036 ERROR1 /NO ROOM OR WRITE-LOCKED 5924 006543 1057 TAD FLNGTH 5925 006544 4230 JMS LCLOSE /UPDATE DIRECTORY IN ADVANCE! 5926 006545 1374 TAD (20 /SET THE 'WRITE' BIT 5927 006546 4350 JMS LOADER /SAVE THE PROGRAM 5928 006547 5715 JMP I SAVE 5929 ///// 5930 006550 0000 LOADER, 0 /READ (OR WRITE) A PROGRAM 5931 006551 1057 TAD FLNGTH /COMPUTE FUNCTION WORD 5932 006552 4723 JMS I LSHFT /'SHFTL6' 5933 006553 7124 STL RAL /SET TO SEARCH FORWARD 5934 006554 1374 IFNZRO T < TAD (T > /ADD FIELD BITS (12K) 5935 006555 3361 DCA .+4 5936 006556 1060 TAD STBLK 5937 006557 3363 DCA .+4 5938 006560 4465 JMS I LIBHND /GET THE PROGRAM 5939 006561 0000 0 5940 006562 0200 200 /LOADS FROM 200 UP 5941 006563 0000 0 /STARTING BLOCK NO. 5942 006564 5576 JMP I [DERR 5943 006565 4545 DISMISS /SO WE CAN USE THE STACK 5944 006566 4552 LPUSHF 5945 006567 0055 NEWDEV /SAVE NEW POINTERS 5946 006570 4551 LPOPF 5947 006571 0073 LIBDEV-1 /IN CASE WE 'GOSUB' 5948 006572 5750 JMP I LOADER 5949 5950 006573 6612 PAGE 006574 0020 006575 7257 006576 7271 006577 0603 5951 /THE 'OUTPUT DATE' COMMAND 5952 5953 006600 1171 DATER, TAD [NODATE-1 5954 006601 3010 DCA AUTO 5955 006602 1167 TAD [-4 5956 006603 3036 DCA GOSW 5957 006604 6221 CDF T 5958 006605 1410 TAD I AUTO /GET DATE 5959 006606 4771 JMS I ZEROER-1 /OUTPUT IT 5960 006607 2036 ISZ GOSW 5961 006610 5204 JMP .-4 5962 006611 5031 JMP EXIT /RETURN 5963 ///// 5964 5965 006612 0000 DEVCHK, 0 /CHECK THE DEVICE TYPE 5966 006613 1064 TAD DEVNO 5967 006614 1224 TAD P17757 5968 006615 3225 DCA JUMPER 5969 006616 6211 CDF 10 5970 006617 1625 TAD I JUMPER 5971 006620 6201 CDF L 5972 006621 7700 SMA CLA 5973 006622 4036 ERROR1 /DEVICE IS NOT FILE STRUCTURED 5974 006623 5612 JMP I DEVCHK 5975 006624 7757 P17757, 17757 /DEVICE CONTROL WORD TABLE 5976 ///// 5977 5978 006625 0000 JUMPER, 0 /SORT AND BRANCH SUBROUTINE 5979 006626 4424 JMS I IOWAIT /CLEAR AC, RESET DF, TURN IOF 5980 006627 1625 TAD I JUMPER /GET LIST ADDRESS 5981 006630 2225 ISZ JUMPER 5982 006631 3010 DCA AUTO 5983 006632 1410 TAD I AUTO 5984 006633 7510 SPA /END OF LIST ? 5985 006634 5246 JMP ERR 5986 006635 7161 STL CIA 5987 006636 1066 TAD CHAR 5988 006637 7640 SZA CLA /FOUND IT ? 5989 006640 5232 JMP .-6 /NO 5990 006641 1010 TAD AUTO 5991 006642 1625 TAD I JUMPER /ADD OFFSET 5992 006643 3225 DCA JUMPER 5993 006644 1625 TAD I JUMPER /POINT TO ENTRY 5994 006645 3225 DCA JUMPER 5995 006646 7300 ERR, CLA CLL /FALL THROUGH OFFSET 5996 006647 5625 JMP I JUMPER /L=0 5997 ///// 5998 /LIBRARY COMMAND LIST: 5999 6000 006650 6477 KOMGO, GOBACK /CR 6001 006651 6477 GOBACK /; 6002 006652 6772 ZEROER /Z 6003 006653 7571 NAMER /N 6004 006654 6446 GOSUB /G 6005 006655 6407 SCANER-1 /P 6006 006656 6766 LLIST /L 6007 006657 6770 LISTAL /A 6008 006660 6464 CALLER /C 6009 006661 6422 DELETR /D 6010 006662 6705 BRANCH /B 6011 006663 7600 7600 /E 6012 006664 6416 SAVER /S 6013 006665 6463 RUNNER /R 6014 006666 6507 INITIAL /I 6015 6016 /FILE COMMAND LIST 6017 6018 006667 6767 FILEGO, LIST1 /O,L 6019 006670 5650 ABORT /A 6020 006671 5652 CLOSE /C 6021 006672 6600 DATER /D 6022 006673 5741 DUMPER /B 6023 006674 6715 ECOSET /E 6024 006675 0200 SINPUT /S 6025 006676 6032 RESTOR /R 6026 006677 6045 INPUT /I 6027 006700 5757 OUTPUT /O 6028 6029 /RESTORE COMMAND LIST 6030 6031 006701 0211 ORGO, SRST /S 6032 006702 6056 RERD /R 6033 006703 6062 IRST /I 6034 006704 6003 ORST /O 6035 6036 /THE 'LOGICAL BRANCH' COMMAND ALLOWS PROGRAMS TO TEST THE 6037 /TELETYPE WITHOUT READING A CHARACTER. THE BRANCH OCCURS 6038 /IF THERE IS -NO- INPUT: 1.1 T PI;L B .1;C A KEY WAS HIT 6039 /'FIN()' MAY THEN BE USED TO READ AND TEST THE CHARACTER. 6040 6041 /THIS HAS NOW BEEN REPLACED BY THE 'JUMP' COMMAND (V4D). 6042 6043 006705 6213 BRANCH, CDI P /'LOGICAL BRANCH' COMMAND 6044 006706 6001 I0N 6045 006707 5710 JMP I .+1 /USES THE 'JUMP' COMMAND! 6046 006710 2601 PACLST+3 6047 ///// 6048 006711 0000 ONMTMP, ZBLOCK 4 /SAVED FILE NAME 006712 0000 006713 0000 006714 0000 6049 /THE 'OUTPUT EVERYTHING' COMMAND SWITCHES TO A DIFFERENT 6050 /INTERNAL HANDLER FOR ALL OUTPUT, INCLUDING THE ECHO AND 6051 /ERRORS; THIS DEVICE IS RESTORED FOLLOWING AN 'O C' OR 6052 /'O A' COMMAND. THE HANDLER MAY ALSO BE CALLED BY 'O O' 6053 6054 006715 4572 ECOSET, GTNAME /THE 'O E' COMMAND 6055 006716 4730 JMS I INTCHK /WAS IT 'O E LPT:'? 6056 006717 1156 TAD [XOUTL /NO, EVERYTHING ELSE = 'TTY:' 6057 006720 5323 JMP OSCOPE+1 /SAVE ENTRY POINT 6058 6059 006721 0000 ZBLOCK 1 /PATCHED BY LAB OVERLAY 6060 006722 1321 OSCOPE, TAD .-1 /THE 'O S' COMMAND 6061 006723 6211 CDF P 6062 006724 3561 DCA I [ECODEV /AFFECTS BOTH 'OCHAR' AND 'EOF' 6063 006725 1561 TAD I [ECODEV 6064 006726 5727 JMP I .+1 /INSERT ENTRY PT. INTO 'OUTDEV' 6065 006727 6010 TTYOUT+1 6066 ///// 6067 6068 006730 0275 INTCHK, LPTCHK /CHECK FOR INTERNAL HANDLERS 6069 006731 7223 INTRNL+1 /RETURN POINT 6070 006732 4730 JMS I INTCHK /CHECK FOR 'LPT:' 6071 006733 7410 SKP /TRY AGAIN 6072 006734 5727 JMP I INTCHK-1 /PUT ENTRY POINT INTO 'OUTDEV' 6073 006735 7344 SM2 6074 006736 4547 COMPARE /CHECK FOR 'PLTR' 6075 006737 6201 PLTDEV 6076 006740 0054 NEWDEV-1 6077 006741 5731 JMP I INTCHK+1 /NEITHER OF THESE 6078 006742 1737 TAD I .-3 6079 006743 5727 JMP I INTCHK-1 /MOVE THE ENTRY POINT 6080 ////// 6081 6082 006744 6320 LZERO, HANDLR-3 /THE 'LIBRARY ZERO' COMMAND 6083 006745 7164 SM1 /DANGEROUS - BUT USEFUL! 6084 006746 3761 DCA I FILCNT /RESET THE FILE COUNT 6085 006747 3554 DCA I [HANDLR-2 /CLEAR THE LINK WORD 6086 006750 3410 DCA I AUTO /CREATE AN 'EMPTY' WITH 6087 006751 1057 TAD FLNGTH / THE SPECIFIED LENGTH 6088 006752 7450 SNA /IF NO LENGTH, PROBABLY 6089 006753 4036 ERROR1 /DIDN'T WANT TO DO THIS! 6090 006754 7041 LZXIT, CIA 6091 006755 1744 TAD I LZERO /SUBTRACT SYSTEM BLOCKS 6092 006756 3410 DCA I AUTO 6093 006757 4465 JMS I LIBHND /PUT IT BACK 6094 006760 4200 4200 6095 006761 6317 FILCNT, HANDLR-4 6096 006762 0001 1 6097 006763 5576 JMP I [DERR /OH DEAR! 6098 006764 5754 JMP I LZXIT /RESTORE THINGS AND EXIT 6099 ///// 6100 /THE 'LIBRARY LIST' COMMAND SHOWS ONLY FILES WITH ONE EX- 6101 /TENSION. 'LIST ALL' SHOWS EVERYTHING, 'LIST ONLY' JUST 1. 6102 006765 0060 LIBBLK-1 6103 006766 7152 LLIST, CMA CLL RTR /'LIBRARY LIST' COMMAND 6104 006767 7164 LIST1, CMA STL RAL /'LIST ONLY' / 'ONLY LIST' 6105 006770 3573 LISTAL, DCA I [OPEN /'LIST ALL' COMMAND 6106 006771 7346 SM3 /CLEAR THE 'L Z' SWITCH 6107 006772 3000 ZEROER, DCA 0 /'LIBRARY ZERO' COMMAND 6108 006773 3036 DCA GOSW /= NO EMPTIES 6109 006774 4572 GTNAME /GET DEVICE TO LIST 6110 006775 1365 TAD LLIST-1 6111 006776 4561 GETHND /GET THE HANDLER 6112 006777 4212 JMS DEVCHK /CHECK DEVICE TYPE 6113 007000 4545 DISMISS /REMOVE THE USR 6114 007001 4553 JMS I [7607 /SWAP OUT CORE TO MAKE ROOM 6115 007002 4200 4200 /FOR DIRECTORY 6116 007003 6317 HANDLR-4 6117 007004 0040 40 /SYSTEM SCRATCH AREA 6118 007005 5576 JMP I [DERR /WHOOPS! 6119 007006 3502 DCA I SWAP /SET THE FLAG TO SWAP BACK IN 6120 007007 7001 IAC /DIRECTORY BEGINS WITH BLOCK 1 6121 007010 3214 BLOKLP, DCA LBLOCK 6122 007011 4465 JMS I LIBHND 6123 007012 0200 0200 6124 007013 6317 HANDLR-4 /POSITIONED FOR OUR CONVENIENCE! 6125 007014 0001 LBLOCK, 1 6126 007015 5576 JMP I [DERR 6127 007016 1161 TAD [HANDLR /FIRST 5 WORDS ARE INFORMATION 6128 007017 3010 DCA AUTO 6129 007020 1000 TAD 0 /CHECK FOR 'L Z' 6130 007021 7650 SNA CLA 6131 007022 5777 JMP I (LZERO+1 /OR 'EMPTY-2' TO DISABLE 'L Z' 6132 007023 1010 LOOP2, TAD AUTO /SAVE NAME POINTER FOR PRINTING 6133 007024 3254 DCA LIBX 6134 007025 1410 TAD I AUTO 6135 007026 7650 SNA CLA 6136 007027 5335 JMP EMPTY /CHECK IF WE SHOULD LIST EMPTIES 6137 007030 2010 ISZ AUTO 6138 007031 2010 ISZ AUTO 6139 007032 1410 TAD I AUTO /PICK UP EXTENSION 6140 007033 3214 DCA LBLOCK 6141 007034 1561 TAD I [HANDLR /WASTE WORDS (NEGATIVE) 6142 007035 7041 CIA 6143 007036 1010 TAD AUTO /SKIP TO LENGTH 6144 007037 3010 DCA AUTO 6145 007040 1410 TAD I AUTO /ZERO LENGTH MEANS TEMPORARY FILE 6146 *CIA 6147 007041 7450 SNA /LZERO RETURN 6148 007042 5325 JMP LOOP3 /IGNORE SUCH THINGS 6149 007043 3057 DCA FLNGTH 6150 007044 1067 TAD NAMLOC /WAS A NAME GIVEN ? 6151 007045 7650 SNA CLA 6152 007046 5264 JMP CKEXTN /NO 6153 007047 1072 TAD EXTENSION /CHECK THIS TOO? 6154 007050 7650 SNA CLA 6155 007051 7001 IAC /NO, ONLY CHECK THE NAME 6156 007052 1167 TAD [-4 6157 007053 4547 COMPARE /COMPARE THIS NAME WITH ARG 6158 007054 0007 LIBX, AUTO-1 6159 007055 0066 NAMLOC-1 6160 007056 5325 JMP LOOP3 /NON-MATCHING 6161 007057 2573 ISZ I [OPEN /TEST FOR ONLY ONE 6162 007060 1072 TAD EXTENSION /OR A NULL EXTENSION 6163 007061 7640 SZA CLA 6164 007062 3067 DCA NAMLOC /DON'T CHECK ANY MORE 6165 007063 5273 JMP DIRLST 6166 6167 007064 1072 CKEXTN, TAD EXTENSION /DO WE WANT THIS ONE? 6168 007065 7041 CIA 6169 007066 1214 TAD LBLOCK 6170 007067 7640 SZA CLA 6171 007070 1573 TAD I [OPEN /TEST FOR 'ALL' 6172 007071 7710 SPA CLA 6173 007072 5325 JMP LOOP3 /GUESS NOT 6174 007073 7346 DIRLST, SM3 /PRINT 3 WORDS 6175 007074 3106 DCA TEMP 6176 007075 2254 ISZ LIBX 6177 007076 1654 TAD I LIBX 6178 007077 4673 JMS I DIRLST /PRINT 2 CHARS 6179 007100 2106 ISZ TEMP 6180 007101 5275 JMP .-4 6181 007102 1374 TAD DOT 6182 007103 4403 JMS I PRNTC 6183 007104 1214 TAD LBLOCK /PRINT EXTENSION 6184 007105 4673 JMS I DIRLST 6185 007106 1356 TAD NPRNT+2 /SET UP FOR DECIMAL LENGTH PRINT 6186 007107 3055 DCA NEWDEV 6187 007110 3056 NLOOP, DCA NEWDEV+1 /INITIALIZE LEADING-ZERO FLAG 6188 007111 3364 DCA SHFTL6 /CLEAR QUOTIENT 6189 6190 007112 1455 TAD I NEWDEV /FINISHED ALL POWERS OF 10? 6191 007113 7450 SNA 6192 007114 5323 JMP LOOP3-2 /YES, ALL DONE 6193 007115 1057 TAD FLNGTH /NO, ADD THIS POWER 6194 007116 7540 SMA SZA /OVERFLOW? 6195 007117 5343 JMP DIDJET /YES, PRINT THIS DIGIT 6196 007120 3057 DCA FLNGTH /NO, GO THROUGH THE LOOP AGAIN 6197 007121 2364 ISZ SHFTL6 /ADD ONE TO THIS DIGIT 6198 007122 5312 JMP NLOOP+2 /ANOTHER DIVIDE CYCLE 6199 6200 007123 1166 TAD [CR /DONE WITH THIS LINE (WHEW!) 6201 007124 4403 JMS I PRNTC 6202 007125 2613 LOOP3, ISZ I LBLOCK-1 /DONE WITH THIS BLOCK? 6203 007126 5223 JMP LOOP2 /NO, KEEP GOING 6204 007127 4424 JMS I IOWAIT /WAIT FOR I/O 6205 007130 1554 TAD I [HANDLR-2 /LINK TO NEXT BLOCK 6206 007131 7440 SZA /LAST BLOCK? 6207 007132 5210 JMP BLOKLP /NO, GET THE NEXT 6208 007133 4502 JMS I SWAP /YES, RESTORE SWAPPED CORE 6209 007134 5031 JMP EXIT /(JMS RESETS THE FLAG) 6210 /MANY THANKS TO STEVE L. GILLETT FOR FIGURING OUT 6211 /HOW TO MAKE ROOM FOR THE 'LIST EMPTIES' OPTION!! 6212 6213 007135 1410 EMPTY, TAD I AUTO /LIST THE EMPTIES! 6214 007136 3057 DCA FLNGTH /GET THE LENGTH 6215 007137 1036 TAD GOSW /ARE WE SUPPOSED TO? 6216 007140 7740 SMA SZA CLA /',E' TESTED BY 'GTNAME' 6217 007141 5305 JMP NLOOP-3 /YES, INDENT SLIGHTLY 6218 007142 5325 JMP LOOP3 /FORGET IT 6219 6220 007143 7300 DIDJET, CLA CLL /CLEAN UP THE AC 6221 007144 2055 ISZ NEWDEV /NEXT POWER OF TEN 6222 007145 1364 TAD SHFTL6 /IF THIS DIGIT IS ZERO, AND NO 6223 007146 2056 ISZ NEWDEV+1 /OTHER DIGITS HAVE BEEN NON-ZERO, 6224 007147 7440 SZA /PRINT A SPACE INSTEAD 6225 007150 5354 JMP NPRNT 6226 007151 1155 TAD [SP 6227 007152 4403 JMS I PRNTC 6228 007153 5310 JMP NLOOP 6229 6230 007154 1170 NPRNT, TAD ["0 /CHANGE TO ASCII 6231 007155 4403 JMS I PRNTC 6232 007156 7160 CMA STL /SET ZERO SWITCH 6233 007157 5310 JMP NLOOP 6234 6235 DECIMAL;*CMA STL /TRICKY, HUH? 6236 007160 1750 1000 6237 007161 0144 100 6238 007162 0012 10 6239 007163 0001 1 6240 OCTAL; *SM1 /MORE TRICKS! 6241 6242 007164 0000 SHFTL6, 0 /CLEVER USE TERMINATES TABLE 6243 007165 7106 CLL RTL 6244 007166 7006 RTL 6245 007167 7006 RTL 6246 007170 5764 JMP I SHFTL6 /CONSIDER 'BSW' FOR THE 8/E 6247 6248 007171 0274 NAMLST, "< /BLOCK 6249 007172 0272 ": /DEVICE 6250 007173 0250 "( /VARIABLE DATA 6251 007174 0256 DOT, ". /EXTENSION 6252 007175 0333 "[ /SIZE 6253 007176 0254 ", /ECHO 6254 6255 007177 6745 PAGE 35 6256 /ROUTINE TO ENTER OR FIND A FILE FOR 'O O', 'O I' & 'LIB' 6257 6258 007200 0000 OPEN, 0 /LOOKUP AND ENTER ROUTINE 6259 007201 3036 DCA GOSW /SET ECHO/LOAD SWITCH 6260 007202 7001 IAC 6261 007203 7004 RAL /SET CALL CODE (2 OR 3) 6262 007204 3271 DCA CALL 6263 007205 4572 GTNAME /GET DEVICE AND FILENAME 6264 6265 007206 1335 TAD MDSK /CALLING SEQUENCE: 6266 007207 1055 TAD NEWDEV / AC=GOSW, L=1 FOR ENTER 6267 007210 7450 SNA / JMS I [OPEN 6268 007211 1067 TAD NAMLOC / HANDLER BLOCK (-1) 6269 007212 7650 SNA CLA / ERROR RETURN 6270 007213 5244 JMP SHUT+1 / 'TTY' RETURN 6271 007214 7344 SM2 / REGULAR RETURN 6272 007215 4547 COMPAR /CHECK FOR CALLS TO 'TTY:' 6273 007216 6340 TTYDEV-1 /'TTY:' IS ALSO THE DEFAULT 6274 007217 0054 TLSW, NEWDEV-1 /WHEN NO OTHER NAME IS FOUND 6275 007220 5622 JMP I INTRNL /CHECK FOR OTHER INTERNAL DEV. 6276 007221 5244 JMP SHUT+1 /'TTY:' 6277 007222 6732 INTRNL, INTCHK+2 /'.+1' FOR 8K 6278 6279 007223 1600 TAD I OPEN /GET HANDLER BLOCK TO USE 6280 007224 4561 GETHND /LOAD THE HANDLER 6281 007225 1067 TAD NAMLOC /CHECK FOR A DIRECT ACCESS CALL 6282 007226 7164 SHFT, CMA STL RAL /POINTS TO 'SHFTL6' 6283 007227 1271 TAD CALL /'NAMLOC'=1, 'CALL'=2 (ONLY) 6284 007230 7450 SNA 6285 007231 4036 ERROR1 /CANNOT USE '<>' WITH 'OPEN OUTPUT' 6286 007232 7001 IAC 6287 007233 7650 SNA CLA 6288 007234 5242 JMP SHUT-1 /OK: 'STBLK' & 'FLNGTH' ARE SET 6289 6290 007235 4257 JMS OPENUP /DO WHAT WE CAME FOR 6291 007236 5245 JMP SHUT+2 /ERROR RETURN 6292 007237 1273 TAD CALL+2 6293 007240 7041 CIA 6294 007241 3057 DCA FLNGTH /SAVE POSITIVE LENGTH 6295 007242 2200 ISZ OPEN 6296 007243 4545 SHUT, DISMISS /REMOVE THE USR 6297 007244 2200 ISZ OPEN 6298 007245 2200 ISZ OPEN 6299 007246 5600 JMP I OPEN /NORMAL RETURN 6300 ///// 6301 6302 007247 0000 USRIN, 0 /LOCK THE USR IN CORE - 'GETMON' 6303 007250 6002 I0F 6304 007251 6212 CIF 10 6305 007252 4406 JMS I USR 6306 007253 0010 10 6307 007254 1164 TAD [200 6308 007255 3006 DCA USR 6309 007256 5647 JMP I USRIN 6310 007257 0000 OPENUP, 0 /CALLED BY 'SAVE' AND 'OPEN' 6311 007260 1120 TAD XNAME 6312 007261 3272 DCA CALL+1 /INITIALIZE USR CALL 6313 007262 1057 TAD FLNGTH /REQUESTED SIZE FROM 'GTNAME' 6314 007263 7106 CLL RTL 6315 007264 7006 RTL 6316 007265 0274 AND O7760 /SIZE 6317 007266 1106 TAD TEMP /DEVICE NO. 6318 007267 6212 CIF 10 6319 007270 4406 JMS I USR /'ENTER' OR 'FETCH' 6320 007271 0000 CALL, 0 6321 007272 0067 NAMLOC /BECOMES THE BLOCK NO. 6322 007273 0000 0 / AND THE FILE LENGTH 6323 007274 7760 O7760, SNL SMA SZA CLA /ERROR RETURN 6324 007275 2257 ISZ OPENUP 6325 007276 1272 TAD CALL+1 /SAVE STARTING BLOCK 6326 007277 3060 DCA STBLK 6327 007300 5657 JMP I OPENUP 6328 6329 *CLA CLL IAC 6330 007301 7000 SWAPIN, NOP /RESTORE CORE AFTER DIRECTORY LIST 6331 007302 4553 JMS I [7607 /SYSTEM HANDLER 6332 007303 0200 200 6333 007304 6317 HANDLR-4 6334 007305 0040 40 6335 007306 4036 DERR, ERROR1 /DEVICE ERROR = 'CLA CLL RTL' 6336 007307 5701 JMP I SWAPIN 6337 6338 007310 0000 USROUT, 0 /REMOVE THE USR - 'DISMISS' 6339 007311 7330 SM0 6340 007312 1006 TAD USR /CHECK POINTER TO FIND OUT 6341 007313 7700 SMA CLA 6342 007314 5710 JMP I USROUT /ALREADY GONE 6343 007315 1313 TAD .-2 /RESET THE POINTER 6344 007316 3006 DCA USR 6345 007317 6002 I0F 6346 007320 6212 CIF 10 6347 007321 4564 JMS I [200 6348 007322 0011 11 6349 007323 5710 JMP I USROUT 6350 6351 *SP1 6352 007324 0000 IOWATE, 0 /WAIT FOR TELETYPE TO FINISH 6353 007325 6211 CDF P 6354 007326 6001 I0N 6355 007327 1617 TAD I TLSW 6356 007330 7640 SZA CLA 6357 007331 5326 JMP .-3 6358 007332 6002 I0F 6359 007333 6201 CDF L 6360 007334 5724 JMP I IOWATE /THEN TURN THE INTERRUPT OFF 6361 6362 007335 2055 MDSK, -5723 6363 007336 0000 XFORM, 0 6364 007337 0007 AND K77 6365 007340 7540 SMA SZA 6366 007341 1155 TAD [240 6367 007342 0007 AND K77 6368 007343 1155 TAD [240 6369 007344 4403 JMS I PRNTC 6370 007345 5736 JMP I XFORM 6371 6372 *SM3 6373 007346 0000 NPACK, 0 /STANDARD 6-BIT UNPACK ROUTINE 6374 007347 3357 DCA CMPR 6375 007350 1357 TAD CMPR 6376 007351 4626 JMS I SHFT /'BSW' 6377 007352 7004 RAL 6378 007353 4336 JMS XFORM 6379 007354 1357 TAD CMPR 6380 007355 4336 JMS XFORM 6381 007356 5746 JMP I NPACK /CALLED BY 'DIRLST' & 'DATER' 6382 6383 007357 0000 CMPR, 0 /COMPARE TWO BLOCKS OF ANY LENGTH 6384 007360 3336 DCA XFORM /CALLING SEQUENCE: 6385 007361 1757 TAD I CMPR / AC= -# OF WORDS 6386 007362 2357 ISZ CMPR / COMPARE 6387 007363 3012 DCA AUTO 2 / FIRST-1 6388 007364 1757 TAD I CMPR / SECOND-1 6389 007365 2357 ISZ CMPR / RETURN IF NO MATCH 6390 007366 3013 DCA AUTO 3 / RETURN IF MATCH 6391 007367 1412 TAD I AUTO 2 /COMPARE TWO WORDS 6392 007370 7041 CIA 6393 007371 1413 TAD I AUTO 3 6394 007372 7640 SZA CLA 6395 007373 5757 JMP I CMPR /NO MATCH 6396 007374 2336 ISZ XFORM /DONE ? 6397 007375 5367 JMP .-6 /NO, CHECK TWO MORE 6398 007376 2357 ISZ CMPR /YES, BUMP RETURN POINTER 6399 007377 5757 JMP I CMPR 6400 ///// 6401 PAGE 36 6402 /READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV' 6403 6404 007400 0000 NAME, 0 6405 007401 7164 SM1 /POINTER TO 'SHFTL6' 6406 007402 3011 DCA AUTO 1 /PERIOD COUNTER 6407 007403 3320 DCA MGETA /DIGIT COUNTER 6408 007404 1073 TAD DSK 6409 007405 3055 DCA NEWDEV 6410 007406 3056 DEVNAM, DCA NEWDEV+1 6411 007407 3067 DCA NAMLOC /CLEAR NAME AREA 6412 007410 3070 DCA NAMLOC+1 6413 007411 3071 DCA NAMLOC+2 /BUT NOT THE EXTENSION! 6414 007412 1120 TAD XNAME 6415 007413 3060 DCA STBLK 6416 007414 3012 DCA AUTO 2 /CHAR. COUNTER 6417 007415 3057 DCA FLNGTH 6418 007416 4312 NAMLUP, JMS MGETC /'SM1' SETS L=1 6419 007417 4550 LJUMP /'LJUMP' CLEARS IT 6420 007420 7170 NAMLST-1 /TRAP '< : ( . [ ,' 6421 007421 0341 NAMGO-NAMLST 6422 007422 0012 PLUS10, "9-"0+1 /'NOP' 6423 6424 007423 1066 TAD CHAR /CHECK FOR A-Z, 0-9 6425 007424 1333 TAD MINUS9 6426 007425 7100 CLL 6427 007426 1222 TAD PLUS10 6428 007427 7430 SZL 6429 007430 5234 JMP .+4 /OK 6430 007431 1240 TAD K7760 /"0-"@ = -20 6431 007432 7120 STL 6432 007433 1377 TAD ("@-"Z-1 6433 007434 7620 SNL CLA 6434 007435 5365 JMP NAMEND /ILLEGAL CHARACTER 6435 6436 007436 1012 TAD AUTO 2 6437 007437 1376 TAD (-5 6438 007440 7760 K7760, SNL SMA SZA CLA /TOO MANY? 6439 007441 5262 JMP IGNORE 6440 007442 1012 TAD AUTO 2 6441 007443 7110 CLL RAR 6442 007444 1060 TAD STBLK 6443 007445 3312 DCA MGETC /NAME POINTER 6444 007446 2012 ISZ AUTO 2 6445 007447 1066 TAD CHAR 6446 007450 0007 AND K77 6447 007451 7420 SNL 6448 007452 4601 JMS I NAME+1 /'SHFTL6' 6449 007453 6201 CDF L 6450 007454 1712 TAD I MGETC 6451 007455 3712 DCA I MGETC 6452 007456 6211 NXTNUM, CDF P 6453 007457 1413 TAD I PDLXR /MAY BE GARBAGE 6454 007460 1170 TAD ["0 6455 007461 3066 DCA CHAR 6456 007462 2320 IGNORE, ISZ MGETA 6457 007463 1320 TAD MGETA 6458 007464 7750 SPA SNA CLA /END OF THE STRING? 6459 007465 5217 JMP NAMLUP+1 6460 007466 1423 TAD I XCHAR /YES, IS THERE MORE? 6461 007467 1335 TAD MCOMMA 6462 007470 7100 CLL 6463 007471 7640 SZA CLA /CHECK FOR A COMMA 6464 007472 5216 JMP NAMLUP 6465 6466 *-"E 6467 007473 4320 VARBL, JMS MGETA /PROCESS A VARIABLE FILE NAME 6468 007474 7141 CLL CIA 6469 007475 3066 DCA CHAR /ASSUME ITS A LETTER 6470 007476 1421 TAD I H0RD /NOW CHECK THE SIGN 6471 007477 7510 SPA 6472 007500 5347 JMP VLETR /IT WAS, USE -1 AS THE COUNT 6473 007501 6213 CDI P 6474 007502 5340 JMP VFN /CONVERT POS. NUM. TO ASCII 6475 6476 007503 4320 BLKNUM, JMS MGETA /READ THE BLOCK NUMBER 6477 007504 2067 ISZ NAMLOC /SET THE BLOCK FLAG 6478 007505 5213 JMP NAMLUP-3 6479 6480 *-"9-1 6481 007506 1067 COLON, TAD NAMLOC /MOVE NAME TO 'NEWDEV' 6482 007507 3055 DCA NEWDEV 6483 007510 1070 TAD NAMLOC+1 6484 007511 5206 JMP DEVNAM 6485 6486 007512 0000 MGETC, 0 /CROSS-FIELD CALL 6487 007513 6213 CDI P 6488 007514 5351 JMP LGETC /L=1 TO SKIP 'GETC' 6489 007515 3066 DCA CHAR 6490 007516 5712 JMP I MGETC 6491 6492 *SNL SMA-1 6493 007517 5720 JMP I .+1 /TRY TO FIGURE THIS OUT! 6494 007520 0000 MGETA, 0 /EVALUATE AN EXPRESSION 6495 007521 4312 JMS MGETC /SKIP THE DELIMITER 6496 007522 6213 CDI P 6497 007523 5356 JMP GETA /CALL 'EVAL' 6498 6499 *-", 6500 007524 2011 PERIOD, ISZ AUTO 1 /DOUBLE PERIODS? 6501 007525 5365 JMP NAMEND /APPARENTLY 6502 007526 3072 DCA EXTENSION /CLEAR OUT THE ASSUMED ONE 6503 007527 2060 ISZ STBLK /ADVANCE STORAGE POINTER 6504 007530 1375 TAD (4 /ALLOW FOR TWO MORE CHARACTERS 6505 007531 5214 JMP NAMLUP-2 6506 007532 7503 NAMGO, BLKNUM /BLOCK 6507 007533 7506 MINUS9, COLON /DEVICE 6508 007534 7473 MINUSE, VARBL /LETTERS & NUMBERS 6509 007535 7524 MCOMMA, PERIOD /EXTENSION 6510 007536 7540 SQBRKT /SIZE 6511 007537 7553 ECHCHK /ECHO 6512 6513 *SMA SZA 6514 007540 4320 SQBRKT, JMS MGETA /READ REQUESTED FILE SIZE 6515 007541 5215 JMP NAMLUP-1 6516 6517 007542 3013 VFR, DCA PDLXR /SAVE STARTING ADDRESS 6518 007543 1774 TAD I (T3 6519 007544 7550 SPA SNA /CHECK DECIMAL EXPONENT 6520 007545 7201 CLA IAC /FORCE 1 IF .LE. ZERO 6521 007546 7161 STL CIA 6522 007547 3320 VLETR, DCA MGETA /EXPONENT=NUMBER OF DIGITS 6523 007550 7420 SNL 6524 007551 5262 JMP IGNORE /LETTERS 6525 007552 5256 JMP NXTNUM /NUMBERS 6526 6527 007553 1155 ECHCHK, TAD [SP /REPLACE THE COMMA WITH A SPACE 6528 007554 7410 SKP 6529 007555 2036 ISZ GOSW /CLEAR THE SWITCH & REMOVE THE 'E' 6530 007556 6211 CDF P 6531 007557 3423 DCA I XCHAR 6532 007560 4773 JMS I (SCANER /SKIP TO THE 'ECHO' OR LINE NO. 6533 007561 1423 TAD I XCHAR 6534 007562 1334 TAD MINUSE /DOES IT BEGIN WITH AN 'E'? 6535 007563 7650 SNA CLA 6536 007564 5355 JMP ECHCHK+2 /YES, MARK IT AND CONTINUE 6537 6538 007565 6213 NAMEND, CDI P /EVALUATE THE LINE NUMBER 6539 007566 5312 JMP GETL 6540 007567 4424 JMS I IOWAIT /AND WAIT FOR THE TERMINAL 6541 007570 5600 JMP I NAME /***RETURN*** 6542 6543 007571 4572 NAMER, GTNAME /'LIBRARY NAME' COMMAND 6544 007572 5025 JMP IOWAIT+1 /JUST UPDATES THE HEADER 6545 6546 007573 6410 PAGE 37 007574 0043 007575 0004 007576 7773 007577 7745 6547 /PAGE ZERO (FIELD 0) LITERALS: 6548 6549 LPUSHF= JMS I [MPUSHF 6550 LPOPF= JMS I [MPOPF 6551 LJUMP= JMS I [JUMPER 6552 COMPAR= JMS I [CMPR 6553 GTNAME= JMS I [NAME 6554 GETHND= JMS I [HANDLR 6555 GETMON= JMS I [USRIN 6556 DISMIS= JMS I [USROUT 6557 6558 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 6559 /READ AND STORE THE OS/8 DATE WORD: 6560 6561 FIELD 2 6562 6563 *14 6564 020014 1617 NODATE, TEXT "NO/DA/TE" /BECOMES THE CURRENT DATE 020015 5704 020016 0157 020017 2405 020020 0000 6565 6566 *20 6567 020020 0000 NUHEAD, 0 /MOVE THE NAME UP FROM FIELD L 6568 020021 1423 TAD I .+2 6569 020022 3020 DCA NUHEAD 6570 020023 0106 TEMP 6571 020024 1026 TAD .+2 6572 020025 3013 DCA PDLXR 6573 020026 0066 NAMLOC-1 6574 020027 1031 TAD .+2 6575 020030 3010 DCA AUTO 6576 020031 0212 TITLE-1 6577 020032 7346 SM3 6578 020033 3132 DCA DATUM 6579 6580 020034 6201 CDF L 6581 020035 1413 TAD I PDLXR 6582 020036 6221 CDF T 6583 020037 3410 DCA I AUTO 6584 020040 2132 ISZ DATUM 6585 020041 5034 JMP .-5 6586 6587 020042 3410 DCA I AUTO /CLEAR THE I.D. 6588 6589 020043 1014 TAD NODATE+0 /MOVE THE DATE INTO PLACE 6590 020044 3410 DCA I AUTO 6591 020045 1015 TAD NODATE+1 6592 020046 3410 DCA I AUTO 6593 020047 1016 TAD NODATE+2 6594 020050 3410 DCA I AUTO 6595 020051 1017 TAD NODATE+3 6596 020052 3410 DCA I AUTO 6597 020053 6203 CDI L 6598 020054 5420 JMP I NUHEAD 6599 6600 020055 7440 DAY, SZA /ZERO = READ CURRENT DATE 6601 020056 5061 JMP NIGHT /NON-ZERO = SET NEW DATE 6602 TAD I (17666 page zero ^ page zero ^ 020057 1577 6603 020060 5063 JMP NIGHT+2 6604 6605 NIGHT, DCA I (17666 page zero ^ page zero ^ 020061 3577 6606 020062 4132 JMS DATUM 6607 020063 6213 CDI P 6608 020064 5465 JMP I .+1 /'FL0ATR' 6609 020065 2021 FL0AT 6610 020066 0000 PACK1, 0 /HALF-WORD PACK ROUTINE 6611 TAD (60 /ADD OFFSET page zero ^ page zero ^ 020067 1176 6612 AND (77 page zero ^ page zero ^ 020070 0175 6613 ISZ (-1 /TEST THE SWITCH page zero ^ page zero ^ 020071 2174 6614 020072 5000 JMP PACK0 6615 020073 7106 CLL RTL 6616 020074 7006 RTL 6617 020075 7006 RTL 6618 020076 3013 DCA PDLXR /SAVE LEFT HALF 6619 020077 5466 JMP I PACK1 6620 6621 *0 6622 020000 1013 PACK0, TAD PDLXR /MERGE THE PIECES 6623 020001 6221 CDF T 6624 020002 3410 DCA I AUTO 6625 020003 6211 CDF 10 6626 020004 7164 SM1 6627 DCA (-1 /RESET THE SWITCH page zero ^ page zero ^ 020005 3174 6628 020006 5466 JMP I PACK1 6629 6630 *7 6631 020007 0600 600 /EXTENDED DATE MASK 6632 020010 0000 ZBLOCK 4 /INDICATE USAGE 020011 0000 020012 0000 020013 0000 6633 6634 *104 /LEAVE ROOM FOR 'PC0' 6635 020104 0000 PACK2, 0 6636 020105 3012 DCA AUTO 2 /SAVE DIGITS 6637 020106 3011 DCA AUTO 1 /CLEAR QUOT. 6638 020107 5112 JMP .+3 6639 020110 2011 ISZ AUTO 1 /DIVIDE BY TEN 6640 020111 3012 DCA AUTO 2 6641 020112 1012 TAD AUTO 2 6642 TAD (-12 page zero ^ page zero ^ 020113 1173 6643 020114 7500 SMA 6644 020115 5110 JMP .-5 6645 6646 020116 7200 CLA /CLEAR OVERDRAW 6647 020117 1011 TAD AUTO 1 /FIRST DIGIT 6648 020120 4066 JMS PACK1 6649 020121 1012 TAD AUTO 2 /SECOND DIGIT 6650 020122 4066 JMS PACK1 6651 020123 7344 SM2 /"0"-2="." 6652 020124 4066 JMS PACK1 6653 020125 5504 JMP I PACK2 6654 /ROUTINE TO UNPACK THE DATE - USED BY 'FDAY' 6655 6656 020126 0000 DATA, 0 /CALLED FROM 'INITLZ' 6657 020127 4132 JMS DATUM 6658 020130 6203 CDI L 6659 020131 5526 JMP I DATA 6660 6661 020132 0000 DATUM, 0 /UNPACK THE DATE WORD 6662 020133 7164 SM1 6663 DCA (-1 /INITIALIZE page zero ^ page zero ^ 020134 3174 6664 TAD (NODATE-1 page zero ^ page zero ^ 020135 1172 6665 020136 3010 DCA AUTO 6666 020137 6211 CDF 10 6667 TAD I (17666 page zero ^ page zero ^ 020140 1577 6668 020141 7450 SNA 6669 020142 5532 JMP I DATUM /SKIP NULL DATE 6670 020143 7012 RTR 6671 AND (77 page zero ^ page zero ^ 020144 0175 6672 020145 7110 CLL RAR 6673 020146 4104 JMS PACK2 /DAY 6674 TAD I (17666 page zero ^ page zero ^ 020147 1577 6675 020150 7006 RTL 6676 020151 7006 RTL 6677 020152 0162 AND K7 6678 020153 7004 RAL 6679 020154 4104 JMS PACK2 /MONTH 6680 TAD I (17666 page zero ^ page zero ^ 020155 1577 6681 020156 0162 AND K7 6682 020157 3013 DCA PDLXR 6683 020160 6201 CDF 0 6684 TAD I (7777 /WILL BE -1! page zero ^ page zero ^ 020161 1574 6685 020162 0007 K7, AND 7 6686 020163 7112 CLL RTR 6687 020164 7012 RTR 6688 TAD (106 /1970 page zero ^ page zero ^ 020165 1171 6689 020166 1013 TAD PDLXR 6690 020167 4104 JMS PACK2 /YEAR 6691 020170 5532 JMP I DATUM 6692 6693 020171 0106 FIELD 2 020172 0013 020173 7766 020174 7777 020175 0077 020176 0060 020177 7666 6694 $ 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 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 DVDONE 3356 DVI 7407 unreferenced DVIEM 3311 DVIMQL 3304 DVIOVF 3324 unreferenced DVIS1 3335 DVIS2 3337 DVLP 7124 DVNORM 3332 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 EMAC 3301 EMDVI 4516 EMINUS 1657 EMMUY 4513 EMOP 3277 EMPTY 7135 EMSWP 4567 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 EXMQ0 3274 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 L0002 7326 unreferenced L1 5171 L10 4726 L11 4722 L12 4716 L2 5165 L3 5161 L4 5155 L4000 7330 L5 5151 L6 5145 L7 4742 L7777 7340 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 MDCNT 3276 MDM1 6000 MDONE 6677 MDSK 7335 MDXIT 6705 MEMSIZ 6233 MEND 6717 MEQ 1006 MF 2033 MGETA 7520 MGETC 7512 MINDIV 3302 MINT 3043 MINUS9 7533 MINUSE 7534 MODEPT 0317 MODIFY 0367 MODLN 0402 MOVE 5553 MPER 2146 MPEXIT 3262 MPLOOP 3242 MPLY 6141 MPOPF 3120 MPRET 3273 unreferenced MPUSHF 3042 MQLDVI 4517 MQLMUY 4514 MSC 2353 MULT10 4561 MULT2 6231 MUY 7405 unreferenced MUYEM 3217 MUYMQL 3230 MUYSWP 3210 MV1 5453 MV2 3260 MV3 3330 NAGSW 0070 NAME 7400 NAMEND 7565 NAMER 7571 NAMGO 7532 NAMLOC 0067 NAMLST 7171 NAMLUP 7416 NEG 6225 NEG14 3303 NEGATE 4557 NEWDEV 0055 NEXT 1132 NEXTLN 0237 NEXTP 7604 NIGHT 0061 NLOOP 7110 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 RMDPHI 3300 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 SBAR 0416 SBLK 0236 SC3 5254 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 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 SWPEM 3200 SWPMUY 4515 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