1            /EFOC0B -- PS/8 FOCAL LIBRARY ROUTINES
   2            /VERSION FOR ETOS WITH INTERRUPTS REMOVED
   3            
   4            
   5            
   6            /ASSEMBLY INSTRUCTIONS:
   7            
   8            /.R PAL8
   9            /*EFOCLB,EFOCLB<EFOC0B,EFOC1B,EFLOTB,EFOCNB,DOLLAR
  10            /.R ABSLDR
  11            /*EFOCLB,INITAL=10200$
  12            /.SAVE SYS EFOCLB
  13            /.R EFOCLB
  14            
  15            /(DOLLAR CONTAINS DOLLAR SIGNS TO TERMINATE THE ASSEMBLY)
  16            
  17            /IDENTITIES TO HELP ELIMINATE INTERRUPTS
  18                    ION=NOP
  19                    IOF=NOP
  20            
  21            
  22            
  23            
  24                    FIELD 0
  25            
  26                    *10
  27 00010 0000 AUTO1,  0               /AUTO-INDEX REGISTERS...ACTUALLY USE SOME
  28 00011 0000 AUTO2,  0
  29 00012 0000 AUTO3,  0
  30 00013 0000 AUTO4,  0
  31 00014 0000 AUTO5,  0
  32 00015 0000 AUTO6,  0
  33 00016 0000 AUTO7,  0
  34 00017 0000 AUTO8,  0
  35 00020 0000 XCNTR,  0               /GENERAL COUNTER--SUCH AS FOR MPD2,MPD3
  36 00021 7700 USR,    7700            /POINTER TO MONITOR (200 IF IN CORE)
  37 00022 4577 PEXIT,  JMS I [DISMIS   /NORMAL RETURN FOR PS/8 COMMANDS
  38 00023 6213         CDF CIF 10
  39 00024 5425         JMP I .+1
  40 00025 7510         GOSWITCH-3
  41            
  42 00026 0000 NAMLOC, ZBLOCK 3
     00027 0000 
     00030 0000 
  43 00031 0000 EXTENSION,      0               /"FC" OR "FD"
  44 00032 0000 LISTFLG,        0
  45 00033 0000 NEWDEV, ZBLOCK 2
     00034 0000 
  46 00035 0000 TEM7,   0
  47 00036 0000 ATEM,   0
  48 00037 0066 XCHAR,  CHAR
  49 00040 7607 SHNDLR, 7607
  50                    /DEFINE LOWER FIELD INSTRUCTIONS . . .
  51            
  52                    TGETC=JMS I .
  53 00041 7347         XGETC
  54                    TPOPA=JMS I .
  55 00042 5732         MPOPA
  56                    TPUSHA=JMS I .
  57 00043 5631         MPUSHA
  58                    TPUSHF=JMS I .
  59 00044 5656         MPD2
  60                    TPOPF=JMS I .
  61 00045 5705         MPD3
  62                    TSORTJ=JMS I .
  63 00046 6737         MSORTJ
  64            
  65 00047 0000 ECHFLG, 0
  66 00050 0000 OPNFLG, 0
  67 00051 0000 IPNFLG, 0
  68 00052 0000 FLNGTH, 0
  69 00053 0000 STBLK,  0
  70 00054 0000 DEVNO,  0
  71 00055 0000 LIBBLK, 0               /FOR DEVICE NAME
  72 00056 0000         0
  73 00057 7400         7400            /LOAD POINT
  74 00060 0000         0               /FOR DEVICE #
  75 00061 0000 LIBHND, 0               /HANDLER ENTRY
  76                    TESTRM=JMS I .
  77 00062 5755         MSORTC
  78                    ERROR1=JMS I .
  79 00063 7244         ERROR
  80                    *66
  81 00066 0000 CHAR,   0               /FOR OBSCURE FAKING REASONS
  82            
  83 00067 0000 INBLK,  0
  84 00070 0000         0
  85 00071 5000         5000
  86 00072 0000         0
  87 00073 0000 INHND,  0
  88            
  89 00074 0000 OUTBLK, 0
  90 00075 0000         0
  91 00076 5200         5200
  92 00077 0000         0
  93 00100 0000 OUTHND, 0
  94            
  95                    TPRINTC=JMS I .
  96 00101 6321         MPRINTC
  97                    TGETLN=JMS I .
  98 00102 7337         MGETLN
  99                    TSPNOR=JMS I .
 100 00103 6726         XTSPNOR
 101 00104 0000 LIBFIL, 0
 102 00105 0000 DEVHLD, 0
 103            
 104                    PAGE
 105                   /INITIAL TEXT FOR PS/8 FOCAL
 106            
 107                    *200
 108 00200 0000 PC0,    0
 109 00201 0000         0
 110 00202 0000         0
 111 00203 0000         0
 112 00204 0000         0
 113 00205 5051         5051
 114 00206 0060         BUFR
 115 00207 0224         LINE1
 116 00210 0000 LINE0,  0
 117 00211 0000         0
 118 00212 0355         TEXT "C-PS/8 FOCAL, 1974"
     00213 2023 
     00214 5770 
     00215 4006 
     00216 1703 
     00217 0114 
     00220 5440 
     00221 6171 
     00222 6764 
     00223 0000 
 119                    *.-1
 120 00223 7715         7715            /DUMMY CR
 121                    LINE1=.
 122                    PAGE
 123            /PS/8 FOCAL FILE ROUTINES
 124            
 125                    *3614
 126            
 127 03614 4503 RESTORE,TSPNOR          /'OPEN RESTORE' COMMAND
 128 03615 1066         TAD CHAR        /SAVE COMMAND CHAR (3 WORD COMMAND!)
 129 03616 4443         TPUSHA
 130 03617 4441         TGETC
 131 03620 4462         TESTRM          /GO TO END OF COMMAND WORD
 132 03621 7610         SKP CLA
 133 03622 5217         JMP .-3
 134 03623 7340         CLA CLL CMA     /INITIALIZE ECHO SWITCH
 135 03624 3047         DCA ECHFLG
 136 03625 4576         JMS I [NAME     /JUST TO SET ECHO MODE
 137 03626 4442         TPOPA
 138 03627 1175         TAD [-"I        /OPEN RESTORE INPUT?
 139 03630 7450         SNA
 140 03631 5574         JMP I [IRST     /YES
 141 03632 1173         TAD ["I-"O      /NO, MUST BE OUTPUT
 142 03633 7640         SZA CLA
 143 03634 4463         ERROR1          /NEITHER ONE!
 144 03635 5572         JMP I [ORST
 145            
 146 03636 0000 OCLOSE, 0               /CLOSE THE OPEN OUTPUT FILE
 147 03637 1050         TAD OPNFLG
 148 03640 7650         SNA CLA         /DON'T BOTHER IF IT ISN'T OPEN
 149 03641 5636         JMP I OCLOSE
 150 03642 1171         TAD [232        /WRITE '^Z'
 151 03643 4265         JMS NOCHAR
 152 03644 1365         TAD OPTR1       /PAD BUFFER WITH ZEROS
 153 03645 1377         TAD (-4400      /(AND WRITE IT OUT)
 154 03646 7640         SZA CLA
 155 03647 5243         JMP .-4
 156 03650 1105         TAD DEVHLD      /SAVED DEVICE #
 157 03651 6212         CIF 10
 158 03652 4421         JMS I USR
 159 03653 0004         4
 160 03654 5546         ONMTMP          /POINTER TO SAVED NAME
 161 03655 0000 BLKCNT, 0               /FILE LENGTH (BLOCKS)
 162 03656 4463         ERROR1          /HUH?
 163 03657 3050         DCA OPNFLG      /CLEAR 'FILE OPEN' FLAG
 164 03660 6211         CDF 10
 165 03661 1170         TAD [XOUTL      /RESTORE TELETYPE OUTPUT ROUTINE
 166 03662 3567         DCA I [OUTDEV
 167 03663 6201         CDF
 168 03664 5636         JMP I OCLOSE    /DO WHATEVER ELSE NEEDS TO BE DONE
 169            
 170 03665 0000 NOCHAR, 0               /PS/8 3/2 BUFFERED CHARACTER OUTPUT
 171 03666 4566         JMS I [FLDSET   /CALLED FROM EITHER FIELD
 172 03667 3326         DCA CCIF        /SAVE CALLING FIELD
 173 03670 6201         CDF
 174 03671 1036         TAD ATEM        /CHARACTER TO BE OUTPUT
 175 03672 0376         AND (377        /MASK OUT GARBAGE
 176 03673 2330         ISZ O3          /WHICH CHAR OF THREE?
 177 03674 5324         JMP O2          /STRAIGHT PACKING
 178 03675 4330         JMS RT          /HALF WORD PACKING - PACK FIRST HALF
 179 03676 1036         TAD ATEM        /GET SAVED ARG
 180 03677 4330         JMS RT          /PACK SECOND HALF
 181 03700 7346         CLA CLL CMA RTL /RESET 3-WAY SWITCH
 182 03701 3330         DCA O3
 183 03702 2370         ISZ OCHCT       /BUFFER CAN ONLY BE FILLED WITH 3RD CHAR OF 3
 184 03703 5326         JMP CCIF        /NOT FULL YET, RETURN TO CALLING ROUTINE
 185 03704 4565         JMS I [PUTDEV   /TELL THE MONITOR THIS HANDLER'S IN CORE
 186 03705 0077                 OUTHND-1        /POINTER TO DEVICE # AND ENTRY
 187 03706 7300         CLA CLL
 188 03707 1367         TAD OLNGTH      /-MAXIMUM ALLOWABLE LENGTH
 189 03710 1255         TAD BLKCNT      /LENGTH SO FAR
 190 03711 7630         SZL CLA         /HAS HE GONE TOO FAR?
 191 03712 5342         JMP OOVER       /YES, KILL HIM
 192 03713 4500         JMS I OUTHND    /WRITE ONE BLOCK BUFFER
 193 03714 4200         4200
 194 03715 4400         4400
 195 03716 0000 OBLK,   0
 196 03717 5564         JMP I [DERR     /DEVICE ERROR
 197 03720 2316         ISZ OBLK        /BUMP OUTPUT BLOCK
 198 03721 2255         ISZ BLKCNT      /AND COUNT OF BLOCKS SO FAR
 199 03722 4353         JMS OSETUP      /RESET POINTERS FOR NEXT BUFFER
 200 03723 5326         JMP CCIF
 201 03724 3765 O2,     DCA I OPTR1     /NORMAL PACKING IS EASY!
 202 03725 2365         ISZ OPTR1       /BUMP POINTER
 203 03726 7402 CCIF,   HLT             /FILLED WITH CIF CDF
 204 03727 5665         JMP I NOCHAR
 205            
 206                    O3=.            /WHY NOT?
 207 03730 0000 RT,     0               /HALF-WORD PACK ROUTINE
 208 03731 7106         CLL RTL
 209 03732 7006         RTL
 210 03733 3036         DCA ATEM        /SAVE FOR SECOND HALF
 211 03734 1036         TAD ATEM
 212 03735 0163         AND [7400
 213 03736 1766         TAD I OPTR2     /ADD IN CHARACTER IN RIGHT HALF
 214 03737 3766         DCA I OPTR2     /PACK IT
 215 03740 2366         ISZ OPTR2       /BUMP POINTER AGAIN
 216 03741 5730         JMP I RT
 217            
 218 03742 3050 OOVER,  DCA OPNFLG      /HE BLEW IT - KILL THE FILE!!
 219 03743 1105         TAD DEVHLD
 220 03744 6212         CIF 10
 221 03745 4421         JMS I USR
 222 03746 0004         4
 223 03747 5546         ONMTMP
 224 03750 0000         0               /LENGTH OF ZERO TO DELETE
 225 03751 7600 O7600,  7600            /IGNORE ERRORS
 226 03752 4463         ERROR1          /BECAUSE WE ALREADY KNOW ABOUT THEM
 227            
 228 03753 0000 OSETUP, 0               /RESET ALL THE POINTERS (WHAT FUN!)
 229 03754 1315         TAD OBLK-1
 230 03755 3365         DCA OPTR1
 231 03756 1315         TAD OBLK-1
 232 03757 3366         DCA OPTR2
 233 03760 7346         CLA CLL CMA RTL
 234 03761 3330         DCA O3
 235 03762 1351         TAD O7600
 236 03763 3370         DCA OCHCT
 237 03764 5753         JMP I OSETUP
 238            
 239 03765 0000 OPTR1,  0
 240 03766 0000 OPTR2,  0
 241 03767 0000 OLNGTH, 0
 242 03770 0000 OCHCT,  0
 243            
 244 03776 0377         PAGE
     03777 3400 
 245                   *5400
 246            
 247 05400 4562 OOPEN,  JMS I [IOWAIT   /WAIT FOR TELETYPE TO FINISH (DECTAPES ARE SLOW!)
 248 05401 4561         JMS I [OPEN     /CALL USR, HANDLER; ENTER OUTPUT FILE
 249 05402 0073 YINT,           OUTBLK-1        /OUTPUT HANDLER BLOCK
 250 05403 0003                 3       /MONITOR 'ENTER' CODE
 251 05404 5240 YBLK,   JMP TTYOUT      /'OPEN OUTPUT TTY:'
 252                    JMP OCLCHK      /ERROR ON ENTER - SEE IF FILE ALREADY OPEN
off page        	          ^
     05405 5777 
 253 05406 4577         JMS I [DISMISS  /KICK USR OUT
 254 05407 4444         TPUSHF          /SAVE NAME AND OTHER CRAP
 255 05410 0026                 NAMLOC
 256 05411 4445         TPOPF
 257 05412 5546                 ONMTMP
 258 05413 1053         TAD STBLK       /STARTING BLOCK
 259 05414 3776         DCA I (OBLK
 260 05415 1052         TAD FLNGTH      /-MAXIMUM ALLOWABLE LENGTH
 261 05416 3775         DCA I (OLNGTH
 262 05417 4774         JMS I (OSETUP   /SET UP PACKING POINTERS
 263 05420 7340         CLA CLL CMA     /THERE'S A FILE OPEN!
 264 05421 3050         DCA OPNFLG
 265 05422 1054         TAD DEVNO       /SAVE FOR CLOSE
 266 05423 3105         DCA DEVHLD
 267 05424 3773         DCA I (BLKCNT   /DITTO
 268 05425 1050 ORST,   TAD OPNFLG      /ENTRY FOR 'OPEN RESTORE OUTPUT'
 269 05426 7650         SNA CLA         /IF 'OPEN OUTPUT', FLAG IS ALREADY SET
 270 05427 4463         ERROR1          /NO OUTPUT FILE TO RESTORE
 271 05430 6211         CDF 10
 272 05431 2047         ISZ ECHFLG      /SKIP IF NO ECHO
 273 05432 1274         TAD IBLK+2
 274 05433 3772         DCA I (OUTECH   /SET OUTPUT ROUTINE
 275 05434 1371         TAD (OCHAR      /POINTER TO FILE OUTPUT ROUTINE
 276 05435 6213         CIF CDF 10
 277 05436 3567         DCA I [OUTDEV
 278 05437 5560         JMP I [PROC     /FINISH THE LINE
 279 05440 1170 TTYOUT, TAD [XOUTL      /SWITCH OUTPUT TO TELETYPE (INTERRUPT)
 280 05441 5234         JMP .-5
 281            
 282 05442 1437 FILEST, TAD I XCHAR     /HERE'S WHERE FILES START!!
 283 05443 3066         DCA CHAR        /GET NEXT CHAR
 284 05444 6201         CDF
 285 05445 1370         TAD (604        /SET '.FD' ASSUMED EXTENSION
 286 05446 3031         DCA EXTENSION
 287 05447 4503         TSPNOR          /SKIP SPACES
 288 05450 1066         TAD CHAR        /SAVE COMMAND CHAR
 289 05451 4443         TPUSHA
 290 05452 4441         TGETC
 291 05453 4462         TESTRM          /GO TO END OF COMMAND WORD
 292 05454 7610         SKP CLA
 293 05455 5252         JMP .-3
 294 05456 4442         TPOPA
 295 05457 4446         TSORTJ          /GO DO COMMAND
 296 05460 6763                 FILIST-1
 297 05461 7401                 FILGO-FILIST
 298 05462 4463         ERROR1          /OOPS - BAD 'O' COMMAND
 299            
 300 05463 0000 ICHAR,  0               /GET A CHARACTER FROM A FILE
 301 05464 7300         CLA CLL         /MAKE SURE
 302 05465 2345         ISZ INCHT       /DO WE NEED ANOTHER BUFFER?
 303 05466 5725         JMP I RDPTR     /NO, UNPACK THE CHARACTER
 304 05467 4473         JMS I INHND     /YES, GO GET IT
 305 05470 0200         0200
 306 05471 4000         4000
 307 05472 0000 IBLK,   0
 308 05473 7700         SMA CLA         /ONLY BOTHER WITH FATAL ERRORS
 309 05474 7610         SKP CLA
 310 05475 5564         JMP I [DERR     /WE'VE GOT ONE
 311 05476 2272         ISZ IBLK        /BUMP TO NEXT BLOCK
 312 05477 1271         TAD IBLK-1      /AND RESTORE POINTERS
 313 05500 3344         DCA IPNTR
 314 05501 1161         TAD [7200
 315 05502 3345         DCA INCHT
 316 05503 1744 ICHAR1, TAD I IPNTR     /STRAIGHTFORWARD UNPACK ROUTINE
 317 05504 4325         JMS RDPTR       /DO COMMON CRAP
 318 05505 1744 ICHAR2, TAD I IPNTR     /SAVE LEFT HALF FOR LATER
 319 05506 0163         AND [7400
 320 05507 3343         DCA ITEMP
 321 05510 2344         ISZ IPNTR       /INCREMENT TO NEXT WORD
 322 05511 1744         TAD I IPNTR     /ANOTHER EASY ONE
 323 05512 4325         JMS RDPTR
 324 05513 1744 ICHAR3, TAD I IPNTR     /THIS IS THE TRICKY ONE!
 325 05514 2344         ISZ IPNTR       /GET LOW-ORDER HALF
 326 05515 0163         AND [7400
 327 05516 7112         CLL RTR         /SHIFT RIGHT
 328 05517 7012         RTR
 329 05520 1343         TAD ITEMP       /GET HIGH-ORDER HALF (REMEMBER?)
 330 05521 7012         RTR             /SHIFT SOME MORE
 331 05522 7012         RTR
 332 05523 4325         JMS RDPTR       /GOT IT!
 333 05524 5303         JMP ICHAR1      /1-2-3-1-2-3-1-2-3 ...
 334            
 335 05525 0000 RDPTR,  0               /IF YOU DIDN'T KNOW, THIS IS A COROUTINE!
 336 05526 0157         AND [177        /ISN'T THAT AMAZING?
 337 05527 7450         SNA             /IGNORE NULLS AND PARITY
 338 05530 5264         JMP ICHAR+1
 339 05531 1367         TAD (-32        /END OF FILE? (^Z)
 340 05532 7440         SZA
 341 05533 5340         JMP .+5         /NO
 342 05534 3051         DCA IPNFLG      /YES, CLEAR OPEN FILE FLAG
 343 05535 6211         CDF 10          /AND SET UP CLEVER KLUDGE
 344 05536 1366         TAD (EOF        /TO CHECK FOR A STUPID
 345 05537 3556         DCA I [INDEV    /'ATTEMPT-TO-READ-PAST-EOF'!
 346 05540 1171         TAD [232        /PASS ^Z TO PROGRAM (MIGHT COME IN HANDY)
 347 05541 6213         CIF CDF 10
 348 05542 5663         JMP I ICHAR
 349            
 350 05543 0000 ITEMP,  0
 351 05544 0000 IPNTR,  0
 352 05545 0000 INCHT,  0
 353 05546 0000 ONMTMP, ZBLOCK 4
     05547 0000 
     05550 0000 
     05551 0000 
 354            
 355 05566 3145         PAGE
     05567 7746 
     05570 0604 
     05571 3154 
     05572 3156 
     05573 3655 
     05574 3753 
     05575 3767 
     05576 3716 
     05577 7330 
 356 05600 4562 IOPEN, JMS I [IOWAIT   /WAIT FOR TELETYPE (DECTAPES ARE STILL SLOW!)
 357 05601 4561         JMS I [OPEN     /CALL THAT AMAZING GENERAL-PURPOSE SUBROUTINE
 358 05602 0066                 INBLK-1
 359 05603 0002                 2       /MONITOR 'LOOKUP'
 360 05604 5227         JMP TTYIN       /'OPEN INPUT TTY:'
 361 05605 4463         ERROR1          /WHOOPS - FILE NOT FOUND
 362 05606 4577         JMS I [DISMISS  /BOOT THE USR OUT
 363 05607 1053         TAD STBLK       /SET POINTERS AND OTHER CRAP
 364 05610 3777         DCA I (IBLK
 365 05611 7340         CLA CLL CMA
 366 05612 3051         DCA IPNFLG
 367 05613 7340         CLA CLL CMA
 368 05614 3776         DCA I (INCHT
 369 05615 1051 IRST,   TAD IPNFLG      /'OPEN RESTORE INPUT' COMES HERE
 370 05616 7650         SNA CLA         /FLAG IS SET ALREADY IF 'OPEN INPUT'
 371 05617 4463         ERROR1          /NO INPUT FILE TO RESTORE
 372 05620 1375         TAD (ICHARF     /SET I/O POINTERS
 373 05621 6213         CIF CDF 10
 374 05622 3556         DCA I [INDEV
 375 05623 2047         ISZ ECHFLG      /AND ECHO MODE
 376 05624 1155         TAD [PRINTC
 377 05625 3554         DCA I [PPRNT
 378 05626 5560         JMP I [PROC
 379 05627 1153 TTYIN,  TAD [XI33       /'OPEN INPUT TTY:'
 380 05630 5220         JMP TTYIN-7
 381            
 382 05631 0000 MPUSHA, 0               /PUSH THE AC ON THE STACK
 383 05632 4343         JMS FLDSET      /CALLED FROM EITHER FIELD
 384 05633 3254         DCA ACDF
 385 05634 6211         CDF 10          /DO SOME CRAZY, MIXED-UP POINTER SCRAMBLING
 386 05635 1774         TAD I (PDLXR
 387 05636 3035         DCA TEM7
 388 05637 7040         CMA
 389 05640 1035         TAD TEM7
 390 05641 3774         DCA I (PDLXR
 391 05642 1035         TAD TEM7
 392 05643 7141         CIA CLL
 393 05644 1552         TAD I [BUFR
 394 05645 7630         SZL CLA
 395 05646 4463 PDERR,  ERROR1          /PUSHDOWN OVERFLOW
 396 05647 1774         TAD I (PDLXR
 397 05650 6201         CDF
 398 05651 3011         DCA AUTO2
 399 05652 1036         TAD ATEM
 400 05653 3435         DCA I TEM7
 401 05654 6203 ACDF,   CIF CDF
 402 05655 5631         JMP I MPUSHA
 403            
 404 05656 0000 MPD2,   0               /PUSH 4 WORDS ON THE STACK
 405 05657 1656         TAD I MPD2      /GET POINTER TO FIRST WORD
 406 05660 1151         TAD [3          /PUSH IN REVERSE ORDER
 407 05661 3305         DCA MPD3
 408 05662 2256         ISZ MPD2
 409 05663 4343         JMS FLDSET
 410 05664 3270         DCA FCDF
 411 05665 6201         CDF
 412 05666 1150         TAD [-4
 413 05667 3020         DCA XCNTR
 414 05670 7402 FCDF,   HLT             /CHANGE FIELD TO CALLING FIELD
 415 05671 1705         TAD I MPD3      /GET THE NEXT WORD
 416 05672 6203         CIF CDF
 417 05673 4231         JMS MPUSHA      /PUSH IT
 418 05674 7340         CLA CLL CMA     /BACK UP POINTER
 419 05675 1305         TAD MPD3
 420 05676 3305         DCA MPD3
 421 05677 2020         ISZ XCNTR
 422 05700 5270         JMP FCDF        /GET THE NEXT ONE
 423 05701 1270         TAD FCDF
 424 05702 3303         DCA .+1
 425 05703 0000         0               /RESTORE CALLING FIELD
 426 05704 5656         JMP I MPD2
 427            
 428 05705 0000 MPD3,   0               /POP 4 WORDS
 429 05706 7340         CLA CLL CMA     /GET POINTER-1
 430 05707 1705         TAD I MPD3
 431 05710 3012         DCA AUTO3
 432 05711 2305         ISZ MPD3
 433 05712 1373         TAD (CDF
 434 05713 6214         RDF
 435 05714 3321         DCA FCIF
 436 05715 1150         TAD [-4         /FOUR WORDS
 437 05716 3020         DCA XCNTR
 438 05717 6201         CDF
 439 05720 4332         JMS MPOPA       /GET ONE
 440 05721 6201 FCIF,   CDF
 441 05722 3412         DCA I AUTO3     /PUT IT AWAY
 442 05723 2020         ISZ XCNTR       /ALL DONE?
 443 05724 5317         JMP FCIF-2      /NO, GET ANOTHER
 444 05725 7326         CLL CLA CML RTL /YES, CHANGE CDF TO CIF CDF
 445 05726 1321         TAD FCIF
 446 05727 3330         DCA .+1
 447 05730 0000         0               /CHANGE FIELD AND EXIT
 448 05731 5705         JMP I MPD3
 449            
 450 05732 0000 MPOPA,  0               /POP A WORD
 451 05733 4343         JMS FLDSET      /(THIS ONE'S EASY)
 452 05734 3341         DCA ACIF
 453 05735 6211         CDF 10
 454 05736 2774         ISZ I (PDLXR
 455 05737 6201         CDF
 456 05740 1411         TAD I AUTO2
 457 05741 6203 ACIF,   CIF CDF
 458 05742 5732         JMP I MPOPA
 459            
 460 05743 0000 FLDSET, 0
 461 05744 3036         DCA ATEM
 462 05745 1272         TAD FCDF+2
 463 05746 6214         RDF
 464 05747 5743         JMP I FLDSET
 465            
 466 05750 1032 XRESTOR,TAD LISTFLG     /PART OF ERROR ROUTINE TO
 467 05751 7640         SZA CLA         /RESET I/O TO CONSOLE TERMINAL AND
 468                    JMS SWAPIN      /RESTORE CORE SWAPPED BY DIRECTORY
off page        	          ^
     05752 4772 
 469 05753 6213         CIF CDF 10      /LISTING
 470                    JMP RECOVY
off page        	         ^
     05754 5771 
 471            
 472 05755 0000 MSORTC, 0               /CHECK FOR TERMINATOR
 473 05756 6213         CIF CDF 10
 474 05757 4547         JMS I [TERMER
 475 05760 2355         ISZ MSORTC
 476 05761 5755         JMP I MSORTC
 477            
 478 05771 2706         PAGE
     05772 7275 
     05773 6201 
     05774 0013 
     05775 3126 
     05776 5545 
     05777 5472 
 479            /LIBRARY COMMAND PROCESSOR
 480            
 481                    /****** STORAGE ALLOCATION MAP ******
 482                    /*****                          *****
 483                    /*      3600    FILES (OUTPUT AND RESTORE)
 484                    /*      4000    INPUT BUFFER (PAGE 1)
 485                    /*      4200    INPUT BUFFER (PAGE 2)
 486                    /*      4400    OUTPUT BUFFER (PAGE 1)
 487                    /*      4600    OUTPUT BUFFER (PAGE 2)
 488                    /*      5000    INPUT HANDLER
 489                    /*      5200    OUTPUT HANDLER
 490                    /*      5400    FILES (INPUT AND OPEN)
 491                    /*
 492                    /*      5600    PUSHDOWN LIST CONTROLS
 493                    /*      6000    NAME, GTMON, DISMISS, IOWAIT
 494                    /*      6200    HANDAD, COMPARE
 495                    /*      6400    LOWLIB, SAVER, RETURN
 496                    /*      6600    CHAINER, FETCHER, GOSUB
 497                    /*      7000    LIBRARIAN
 498                    /*      7200    MISCELLANEOUS
 499                    /*      7400    LIBRARY HANDLER
 500                    /*****                          *****
 501                    /************************************
 502            
 503            
 504            
 505            
 506 06000 0000 NAME,   0               /READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV'
 507 06001 4352         JMS DISMIS      /'GETC' WON'T WITH THE USR IN CORE
 508 06002 1377         TAD (5723       /CODE FOR 'DSK:'
 509 06003 3033         DCA NEWDEV      /(DEFAULT DEVICE)
 510 06004 3034         DCA NEWDEV+1
 511 06005 4216         JMS GNAME       /GET FIRST PART (MIGHT BE DEVICE)
 512 06006 1146         TAD ["A-":      /WAS IT A DEVICE?
 513 06007 7640         SZA CLA
 514 06010 5600         JMP I NAME      /NO, ALL SET UP
 515 06011 4441         TGETC           /YES, MOVE PAST ':'
 516 06012 1026         TAD NAMLOC      /MOVE TO DEVICE AREA
 517 06013 3033         DCA NEWDEV
 518 06014 1027         TAD NAMLOC+1
 519 06015 5204         JMP NAME+4      /GET FILENAME
 520            
 521 06016 0000 GNAME,  0               /READ A NAME INTO 'NAMLOC'
 522 06017 3026         DCA NAMLOC      /CLEAR NAME AREA
 523 06020 3027         DCA NAMLOC+1    /(DON'T CLEAR ASSUMED EXTENSION)
 524 06021 3030         DCA NAMLOC+2
 525 06022 1145         TAD [NAMLOC     /INITIALIZE POINTERS
 526 06023 3333         DCA NMBASE
 527 06024 7240         CLA CMA
 528 06025 3334         DCA PERDSW
 529 06026 3335         DCA NAMECT
 530 06027 4503         TSPNOR
 531 06030 7410         SKP
 532 06031 4441 NAMEC,  TGETC           /MAIN LOOP
 533 06032 1066         TAD CHAR        /LOWER FIELD COPY, OF COURSE
 534 06033 1144         TAD [-".        /EXTENSION?
 535 06034 7450         SNA
 536 06035 5271         JMP PERD        /YES, CLEAR DEFAULT EXTENSION
 537 06036 1143         TAD [".-",      /COMMA?
 538 06037 7650         SNA CLA
 539 06040 5302         JMP ECHCHK      /YES, CHECK FOR ECHO
 540 06041 4316 ECHGO,  JMS DECODE      /MUST BE A-Z, 0-9
 541 06042 5616         JMP I GNAME     /IT WASN'T, MUST BE END OF NAME
 542 06043 7430         SZL             /RESTORE CHARACTER
 543 06044 1142         TAD [57
 544 06045 7001         IAC
 545 06046 3316         DCA DECODE      /TEMPORARY STORAGE
 546 06047 1335         TAD NAMECT      /NO MORE THAN 6 CHARACTERS/NAME
 547 06050 1173         TAD [-6
 548 06051 7700         SMA CLA
 549 06052 5231         JMP NAMEC
 550 06053 1335         TAD NAMECT      /BUILD POINTER TO CHARACTER POSITION
 551 06054 7110         CLL RAR
 552 06055 1333         TAD NMBASE
 553 06056 3336         DCA TT
 554 06057 1316         TAD DECODE      /LEFT OR RIGHT HALF?
 555 06060 7430         SZL
 556 06061 5265         JMP .+4
 557 06062 7106         CLL RTL         /LEFT, SHIFT OVER
 558 06063 7006         RTL
 559 06064 7006         RTL
 560 06065 1736         TAD I TT        /ADD IN OTHER HALF
 561 06066 3736         DCA I TT
 562 06067 2335         ISZ NAMECT      /BUMP COUNT
 563 06070 5231         JMP NAMEC       /CONTINUE LOOP
 564            
 565 06071 1026 PERD,   TAD NAMLOC      /FOUND A PERIOD IN STRING
 566 06072 7640         SZA CLA
 567 06073 2334         ISZ PERDSW
 568 06074 4463         ERROR1          /DOUBLE PERIODS OR NO FILE NAME
 569 06075 3031         DCA EXTENSION   /CLEAR EXTENSION
 570 06076 4441         TGETC           /MOVE PAST PERIOD
 571 06077 2333         ISZ NMBASE      /FAKE OUT POINTERS
 572 06100 1141         TAD [4
 573 06101 5226         JMP NAMEC-3
 574            
 575 06102 4441 ECHCHK, TGETC           /MOVE PAST COMMA
 576 06103 4503         TSPNOR
 577 06104 1066         TAD CHAR        /MUST BE FOLLOWED BY 'ECHO'
 578 06105 1140         TAD [-"E
 579 06106 7640         SZA CLA
 580 06107 5616         JMP I GNAME
 581 06110 3047         DCA ECHFLG      /SET ECHO FLAG
 582 06111 4441         TGETC           /MOVE TO END OF WORD
 583 06112 4316         JMS DECODE
 584 06113 5616         JMP I GNAME
 585 06114 7300         CLA CLL
 586 06115 5311         JMP .-4
 587            
 588 06116 0000 DECODE, 0               /CHECK FOR A-Z, 0-9
 589 06117 1066         TAD CHAR
 590 06120 1137         TAD [-"9-1
 591 06121 7100         CLL
 592 06122 1136         TAD ["9+1-"0
 593 06123 7430         SZL
 594 06124 5331         JMP DCDYES
 595 06125 1135         TAD ["0-"Z-1
 596 06126 7120         CLL CML
 597 06127 1134         TAD ["Z-"A+1
 598 06130 7420         SNL
 599 06131 2316 DCDYES, ISZ DECODE      /IT WAS!
 600 06132 5716         JMP I DECODE
 601            
 602 06133 0000 NMBASE, 0
 603 06134 0000 PERDSW, 0
 604 06135 0000 NAMECT, 0
 605 06136 0000 TT,     0
 606            
 607 06137 0000 IOWAIT, 0               /WAIT FOR TELETYPE TO FINISH
 608 06140 6041         TSF
 609 06141 5340         JMP .-1
 610 06142 5737         JMP I IOWAIT
 611            
 612 06143 0000 GTMON,  0               /LOCK THE USR IN CORE
 613 06144 6212         CIF 10          /(NOP IF ALREADY IN CORE)
 614 06145 4421         JMS I USR
 615 06146 0010         10
 616 06147 1133         TAD [200        /SET POINTER FOR LATER CALLS
 617 06150 3021         DCA USR
 618 06151 5743         JMP I GTMON
 619            
 620 06152 0000 DISMIS, 0               /IF THE USR IS IN, KICK IT OUT
 621 06153 7300         CLA CLL
 622 06154 1021         TAD USR         /CHECK POINTER TO FIND OUT
 623 06155 7710         SPA CLA
 624 06156 5752         JMP I DISMIS
 625 06157 6212         CIF 10
 626 06160 4421         JMS I USR
 627 06161 0011         11
 628 06162 1251         TAD ECHGO+10    /RESET POINTER
 629 06163 3021         DCA USR
 630 06164 5752         JMP I DISMIS
 631            
 632 06177 5723         PAGE
 633 06200 0000 HANDAD,        0               /LOADS HANDLER INTO PROPER SLOT
 634 06201 1600         TAD I HANDAD    /WHICH SLOT?
 635 06202 2200         ISZ HANDAD
 636 06203 3206         DCA SLOT
 637 06204 4276         JMS COMPARE     /IF THE HANDLER HAS THE SAME NAME,
 638 06205 7776                 -2      /DON'T LOAD IT AGAIN
 639 06206 0000 SLOT,           0
 640 06207 0032                 NEWDEV-1
 641 06210 5221         JMP NOTEQ       /DIFFERENT NAMES, LOAD NEW HANDLER
 642 06211 2014         ISZ AUTO5
 643 06212 1414         TAD I AUTO5     /(SET BY 'COMPARE')
 644 06213 3054         DCA DEVNO       /MOVE DEVICE # (FOR SAVE AND CLOSE)
 645 06214 1014         TAD AUTO5       /POINTS TO DEVICE #
 646 06215 3217         DCA .+2
 647 06216 4565         JMS I [PUTDEV   /SO USR KNOWS IT'S IN CORE
 648 06217 0000                 0
 649 06220 5600         JMP I HANDAD
 650            
 651 06221 2206 NOTEQ,  ISZ SLOT        /BUMP POINTER TO SAVE NAME
 652 06222 1033         TAD NEWDEV      /MOVE NEW DEVICE NAME TO TABLE
 653 06223 3606         DCA I SLOT
 654 06224 2206         ISZ SLOT
 655 06225 1034         TAD NEWDEV+1
 656 06226 3606         DCA I SLOT
 657 06227 2206         ISZ SLOT
 658 06230 4532         JMS I [GTMON    /WE MUST CALL THE USR, MIGHT AS WELL LOCK IT IN
 659 06231 1033 RETRY,  TAD NEWDEV      /MOVE DEVICE NAME FOR MONITOR CALL
 660 06232 3242         DCA DEVC
 661 06233 1034         TAD NEWDEV+1
 662 06234 3243         DCA DEVC+1
 663 06235 1606         TAD I SLOT      /MOVE LOAD POINT
 664 06236 3244         DCA DLOAD
 665 06237 6212         CIF 10
 666 06240 4421         JMS I USR       /CALL MONITOR (ALREADY IN CORE)
 667 06241 0001         1
 668 06242 0000 DEVC,   0
 669 06243 0000         0
 670 06244 0000 DLOAD,  0
 671 06245 4463         ERROR1          /DEVICE NOT AVAILABLE OR TWO PAGE HANDLER
 672 06246 7100         CLL
 673 06247 1244         TAD DLOAD       /ENTRY POINT FOR HANDLER
 674 06250 1133         TAD [200        /IF THIS HANDLER IS IN PAGE 7600,
 675 06251 7630         SZL CLA         /DON'T BOTHER TO CHECK FOR LEGALITY
 676 06252 5265         JMP HANDOK      /SYSTEM HANDLER
 677 06253 1244         TAD DLOAD       /IF THE HANDLER WAS NOT LOADED
 678 06254 0131         AND [7600       /INTO THE PROPER PAGE, RELOAD IT!
 679 06255 7141         CLL CIA
 680 06256 1606         TAD I SLOT      /PROPER LOADING ADDRESS
 681 06257 7650         SNA CLA
 682 06260 5265         JMP HANDOK      /EVERYTHING'S ALL RIGHT
 683 06261 3244         DCA DLOAD       /CLEAR ENTRY POINT
 684 06262 4565         JMS I [PUTDEV   /TELL USR THE HANDLER IS NOT
 685 06263 6243                 DEVC+1  /IN CORE ANYMORE
 686 06264 5231         JMP RETRY       /LOAD IT THIS TIME
 687            
 688 06265 2206 HANDOK, ISZ SLOT        /BUMP POINTER TO DEVICE #
 689 06266 1243         TAD DEVC+1      /SAVE IT
 690 06267 3606         DCA I SLOT
 691 06270 2206         ISZ SLOT        /MOVE TO ENTRY POINT
 692 06271 1244         TAD DLOAD       /SAVE ENTRY
 693 06272 3606         DCA I SLOT
 694 06273 1243         TAD DEVC+1      /GET DEVICE #
 695 06274 3054         DCA DEVNO       /SAVE IT AND EXIT
 696 06275 5600         JMP I HANDAD
 697            
 698 06276 0000 COMPARE,0               /COMPARE TWO BLOCKS OF INDEFINITE LENGTH
 699 06277 1676         TAD I COMPARE   /CALLING SEQUENCE:
 700 06300 2276         ISZ COMPARE     /JMS COMPARE
 701 06301 3020         DCA XCNTR       /       -# OF WORDS TO CHECK
 702 06302 1676         TAD I COMPARE   /       FIRST-1
 703 06303 2276         ISZ COMPARE     /       SECOND-1
 704 06304 3014         DCA AUTO5       /RETURN IF MATCH
 705 06305 1676         TAD I COMPARE   /RETURN IF NO MATCH
 706 06306 2276         ISZ COMPARE
 707 06307 3015         DCA AUTO6
 708 06310 1414 AGAIN,  TAD I AUTO5     /COMPARE TWO WORDS
 709 06311 7041         CIA
 710 06312 1415         TAD I AUTO6
 711 06313 7640         SZA CLA
 712 06314 5676         JMP I COMPARE   /NO MATCH
 713 06315 2020         ISZ XCNTR       /FINISHED?
 714 06316 5310         JMP AGAIN       /NO, CHECK NEXT TWO
 715 06317 2276         ISZ COMPARE     /YES, BUMP RETURN POINTER
 716 06320 5676         JMP I COMPARE
 717            
 718 06321 0000 MPRINTC,0               /CROSS-FIELD 'PRINTC'
 719 06322 6213         CIF CDF 10
 720 06323 4777         JMS I (CPRNT
 721 06324 5721         JMP I MPRINTC
 722            
 723 06325 0000 TABCNT, 0               /TAB COUNTER (ONLY PRINTING CHARACTERS)
 724 06326 1376         TAD (-15        /7-BIT CR MEANS RETURN ONLY
 725 06327 7450         SNA
 726 06330 5344         JMP CRONLY
 727 06331 1131         TAD [-200       /CHECK FOR CR
 728 06332 7450         SNA
 729 06333 5352         JMP NEWLIN      /TYPE CR,LF
 730 06334 2325         ISZ TABCNT
 731 06335 1375         TAD (215-240
 732 06336 7500         SMA
 733 06337 2754         ISZ I TABCPT    /IT PRINTS, INCREMENT COUNT
 734 06340 7000         NOP             /IT JUST MIGHT SKIP
 735 06341 1130         TAD [240
 736 06342 6212         CIF 10
 737 06343 5725         JMP I TABCNT
 738            
 739 06344 1127 CRONLY, TAD [215
 740 06345 6212         CIF 10
 741 06346 4526         JMS I [PRINTX
 742 06347 3754         DCA I TABCPT
 743 06350 1133         TAD [200        /NULL FOR DELAY
 744 06351 5326         JMP TABCNT+1
 745            
 746 06352 3754 NEWLIN, DCA I TABCPT
 747 06353 5342         JMP CRONLY-2
 748            
 749 06354 1307 TABCPT, TABC
 750            
 751 06355 0323 COMLIST,"S              /SAVE
 752 06356 0303         "C              /CALL
 753 06357 0322         "R              /RUN
 754 06360 0314         "L              /LIST
 755 06361 0304         "D              /DELETE
 756 06362 0307         "G              /GOSUB
 757 06363 0240         "               /FAKE A 'LIBRARY RETURN' WITH A SPACE
 758 06364 0305         "E              /EXIT
 759            
 760 06365 5600 FILGO,  IOPEN
 761 06366 5400         OOPEN
 762 06367 6555         OCLOSR
 763 06370 3614         RESTOR
 764            
 765 06375 7755         PAGE
     06376 7763 
     06377 7537 
 766                   /ACTUAL LIBRARY PROCESSOR
 767                    /STARTING WITH COMMAND DECODE:
 768            
 769 06400 6211 LOWLIB, CDF 10          /CLEAR SWITCH FOR NORMAL RETURN
 770 06401 3525         DCA I [GOSWITCH /I.E. TO 'PROC' FOR REST OF LINE
 771 06402 1437         TAD I XCHAR     /MOVE CURRENT CHARACTER DOWN
 772 06403 6201         CDF
 773 06404 3066         DCA CHAR
 774 06405 1066         TAD CHAR        /SAVE FOR COMMAND SORT
 775 06406 4443         TPUSHA
 776 06407 1124         TAD [603        /'.FC' ASSUMED EXTENSION
 777 06410 3031         DCA EXTENSION
 778 06411 7610         SKP CLA         /MIGHT BE A TERMINATOR ALREADY
 779 06412 4441         TGETC           /MOVE TO END OF COMMAND WORD
 780 06413 4462         TESTRM
 781 06414 7410         SKP
 782 06415 5212         JMP .-3
 783 06416 4442         TPOPA           /RESTORE COMMAND CHAR
 784 06417 4446         TSORTJ          /AND BRANCH TO APPROIATE ROUTINE
 785 06420 6354                 COMLIST-1
 786 06421 0046                 PCOMGO-COMLIST
 787 06422 4463         ERROR1          /SORRY, CHARLIE!
 788            
 789 06423 6433 PCOMGO, SAVER
 790 06424 6602         FETCHER
 791 06425 6600         CHAINER
 792 06426 7000         LIBRARIAN
 793 06427 7252         PDELET
 794 06430 6701         GOSUB
 795 06431 6540         PRETRN
 796 06432 7600 C7600,  7600
 797            
 798 06433 4576 SAVER,  JMS I [NAME     /GET NAME FOR SAVE
 799 06434 4236         JMS PSAVE       /DO IT
 800 06435 5022         JMP PEXIT       /EASY, WASN'T IT?
 801            
 802 06436 0000 PSAVE,  0               /CALLED BY 'SAVE' AND 'GOSUB'
 803                    JMS OCHK        /CLOSE OUTPUT FILE TO AVOID TROUBLE
off page        	        ^
     06437 4777 
 804 06440 1145         TAD [NAMLOC     /POINTER TO NAME
 805 06441 3270         DCA SAVEPT
 806 06442 6211         CDF 10
 807 06443 1552         TAD I [BUFR     /GET PROGRAM LENGTH
 808 06444 6201         CDF
 809 06445 3523         DCA I [207      /SAVE IT WITH THE PROGRAM
 810 06446 4532         JMS I [GTMON    /CALL THE MONITOR
 811 06447 4522         JMS I [HANDAD   /AND THE HANDLER
 812 06450 0054                 LIBBLK-1
 813 06451 1523         TAD I [207      /SAVED LENGTH, REMEMBER?
 814 06452 0232         AND C7600       /MASK OFF
 815 06453 7110         CLL RAR         /CONVERT TO PAGES
 816 06454 3337         DCA BLOCK       /FOR HANDLER
 817 06455 1337         TAD BLOCK       /ROUND UP TO BLOCKS
 818 06456 1121         TAD [100
 819 06457 0232         AND C7600
 820 06460 7112         CLL RTR
 821 06461 7010         RAR
 822 06462 3336         DCA RECORD      /FOR MONITOR 'ENTER'
 823 06463 1336         TAD RECORD      /GET DESIRED LENGTH
 824 06464 1054         TAD DEVNO       /(SET BY 'HANDAD')
 825 06465 6212         CIF 10
 826 06466 4421         JMS I USR       /ENTER OUTPUT FILE
 827 06467 0003         3
 828 06470 0026 SAVEPT, NAMLOC
 829 06471 0000         0
 830 06472 4463         ERROR1          /NO ROOM ON DEVICE
 831 06473 1336         TAD RECORD      /SHIFT FOR CLOSING LENGTH
 832 06474 7112         CLL RTR
 833 06475 7012         RTR
 834 06476 3304         DCA SAVBLK
 835 06477 1054         TAD DEVNO       /CLOSE THE FILE BEFORE WE WRITE IT!
 836 06500 6212         CIF 10          /(SURE, IT'S CHEATING, BUT
 837 06501 4421         JMS I USR       /IT SAVES TIME!)
 838 06502 0004         4
 839 06503 0026         NAMLOC
 840 06504 0000 SAVBLK, 0
 841 06505 4463         ERROR1          /IMPOSSIBLE ERROR!
 842 06506 1304         TAD SAVBLK      /SAVE THIS CRAP TO REMEMBER
 843 06507 7041         CIA             /WHERE THIS PROGRAM IS
 844 06510 3333         DCA LIBLEN      /IN CASE WE WANT TO GOSUB
 845 06511 1270         TAD SAVEPT
 846 06512 3104         DCA LIBFIL
 847 06513 1033         TAD NEWDEV
 848 06514 3334         DCA LIBDEV
 849 06515 1034         TAD NEWDEV+1
 850 06516 3335         DCA LIBDEV+1
 851 06517 1270         TAD SAVEPT      /MOVE STARTING BLOCK FOR WRITE
 852 06520 3330         DCA POINT4
 853 06521 7130         CLL CML RAR     /COMPUTE FUNCTION WORD
 854 06522 7001         IAC             /SET TO SEARCH FORWARD
 855 06523 1337         TAD BLOCK       /HOW MUCH TO WRITE
 856 06524 3326         DCA BLLL
 857 06525 4461         JMS I LIBHND
 858 06526 0000 BLLL,   0               /WRITE (BLOCK) BLOCKS FROM FIELD 0
 859 06527 0200         200             /FROM 200 UP
 860 06530 0000 POINT4, 0
 861 06531 5564         JMP I [DERR     /GO COMPLAIN ABOUT DEVICE
 862 06532 5636         JMP I PSAVE
 863            
 864 06533 0000 LIBLEN, 0
 865 06534 0000 LIBDEV, ZBLOCK 2
     06535 0000 
 866 06536 0000 RECORD, 0
 867 06537 0000 BLOCK,  0
 868            
 869 06540 4442 PRETRN, TPOPA           /GET BACK ALL THE JUNK WE SAVED
 870 06541 6211         CDF 10          /FOR THE LAST GOSUB
 871 06542 3437         DCA I XCHAR     /IN-LINE CHARACTER
 872 06543 6201         CDF
 873 06544 4445         TPOPF           /DEVICE NAME
 874 06545 0033                 NEWDEV
 875 06546 4442         TPOPA           /FILE LENGTH
 876 06547 3052         DCA FLNGTH
 877 06550 4442         TPOPA           /STARTING BLOCK
 878 06551 3053         DCA STBLK
 879 06552 4522         JMS I [HANDAD   /GET THE HANDLER BACK
 880 06553 0054                 LIBBLK-1
 881                    JMP LOADGO      /LOAD THE PROGRAM
off page        	          ^
     06554 5776 
 882            
 883 06555 4520 OCLOSR, JMS I [OCLOSE   /CLOSE OUTPUT FILE
 884 06556 6213         CIF CDF 10
 885 06557 5560         JMP I [PROC     /ANOTHER EASY ONE!
 886            
 887 06560 0000 PUTDEV, 0               /TELL THE MONITOR A HANDLER IS IN OR OUT
 888 06561 1760         TAD I PUTDEV    /GET POINTER TO DEV # AND ENTRY
 889 06562 3336         DCA RECORD
 890 06563 1736         TAD I RECORD    /DEVICE #
 891 06564 2336         ISZ RECORD      /BUMP POINTER TO ENTRY
 892 06565 1375         TAD (7646       /MONITOR TABLE
 893 06566 3337         DCA BLOCK       /POINTER TO 'HANDLER-IN-CORE' FLAG
 894 06567 1736         TAD I RECORD    /FLAG IS HANDLER ENTRY
 895 06570 6211         CDF 10          /TABLE IS IN FIELD 1
 896 06571 3737         DCA I BLOCK
 897 06572 6201         CDF
 898 06573 2360         ISZ PUTDEV
 899 06574 5760         JMP I PUTDEV
 900            
 901 06575 7646         PAGE
     06576 6620 
     06577 7270 
 902                   /LOOKUP AND LOAD ROUTINES
 903            
 904 06600 7001 CHAINER,IAC             /THESE ALL DO THE SAME THING
 905 06601 7001 GOSUB1, IAC             /AND THEN GO TO DIFFERENT PLACES
 906 06602 7001 FETCHER,IAC
 907 06603 6211         CDF 10
 908 06604 3525         DCA I [GOSWITCH
 909 06605 6201         CDF
 910 06606 4561 LOAD,   JMS I [OPEN     /CALL THE HANDLER AND LOOKUP THE FILE
 911 06607 0054                 LIBBLK-1
 912 06610 0002                 2
 913 06611 5216         JMP .+5         /TTY: NOT A DIRECTORY DEVICE
 914 06612 4463         ERROR1
 915 06613 4577         JMS I [DISMISS
 916 06614 4777         JMS I (GETDEV   /GET DEVICE TYPE
 917 06615 7700         SMA CLA
 918 06616 4463         ERROR1          /NOT A DIRECTORY DEVICE
 919 06617 4502         TGETLN          /SOME COMMANDS HAVE LINE NUMBERS
 920 06620 4577 LOADGO, JMS I [DISMISS  /ONLY USED BY 'RETURN'
 921 06621 1053         TAD STBLK       /BLOCK TO READ FROM
 922 06622 3262         DCA POINT6
 923 06623 1011         TAD AUTO2       /GET PUSHDOWN POINTER
 924 06624 1131         TAD [-200       /DIDDLE IT
 925 06625 0131         AND [7600
 926 06626 7104         CLL RAL
 927 06627 7006         RTL
 928 06630 7006         RTL
 929 06631 1052         TAD FLNGTH      /NOW COMPARE WITH LENGTH OF FILE
 930 06632 7710         SPA CLA
 931                    JMP PDERR       /PROGRAM TOO LONG
off page        	         ^
     06633 5776 
 932 06634 6211         CDF 10
 933 06635 7344         CLA CLL CMA RAL /(=-2)
 934 06636 1525         TAD I [GOSWITCH /IS THIS A GOSUB?
 935 06637 7640         SZA CLA
 936 06640 5247         JMP .+7         /NO, SKIP THIS GARBAGE
 937 06641 1437         TAD I XCHAR     /YES, SAVE PROGRAM NAME, ETC.
 938 06642 6201         CDF
 939 06643 4443         TPUSHA
 940 06644 1127         TAD [215
 941 06645 6211         CDF 10
 942 06646 3437         DCA I XCHAR
 943 06647 6201         CDF
 944 06650 1052         TAD FLNGTH      /COMPUTE FUNCTION WORD
 945 06651 7041         CIA
 946 06652 7106         CLL RTL
 947 06653 7006         RTL
 948 06654 7006         RTL
 949 06655 7124         CLL CML RAL     /SET TO SEARCH FORWARD
 950 06656 3260         DCA LENF1
 951 06657 4461         JMS I LIBHND    /GET THE PROGRAM
 952 06660 3600 LENF1,  3600
 953 06661 0200         0200
 954 06662 0000 POINT6, 0
 955 06663 5564         JMP I [DERR
 956 06664 1033         TAD NEWDEV      /SAVE THIS STUFF SO WE
 957                    DCA LIBDEV      /KNOW WHERE WE ARE
off page        	          ^
     06665 3775 
 958 06666 1034         TAD NEWDEV+1
 959                    DCA LIBDEV+1
off page        	           ^
     06667 3774 
 960 06670 1053         TAD STBLK
 961 06671 3104         DCA LIBFIL
 962 06672 1052         TAD FLNGTH
 963                    DCA LIBLEN
off page        	         ^
     06673 3773 
 964 06674 1523         TAD I [207      /MOVE PROGRAM LENGTH
 965 06675 6211         CDF 10
 966 06676 3552         DCA I [BUFR
 967 06677 6201         CDF
 968 06700 5022         JMP PEXIT       /GO TO APPROPRIATE ROUTINE
 969            
 970 06701 1104 GOSUB,  TAD LIBFIL      /CHECK FOR CURRENT PROGRAM
 971 06702 7440         SZA
 972 06703 5320         JMP NOSAVE      /NO NEED TO SAVE CORE
 973 06704 4444         TPUSHF          /MOVE 'FOCAL.TM' TO NAME AREA
 974 06705 7343                 FOCTXT
 975 06706 4445         TPOPF
 976 06707 0026                 NAMLOC
 977 06710 1372         TAD (5723       /DEVICE 'DSK' FOR SAVE
 978 06711 3033         DCA NEWDEV
 979 06712 3034         DCA NEWDEV+1
 980                    JMS PSAVE       /SAVE FILE (THIS WILL LEAVE USR IN CORE)
off page        	         ^
     06713 4771 
 981 06714 1124         TAD [603        /RESET EXTENSION TO 'FC'
 982 06715 3031         DCA EXTENSION
 983 06716 4577         JMS I [DISMISS  /KICK MONITOR OUT TO SAVE STARTING BLOCK
 984 06717 1104         TAD LIBFIL
 985 06720 4443 NOSAVE, TPUSHA          /'LIBFIL' STILL IN AC
 986                    TAD LIBLEN
off page        	         ^
     06721 1773 
 987 06722 4443         TPUSHA
 988 06723 4444         TPUSHF
 989 06724 6534                 LIBDEV
 990 06725 5201         JMP GOSUB1
 991            
 992 06726 0000 XTSPNOR,0               /DUPLICATE UPPER FIELD ROUTINE
 993 06727 1066         TAD CHAR
 994 06730 1117         TAD [-240
 995 06731 7640         SZA CLA
 996 06732 5726         JMP I XTSPNOR
 997 06733 4441         TGETC
 998 06734 5327         JMP XTSPNOR+1
 999            
1000 06735 2424 TTYTXT, DEVICE TTY      /HANDY THING TO HAVE
     06736 3100 
1001            
1002 06737 0000 MSORTJ, 0               /ANOTHER DUPLICATE
1003 06740 7041         CIA
1004 06741 3036         DCA ATEM
1005 06742 1737         TAD I MSORTJ
1006 06743 2337         ISZ MSORTJ
1007 06744 3013         DCA AUTO4
1008 06745 1413         TAD I AUTO4
1009 06746 7510         SPA
1010 06747 5361         JMP MSEX
1011 06750 1036         TAD ATEM
1012 06751 7640         SZA CLA
1013 06752 5345         JMP .-5
1014 06753 1013         TAD AUTO4
1015 06754 1737         TAD I MSORTJ
1016 06755 3036         DCA ATEM
1017 06756 1436         TAD I ATEM
1018 06757 3036         DCA ATEM
1019 06760 5436         JMP I ATEM
1020            
1021 06761 2337 MSEX,   ISZ MSORTJ
1022 06762 7300         CLA CLL
1023 06763 5737         JMP I MSORTJ
1024            
1025 06764 0311 FILIST, "I              /INPUT
1026 06765 0317         "O              /OUTPUT
1027 06766 0303         "C              /CLOSE
1028 06767 0322         "R              /RESTORE
1029            
1030 06771 6436         PAGE
     06772 5723 
     06773 6533 
     06774 6535 
     06775 6534 
     06776 5646 
     06777 7152 
1031                   /THIS SECTION DOES THE DIRTY WORK OF LISTING
1032                    /ALL "FC"'S AND "FD"'S ON THE DEVICE REFERENCED
1033                    /IT WAS FUN...
1034            
1035 07000 4576 LIBRARIAN,      JMS I [NAME     /GET DEVICE TO LIST
1036 07001 4522         JMS I [HANDAD   /GET THE HANDLER
1037 07002 0054                 LIBBLK-1
1038 07003 4577         JMS I [DISMISS  /KICK OUT USR (IN CASE HANDAD CALLED IT)
1039 07004 4352         JMS GETDEV      /FIND DEVICE TYPE
1040 07005 7700         SMA CLA
1041 07006 4463         ERROR1          /CAN'T LIST A NON-DIRECTORY DEVICE
1042 07007 4440         JMS I SHNDLR    /SWAP OUT CORE TO MAKE ROOM FOR DIRECTORY
1043 07010 4200         4200
1044 07011 1000         1000
1045 07012 0040         40              /SYSTEM SCRATCH AREA
1046 07013 5564         JMP I [DERR     /WHOOPS!
1047 07014 7201         CLA IAC         /SET FLAG TO SWAP BACK IN
1048 07015 3032         DCA LISTFLG
1049 07016 7301         CLL CLA IAC     /DIRECTORY BEGINS WITH BLOCK 1
1050 07017 3223 BLOKLP, DCA LBLOCK
1051 07020 4461         JMS I LIBHND
1052 07021 0200         0200
1053 07022 1000         1000
1054 07023 0001 LBLOCK, 1
1055 07024 5564         JMP I [DERR
1056 07025 1377         TAD (1004       /FIRST 5 WORDS ARE INFORMATION
1057 07026 3013         DCA AUTO4
1058 07027 1013 LOOP2,  TAD AUTO4       /SAVE FOR LATER
1059 07030 3017         DCA AUTO8
1060 07031 1013         TAD AUTO4
1061 07032 3260         DCA LIBX
1062 07033 1413         TAD I AUTO4     /LOOKING FOR .FC & .FD FILES
1063 07034 7650         SNA CLA
1064 07035 5341         JMP PATCH       /ZERO FILE
1065 07036 2013         ISZ AUTO4
1066 07037 2013         ISZ AUTO4
1067 07040 1413         TAD I AUTO4     /PICK UP EXTENSION
1068 07041 3223         DCA LBLOCK
1069 07042 1777         TAD I (1004     /WASTE WORDS (NEGATIVE)
1070 07043 7041         CIA             /THANKS FOR TELLING US, RITCHIE
1071 07044 1013         TAD AUTO4       /SKIP TO LENGTH
1072 07045 3013         DCA AUTO4
1073 07046 1413         TAD I AUTO4     /ZERO LENGTH MEANS TEMPORARY FILE
1074 07047 7450         SNA
1075 07050 5342         JMP LOOP3       /IGNORE SUCH THINGS
1076 07051 7141         CLL CIA
1077 07052 3052         DCA FLNGTH      /SAVE POSITIVE LENGTH
1078 07053 1026         TAD NAMLOC      /IF A NAME WAS GIVEN, SEE IF WE
1079 07054 7650         SNA CLA         /HAVE REACHED IT YET
1080 07055 5264         JMP TESTGO      /NO NAME
1081 07056 4516         JMS I [COMPARE  /COMPARE THIS NAME WITH ARG
1082 07057 7774                 -4
1083 07060 0000 LIBX,           0
1084 07061 0025                 NAMLOC-1
1085 07062 5342         JMP LOOP3       /NON-MATCHING
1086 07063 3026         DCA NAMLOC      /WE FOUND IT, DON'T CHECK ANY MORE
1087 07064 1223 TESTGO, TAD LBLOCK      /COMPARE EXTENSION
1088 07065 1376         TAD (-604       /DO WE WANT THIS ONE?
1089 07066 7440         SZA
1090 07067 7001         IAC
1091 07070 7640         SZA CLA
1092 07071 5342         JMP LOOP3       /GUESS NOT
1093 07072 7346 DIRLIST,CLA CLL CMA RTL /PRINT 3 WORDS
1094 07073 3370         DCA COUNT
1095 07074 1417         TAD I AUTO8/SET BEFORE THIS
1096                    JMS NPACK       /PRINT 2 CHARS
off page        	         ^
     07075 4775 
1097 07076 2370         ISZ COUNT
1098 07077 5274         JMP .-3
1099 07100 1374         TAD (".
1100 07101 4501         TPRINTC
1101 07102 1417         TAD I AUTO8     /PRINT EXTENSION
1102                    JMS NPACK
off page        	        ^
     07103 4775 
1103 07104 1373         TAD (PTABLE     /SET UP FOR DECIMAL LENGTH PRINT
1104 07105 3033         DCA POINT
1105 07106 3034 ZLOOP,  DCA ZERSW
1106 07107 3370         DCA COUNT
1107 07110 1433 NLOOP,  TAD I POINT     /FINISHED ALL POWERS OF 10?
1108 07111 7450         SNA
1109 07112 5336         JMP NEND        /YES, ALL DONE
1110 07113 1052         TAD FLNGTH      /NO, SUBTRACT THIS POWER
1111 07114 7510         SPA             /UNDERFLOW?
1112 07115 5321         JMP PDIGIT      /YES, PRINT THIS DIGIT
1113 07116 3052         DCA FLNGTH      /NO, GO THROUGH THE LOOP AGAIN
1114 07117 2370         ISZ COUNT       /ADD ONE TO THIS DIGIT
1115 07120 5310         JMP NLOOP       /ANOTHER DIVIDE CYCLE
1116            
1117 07121 7300 PDIGIT, CLA CLL         /CRAP IN AC
1118 07122 2033         ISZ POINT       /NEXT POWER OF TEN
1119 07123 1370         TAD COUNT       /IF THIS DIGIT IS ZERO,
1120 07124 2034         ISZ ZERSW       /AND NO OTHER DIGITS HAVE BEEN NON-ZERO,
1121 07125 7440         SZA             /PRINT A SPACE INSTEAD
1122 07126 5332         JMP NPRNT
1123 07127 1130         TAD [240
1124 07130 4501         TPRINTC
1125 07131 5306         JMP ZLOOP
1126 07132 1115 NPRNT,  TAD [260        /CHANGE TO ASCII
1127 07133 4501         TPRINTC
1128 07134 7340         CLA CLL CMA     /SET ZERO SWITCH
1129 07135 5306         JMP ZLOOP
1130 07136 1127 NEND,   TAD [215        /DONE WITH THIS LINE (WHEW!)
1131 07137 4501         TPRINTC
1132 07140 5342         JMP LOOP3
1133            
1134 07141 2013 PATCH,  ISZ AUTO4       /BUMP PAST EMPTY LENGTH
1135 07142 2622 LOOP3,  ISZ I LBLOCK-1  /DONE WITH THIS BLOCK?
1136 07143 5227         JMP LOOP2       /NO, KEEP GOING
1137 07144 4562 LEXIT,  JMS I [IOWAIT   /WAIT FOR I/O
1138 07145 1514         TAD I [1002     /LINK TO NEXT BLOCK
1139 07146 7440         SZA             /LAST BLOCK?
1140 07147 5217         JMP BLOKLP      /NO, GET THE NEXT
1141                    JMS SWAPIN      /YES, RESTORE SWAPPED CORE AND EXIT
off page        	          ^
     07150 4772 
1142 07151 5022         JMP PEXIT
1143            
1144 07152 0000 GETDEV, 0               /GET DEVICE TYPE FROM MONITOR TABLE
1145 07153 1113         TAD [7757       /DCB-1
1146 07154 1054         TAD DEVNO
1147 07155 3370         DCA COUNT
1148 07156 6211         CDF 10
1149 07157 1770         TAD I COUNT
1150 07160 6201         CDF
1151 07161 5752         JMP I GETDEV
1152            
1153                    DECIMAL
1154 07162 6030 PTABLE, -1000
1155 07163 7634         -100
1156 07164 7766         -10
1157 07165 7777         -1
1158 07166 0000         0
1159                    OCTAL
1160            
1161                    POINT=NEWDEV
1162                    ZERSW=NEWDEV+1
1163 07167 0000 POINT7, 0
1164 07170 0000 COUNT,  0
1165            
1166 07172 7275         PAGE
     07173 7162 
     07174 0256 
     07175 7305 
     07176 7174 
     07177 1004 
1167                   /MISCELLANEOUS GENERAL-PURPOSE ROUTINES
1168            
1169                    /THIS IS THE GENERAL OPEN SUBROUTINE
1170                    /CALLNG SEQUENCE:
1171                    /JMS I [OPEN
1172                    /HANDLER BLOCK
1173                    /MONITOR CALL CODE
1174                    /RETURN IF TTY: IS DEVICE
1175                    /ERROR RETURN
1176                    /NORMAL RETURN
1177                    /SETS STBLK, FLNGTH ON PAGE ZERO
1178            
1179 07200 0000 OPEN,   0
1180 07201 7340         CLA CLL CMA     /INITIALIZE ECHO FLAG TO OFF
1181 07202 3047         DCA ECHFLG
1182 07203 4576         JMS I [NAME     /GET DEVICE AND FILENAME
1183 07204 4516         JMS I [COMPARE  /DEVICE 'TTY:' IS SPECIAL
1184 07205 7776                 -2
1185 07206 0032                 NEWDEV-1
1186 07207 6734                 TTYTXT-1
1187 07210 5214         JMP OTHER       /DEVICE OTHER THAN TTY
1188 07211 2200         ISZ OPEN        /INCREMENT TO PROPER RETURN
1189 07212 2200         ISZ OPEN
1190 07213 5600         JMP I OPEN
1191 07214 1600 OTHER,  TAD I OPEN      /GET HANDLER BLOCK TO USE
1192 07215 3223         DCA HND
1193 07216 2200         ISZ OPEN
1194 07217 1145         TAD [NAMLOC     /POINTER TO NAME
1195 07220 3234         DCA NAMPT
1196 07221 4532         JMS I [GTMON
1197 07222 4522         JMS I [HANDAD   /GET THE HANDLER
1198 07223 0000 HND,            0       /SET TO HANDLER BLOCK
1199 07224 1600         TAD I OPEN      /GET MONITOR CALL CODE (2 OR 3)
1200 07225 2200         ISZ OPEN
1201 07226 3233         DCA CALL
1202 07227 3235         DCA LNGTH       /FOR MONITOR KLUDGE (IT FALLS THROUGH ON ERROR)
1203 07230 1054         TAD DEVNO       /DO THE CALL
1204 07231 6212         CIF 10
1205 07232 4421         JMS I USR
1206 07233 0000 CALL,   0
1207 07234 0026 NAMPT,  NAMLOC
1208 07235 0000 LNGTH,  0
1209 07236 5212         JMP OTHER-2     /LET THE CALLING ROUTINE DECIDE ERROR PROCEDURE
1210 07237 1235         TAD LNGTH       /MOVE PARAMETERS TO PAGE ZERO
1211 07240 3052         DCA FLNGTH
1212 07241 1234         TAD NAMPT
1213 07242 3053         DCA STBLK
1214 07243 5211         JMP OTHER-3     /AND TAKE NORMAL RETURN
1215            
1216 07244 0000 ERROR,  0               /LOWER FIELD ERROR ROUTINE
1217 07245 4577         JMS I [DISMIS   /MAKE SURE
1218 07246 1244         TAD ERROR       /FAKE OUT ERROR ROUTINE
1219 07247 6213         CIF CDF 10      /AND GO TO IT
1220 07250 3777         DCA I (ERR2
1221 07251 5776         JMP I (ERR2+1
1222            
1223 07252 4576 PDELET, JMS I [NAME     /DELETE IS AN EASY ONE (THANK GOD!)
1224 07253 4532         JMS I [GTMON
1225 07254 4522         JMS I [HANDAD
1226 07255 0054                 LIBBLK-1
1227 07256 4270         JMS OCHK        /CLOSE ANY OPEN OUTPUT FILE
1228 07257 6212         CIF 10          /DELETE THE FILE
1229 07260 1054         TAD DEVNO
1230 07261 4421         JMS I USR
1231 07262 0004         4
1232 07263 0026         NAMLOC
1233 07264 0000         0
1234 07265 4463         ERROR1
1235 07266 3104         DCA LIBFIL      /IN CASE HE JUST DELETED THIS PROGRAM
1236 07267 5022         JMP PEXIT
1237            
1238 07270 0000 OCHK,   0               /IF ANY FILE EXISTS, CLOSE IT
1239 07271 1105         TAD DEVHLD
1240 07272 7640         SZA CLA
1241                    JMS OCLOSE
off page        	         ^
     07273 4775 
1242 07274 5670         JMP I OCHK
1243            
1244 07275 0000 SWAPIN, 0               /RESTORE CORE AFTER DIRECTORY LIST
1245 07276 3032         DCA LISTFLG
1246 07277 4440         JMS I SHNDLR
1247 07300 0200         200
1248 07301 1000         1000
1249 07302 0040         40
1250 07303 4463 DERR,   ERROR1          /DEVICE ERROR
1251 07304 5675         JMP I SWAPIN
1252            
1253 07305 0000 NPACK,  0               /STANDARD 6-BIT UNPACK ROUTINE
1254 07306 3270         DCA OCHK
1255 07307 1270         TAD OCHK
1256 07310 7012         RTR
1257 07311 7012         RTR
1258 07312 7012         RTR
1259 07313 4317         JMS XFORM
1260 07314 1270         TAD OCHK
1261 07315 4317         JMS XFORM
1262 07316 5705         JMP I NPACK
1263            
1264 07317 0000 XFORM,  0
1265 07320 0112         AND [77
1266 07321 7440         SZA             /PRINT SPACES FOR NULLS
1267 07322 1374         TAD (-40
1268 07323 7510         SPA
1269 07324 1121         TAD [100
1270 07325 1130         TAD [240
1271 07326 4501         TPRINTC
1272 07327 5717         JMP I XFORM
1273            
1274 07330 1050 OCLCHK, TAD OPNFLG      /MAKE 'OPEN OUTPUT' WITH AN ALREADY OPEN FILE
1275 07331 7650         SNA CLA         /THE SAME AS 'OUTPUT CLOSE;OPEN OUTPUT'
1276 07332 4463         ERROR1
1277                    JMS OCLOSE
off page        	         ^
     07333 4775 
1278 07334 1373         TAD (YINT       /FAKE OUT 'OPEN'
1279 07335 3200         DCA OPEN
1280 07336 5214         JMP OTHER
1281            
1282 07337 0000 MGETLN, 0               /CROSS-FIELD FAKE
1283 07340 6213         CIF CDF 10
1284 07341 4772         JMS I (PGETLN
1285 07342 5737         JMP I MGETLN
1286            
1287 07343 0617 FOCTXT, FILENAME FOCAL.TM       /USED BY 'GOSUB'
     07344 0301 
     07345 1400 
     07346 2415 
1288            
1289 07347 0000 XGETC,  0               /ANOTHER FAKE
1290 07350 6213         CIF CDF 10
1291 07351 4771         JMS I (MGETC
1292 07352 1437         TAD I XCHAR
1293 07353 6201         CDF
1294 07354 3066         DCA CHAR
1295 07355 5747         JMP I XGETC
1296            
1297 07371 5774         PAGE
     07372 7543 
     07373 5402 
     07374 7740 
     07375 3636 
     07376 2673 
     07377 2672 
1298            
1299 00112 0077         FIELD 1
     00113 7757 
     00114 1002 
     00115 0260 
     00116 6276 
     00117 7540 
     00120 3636 
     00121 0100 
     00122 6200 
     00123 0207 
     00124 0603 
     00125 7513 
     00126 3171 
     00127 0215 
     00130 0240 
     00131 7600 
     00132 6143 
     00133 0200 
     00134 0032 
     00135 7725 
     00136 0012 
     00137 7506 
     00140 7473 
     00141 0004 
     00142 0057 
     00143 0002 
     00144 7522 
     00145 0026 
     00146 0007 
     00147 3137 
     00150 7774 
     00151 0003 
     00152 0060 
     00153 2605 
     00154 2162 
     00155 4551 
     00156 0064 
     00157 0177 
     00160 0607 
     00161 7200 
     00162 6137 
     00163 7400 
     00164 7303 
     00165 6560 
     00166 5743 
     00167 0063 
     00170 2617 
     00171 0232 
     00172 5425 
     00173 7772 
     00174 5615 
     00175 7467 
     00176 6000 
     00177 6152 
1300            /EFOC1B -- PS/8 FOCAL MAIN INTERPRETER
1301            
1302            
1303            /THIS VERSION OF PS/8 FOCAL WAS DERIVED FROM THE FOLLOWING
1304            /       FOCAL-8 SOURCE:
1305            
1306            /***********************************************************************
1307            /DEC-8E-LFOCA-A-LA1
1308            
1309            /OCTOBER 1971                   RM/SM
1310            
1311            /COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION
1312            /       MAYNARD, MASSACHUSETTS 01754
1313            
1314            /FOCAL IS A REGISTERED TRADEMARK OF
1315            /DIGITAL EQUIPMENT CORPORATION
1316            
1317            /FOCAL-8 IS AN ON-LINE FORMULA CALCULATOR AND
1318            /COMPILER FOR STATEMENTS IN ALGEBRAIC LANGUAGE
1319            /THIS VERSION OF FOCAL-8 IS SUPPORTED ON THE PDP-8/E
1320            
1321            /***********************************************************************
1322            
1323            /NOTES ON LISTING COMMENTS:
1324            
1325            /THE LIMITS OF PAGE BOUNDARY WANDERING ARE DENOTED BY:
1326            
1327            /-------------------------------------------------------------------
1328            /PAGE BOUNDARY
1329            /------------------------------------------------------------------
1330            
1331            /LOCATIONS OVERLAYED BY THE 8K OVERLAY ARE DENOTED BY     /*8K*
1332            
1333            /PSEUDO-FLOATING POINT INSTRUCTIONS
1334            
1335            FIXMRI FPOW=5000
1336            FIXMRI FADD=1000
1337            FIXMRI FSUB=2000
1338            FIXMRI FMUL=4000
1339            FIXMRI FDIV=3000
1340            FIXMRI FGET=0000
1341            FIXMRI FPUT=6000
1342            
1343            FNOR=7000
1344            FEXT=0
1345            FXIT=0
1346            FINT=JMS I 7
1347            FENT=JMS I 7
1348            RFC=6014
1349            SMP=6101
1350            KCF=6030
1351            DCMA=6601
1352            
1353            NEGATE=JMS I 51
1354            
1355            
1356                    FIELD 1
1357            
1358            /MISCELLANEOUS ITEMS
1359            *0
1360 10000 3116 ECHOP,  ECHO
1361 10001 0013 P13,    13      /CONSTANT
1362 10002 0100 C100,   100     /CONSTANT
1363            
1364            /LOCATIONS 4,5,6 RESERVED FOR XODGWU
1365            
1366            *7
1367 10007 6400         FPNT    /ADDRESS OF FLOATING POINT INTERPRETER
1368            
1369            /AUTO-INDEX REGISTERS
1370            
1371 10010 0000 AXIN,   0       /STORAGE INDEX (LOC *10)
1372 10011 0000 XRT,    0       /EXTRA XR
1373 10012 0000 XRT2,   0       /EXTRA XR
1374 10013 4617 PDLXR,  FEXP-1          /PUSHDOWN LIST INDEX REGISTER.
1375 10014 0000 FLTXR,  0       /XR FOR FLOATING POINT
1376 10015 0000 FLTXR2, 0       /EXTRA FOR F.P.
1377 10016 0000 RISZ,   0       /RANDOM RANDOM #'S
1378            
1379            TEXTP=. /TEXT POINTERS (LOC *17)
1380 10017 0000 AXOUT,  0       /OUTPUT INDEX
1381 10020 0000 XCT,    0       /UNPACK SWITCH
1382 10021 0000 GTEM,   0       /UNPACK STORAGE
1383 10022 0200 PC,     PC0     /PROGRAM COUNTER                /*8K*
1384            
1385 10023 0000 THISLN, 0       /LINE POINTER FROM 'FINDLN'
1386 10024 0000 THISOP, 0       /CURRENT 'EVAL' OPERATION
1387 10025 0000 LASTLN, 0       /BACK POINTER FROM 'FINDLN'
1388 10026 0001 DEBGSW, 1       /DEBUG SWITCH  ; NON-ZERO FOR LITERAL.
1389 10027 0000 PACKST, 0       /RUBOUT PROTECTION
1390 10030 0000 PT1,    0       /VARIABLE POINTER
1391 10031 3400 LASTV,  STVAR   /ADDRESS OF LAST VARIABLE       /*8K*
1392 10032 0000 T1,     0       /TEMPORARY REGISTER - MAIN
1393 10033 0000 T3,     0       /TEMP REGISTER FOR OUTPUT
1394 10034 0000 INBUF,  0       /KEYBOARD INPUT BUFFER
1395 10035 4617 BOTTOM, FEXP-1          /LAST LOCATION CURRENTLY AVAILABLE IN FIELD ZERO
1396 10036 0000 INSUB,  0       /0= GETC; #0 = READC
1397 10037 2010 GOK,    GOKILL  /TO KILL 'CURRENT PROGRAM SAVED' FLAG
1398            
1399            /  *40 = FLOATING POINT
1400            
1401            *54
1402            
1403            /VARIABLES   -   INITIALIZED FOR THE DIALOGUE
1404            
1405            
1406 10054 0000 SORTCN, 0       /NUMBER IN TABLE FROM SORTC
1407 10055 0000 LASTOP, 0       /LAST OPERATION FOR EVAL
1408 10056 0000 EFOP,   0               /FUNCTION CODE.
1409 10057 7760 CNTR,   -20     /DELETE AND ERROR COUNTER(USED BY F.P. ALSO)
1410            
1411 10060 0224 BUFR,   LINE1   /NEXT LOCATION IN BUFFER = LAST LOCATION OF TEXT/*8K*
1412            
1413 10061 2617 ADD,    XOUTL   /CHAR. BUF. IN.  (DEBUG AIDS.SEE BELOW.)
1414 10062 0000 XCTIN,  0       /PACK SWITCH
1415 10063 2617 OUTDEV, XOUTL   /POINTER TO OUT. SUB.   (OUTL)-FOR DEBUGGING
1416 10064 2605 INDEV,  XI33    /POINTER TO IN. SUB.    (I33)-FOR DEBUGGING
1417            
1418 10065 0001 NAGSW,  0001    /NOT ALL AND/OR GROUP SWITCH(4000=ONE;1=ALL;0=GROUP);(0000)-FOR TSS-8
1419 10066 0215 CHAR,   215     /THE MOST IMPORTANT REGISTER
1420 10067 0000 LINENO, 0000    /LINE NUMBER READ BY GETLN;(0400)-FOR TSS-8
1421 10070 0006 GINC,   WORDS+2 /=6 FOR 4-WORD - CONSTANT
1422            
1423 10071 0000 T2,     0       /TEMP REGISTER - FOR NEW INST. ROUTINES.
1424            
1425            
1426            
1427            
1428                    *73
1429 10073 0214 LIST6,  214     /F.F. (^L)
1430 10074 0207         207     /BELL
1431            LIST7=.
1432 10075 0337 P337,   337     /LEFT ARR
1433 10076 0212 CLF,    212     /L.F.
1434            LIST3=. /EXCRETION LIST
1435 10077 0215 CCR,    215     /LIST BRANCHER.
1436 10100 7402 DMPSW,  HLT     /(SEARCH CHARACTER)-VARIABLE
1437            /=0000 FOR TRACE ON.
1438            
1439            
1440            /THE REST OF PAGE ZERO IS PURE TO THE MULTI-USER SYSTEM
1441            
1442            M100=.
1443 10101 7700 P7700,  7700    /LEFT MASK
1444 10102 0256 PER,    256     /PERIOD
1445 10103 7701 M77,    -77     /EXTEND CODE TEST
1446 10104 7600 P7600,  7600    /GROUP MASK
1447 10105 7760 M20,    -20     /CONSTANT
1448 10106 0177 P177,   177     /STEP MASK
1449 10107 0017 P17,    17      /BCD MASK
1450 10110 0277 P277,   277     /"?"
1451 10111 7776 M2,     -2      /CONSTANT
1452 10112 7477 MINUSA, -301    /CONSTANT
1453 10113 0260 C260,   260     /ASCII FOR ZERO
1454 10114 7540 M240,   -240    /SPACE TEST
1455 10115 7522 MPER,   -256    /PERIOD TEST
1456 10116 7563 MCR,    -215    /C.R. TEST
1457 10117 7774 MFLT,   -WORDS  /= -4 FOR 4-WORD
1458 10120 7773 M5,     -5      /PAREN TEST
1459 10121 7767 M11,    -11     /PAREN TEST
1460 10122 0077 P77,    77      /RIGHT MASK
1461 10123 0200 C200,   200     /CONSTANTS
1462 10124 4000 P4000,  4000    /NAGSW TEST CONSTANT (FOR PDP-5)
1463            
1464 10125 2030 FLARGP, FLARG   /DATA ADDRESS
1465 10126 5715 DOUBLE, MULT2   /MULTIPLY FLAC BY 2
1466 10127 6000 FOUTPUT,FLOUTP  /FLOATING OUTPUT
1467 10130 6200 FINPUT, FLINTP  /FLOATING INPUT
1468                    COMBUF=.
1469 10131 0104 LIBN,   LIBFIL  /COMMAND BUFFER START
1470 10132 0210 CFRS,   LINE0   /ADDRESS OF DUMMY LINE
1471            
1472            STARTV=.
1473 10133 3400 END,    STVAR   /VARIABLE BUFFER START
1474 10134 0224 ENDT,   LINE1   /TEXT BUFFER START
1475 10135 2017 EFUN3I, EFUN3   /FUNCTION RETURN
1476 10136 2407 CFRSX,  FLTZER  /MOVED FOR ^L FUDGE
1477            
1478            
1479            /'FINPUT' USES CHAR AND GETC OR READC TO DEVELOP 
1480            /A NUMBER WHICH IS THEN STORED VIA PT1.
1481            
1482            WORDS=4 /OR 3
1483            /NEW INSTRUCTIONS:
1484            
1485            PUSHJ=JMS I .   /RECURSIVE SUBROUTINE CALLS
1486 10137 2414         XPUSHJ
1487            POPJ=JMP I .    /RECURSIVE RETURN
1488 10140 1561         XPOPJ
1489            PUSHA=JMS I .   /SAVE AC
1490 10141 1354         XPUSHA
1491            POPA=JMS I .    /RESTORE AC
1492 10142 0520         XPOPA
1493            PUSHF=JMS I .   /SAVE FP #
1494 10143 0476         PD2
1495            POPF=JMS I .    /RESTORE FP #
1496 10144 0507         PD3
1497            GETC=JMS I .    /UNPACK A CHARACTER
1498 10145 2273         UTRA
1499            PACKC=JMS I .   /PACK A CHARACTER
1500 10146 2504         PACBUF
1501            SORTJ=JMS I .   /SORT AND BRANCH ON AC OR CHAR
1502 10147 1142         SORTB
1503            SORTC=JMS I .   /SORT CHAR
1504 10150 0721         XSORTC
1505            PRINTC=JMS I .  /PRINT AC OR CHAR
1506 10151 2463 XPRNTC, OUT
1507            READC=JMS I .   /READ DATA INTO CHAR AND PRINT IT
1508 10152 2154 RDIV,   CHIN
1509            PRNTLN=JMS I .  /PRINT C(LINENO)
1510 10153 2423         XPRNT
1511            GETLN=JMS I .   /UNPACK AND FORM A LINENUMBER
1512 10154 0315         XGETLN
1513            FINDLN=JMS I .  /SEARCH FOR A GIVEN LINE
1514 10155 2241         XFIND
1515            ENDLN=JMS I .   /INSERT LINE POINTERS
1516 10156 2357         XENDLN
1517            RTL6=JMS I .    /ROTATE LEFT SIX
1518 10157 0412         XRTL6
1519            SPNOR=JMS I .   /IGNORE SPACES AND LEADING ZEROS
1520 10160 1515         XSPNOR
1521            TESTN=JMS I .   /PERIOD; OTHER; NUMBER
1522 10161 1531         XTESTN
1523            TSTLPR=JMS I .  /SKIP IF 5<SORTCN<= 11 (I.E. AN L-PAR)
1524 10162 2035         LPRTST
1525            TSTGRP=JMS I .  /SKIP IF G(AC) = G(LINENO)
1526 10163 0744         GRPTST
1527            TESTC=JMS I .   /TERM; NUMBER; FUNCTION; LETTER- AND IGNORE SPACES.
1528 10164 0700         XTESTC
1529            DELETE=JMS I .  /REMOVE OLD TEXT LINE
1530 10165 2062 PSIN,   XDELETE
1531            ERROR2=JMS I .  /EXCESS SOMETHING ERROR
1532            ERROR3=JMS I .  /MISCELLANEOUS ERROR
1533            ERROR4=JMS I .  /FORMAT ERROR
1534 10166 2672         ERR2
1535            
1536 10167 2566 DPC,    PS8PC   /PC
1537 10170 6160 DTHIS,  THISD   /THISLN
1538 10171 6165 DPT1,   PT1D    /PT1
1539 10172 6343 DXRT,   XRTD    /(TAD I XRT)
1540 10173 6350 DAXIN,  AXIND   /(DCA I AXIN)
1541 10174 2573 DAXOUT, AXOUTD  /(TAD I AXOUT)
1542 10175 3400 SECRTV, STVAR   /FOR SECRET VARIABLES, OF COURSE
1543 10176 2677         RECOVR+1
1544            
1545            /COMMAND/INPUT DRIVER
1546            
1547            *177
1548 10177 7610 START,  SKP CLA         /PROGRAM START FROM SELF
1549 10200 5576         JMP I 176       /FUDGE FOR ?00.00 PRINTOUT
1550 10201 1123         TAD C200        /INITIALIZE PC
1551 10202 3022         DCA PC          /FOR COMMAND MODE
1552 10203 7001         IAC             /USE ONE IN THE AC TO
1553 10204 3100         DCA DMPSW       /INIT UNPACK AND TRACE SWITCH
1554 10205 3026         DCA DEBGSW      /ENABLE TRACE FOR INPUT OF (?)
1555 10206 1226         TAD PUSHB       /OVERFLOW PROTECTION
1556 10207 3013         DCA PDLXR       /NO PATCH TEST
1557 10210 1225         TAD CSTAR       /TYPE * TO INDICATE COMMAND MODE
1558 10211 4400         JMS I ECHOP     /SHOULD WE PRINT A '*'?
1559 10212 1060 IBAR,   TAD BUFR        /COMMAND INPUT BUFFER
1560 10213 3010         DCA AXIN        /FOR UNPACKING
1561 10214 3062         DCA XCTIN
1562 10215 1060         TAD BUFR        /RUBOUT PROTECTION
1563 10216 3027         DCA PACKST
1564 10217 4552 IGNOR,  READC           /READ COMMAND STRING
1565 10220 4547         SORTJ
1566 10221 0074         LIST7-1 /MOVED DOWN ONE
1567 10222 0472         INLIST-LIST7
1568 10223 4546         PACKC           /SAVE STRING CHARACTER.
1569 10224 5217         JMP IGNOR
1570            
1571 10225 0252 CSTAR,  252             /ACKNOWLEDGE CHARACTER
1572 10226 3626 PUSHB,  RESTORE-1+13    /END FOR TEXT AND COMMAND INPUT
1573            
1574            /COMMAND/INPUT PROCESSOR
1575            
1576 10227 4546 IRETN,  PACKC           /START TO PACK C.R.
1577 10230 4546         PACKC           /FINISH C.R.
1578 10231 1060         TAD  BUFR               /INITIALIZE FOR UNPACKING
1579 10232 3017 GONE,   DCA AXOUT       /SETUP CURRENT LINE
1580 10233 3020         DCA XCT
1581 10234 4545         GETC            /READ FIRST CHARACTER.
1582 10235 1367         TAD PUSHB1      /INIT STACK POINTER
1583 10236 3013         DCA PDLXR
1584 10237 4560         SPNOR           /IGNORE LEADING BLANKS
1585 10240 4561         TESTN           /DOES THE LINE BEGIN WITH 1-9?
1586 10241 5361         JMP GZERR       /PERIOD =ILLEGAL GROUP ZERO USAGE
1587 10242 5271         JMP INPUTX      /NO
1588 10243 2026         ISZ DEBGSW      /YES,DISABLE TRACE FOR REPACKING
1589 10244 4554         GETLN           /READ THIS LINE NUMBER
1590 10245 1124         TAD P4000       /TEST  FOR SINGLE LINE.
1591 10246 1065         TAD NAGSW
1592 10247 7640         SZA CLA
1593 10250 4566         ERROR3          /ILLEGAL LINE NUMBER ON INPUT
1594 10251 1060         TAD BUFR        /SET POINTERS
1595 10252 3010         DCA AXIN
1596 10253 3062         DCA XCTIN
1597 10254 1067         TAD LINENO      /SAVE LINE #
1598 10255 4573         JMS I DAXIN     /DCA I AXIN
1599 10256 4560         SPNOR           /IGNORE SPACES AFTER LINE NUMBER
1600 10257 7410         SKP
1601 10260 4545         GETC            /READ 1ST AFTER LINENO TERMINATOR.
1602 10261 4546 SRETN,  PACKC           /SAVE TEXT AND RESTORE DATA FIELD
1603 10262 1066         TAD CHAR        /TEST FOR END OF INPUT STRING
1604 10263 1116         TAD MCR
1605 10264 7640         SZA CLA
1606 10265 5260         JMP .-5
1607 10266 4565         DELETE          /REMOVE OLD LINE, IF ANY.
1608 10267 4556         ENDLN           /INSERT NEW LINE
1609 10270 5177         JMP START       /POINTERS MUST BE REINITIALIZED
1610 10271 4537 INPUTX, PUSHJ           /PROCESS IMMEDIATE COMMAND.
1611 10272 0607         PROC
1612 10273 4567         JMS I DPC       /TAD I PC
1613 10274 7450         SNA             /END OF PROGRAM? 
1614 10275 5177         JMP START       /YES
1615 10276 3022         DCA PC          /SAVE NEW LINE NO.
1616 10277 1022         TAD PC          /START NEW LINE
1617 10300 7001         IAC
1618 10301 5232         JMP GONE        /PROCESS OTHER COMMANDS
1619            
1620            /TEXT LINE BUFFER FORMAT*
1621            
1622            /#1 : POINTER OR ZERO IN LAST
1623            /#2 : LINENO
1624            /#3 - #N+1 : TEXT
1625            /#N : C.R.
1626            
1627            /LINE NUMBER FORMATION
1628            
1629 10302 0007 FL100,  7
1630 10303 3100         3100
1631 10304 0000         0
1632 10305 0000 FLP5,   0
1633 10306 2000         2000
1634 10307 0000         0
1635 10310 0000         0
1636 10311 0000 PTEMP,  ZBLOCK 4
     10312 0000 
     10313 0000 
     10314 0000 
1637 10315 0000 XGETLN, 0       /COMPUTED LINE #'S
1638 10316 4560         SPNOR   /IGNORE SPACE
1639 10317 1066         TAD CHAR        /'A' IS SPECIAL
1640 10320 1112         TAD MINUSA
1641 10321 7650         SNA CLA
1642 10322 5350         JMP TESTA
1643 10323 4537         PUSHJ   /EVALUATE NUMBER OR EXPRESSION
1644 10324 1613                 EVAL
1645 10325 4407         FENT
1646 10326 6311         FPUT PTEMP      /SAVE IT
1647 10327 0000         FEXT
1648 10330 4453         JMS I INTEGER           /GET GROUP PART
1649 10331 1371         TAD P7740       /CHECK IF TOO BIG
1650 10332 7700         SMA CLA
1651 10333 4566         ERROR2  /BAD GROUP #
1652 10334 1046         TAD FLAC+2      /GET GROUP AGAIN
1653 10335 4557         RTL6
1654 10336 7004         RAL
1655 10337 3067         DCA LINENO      /SAVE IT
1656 10340 4451         NEGATE
1657 10341 4407         FENT
1658 10342 1311         FADD PTEMP      /GET FRACTION
1659 10343 4302         FMUL FL100
1660 10344 1305         FADD FLP5       /ROUND UP
1661 10345 0000         FEXT
1662 10346 4453         JMS I INTEGER
1663 10347 1067         TAD LINENO      /ADD GROUP
1664 10350 3067 TESTA,  DCA LINENO
1665 10351 7300         CLA CLL
1666            
1667 10352 1067         TAD LINENO      /CHECK FOR ERROR
1668 10353 0104         AND P7600
1669 10354 7640         SZA CLA
1670 10355 7020         CML
1671 10356 1067         TAD LINENO
1672 10357 0106         AND P177
1673 10360 7460         SNL SZA
1674 10361 4566 GZERR,  ERROR2          /ILLEGAL GROUP ZERO USAGE
1675 10362 7640         SZA CLA         /AND SET NAGSW
1676 10363 1372         TAD P2000
1677 10364 7024         CML RAL
1678 10365 3065         DCA NAGSW
1679 10366 5715         JMP I XGETLN
1680 10367 3611 PUSHB1, 3576+13
1681 10370 5600 LCON,   DECONV
1682 10371 7740 P7740,  7740
1683 10372 2000 P2000,  2000
1684            
1685            /RANGE OF ACCEPTABLE LINE NUMBERS = 1.01 TO 31.99
1686            /NAGSW:
1687            
1688            /GROUP=0000
1689            /LINE=4000
1690            /ALL=0001
1691            
1692            /---------------------------------------------------------------------
1693            /LIST OF FUNCTION ADDRESSES. (NAMES ARE IN "FNTABL")
1694            
1695            FNTABF=.
1696 10373 2014         XABS    /FABS   -ABSOLUTE VALUE
1697 10374 7554         XSGN    /FSGN   -SIGN PART
1698 10375 1351         XINT    /FITR   -INTEGER PART
1699 10376 3200         FDIS    /TEK 4010 DISPLAY FUNCTION
1700 10377 7547 PFRAN,  FRAN    /FRAN   -RANDOM NUMBER
1701 10400 3306         FJOY    /TEK 4010 CROSSHAIR INPUT FUNCTION
1702 10401 5000         ARTN    /FATN   -ARCTANGENT
1703 10402 4620         FEXP    /FEXP   -E^X
1704 10403 5040         FLOG    /FLOG   -LN(X)
1705 10404 5205         FSIN    /FSIN   -SINE
1706 10405 5200         FCOS    /FCOS   -COSINE
1707 10406 7400         XSQRT   /FSQT   -SQUARE ROOT
1708 10407 7520         FIN     /CHARACTER INPUT FUNCTION
1709 10410 7532         FOUT    /CHARACTER OUTPUT FUNCTION
1710 10411 0551         FIND    /FIND FUNCTION
1711            
1712            /-----------------------------------------------------------------------
1713 10412 0000 XRTL6,  0       /ROTATE AC LEFT SIX - "RTL6"
1714 10413 7106         CLL RTL
1715 10414 7006         RTL
1716 10415 7006         RTL
1717 10416 5612         JMP I XRTL6     /--RETURN--
1718            
1719            /RECURSIVE OPERATE, EXECUTE, OR CALL 
1720            
1721 10417 4554 DO,     GETLN           /EXECUTE ONE LINE, A GROUP,OR ALL
1722 10420 1022         TAD PC          /SAVE ADDRESS
1723 10421 4541         PUSHA           /OF CURRENT LINE
1724 10422 4543         PUSHF           /SAVE REST OF THIS LINE
1725 10423 0017         TEXTP           /ADDRESS OF TEXT POINTERS
1726 10424 4543 DGRP,   PUSHF           /SAVE NAGSW; CHAR; AND LINENO.
1727 10425 0065         NAGSW
1728 10426 1065         TAD NAGSW       /CHECK DATA FROM GETLN.
1729 10427 7710         SPA CLA         /SKIP IF GROUP OR ALL
1730 10430 5262         JMP DOONE       /DO ONE LINE
1731 10431 4555         FINDLN          /INIT FOR GROUP AND SET THISLN
1732 10432 7000         NOP
1733 10433 1023         TAD THISLN      /TEST FOR GOOD GROUP NUMBER.
1734 10434 3011         DCA XRT
1735 10435 4572         JMS I DXRT      /TAD I XRT      /*8K*
1736 10436 4563         TSTGRP
1737 10437 4566         ERROR2          /NO SUCH GROUP NUMBER
1738 10440 4537 DGRP1,  PUSHJ           /EXECUTE OBJECT LINE AND SET PC.
1739 10441 0604         PROCESS-2
1740 10442 4544         POPF            /RESTORE THE DATA
1741 10443 0065         NAGSW
1742 10444 4567         JMS I DPC
1743 10445 7450         SNA
1744 10446 5270         JMP DCONT       /ALL DONE
1745 10447 7001         IAC
1746 10450 3030         DCA PT1         /SAVE POINTER TO LINENO
1747 10451 1065         TAD NAGSW       /CHECK FOR GROUP
1748 10452 7740         SMA SZA CLA
1749 10453 5257         JMP .+4         /DO ALL
1750 10454 4571         JMS I DPT1      /TAD I PT1
1751 10455 4563         TSTGRP
1752 10456 5270         JMP DCONT       /NOT IN GROUP
1753 10457 4571         JMS I DPT1      /TAD I PT1
1754 10460 3067         DCA LINENO
1755 10461 5224         JMP DGRP        /CONTINUE THE SUBROUTINE
1756            
1757 10462 4555 DOONE,  FINDLN          /FIND THE LINE
1758 10463 4566         ERROR2          /NO SUCH LINE NUMBER
1759 10464 4537         PUSHJ           /EXECUTE IT
1760 10465 0606         PROCESS
1761 10466 4544         POPF            /RESTORE CHAR
1762 10467 0065         NAGSW
1763 10470 4544 DCONT,  POPF            /RESTORE TEXT POINTERS
1764 10471 0017         TEXTP
1765 10472 4542         POPA            /RESTORE ADDRESS OF CURRENT LINE.
1766 10473 3022         DCA PC
1767 10474 5675         JMP I .+1       /CONTINUE PROCESSING THIS LINE.
1768 10475 0607         PROC
1769            
1770            /PUSHDOWN LIST CONTROLS
1771            
1772 10476 0000 PD2,    0               /PUSHDOWN THE AC - "PUSHA"
1773 10477 1676         TAD I PD2
1774 10500 2276         ISZ PD2
1775 10501 3304         DCA .+3
1776 10502 6202         CIF
1777 10503 4706         JMS I .+3
1778 10504 0000         0
1779 10505 5676         JMP I PD2
1780 10506 5656         MPD2
1781            
1782 10507 0000 PD3,    0
1783 10510 1707         TAD I PD3
1784 10511 3315         DCA .+4
1785 10512 2307         ISZ PD3
1786 10513 6202         CIF
1787 10514 4717         JMS I .+3
1788 10515 0000         0
1789 10516 5707         JMP I PD3
1790 10517 5705         MPD3
1791            
1792 10520 0000 XPOPA,  0
1793 10521 6202         CIF
1794 10522 4724         JMS I .+2
1795 10523 5720         JMP I XPOPA
1796 10524 5732         MPOPA
1797            
1798 10525 1133 ZSERCH, TAD STARTV
1799 10526 1347         TAD Z3
1800 10527 3030         DCA PT1         /POINT TO MANTISSA
1801 10530 1031         TAD LASTV       /CHECKED ALL VARIABLES FOR 0?
1802 10531 7141         CLL CIA
1803 10532 1030         TAD PT1
1804 10533 7630         SZL CLA
1805 10534 5343         JMP ZERROR      /FAKE ERROR MESSAGE (NO CHANGE FROM FOCAL)
1806 10535 1430         TAD I PT1       / IS THIS VARIABLE = 0?
1807 10536 7650         SNA CLA
1808 10537 5750         JMP I ZFOUND    /YES, CHANGE ITS NAME
1809 10540 1030         TAD PT1         /NO, CHECK THE NEXT
1810 10541 1070         TAD GINC
1811 10542 5327         JMP ZSERCH+2
1812            
1813 10543 1346 ZERROR, TAD Z1467       /FAKE ERROR ADDRESS (+1)
1814 10544 3566         DCA I 166       /(ERROR2-JMS I 0)
1815 10545 5566         JMP I 166       /KLUDGE
1816            
1817 10546 1467 Z1467,  1467
1818 10547 0003 Z3,     3
1819 10550 1506 ZFOUND, ZERFND
1820            
1821            
1822 10551 1365 FIND,   TAD XFIND1      /SETUP 'READC' EXIT
1823 10552 3552         DCA I RDIV
1824 10553 4453         JMS I INTEGER           /FIX ARG
1825 10554 7200         CLA
1826 10555 4464 FIND1,  JMS I INDEV     /GET THE NEXT CHAR
1827 10556 3066         DCA CHAR        /SAVE IT
1828 10557 1066         TAD CHAR
1829 10560 7041         CIA             /IS IT THE ONE WE WANT?
1830 10561 1046         TAD FLAC+2
1831 10562 7640         SZA CLA
1832 10563 5766         JMP I XCHIN     /GO FINISH 'READC' (ECHO)
1833 10564 5535         JMP I EFUN3I
1834            
1835 10565 0555 XFIND1, FIND1
1836 10566 2157 XCHIN,  CHIN+3
1837            
1838            
1839            /--------------------------------------------------------------------
1840            
1841            INLIST=.        /INPUT CONTROL CHARACTERS
1842 10567 0212         IBAR            /B.A. = RESTART
1843 10570 0217         IGNOR           /L.F. = IGNORE
1844 10571 0227         IRETN           /C.R. = TERMINATE STRING
1845            
1846 10572 1075 FLIST2, FLIMIT          /,=STANDARD
1847 10573 1137         FINFIN          /;=SHORT
1848 10574 2671         ERROR5          /CR=DUMB
1849            
1850 10575 1065 FLIST1, FINCR           /,=STANDARD FORMAT
1851 10576 0606         PROCESS         /;=SET;PLUS ,..
1852 10577 0612         PC1             /C.R.=SET COMMAND.
1853            
1854 10600 7472 MF,     -306            /USED BY TESTC
1855            
1856            
1857            /PRIMARY CONTROL AND TRANSFER
1858            
1859 10601 4554 GOTO,   GETLN           /READ THE LINE NUMBER REQUESTED
1860 10602 4555         FINDLN          /LOCATE IT AND RESET TEXTP
1861 10603 4566         ERROR2          /NOT THERE
1862 10604 1023         TAD THISLN      /SET PC
1863 10605 3022         DCA PC
1864            /---------------------------------------------------------------------
1865 10606 4545 PROCESS,GETC            /TEST FOR END OF LINE
1866 10607 1066 PROC,   TAD CHAR        /FIRST CHARACTER READY = USE PROC
1867 10610 1116         TAD MCR
1868 10611 7650         SNA CLA
1869 10612 5540 PC1,    POPJ            /EXIT "PROCESS"
1870 10613 4550         SORTC           /IGNORE "SPACE",",", AND ";".
1871 10614 1374         GLIST-1
1872 10615 5206         JMP PROCESS
1873 10616 1066         TAD CHAR        /SAVE COMMAND CHARACTER
1874 10617 0075         AND P337        /EXECUTE LOWER CASE ALSO
1875 10620 4541         PUSHA
1876 10621 4545         GETC            /GO TO TERMINATOR
1877 10622 4550         SORTC
1878 10623 1374         GLIST-1
1879 10624 7410         SKP
1880 10625 5221         JMP .-4
1881 10626 4634         JMS I PXKSF
1882 10627 4542         POPA
1883 10630 4547         SORTJ           /GO DO COMMAND
1884 10631 0773         COMLST-1
1885 10632 0175         COMGO-COMLST
1886 10633 4566         ERROR2          /ILLEGAL COMMAND
1887            
1888 10634 2660 PXKSF,  XKSF            /ADDRESS OF KBD BREAK CHECK
1889            
1890            COMMENTS=PC1            /ALSO IS CONTINUE
1891            
1892            /OUTPUT COMMAND TEXT
1893            
1894 10635 4554 WRITE,  GETLN           /SET LINENO
1895 10636 2026         ISZ DEBGSW      /DISABLE TRACE
1896 10637 4555         FINDLN          /SEARCH FOR LINE NUMBER
1897 10640 5267         JMP WTESTG      /NOT THERE OR GROUP
1898 10641 1067         TAD LINENO
1899 10642 7640         SZA CLA
1900 10643 4553         PRNTLN          /PRINT LINE NUMBER AND A SPACE.
1901 10644 4545         GETC
1902 10645 4551         PRINTC          /PRINT TEXT OF A LINE.
1903 10646 1066         TAD CHAR
1904 10647 1116         TAD MCR
1905 10650 7640         SZA CLA         /SKIP IF END OF LINE
1906 10651 5244         JMP .-5
1907 10652 4570         JMS I DTHIS     /TAD I THISLN
1908 10653 7450 WTEST2, SNA
1909 10654 5271         JMP WX-2
1910 10655 7001         IAC
1911 10656 3030         DCA PT1         /SAVE POINTER TO LINENO OF NEXT
1912 10657 1065         TAD NAGSW
1913 10660 7700         SMA CLA
1914 10661 4571         JMS I DPT1      /TAD I PT1
1915 10662 4563         TSTGRP          /TRY NEXT LINENO FOR GROUP.
1916 10663 5273         JMP WX
1917 10664 4571 WALL,   JMS I DPT1      /TAD I PT1
1918 10665 3067         DCA LINENO
1919 10666 5237         JMP WRITE+2
1920 10667 1023 WTESTG, TAD THISLN      /INIT GROUP PRINTOUT
1921 10670 5253         JMP WTEST2
1922 10671 3026         DCA DEBGSW
1923 10672 5540         POPJ
1924 10673 1065 WX,     TAD NAGSW
1925 10674 7750         SPA SNA CLA     /SKIP IF ALL
1926 10675 5271         JMP WX-2
1927 10676 4551         PRINTC          /PRINT C.R. AGAIN
1928 10677 5264         JMP WALL
1929            
1930            
1931 10700 0000 XTESTC, 0       /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC"
1932 10701 4560         SPNOR           /IGNORE SPACES
1933 10702 4550         SORTC           /TEST THE VARIABLE TERMINATORS
1934 10703 1767         TERMS-1
1935 10704 5700         JMP I XTESTC    /YES - SORTCN IS SET--RETURN--
1936 10705 1066         TAD CHAR        /NO
1937 10706 2300         ISZ XTESTC
1938 10707 1200         TAD MF
1939 10710 7650         SNA CLA         /TEST FOR "F"
1940 10711 5317         JMP XT3
1941 10712 4561         TESTN
1942 10713 5700         JMP I XTESTC    /.--RETURN--
1943 10714 7410         SKP             /OTHER
1944 10715 5700         JMP I XTESTC    /NUMBER--RETURN--
1945 10716 2300         ISZ XTESTC
1946 10717 2300 XT3,    ISZ XTESTC      /RETURNS:T;N;F;A
1947 10720 5700         JMP I XTESTC    /--RETURN--
1948            
1949 10721 0000 XSORTC, 0       /SORT CHAR AGAINST TABLE - "SORTC"
1950 10722 1721         TAD I XSORTC
1951 10723 3012         DCA XRT2        /1ST ARG IS LIST-1
1952 10724 1412         TAD I XRT2
1953 10725 7510         SPA             /LIST IS ENDED BY A NEGATIVE NUMBER
1954 10726 5340         JMP SEXC        /2AND EXIT = NOT IN LIST
1955 10727 7041         CIA
1956 10730 1066         TAD CHAR
1957 10731 7640         SZA CLA         /COMPARE
1958 10732 5324         JMP .-6
1959 10733 1721         TAD I XSORTC    /COMPUTE INCREMENT : 0 - N
1960 10734 7040         CMA
1961 10735 1012         TAD XRT2
1962 10736 3054         DCA SORTCN
1963 10737 7410         SKP             /1ST EXIT = YES
1964 10740 2321 SEXC,   ISZ XSORTC
1965 10741 2321         ISZ XSORTC
1966 10742 7300         CLA CLL
1967 10743 5721         JMP I XSORTC    /--RETURN--
1968            
1969            
1970 10744 0000 GRPTST, 0       /AC VS LINENO - "TSTGRP"
1971 10745 0104         AND P7600
1972 10746 7041         CIA
1973 10747 3071         DCA T2
1974 10750 1067         TAD LINENO
1975 10751 0104         AND P7600
1976 10752 1071         TAD T2
1977 10753 7650         SNA CLA
1978 10754 2344         ISZ GRPTST
1979 10755 5744         JMP I GRPTST    /--RETURN--
1980            
1981            /INPUT FROM TEXT OR KEYBOARD;
1982            /IF BACK-ARROW, RESTART INPUT
1983            
1984 10756 0000 INPUT,  0               /INPUT A CHARACTER
1985 10757 1036         TAD INSUB       /NON-ZERO FOR KEYBOARD
1986 10760 7640         SZA CLA
1987 10761 5364         JMP .+3
1988 10762 4545         GETC
1989 10763 5756         JMP I INPUT     /--RETURN--
1990 10764 4552         READC
1991 10765 4547         SORTJ
1992 10766 6776         SPECIAL-1
1993 10767 3401         INFIX-SPECIAL
1994 10770 5756         JMP I INPUT     /--RETURN--
1995            
1996            /----------------------------------------------------------------------
1997 10771 1035 ILIST,  IF1             /,
1998 10772 0606         PROCESS         /;
1999 10773 0612         PC1             /CR
2000            
2001                            /ENGLISH-FRENCH
2002            COMLST=.        /COMMAND DECODING LIST
2003 10774 0323         323     /SET    - ORGANIZE
2004 10775 0306         306     /FOR    - QUAND
2005 10776 0311         311     /IF     - SI
2006 10777 0304         304     /DO     - FAIZ
2007 11000 0307         307     /GOTO   - VA
2008 11001 0303         303     /COMMENT- COMMENTE
2009 11002 0301         301     /ASK    - DEMANDE
2010 11003 0324         324     /TYPE   - TAPE
2011 11004 0314         314     /LIBRARY- ENTREPOSE
2012 11005 0305         305     /ERASE  - BIFFE
2013 11006 0327         327     /WRITE  - INSCRIS
2014 11007 0315         315     /MODIFY - MODIFIE
2015 11010 0321         321     /QUIT   - ARRETE
2016 11011 0322         322     /RETURN - RETOURNE
2017 11012 0317         "O              /ADD 'OPEN' COMMAND
2018            
2019            /THIS COMMAND LIST IS SPEED OPTIMIZED.
2020            
2021            
2022            /CONDITIONAL TRANSFER PROCESS.
2023            
2024 11013 4564 IF,     TESTC           /IGNORE SPACES AND TEST
2025            /---------------------------------------------------------------------
2026 11014 4637         JMS I IECALL    /T
2027 11015 4542         POPA            /N-DUMP THE (EFOP)
2028 11016 4640         JMS I IPART     /F-CHECK FOR PAREN MATCH
2029 11017 1111         TAD M2          /A
2030 11020 3032         DCA T1
2031 11021 1045         TAD FLAC+1      /TEST -,0,+
2032 11022 7510         SPA
2033 11023 2032         ISZ T1          /N-TO   -1,-2,-3
2034 11024 7750         SPA SNA CLA
2035 11025 2032 IF3,    ISZ T1          /COUNT COMMAS
2036 11026 7410         SKP
2037 11027 5775         JMP I COMGO+4   /TRANSFER
2038 11030 4547         SORTJ           /SEARCH TEXT UNTILL ,;C.R.
2039 11031 1375         TLIST-1
2040 11032 7373         ILIST-TLIST
2041 11033 4545         GETC
2042 11034 5230         JMP .-4
2043 11035 4545 IF1,    GETC            /MOVE PAST COMMA 
2044 11036 5225         JMP IF3
2045 11037 1601 IECALL, ECALL
2046 11040 2047 IPART,  PARTEST
2047            
2048            /LOOP CONTROL STATEMENT
2049            
2050            SET=.                   /SUBSET OF "FOR".
2051            
2052 11041 4537 FOR,    PUSHJ           /LOOPS, ETC.
2053 11042 1401         GETARG          /LOOK FOR "=" NEXT
2054 11043 4560         SPNOR           /IGNORE SPACES
2055 11044 1066         TAD CHAR
2056 11045 1335         TAD MEQ
2057 11046 7440         SZA
2058 11047 4566         ERROR4          /LEFT OF "=" IN ERROR: 'FOR' OR 'SET'
2059 11050 1030         TAD PT1
2060 11051 4541         PUSHA           /SAVE POINTER TO VARIABLE
2061 11052 4537         PUSHJ
2062 11053 1612         EVAL-1          /GET INITIAL VALUE EXPRESSION
2063 11054 4542         POPA
2064 11055 3030         DCA PT1
2065 11056 4407         FINT            /INITIALIZE NOW.
2066 11057 6430         FPUT I PT1
2067 11060 0000         FXIT
2068 11061 4547         SORTJ           /TEST LAST CHAR FROM "EVAL"
2069 11062 1375         TLIST-1
2070 11063 7177         FLIST1-TLIST
2071 11064 4566         ERROR4          /EXCESS R-PAR
2072 11065 1030 FINCR,  TAD PT1         /SAVE VARIABLE ADDRESS *
2073 11066 4541         PUSHA
2074 11067 4537         PUSHJ           /EVALUATE THE INCREMENT,IF ANY.
2075 11070 1612         EVAL-1
2076 11071 4547         SORTJ           /TEST TERMINATORS
2077 11072 1375         TLIST-1
2078 11073 7174         FLIST2-TLIST
2079 11074 4566         ERROR4          /ILLEGAL TERMINATOR IN 'FOR'
2080 11075 4543 FLIMIT, PUSHF           /SAVE THE INCREMENT.    *
2081 11076 2030         FLARG
2082 11077 4537         PUSHJ           /GET THE LIMIT(NO ERROR DETECTION AFTER LIMIT)
2083 11100 1612         EVAL-1
2084 11101 4543 FCONT,  PUSHF           /SAVE THE LIMIT *
2085 11102 2030         FLARG
2086 11103 4543         PUSHF           /SAVE TEXT OF OBJECT STATEMENTS
2087 11104 0017         TEXTP
2088 11105 4537         PUSHJ           /DO THE OBJECT STATEMENTS
2089 11106 0606         PROCESS
2090 11107 4544         POPF            /RESTORE REMAINING TEXT.
2091 11110 0017         TEXTP
2092 11111 4544         POPF            /GET LIMIT
2093 11112 2030         FLARG
2094 11113 4544         POPF            /GET INCREMENT
2095 11114 7470         ITER1
2096 11115 4542         POPA            /GET VARIABLE ADDRESS
2097 11116 3030         DCA PT1
2098 11117 4407        FINT            /INCREMENT AND TEST
2099 11120 0430         FGET I PT1      /LOAD THE VARIABLE
2100 11121 1733         FADD I FINKP    /INCREMENT IT
2101 11122 6430         FPUT I PT1      /CHANGE IT
2102 11123 2525         FSUB I FLARGP   /TEST IT
2103 11124 0000         FXIT
2104 11125 1045         TAD FLAC+1
2105 11126 7740         SMA SZA CLA
2106 11127 5540         POPJ            /END OF LOOP
2107 11130 1030         TAD PT1
2108 11131 4541         PUSHA           /SAVE ADDRESS *
2109 11132 4543         PUSHF           /SAVE INCREMENT AGAIN *
2110 11133 7470 FINKP,  ITER1
2111 11134 5301         JMP FCONT
2112 11135 7503 MEQ,    -275
2113 11136 7524 MCOM,   -254
2114 11137 4543 FINFIN, PUSHF           /SET INCREMENT TO ONE.
2115 11140 2405         FLTONE  /MOVED FOR ^L FUDGE
2116 11141 5301         JMP FCONT
2117            
2118            
2119            
2120 11142 0000 SORTB,  0       /SORT AND BRANCH ROUTINE. - "SORTJ"
2121 11143 7450         SNA
2122 11144 1066         TAD CHAR        /ASSUME CHAR IF AC=0
2123 11145 7041         CIA
2124 11146 3071         DCA T2          /SAVE SORT ITEM
2125 11147 1742         TAD I SORTB     /FIRST ARG IS LIST LESS ONE
2126 11150 2342         ISZ SORTB       /2AND IS INTRA-LIST LENGTH
2127 11151 3012         DCA XRT2
2128 11152 1412         TAD I XRT2
2129 11153 7510         SPA             /**LISTS ENDED BY NEGATIVE NUMBERS**
2130 11154 5366         JMP SEX         /READ EXIT
2131 11155 1071         TAD T2          /FIND ADDRESS
2132 11156 7640         SZA CLA
2133 11157 5352         JMP .-5
2134 11160 1012         TAD XRT2        /MATCH FOUND.
2135 11161 1742         TAD I SORTB
2136 11162 3071         DCA T2
2137 11163 1471         TAD I T2
2138 11164 3071         DCA T2          /DEBUG : AC = ADDRESS
2139 11165 5471         JMP I T2
2140 11166 2342 SEX,    ISZ SORTB       /MATCH NOT FOUND.
2141 11167 7300         CLA CLL
2142 11170 5742         JMP I SORTB     /--RETURN--
2143            COMGO=.        /COMMAND ROUTINE ADDRESSES
2144 11171 1041         SET
2145 11172 1041         FOR
2146 11173 1013         IF
2147 11174 0417         DO
2148 11175 0601         GOTO            /(REFERENCED)
2149 11176 0612         COMMENT
2150 11177 1211         ASK
2151 11200 1212         TYPE
2152 11201 7503         LIB
2153 11202 2203         ERASE
2154 11203 0635         WRITE
2155 11204 1313         MODIFY
2156 11205 0177         START   /RETURN TO COMMAND MODE VIA 'QUIT'
2157 11206 1557         RETRN   /MOVE 'RETURN'
2158 11207 3133         FILER   /ADD 'OPEN'
2159            
2160            
2161            
2162            
2163            
2164            /---------------------------------------------------------------------
2165            /INPUT-OUTPUT STATEMENTS
2166            
2167 11210 0000 ATSW,   0               /ASK-TYPE SWITCH
2168 11211 7240 ASK,    CLA CMA         /REMEMBER WHICH CALL.
2169 11212 3210 TYPE,   DCA ATSW
2170 11213 4547 TASK,   SORTJ           /SPECIAL CHARACTER? 
2171 11214 1366         ALIST-1
2172 11215 0176         ATLIST-ALIST
2173 11216 2210         ISZ ATSW        /TEST QUOTE SWITCH
2174 11217 5234         JMP TYPE2
2175 11220 4537         PUSHJ           /DO ASK; SETUP PT1
2176 11221 1401         GETARG
2177 11222 1066         TAD CHAR        /SAVE IN-LINE CHARACTER.
2178 11223 4541         PUSHA
2179 11224 7300         CLA CLL /DON'T PRINT COLON
2180 11225 7000         NOP
2181 11226 2036         ISZ INSUB       /INDICATE 'READC'
2182 11227 7001         IAC             /POINT PAST CHAR
2183 11230 4530         JMS I FINPUT    /READ DATA AND SAVE
2184 11231 4542         POPA            /RE-TEST LAST TERMINATOR
2185 11232 3066         DCA CHAR
2186 11233 5211         JMP ASK         /CONTINUE PROCESSING
2187            
2188 11234 4537 TYPE2,  PUSHJ           /DO TYPE
2189 11235 1613         EVAL
2190 11236 4527         JMS I FOUTPUT   /PRINT
2191 11237 5212         JMP TYPE
2192 11240 2026 TQUOT, ISZ DEBGSW      /DISABLE TRACE
2193 11241 4545         GETC            /TYPE LITERALS
2194 11242 4547         SORTJ
2195 11243 1401         TLIST2-1
2196 11244 0774         TLIST3-TLIST2
2197 11245 4551         PRINTC
2198 11246 5241         JMP TQUOT+1
2199 11247 4545 TINTR,  GETC            /PASS PERCENT SIGN
2200 11250 4554         GETLN           /READ FORMAT CONTROL: "%7.03"
2201 11251 1067         TAD LINENO
2202 11252 3052         DCA FISW        /SAVE FORMAT CODE
2203 11253 5213         JMP TASK
2204 11254 1264 TCRLF2, TAD P15 /PRINT CR ONLY
2205 11255 4551         PRINTC          /(PRINTC HANDLES NULL FOR DELAY!)
2206 11256 5261         JMP .+3
2207 11257 1077 TCRLF,  TAD CCR         /EXCLAMATION POINT=CR,LF.
2208 11260 4551         PRINTC
2209 11261 3026 TASK4,  DCA DEBGSW      /RE-ENABLE THE TRACE
2210 11262 4545         GETC            /MOVE TO NEXT CHARACTER
2211 11263 5213         JMP TASK
2212 11264 0015 P15,    15              /":"
2213            
2214 11265 4537 TTAB,   PUSHJ           /TAB ARGUMENT IN ASK OR TYPE
2215 11266 1612                 EVAL-1
2216 11267 4407         FENT
2217 11270 1711         FADD I TRND     /LET'S ROUND OFF
2218 11271 0000         FEXT
2219 11272 4453         JMS I INTEGER
2220 11273 7041         CIA
2221 11274 1307         TAD TABC
2222 11275 7001         IAC
2223 11276 7500         SMA
2224 11277 5305         JMP PBACK
2225 11300 3310         DCA CNTRX
2226 11301 1312         TAD SPACE
2227 11302 4551         PRINTC
2228 11303 2310         ISZ CNTRX
2229 11304 5301         JMP .-3
2230 11305 7300 PBACK,  CLA CLL
2231 11306 5213         JMP TASK
2232            
2233 11307 0000 TABC,   0
2234 11310 0000 CNTRX,  0
2235 11311 0305 TRND,   FLP5
2236 11312 0240 SPACE,  240
2237            
2238            
2239            
2240            /IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW"
2241            /       #0: DISABLE AND RETURN ALL"?" ' S.
2242            /IF DMPSW = 0: TRACE ON, IF ENABLED
2243            /       #0: TRACE OFF
2244            /IF BOTH = 0 : PRINT TRACE.
2245            /SEARCH ROUTINES
2246            
2247 11313 4554 MODIFY, GETLN           /READ LINE NO.
2248 11314 4555         FINDLN          /LOOK IT UP NOW.
2249 11315 4566         ERROR2          /NOT THERE = BAD COMMAND UNLESS ZERO.
2250 11316 1060         TAD BUFR        /SET POINTERS
2251 11317 3010         DCA AXIN        /FOR INPUT
2252 11320 3062         DCA XCTIN
2253 11321 1067         TAD LINENO      /COPY THE SAME LINE NUMBER.
2254 11322 4573         JMS I DAXIN     /DCA I AXIN
2255 11323 1010         TAD AXIN        /SAVE START OF NEW LINE
2256 11324 3027         DCA PACKST
2257 11325 4464 SCONT,  JMS I INDEV     /READ THE TELETYPE INPUT SILENTLY.
2258 11326 3100         DCA LIST3+1     /SAVE SEARCH CHARACTER
2259 11327 2026         ISZ DEBGSW      /NO BREAKS.
2260 11330 4545 SCHAR,  GETC            /TYPE+TEST-F.F.
2261 11331 4551         PRINTC          /PLAYBACK THE TEXT
2262 11332 4547         SORTJ           /LOOK FOR MATCH
2263 11333 0076         LIST3-1
2264 11334 1266         LISTGO-LIST3    /LISTGO HAS MOVED
2265 11335 4546         PACKC           /SAVE NEW LINE.
2266 11336 5330         JMP SCHAR
2267 11337 1060 SBAR,   TAD BUFR        /RESTART-B.A.
2268 11340 7001         IAC
2269 11341 3010         DCA AXIN        /SET POINTERS
2270 11342 3062         DCA XCTIN
2271 11343 4552 SFOUND, READC           /READ FROM KEYBOARD
2272 11344 4547         SORTJ           /TEST
2273 11345 0072         LIST6-1
2274 11346 1266         SRNLST-LIST6
2275 11347 4546 SGOT,   PACKC           /PACK CHAR.
2276 11350 5343         JMP SFOUND      /MORE
2277            /TAKE THE INTEGER PART
2278            
2279 11351 4453 XINT,   JMS I INTEGER   /(FIX)
2280 11352 7200         CLA
2281 11353 5535         JMP I EFUN3I
2282            
2283 11354 0000 XPUSHA, 0
2284 11355 6202         CIF
2285 11356 4760         JMS I .+2
2286 11357 5754         JMP I XPUSHA
2287 11360 5631         MPUSHA
2288            
2289            
2290            
2291            
2292            /----------------------------------------------------------------------
2293            SRNLST=.        /'MODIFY' CONTROL CHARACTER TABLE
2294 11361 1330         SCHAR   /F.F. = CONTINUE
2295 11362 1325         SCONT   /BELL = CHANGE SEARCH CHARACTER
2296 11363 1337         SBAR    /B. A. = RESTART
2297 11364 1326         SCONT+1 /L.F. = FINISH THE LINE
2298 11365 0261 LISTGO, SRETN   /C.R. = END THE LINE HERE AS IS
2299 11366 1347         SGOT    /CHAR = SEARCH CHAR.
2300            
2301            
2302            
2303            
2304            
2305            / ASK/TYPE LIST OF CONTROLS.
2306 11367 0272 ALIST,  ":
2307 11370 0245         245     /%
2308 11371 0242         242     /"
2309 11372 0241         241     /!
2310 11373 0243         243     /#
2311 11374 0244         244     /$
2312            GLIST=.
2313 11375 0240         240     /SPACE
2314            TLIST=.
2315 11376 0254         254     /,
2316 11377 0273         273     /;
2317 11400 0215         215     /C.R.
2318            /THIS LIST IS ENDED BY 'TESTC'.
2319            
2320            /FIND OR ENTER A VARIABLE IN THE LIST.
2321            
2322 11401 4564 GETARG, TESTC           /FIRST LETTER OF ARG
2323 11402 0242 TLIST2, 0242            /"
2324 11403 0215         0215            /C.R. - FUNCTION OR NUMBER IS NOT AN ARG.
2325 11404 4566         ERROR4          /BAD ARGUEMENT IN 'FOR', 'SET', OR 'ASK'
2326 11405 3062 GETVAR, DCA XCTIN       /RESET PACK SWITCH
2327 11406 4546         PACKC           /PACK FIRST CHAR
2328 11407 1061         TAD ADD         /SAVE NAME
2329 11410 3056         DCA EFOP        /WHERE WE CAN PUSH IT
2330 11411 4545 GETLP,  GETC            /GET NEXT CHAR
2331 11412 4550         SORTC           /END OF NAME?
2332 11413 1767                 TERMS-1
2333 11414 5222         JMP GSERCH      /YES
2334 11415 2062         ISZ XCTIN       /IS THIS THE SECOND CHAR
2335 11416 5211         JMP GETLP       /MORE THAN 2 CHARS, IGNORE IT
2336 11417 1066         TAD CHAR        /PACK SECOND CHAR
2337 11420 0122         AND P77         /MASK IT
2338 11421 5207         JMP GETLP-2     /ADD TO NAME
2339 11422 4562 GSERCH, TSTLPR          /CHECK FOR SUBSCRIPT
2340 11423 5231         JMP GS1
2341 11424 4756         JMS I GECALL    /PICK IT UP
2342 11425 4542         POPA            /RESTORE NAME
2343 11426 3056         DCA EFOP
2344 11427 4764         JMS I PTEST     /CHECK PAREN MATCH
2345 11430 4453         JMS I INTEGER           /CONVERT IT
2346 11431 3315 GS1,    DCA SUBS        /SAVE SUBSCRIPT
2347 11432 1056         TAD EFOP        /MAKE SURE IT'S FOUND
2348 11433 3431         DCA I LASTV
2349 11434 1175         TAD SECRTV      /SEARCH STARTS WITH SECRET VARIABLES
2350 11435 3030 GLOOP,  DCA PT1
2351 11436 1056         TAD EFOP        /IS THIS THE ONE?
2352 11437 7041         CIA
2353 11440 1430         TAD I PT1
2354 11441 7650         SNA CLA
2355 11442 5246         JMP CHKVAR      /MATCHED - CHECK SUBSCRIPT
2356 11443 1030 NXTVAR, TAD PT1         /NO MATCH - BUMP POINTER
2357 11444 1070         TAD GINC
2358 11445 5235         JMP GLOOP       /TRY AGAIN
2359 11446 2030 CHKVAR, ISZ PT1         /BUMP TO SUBSCRIPT
2360 11447 1030         TAD PT1         /CHECK IF IT'S REALLY THERE
2361 11450 7141         CLL CIA
2362 11451 1031         TAD LASTV
2363 11452 7620         SNL CLA
2364 11453 5264         JMP MAKVAR      /NO - IT WAS THE DUMMY
2365 11454 1315         TAD SUBS        /CHECK THE SUBSCRIPT
2366 11455 7041         CIA
2367 11456 1430         TAD I PT1
2368            
2369            
2370 11457 2030 GLOOP1, ISZ PT1         /POINT TO DATA (IN CASE IT'S NEEDED)
2371 11460 7650         SNA CLA         /SUBSCRIPT MATCH?
2372 11461 5540         POPJ            /YES!
2373 11462 7344         CLA CLL CMA RAL /SET AC=(-2)
2374 11463 5243         JMP NXTVAR      /AND BUMP POINTER
2375 11464 1035 MAKVAR, TAD BOTTOM      /CHECK FOR OVERFLOW
2376 11465 7141         CLL CIA
2377 11466 1031         TAD LASTV
2378 11467 1001         TAD P13
2379 11470 7630         SZL CLA
2380 11471 5730         JMP I ZERSCH    /GO REPLACE A ZERO VARIABLE
2381 11472 1031         TAD LASTV       /ADD ANOTHER VARIABLE
2382 11473 1070         TAD GINC
2383 11474 3031         DCA LASTV
2384 11475 1030 MAKV1,  TAD PT1         /SAVE POINTER
2385 11476 3011         DCA XRT
2386 11477 1315         TAD SUBS        /INSERT SUBSCRIPT
2387 11500 3430         DCA I PT1
2388 11501 3411         DCA I XRT       /ZERO OUT DATA
2389 11502 3411         DCA I XRT
2390 11503 3411         DCA I XRT
2391 11504 3411 VARPCH, DCA I XRT       /(NOP) - FOR 3-WORD
2392 11505 5257         JMP GLOOP1
2393 11506 7346 ZERFND, CLA CLL CMA RTL /SET PT1 TO START OF VARIABLE
2394 11507 1030         TAD PT1
2395 11510 3030         DCA PT1
2396 11511 1056         TAD EFOP        /REPLACE THE NAME
2397 11512 3430         DCA I PT1
2398 11513 2030         ISZ PT1         /POINT TO SUBSCRIPT
2399 11514 5275         JMP MAKV1       /AND FINISH UP
2400            
2401            
2402            
2403            SUBS=.
2404 11515 0000 XSPNOR, 0               /IGNORE LEADING SPACES - "SPNOR"
2405 11516 1066         TAD CHAR
2406 11517 1114         TAD M240
2407 11520 7640         SZA CLA
2408 11521 5715         JMP I XSPNOR    /--RETURN--
2409 11522 4545         GETC
2410 11523 5316         JMP XSPNOR+1
2411            
2412            
2413 11524 7520 M260,   -260
2414 11525 7507 M271,   -271
2415            
2416            
2417            
2418 11526 0240 SP,     240
2419 11527 7504         LIB+1
2420 11530 0525 ZERSCH, ZSERCH          /POINTER TO ERO SEACH
2421 11531 0000 XTESTN, 0               /RETURNS: .; OTHER; NUMBER - "TESTN"
2422 11532 1066         TAD CHAR
2423 11533 1115         TAD MPER
2424 11534 7640         SZA CLA
2425 11535 2331         ISZ XTESTN
2426 11536 1066         TAD CHAR
2427 11537 1324         TAD M260
2428 11540 3054         DCA SORTCN      /SAVE VALUE OF THE NUMBER
2429 11541 1054         TAD SORTCN      /TEST IF REALLY A DIGIT.
2430 11542 7710         SPA CLA
2431 11543 5731         JMP I XTESTN    /--RETURN--
2432 11544 1066         TAD CHAR
2433 11545 1325         TAD M271
2434 11546 7750         SPA SNA CLA
2435 11547 2331         ISZ XTESTN      /IF A NUMBER
2436 11550 5731         JMP I XTESTN    /--RETURN--
2437 11551 4537 LGOSUB, PUSHJ           /EXECUTE SUBROUTINE
2438 11552 0420                 DO+1
2439 11553 1326         TAD SP          /LIBRARY 'SPACE' = LIBRARY RETURN!
2440 11554 3066         DCA CHAR
2441 11555 5727         JMP I SP+1      /SKIP 'SPNOR'
2442 11556 1601 GECALL, ECALL
2443 11557 1123 RETRN,  TAD C200
2444 11560 3022         DCA PC
2445            
2446            /EXIT FROM A "DO" SUBROUTINE
2447            
2448            
2449 11561 4542 XPOPJ,  POPA
2450 11562 3071         DCA T2
2451 11563 5471         JMP I T2
2452 11564 2047 PTEST,  PARTEST         /USE THAT FREE LOCATION
2453            
2454            
2455            
2456            /ASK-TYPE CONTROL CHARACTER TABLE
2457 11565 1265 ATLIST, TTAB
2458 11566 1247         TINTR   /% - FORMAT DELIMITER
2459 11567 1240         TQUOT   /" - LITERAL DELIMITER
2460 11570 1257         TCRLF   /! - CARRIAGE RETURN AND LINE FEED
2461 11571 1254         TCRLF2  /# - CARRIAGE RETURN ONLY
2462 11572 3046         TDUMP   /$/- DUMP THE SYMBOL TABLE CONTENTS
2463 11573 1261         TASK4   /SP- TERMINATOR FOR NAMES
2464 11574 1261         TASK4   /, - TERMINATOR FOR EXPRESSIONS
2465 11575 0606         PROCESS /; - TERMINATOR FOR COMMANDS
2466 11576 0612         PC1     /C.R. - TERMINATOR FOR STRINGS
2467            
2468            /$ - FOR 'TDUMP' TERMINATES THE COMMAND.
2469            
2470            
2471            *1601
2472            
2473            /EVALUATE AN EXPRESSION WHICH
2474            /TERMINATES WITH AN R-PAR,; OR C.R. AND
2475            /LEAVE THE RESULT IN FLAC AND IN FLARG.
2476            
2477            
2478            
2479            
2480            /----------------------------------------------------------------------
2481 11601 0000 ECALL,  0       /RECURSIVE CALL TO "EVAL"
2482 11602 1054         TAD SORTCN      /SAVE 'SORTCN','LASTOP',AND 'EFOP'
2483 11603 4541         PUSHA
2484 11604 1055         TAD LASTOP
2485 11605 4541         PUSHA
2486 11606 1056         TAD EFOP        /SAVE FUNCTION CODE.
2487 11607 4541         PUSHA
2488 11610 1201         TAD ECALL       /RETURN TO CALLING
2489 11611 4541         PUSHA           /ADDRESS AFTER NEXT POPJ
2490            
2491 11612 4545         GETC            /MOVE PAST EXTRA CHARACTER
2492 11613 3055 EVAL,   DCA LASTOP      /EVAUATION CONTROLLER (CHECKPOINT ?)
2493 11614 4564         TESTC           /TEST CHARACTER AND IGNORE SPACES
2494 11615 5227         JMP ETERM1      /TERMINATOR
2495 11616 5332         JMP ENUM        /NUMBER
2496 11617 5343         JMP EFUN        /FUNCTION
2497 11620 4537         PUSHJ           /LETTER OF VARIABLE
2498 11621 1405         GETVAR          /FIND OR CREATE VARIABLE;ALSO SET PT1.
2499 11622 4564 OPNEXT, TESTC           /PT1=>ARG
2500 11623 5244         JMP ETERMN      /T
2501 11624 0212 ECHOLST,0212            /N-ERROR IN FORMAT
2502 11625 0377         0377            /F
2503 11626 5250         JMP ETERM+1     /'EVAL' FOUND A TERMINATOR WHICH WAS NOT
2504                                    /END OF EXPRESSION (NOT ERROR!)
2505 11627 1136 ETERM1, TAD CFRSX       /SET PT1.
2506 11630 3030         DCA PT1         /TO POINT TO ZERO
2507 11631 1111         TAD M2          /TEST FOR UNARY OPERATIONS
2508 11632 1054         TAD SORTCN
2509 11633 7450         SNA
2510 11634 5247         JMP ETERM       /CREATE DUMMY FOR UNARY MINUS
2511 11635 7001         IAC
2512 11636 7650         SNA CLA
2513 11637 5323         JMP ARGNXT      /IGNORE UNARY PLUS
2514 11640 1054         TAD SORTCN      /TEST FOR NULL PARENS.
2515 11641 1121         TAD M11
2516 11642 7710         SPA CLA
2517 11643 5363         JMP ELPAR       /MIGHT BE AN L-PAR.
2518 11644 4562 ETERMN, TSTLPR
2519 11645 7410         SKP
2520 11646 4566         ERROR4          /OPERATOR MISSING BEFORE PAREN
2521 11647 1054 ETERM,  TAD SORTCN      /SET FROM "TESTC"-"SORTC"
2522 11650 3024         DCA THISOP
2523 11651 1024         TAD THISOP
2524 11652 1121         TAD M11
2525 11653 7700         SMA CLA         /END?
2526 11654 3024         DCA THISOP      /"THISOP" EQUIV. TO END OF EXP.
2527            
2528 11655 1024 ETERM2, TAD THISOP      /COMPARE PRIORITIES
2529 11656 7041         CIA
2530 11657 1055         TAD LASTOP
2531 11660 7710         SPA CLA
2532 11661 5310         JMP EPAR        /CONTINUE
2533 11662 1055         TAD LASTOP      /FIND OPERATION
2534 11663 7112         CLL RTR
2535 11664 7012         RTR
2536 11665 1331         TAD OPTABL
2537 11666 3274         DCA FLOP
2538 11667 1055         TAD LASTOP
2539 11670 7640         SZA CLA         /TEST FOR END OF DATA INTO FLOATING AC.
2540 11671 4544         POPF            /GET LAST DATA
2541 11672 0044         FLAC
2542 11673 4407         FINT
2543 11674 0000 FLOP,   00              /(FLOPR I PT1)+-*/
2544 11675 6525         FPUT I FLARGP   /SAVE RESULT
2545 11676 0000         FXIT
2546 11677 1125         TAD FLARGP
2547 11700 3030         DCA PT1
2548 11701 1024         TAD THISOP
2549 11702 1055         TAD LASTOP      /=0?
2550 11703 7650         SNA CLA
2551 11704 5540         POPJ            /EXIT "EVAL"
2552 11705 4542         POPA            /GET PRIOR OP
2553 11706 3055         DCA LASTOP
2554 11707 5255         JMP ETERM2      /COMPARE THIS OP
2555 11710 4562 EPAR,   TSTLPR          /TEST FOR SUB-EXPRESSION
2556 11711 7410         SKP
2557 11712 5365         JMP EPAR2       /GO EVALUATE EXPRESSION
2558 11713 1055         TAD LASTOP      /CONTINUE READING THE EXPRESSION
2559 11714 4541         PUSHA           /SAVE "LASTOP".
2560 11715 1030         TAD PT1
2561 11716 3320         DCA .+2
2562 11717 4543         PUSHF           /SAVE LAST ARGUMENT
2563 11720 0000         00
2564 11721 1024         TAD THISOP      /MORE TO COME
2565 11722 3055         DCA LASTOP
2566 11723 4545 ARGNXT, GETC            /READ 1ST CHAR OF AN ARG.
2567 11724 4564         TESTC           /DO SPECIAL CHECK
2568 11725 5363         JMP ELPAR       /COULD BE LEFT PAREN
2569 11726 5332         JMP ENUM        /N
2570 11727 5343         JMP EFUN        /F
2571 11730 5220         JMP OPNEXT-2    /L
2572 11731 0430 OPTABL, FGET I PT1      /BASE FOR OPERATION COMPUTATION
2573            
2574 11732 4543 ENUM,   PUSHF           /TO PROCESS A NUMBER,SAVE AC
2575 11733 0044         FLAC
2576 11734 1125         TAD FLARGP      /SET POINTER AS FOR A VARIABLE.
2577 11735 3030         DCA PT1
2578 11736 3036         DCA INSUB       /POINT TO 'GETC' AND USE CHAR
2579 11737 4530         JMS I FINPUT    /READ TEXT NUMBER => (PT1)
2580 11740 4544         POPF            /RESTORE THE AC
2581 11741 0044         FLAC
2582 11742 5222         JMP OPNEXT      /CONTINUE
2583 11743 3056 EFUN,   DCA EFOP        /SET CODE
2584 11744 4545         GETC            /READ FUNCTION NAME.(1,2,OR 3 LETTERS)
2585 11745 4550         SORTC           /LOOK FOR TERMINATION CHARACTER.
2586 11746 1767         TERMS-1
2587 11747 5354         JMP EFUN2       /YES
2588 11750 1056         TAD EFOP        /NO
2589 11751 7104         CLL RAL         /MISH-MASH HASH CODE
2590 11752 1066         TAD CHAR
2591 11753 5343         JMP EFUN
2592 11754 4562 EFUN2,  TSTLPR
2593 11755 4566         ERROR4          /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT
2594 11756 4201         JMS ECALL       /CALL "EVAL" TO COMPUTE ARGUMENT
2595 11757 4542         POPA            /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I.
2596 11760 4547         SORTJ
2597 11761 2163         FNTABL-1
2598 11762 6207         FNTABF-FNTABL
2599 11763 4562 ELPAR,  TSTLPR          /LEFT PAREN OR FELL THROUGH FUNCTION TABLE
2600 11764 4566         ERROR4          /DOUBLE OPERATORS OR ILLEGAL FUNCTION NAME.
2601 11765 4201 EPAR2,  JMS ECALL       /EVALUATE NESTED EXPRESSION
2602            /--------------------------------------------------------------------
2603 11766 4542         POPA            /DUMP EXTRA ARG.
2604 11767 5535         JMP I EFUN3I
2605            
2606            TERMS=.         /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR'
2607 11770 0240         240             /SPACE  0
2608 11771 0253         253             /+      1
2609 11772 0255         255             /-      2
2610 11773 0257         257             //      3
2611 11774 0252         252             /*      4
2612 11775 0336         336             /UP ARR 5
2613 11776 0250         250             /(      6 L-PARS
2614 11777 0333         333             /[      7
2615 12000 0274         274             /<      10
2616 12001 0251         251             /)      11 R-PARS
2617 12002 0335         335             /]      12
2618 12003 0276         276             />      13
2619 12004 0254         254             /,      14
2620 12005 0273         273             /;      15
2621 12006 0215         215             /C.R.   16
2622 12007 0275         275     /= TO END GETARG FROM 'SET'
2623            
2624            
2625            
2626 12010 6201 GOKILL, CDF
2627 12011 3531         DCA I LIBN      /ZERO 'CURRENT PROGRAM SAVED' FLAG
2628 12012 6211         CDF 10
2629 12013 5177         JMP START
2630            /-----------------------------------------------------------------------
2631 12014 1231 XABS,   TAD FLARG+1     /TAKE ABSOLUTE VALUE OF FLAC
2632 12015 7710         SPA CLA         /SKIP TO CONTINUE
2633 12016 4451         JMS I MINSKI    /NEGATE THE FLOATING AC
2634            
2635            /CONTINUATION OF FUNCTION CALLS.
2636            
2637 12017 4407 EFUN3,  FINT
2638 12020 7000         FNOR            /NORMALIZE FUNCTION RETURN
2639 12021 6230         FPUT FLARG      /SAVE FUNCTION VALUE
2640 12022 0000         FXIT
2641 12023 1125         TAD FLARGP      /SET POINTER
2642 12024 3030         DCA PT1
2643 12025 4247         JMS PARTEST
2644 12026 5627         JMP I .+1       /FUNCTION RETURN IS OK
2645 12027 1622         OPNEXT
2646            
2647            
2648 12030 0000 FLARG,  0       /DATA TEMPORARY STORAGE
2649 12031 0000         0
2650 12032 0000         0
2651 12033 0000         0
2652            
2653 12034 0003 P3,     3
2654 12035 0000 LPRTST, 0               /SKIP IF LEFT PAREN. - 'TSTLPR'
2655 12036 1054         TAD SORTCN
2656 12037 1121         TAD M11
2657 12040 7700         SMA CLA
2658 12041 5635         JMP I LPRTST    /--RETURN--
2659 12042 1054         TAD SORTCN
2660 12043 1120         TAD M5
2661 12044 7740         SMA SZA CLA
2662 12045 2235         ISZ LPRTST
2663 12046 5635         JMP I LPRTST    /--RETURN--
2664            
2665 12047 0000 PARTEST,0               /TEST THE PAREN MATCHINGS
2666 12050 4542         POPA            /RESTORE LAST OPERATION
2667 12051 3055         DCA LASTOP
2668 12052 4542         POPA            /REVERSE THESE TWO INSTRUCTIONS
2669 12053 1234         TAD P3
2670 12054 7041         CIA             /CHECK FOR PAREN MATCH.
2671 12055 1054         TAD SORTCN      /(STILL SET FROM THE LAST "EVAL")
2672 12056 7640         SZA CLA         /SKIP IF MATCH  
2673 12057 4566         ERROR4          /PAREN ERROR
2674 12060 4545         GETC            /MOVE PAST R-PAR
2675 12061 5647         JMP I PARTEST   /--RETURN--
2676            
2677            /THE DELETE A LINE ROUTINE
2678            
2679 12062 0000 XDELETE,0               /UNCHAIN A LINE AND RECOVER THE SPACE.
2680 12063 4555         FINDLN          /SETS "THISLN" AND "LASTLN".
2681 12064 5662         JMP I XDELETE   /ALREADY GONE --RETURN--
2682 12065 2026         ISZ DEBGSW      /DISABLE TRACE
2683 12066 4545         GETC            /MEASURE LENGTH
2684 12067 1066         TAD CHAR
2685 12070 1116         TAD MCR
2686 12071 7640         SZA CLA
2687 12072 5266         JMP .-4
2688 12073 1017         TAD AXOUT       /SAVE LAST ADDRESS
2689 12074 7040         CMA
2690 12075 1023         TAD THISLN
2691 12076 3057         DCA CNTR        /LENGTH < 0
2692 12077 1132         TAD CFRS        /IT IS ILLEGAL TO DELETE THE FIRST LINE
2693 12100 7041         CIA
2694 12101 1023         TAD THISLN
2695 12102 7650         SNA CLA
2696 12103 5177         JMP START       /JUST IGNORE SUCH COMMANDS
2697 12104 6201         CDF             /CHANGE DATA FIELD FOR 'DELETE'
2698 12105 1423         TAD I THISLN    /DISCONNECT
2699 12106 3425         DCA I LASTLN
2700 12107 1132         TAD CFRS        /START LIST AT TOP
2701 12110 3071 DOK,    DCA T2          /EXAMINATION ADDRESS
2702 12111 1471         TAD I T2        /GET THE NEXT ADDR.
2703 12112 7450         SNA             /TEST FOR END
2704 12113 5326         JMP DONE        /YES-WRAP UP ALL.
2705 12114 3032         DCA T1          /SAVE NEXT ADDRESS.
2706 12115 1023         TAD THISLN      /COMPARE LINE POSITIONS
2707 12116 7141         CIA CLL
2708 12117 1032         TAD T1
2709 12120 7630         SZL CLA         /SKIP IF THISLN > X
2710 12121 1057         TAD CNTR        /CHANGE (X) TO ACCOUNT FOR
2711 12122 1032         TAD T1          /GARBAGE COLLECTION.
2712 12123 3471         DCA I T2
2713 12124 1032         TAD T1          /GET NEXT
2714 12125 5310         JMP DOK
2715            
2716            /GARBAGE COLLECTION
2717            
2718 12126 7040 DONE,   CMA             /BACKUP L FOR XR
2719 12127 1023         TAD THISLN
2720 12130 3011         DCA XRT
2721 12131 1057         TAD CNTR        /SETUP END OF HOSE
2722 12132 7040         CMA
2723 12133 1023         TAD THISLN
2724 12134 3012         DCA XRT2
2725 12135 1057         TAD CNTR        /CORRECT END OF BUFFER POINTER.
2726 12136 1060         TAD BUFR
2727 12137 3060         DCA BUFR
2728 12140 1010         TAD AXIN        /COMPUTE COUNT
2729 12141 7040         CMA
2730 12142 1012         TAD XRT2
2731 12143 3032         DCA T1
2732 12144 1010         TAD AXIN
2733 12145 1057         TAD CNTR
2734 12146 3010         DCA AXIN
2735 12147 1412         TAD I XRT2      /SIPHON LOWER PART.
2736 12150 3411         DCA I XRT
2737 12151 2032         ISZ T1
2738 12152 5347         JMP .-3
2739 12153 5263         JMP XDELETE+1   /RESET 'LASTLN','THISLN', AND DATA FIELD.
2740            
2741            
2742 12154 0000 CHIN,   0               /READ IN A CHARACTER SUBR. - "READC"
2743 12155 4464         JMS I INDEV
2744 12156 3066         DCA CHAR
2745 12157 4547         SORTJ           /USE 'SORTJ' INSTEAD OF 'SORTC'
2746 12160 1623                 ECHOLST-1       /SO 'SORTCN' DOESN'T GET KILLED
2747 12161 5704                 ECHOGO-ECHOLST
2748 12162 4551 PPRNT,  PRINTC          /ECHO THE INPUT
2749 12163 5754         JMP I CHIN      /--RETURN--
2750            /-------------------------------------------------------------------
2751            
2752            
2753            FNTABL=.
2754 12164 2533         2533    /FABS
2755 12165 2650         2650    /FSGN
2756 12166 2636         2636    /FITR
2757 12167 2565         2565            /FDIS
2758 12170 2630         2630    /FRAN
2759 12171 2637         2637            /FJOY
2760 12172 2572         2572    /FATN
2761 12173 2624         2624    /FEXP
2762 12174 2625         2625    /FLOG
2763 12175 2654         2654    /FSIN
2764 12176 2575         2575    /FCOS
2765 12177 2702         2702    /FSQT
2766 12200 1140         1140            /FIN
2767 12201 2672         2672            /FOUT
2768 12202 2604         2604            /FIND
2769            
2770            /ERASE SINGLE LINES, GROUPS, OR VARIABLES
2771            
2772 12203 4564 ERASE,  TESTC           /TEST THE SECOND WORD, IF ANY.
2773            /---------------------------------------------------------------------
2774 12204 5236         JMP ERVX        /ERASE VARIABLES
2775 12205 5221         JMP ERL         /LINES OR GROUPS
2776 12206 5212         JMP .+4         /ERROR
2777 12207 1066         TAD CHAR        /ALL TEXT
2778 12210 1112         TAD MINUSA
2779 12211 7440         SZA
2780 12212 4566         ERROR3          /BAD ARG FOR ERASE.
2781 12213 1134 ERT,    TAD ENDT        /ERASE ALL TEXT **
2782 12214 3060         DCA BUFR
2783 12215 6201         CDF
2784 12216 3532         DCA I CFRS      /ERASE ALL TEXT
2785 12217 5437         JMP I GOK
2786 12220 5177         JMP START       /POINTERS MAY BE DIFFERENT NOW.
2787 12221 4554 ERL,    GETLN           /ERASE LINES.
2788 12222 1060         TAD BUFR        /PROTECT REST OF TEXT.
2789 12223 3010         DCA AXIN
2790 12224 4565 ERG,    DELETE          /EXTRACT ONE LINE
2791 12225 2023         ISZ THISLN
2792 12226 1065         TAD NAGSW
2793 12227 7700         SMA CLA
2794 12230 4570         JMS I DTHIS     /TAD I THISLN
2795 12231 4563         TSTGRP          /DONE ERASING GROUP?
2796 12232 5437         JMP I GOK        /YES, ERASE 'CURRENT PROGRAM SAVED' FLAG
2797 12233 4570         JMS I DTHIS     /TAD I THISLN
2798 12234 3067         DCA LINENO
2799 12235 5224         JMP ERG
2800 12236 1133 ERVX,   TAD END         /ZERO VARIABLES (BUT NOT SECRET VARIABLES)
2801 12237 3031         DCA LASTV
2802 12240 5540         POPJ
2803            
2804            
2805            /ROUTINE CALLED VIA "FINDLN":
2806            
2807            /SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ]
2808            /1ST RETURN IF NOT FOUND,
2809            /2AND IF FOUND.
2810            /"THISLN" = FOUND LINE OR NEXT LARGER.
2811            /"LASTLN" = LESSER AND/OR LAST.
2812            /"TEXTP" IS SET
2813            
2814 12241 0000 XFIND,  0
2815 12242 1132         TAD CFRS        /INITIALIZE POINTERS TO FIRST LINE
2816 12243 3025         DCA LASTLN
2817 12244 1132         TAD CFRS
2818 12245 3023 FINDN,  DCA THISLN      /SAVE THIS ONE
2819 12246 1023         TAD THISLN
2820 12247 3011         DCA XRT
2821 12250 1067         TAD LINENO
2822 12251 7141         CLL CMA IAC     /CLEAR LINK AND NEGATE LINENO.
2823 12252 4572         JMS I DXRT      /TAD I XRT
2824 12253 7450         SNA
2825 12254 5265         JMP FEND3-1     /FOUND IT.
2826 12255 7630         SZL CLA
2827 12256 5266         JMP FEND3       /PAST IT.
2828 12257 1023         TAD THISLN      /MOVE POINTERS
2829 12260 3025         DCA LASTLN
2830 12261 4570         JMS I DTHIS     /TAD I THISLN
2831 12262 7440         SZA
2832 12263 5245         JMP FINDN       /NOT YET
2833 12264 7410         SKP
2834 12265 2241         ISZ XFIND       /2ND EXIT = FOUND
2835 12266 1023 FEND3,  TAD THISLN      /1ST RETURN = NOT FOUND
2836 12267 7001         IAC
2837 12270 3017         DCA AXOUT       /SET "TEXTP".
2838 12271 3020         DCA XCT
2839 12272 5641         JMP I XFIND     /--RETURN--
2840            
2841            
2842 12273 0000 UTRA,  0               /UNPACK CHARACTER. - "GETC"
2843 12274 4327         JMS GET1
2844 12275 7710 UTE,    SPA CLA         /NORM & EXTEND
2845 12276 1002         TAD C100        /300-337 & 340-376
2846 12277 1356         TAD M137        /240-276 & 200-236
2847 12300 1066         TAD CHAR
2848 12301 7450         SNA
2849 12302 5315         JMP UTX         /"?" FOUND
2850 12303 1075         TAD P337
2851 12304 3066 UTQ,    DCA CHAR
2852 12305 1026         TAD DEBGSW
2853 12306 1100         TAD DMPSW
2854 12307 7650         SNA CLA         /PRINT ONLY IF BOTH ARE ZERO.
2855 12310 4551         PRINTC
2856 12311 5673         JMP I UTRA      /--RETURN--
2857 12312 4327 EXTR,   JMS GET1
2858 12313 7040         CMA
2859 12314 5275         JMP UTE
2860 12315 1026 UTX,    TAD DEBGSW      /TEST FOR TRACE-ENABLED
2861 12316 7640         SZA CLA
2862 12317 5325         JMP .+6
2863 12320 1100         TAD DMPSW       /FLIP THE TRACE FLOP
2864 12321 7650         SNA CLA
2865 12322 7001         IAC
2866 12323 3100         DCA DMPSW
2867 12324 5274         JMP UTRA+1      /GET NEXT CHARACTER INSTEAD.
2868 12325 1110         TAD P277        /TRACE DISABLED = RETURN "?"
2869 12326 5304         JMP UTQ
2870 12327 0000 GET1,   0               /UNPACK 6-BITS
2871 12330 2020         ISZ XCT         /STARTS=0
2872 12331 5344         JMP GET3
2873 12332 1021         TAD GTEM
2874 12333 0122 GEND,   AND P77
2875 12334 3066         DCA CHAR        /SAVE
2876 12335 1066         TAD CHAR
2877 12336 1103         TAD M77
2878 12337 7650         SNA CLA
2879 12340 5312         JMP EXTR        /EXTENDED
2880 12341 1066         TAD CHAR
2881 12342 1355         TAD M40
2882 12343 5727         JMP I GET1      /--RETURN--
2883 12344 4574 GET3,   JMS I DAXOUT    /TAD I AXOUT
2884 12345 3021         DCA GTEM
2885 12346 7040         CMA
2886 12347 3020         DCA XCT
2887 12350 1021         TAD GTEM
2888 12351 7112         RTR CLL
2889 12352 7012         RTR
2890 12353 7012         RTR
2891 12354 5333         JMP GEND
2892 12355 7740 M40,    -40
2893 12356 7641 M137,   -137
2894 12357 0000 XENDLN,        0       /TERMINATE THE BUFFERED LINE - "ENDLN"
2895 12360 6201         CDF
2896 12361 1425         TAD I LASTLN    /SAVE OLD POINTER
2897 12362 3460         DCA I BUFR
2898 12363 1060         TAD BUFR        /POINT TO NEW LAST LINE
2899 12364 3425         DCA I LASTLN
2900 12365 1061         TAD ADD         /CHECK FOR EXTRA INFO
2901 12366 7440         SZA 
2902 12367 3410         DCA I AXIN
2903 12370 1010         TAD AXIN        /COMPUTE NEW END OF BUFFER
2904 12371 7001         IAC
2905 12372 3060         DCA BUFR
2906 12373 3531         DCA I LIBN      /WE'VE ADDED A NEW LINE
2907 12374 6211         CDF 10          /KILL 'CURRENT PROGRAM SAVED' FLAG
2908 12375 5757         JMP I XENDLN    /--RETURN--
2909            /---------------------------------------------------------------------
2910            
2911            
2912            
2913            TLIST3=.        /LITERAL TERMINATORS
2914 12376 1261         TASK4   /"
2915 12377 0612         PC1     /C.R. = AUTOMATIC QUOTE MATCH
2916            
2917            
2918            INFIX=.         /DATA CONTROL CHARACTERS
2919 12400 6202         FLINTP+2        /LEFT ARROW     = KILL
2920 12401 0757         INPUT+1         /RUBOUT         = IGNORE
2921 12402 0757         INPUT+1         /L.F.           = IGNORE
2922 12403 6250         ENDFI+5         /ALT MODE       = EXIT
2923            
2924 12404 0757         INPUT+1         /^L IN ASK STATEMENT, IGNORE IT
2925 12405 0001 FLTONE, 0001    /(NO RELATIVE REFERENCES)
2926 12406 2000         2000
2927 12407 0000 FLTZER, 0000
2928 12410 0000         0000
2929 12411 0000         0000
2930 12412 0000         0000
2931 12413 7766 M12,    -12     /DECIMAL CONVERSION FACTOR FOR "PRNT"
2932            /----------------------------------------------------------------------
2933            
2934            
2935 12414 0000 XPUSHJ, 0
2936 12415 7301         CLA CLL IAC
2937 12416 1214         TAD XPUSHJ      /BUMP RETURN ADDRESS
2938 12417 4541         PUSHA           /SAVE IT ON THE STACK
2939 12420 1614         TAD I XPUSHJ    /GET THE ADDRESS
2940 12421 3214         DCA XPUSHJ      /INDIRECT INDIRECT!
2941 12422 5614         JMP I XPUSHJ
2942            
2943 12423 0000 XPRNT, 0       /PRINT A LINE NUMBER - "PRNTLN"
2944 12424 1067         TAD LINENO
2945 12425 4557         RTL6
2946 12426 0122         AND P77
2947 12427 4240         JMS PRNT        /TWO DIGIT "PART" NUMBER
2948 12430 1102         TAD PER
2949 12431 4551         PRINTC          /PERIOD FOR SEPARATION
2950 12432 1067         TAD LINENO
2951 12433 4240         JMS PRNT        /TWO DIGIT "STEP" NUMBER.
2952 12434 1360         TAD M140
2953 12435 3066         DCA CHAR        /SAVE SPACE IN CHAR.
2954 12436 4551         PRINTC          /PRINT TRAILING SPACE
2955 12437 5623         JMP I XPRNT     /--RETURN--
2956            VAL=T1
2957 12440 0000 PRNT,   0       /PRINT TWO DECIMAL DIGITS
2958 12441 0106         AND P177
2959 12442 3032         DCA VAL
2960 12443 1113         TAD C260
2961 12444 3033         DCA T3
2962 12445 5250         JMP .+3
2963 12446 2033         ISZ T3
2964 12447 3032 XYZ,    DCA VAL
2965 12450 1032         TAD VAL
2966 12451 1213         TAD M12
2967 12452 7500         SMA
2968 12453 5246         JMP XYZ-1
2969 12454 7200         CLA
2970 12455 1033         TAD T3
2971 12456 4551         PRINTC
2972 12457 1032         TAD VAL
2973 12460 1113         TAD C260
2974 12461 4551         PRINTC
2975 12462 5640         JMP I PRNT      /--RETURN--
2976 12463 0000 OUT,    0               /OUTPUT A CHARACTER - "PRINTC"
2977 12464 7450         SNA             /USE (AC) OR (CHAR)
2978 12465 1066         TAD CHAR
2979 12466 6202         CIF
2980 12467 4703         JMS I TAB       /COUNT CHARACTERS
2981 12470 5273         JMP OUTCR       /IT WAS A CR, PRINT CR/LF
2982 12471 4463         JMS I OUTDEV    /PRINT NORMAL CHAR
2983 12472 5663         JMP I OUT
2984 12473 1077 OUTCR,  TAD CCR
2985 12474 4463         JMS I OUTDEV
2986 12475 1076         TAD CLF
2987 12476 4463         JMS I OUTDEV
2988 12477 1123         TAD C200        /PRINT 2 NULLS
2989 12500 4463         JMS I OUTDEV    /AFTER EACH CR/LF
2990 12501 1123         TAD C200
2991 12502 5271         JMP OUTCR-2
2992 12503 6325 TAB,    TABCNT
2993            
2994 12504 0000 PACBUF, 0               /PACK A CHARACTER - "PACKC"
2995 12505 1110         TAD P277
2996 12506 7041         CIA
2997 12507 1066         TAD CHAR
2998 12510 7450         SNA             /CHANGE 277 TO 337
2999 12511 1354         TAD P40
3000 12512 1101         TAD M100
3001 12513 7450         SNA             /TEST FOR RUBOUT.
3002 12514 5757         JMP I RUBIT
3003 12515 1355         TAD P377
3004 12516 3071         DCA T2          /SAVE INPUT ITEM
3005 12517 1071         TAD T2          /SO THAT QUESTION DOESN'T MAKE
3006 12520 0356         AND C140        /CHAR LOOK LIKE A LEFT-ARROW
3007 12521 1360         TAD M140
3008 12522 7440         SZA             /DATA WORD.
3009 12523 1356         TAD C140
3010 12524 7650         SNA CLA
3011 12525 5334         JMP ESCA        /340-377 AND 200-237
3012 12526 1071 PA1,    TAD T2          /240-337
3013 12527 0122         AND P77
3014 12530 7440         SZA             /IGNORE 300
3015 12531 4337         JMS PCK1
3016 12532 6211 PACX,   CDF 10          /RESTORE FIELD AFTER 'PACKC'
3017 12533 5704         JMP I PACBUF    /--RETURN--
3018 12534 1122 ESCA,   TAD P77
3019 12535 4337         JMS PCK1
3020 12536 5326         JMP PA1
3021 12537 0000 PCK1,   0
3022 12540 2062         ISZ XCTIN       /=0 TO START
3023 12541 5361         JMP ROT
3024 12542 1061         TAD ADD
3025 12543 4573         JMS I DAXIN     /DCA I AXIN
3026 12544 3061         DCA ADD         /CLEAR PACKING WORD     /*8K*
3027 12545 1013         TAD PDLXR       /CHECK FOR OVERFLOW     /*8K*
3028 12546 7141         CMA IAC CLL                     /*8K*
3029 12547 1001         TAD P13         /RESERVATIONS FOR PUSH-DOWN LIST/*8K*
3030 12550 1010         TAD AXIN
3031 12551 7620         SNL CLA
3032 12552 5737         JMP I PCK1      /--RETURN--
3033 12553 4566         ERROR2          /FULL BUFFER
3034 12554 0040 P40,    40
3035 12555 0377 P377,   377
3036 12556 0140 C140,   140
3037 12557 3000 RUBIT,  RUB1
3038 12560 7640 M140,   -140
3039 12561 4557 ROT,    RTL6    /(EAE)
3040 12562 3061         DCA ADD
3041 12563 7040         CMA
3042 12564 3062         DCA XCTIN
3043 12565 5737         JMP I PCK1
3044            
3045            
3046 12566 0000 PS8PC,  0               /PC
3047 12567 6201         CDF
3048 12570 1422         TAD I PC
3049 12571 6211         CDF 10
3050 12572 5766         JMP I PS8PC
3051            
3052 12573 0000 AXOUTD, 0
3053 12574 6201         CDF
3054 12575 1417         TAD I AXOUT
3055 12576 6211         CDF 10
3056 12577 5773         JMP I AXOUTD
3057            /INPUT OUTPUT HANDLERS -- NO INTERRUPTS
3058            *2600
3059            
3060 12600 7560 MBREAK, -220            /CONTROL-P
3061 12601 7575 MCTRLC, -203            /CONTROL-C
3062            
3063 12602 2016 RANRAN, ISZ RISZ        /BUMP RANDOM NUMBER
3064 12603 5206         JMP XI33+1      /WHILE WAITING FOR INPUT
3065 12604 5202         JMP RANRAN      /DON'T LEAVE ZERO
3066            
3067 12605 0000 XI33,   0               /VIA (INDEV)
3068 12606 6031         KSF
3069 12607 5202         JMP RANRAN      /BUMP RANDOM NUMBER
3070 12610 6036         KRB
3071 12611 0106         AND P177        /IGNORE PARITY BIT
3072 12612 7450         SNA
3073 12613 5206         JMP XI33+1      /IGNORE NULL
3074 12614 1123         TAD C200        /FORCE PARITY BIT ON
3075 12615 4241         JMS XTSBRK
3076 12616 5605         JMP I XI33      /--RETURN--
3077            
3078 12617 0000 XOUTL,  0               /VIA (OUTDEV)
3079 12620 3205         DCA XI33        /TEMP. STORAGE
3080 12621 1205         TAD XI33
3081 12622 6041         TSF
3082 12623 5227         JMP XOUBRK      /CHECK FOR BREAK CHARS.
3083 12624 6046         TLS
3084 12625 7300         CLA CLL
3085 12626 5617         JMP I XOUTL     /--RETURN--
3086            
3087 12627 7300 XOUBRK, CLA CLL
3088 12630 6031         KSF             /BREAK?
3089 12631 5221         JMP XOUTL+2     /NO
3090 12632 6036         KRB             /YES
3091 12633 0106         AND P177
3092 12634 1123         TAD C200
3093 12635 4241         JMS XTSBRK
3094 12636 7300         CLA CLL
3095 12637 5221         JMP XOUTL+2
3096            
3097 12640 0000 XTSBSV, 0       /TEMPORARY STORAGE FOR XTSBRK
3098 12641 0000 XTSBRK, 0       /TEST FOR BREAK CHAR
3099 12642 3240         DCA XTSBSV
3100 12643 1240         TAD XTSBSV
3101 12644 1201         TAD MCTRLC
3102 12645 7650         SNA CLA
3103 12646 5255         JMP CNTRC       /RETURN TO MONITOR
3104 12647 1240         TAD XTSBSV
3105 12650 1200         TAD MBREAK
3106 12651 7650         SNA CLA
3107 12652 5276         JMP RECOVR      /RETURN TO *
3108 12653 1240         TAD XTSBSV      /NO BREAK -- RESTORE AC
3109 12654 5641         JMP I XTSBRK
3110            
3111            /HANDLE CTRL/C
3112 12655 6203 CNTRC,  CIF CDF
3113 12656 5657         JMP I .+1
3114 12657 7600         7600
3115            
3116 12660 0000 XKSF,   0       /TEST FOR KEYBOARD BREAK
3117 12661 6031         KSF
3118 12662 5660         JMP I XKSF      /NO
3119 12663 6036         KRB
3120 12664 0106         AND P177
3121 12665 1123         TAD C200
3122 12666 4241         JMS XTSBRK
3123 12667 7300         CLA CLL         /IGNORE NON-BREAK CHAR
3124 12670 5660         JMP I XKSF
3125            
3126            /ERROR RECOVERY PROCEEDURE
3127            
3128 12671 3272 ERROR5, DCA .+1
3129 12672 0000 ERR2,   0
3130 12673 7340         CLA CLL CMA     /PUT ERROR CODE IN 'LINENO' FOR 'PRNTLN'
3131 12674 1272         TAD ERR2
3132 12675 7410         SKP
3133 12676 1123 RECOVR, TAD C200        /TELETYPE BREAK
3134 12677 3067         DCA LINENO
3135 12700 3034         DCA INBUF       /AND INPUT BUFFER
3136 12701 6046         TLS             /SET TTY FLAG TO PREVENT HANGUP
3137 12702 6041         TSF
3138 12703 5302         JMP .-1
3139 12704 6203 RECOVX, CIF CDF         /DO LOWER FIELD FIXES
3140                    JMP XRESTOR     /IN FIELD 0
off page        	           ^
     12705 5777 
3141 12706 1376 RECOVY, TAD (PRINTC     /'OPEN INPUT TTY:,ECHO; OPEN OUTPUT TTY:'
3142                    DCA PPRNT
off page        	        ^
     12707 3775 
3143 12710 1374         TAD (XI33
3144 12711 3064         DCA INDEV
3145 12712 1373         TAD (XOUTL
3146 12713 3063         DCA OUTDEV
3147 12714 1077         TAD CCR         /PRINT CR/LF BEFORE ERROR MESSAGE
3148 12715 4551         PRINTC
3149 12716 1110         TAD P277
3150 12717 4551         PRINTC          /PRINT A '?'?
3151 12720 4553         PRNTLN
3152 12721 2022         ISZ PC
3153 12722 4567         JMS I DPC
3154 12723 7450         SNA
3155 12724 5332         JMP .+6
3156 12725 3067         DCA LINENO
3157 12726 1101         TAD P7700
3158 12727 4551         PRINTC
3159 12730 4551         PRINTC
3160 12731 4553         PRNTLN
3161 12732 1077         TAD CCR
3162 12733 4551         PRINTC
3163 12734 5177         JMP START
3164            
3165 12773 2617 PAGE
     12774 2605 
     12775 2162 
     12776 4551 
     12777 5750 
3166            /CHARACTER REMOVAL ROUTINE
3167            
3168 13000 1062 RUB1,   TAD XCTIN       /RUBOUT ONE LETTER
3169 13001 7640         SZA CLA
3170            /----------------------------------------------------------------------
3171 13002 5210         JMP .+6
3172 13003 1010         TAD AXIN
3173 13004 7041         CIA
3174 13005 1027         TAD PACKST
3175 13006 7700         SMA CLA         /TEST NULL LINE
3176 13007 5635         JMP I RUB5
3177 13010 1245         TAD SPLAT       /FOR A RUBOUT ACKNOWLEDGEMENT
3178 13011 4400         JMS I ECHOP     /SHALL WE ECHO A '\'?
3179 13012 1010         TAD AXIN
3180 13013 3071         DCA T2
3181 13014 6201         CDF             /LOWER FIELD TO RUBOUT TEXT
3182 13015 2062         ISZ XCTIN       /TEST HALF
3183 13016 5236         JMP RUB2
3184 13017 1471         TAD I T2        /"ADD" IS FULL.
3185 13020 0122         AND P77
3186 13021 1103         TAD M77
3187 13022 7640         SZA CLA         /TEST FOR EXTEND
3188 13023 5233         JMP RUB4
3189 13024 7040 RUB3,   CMA             /SET SWITCH
3190 13025 3062         DCA XCTIN
3191 13026 7040         CMA             /BACKUP POINTER
3192 13027 1010         TAD AXIN
3193 13030 3010         DCA AXIN
3194 13031 1471         TAD I T2        /RESET ADD
3195 13032 0101         AND P7700
3196 13033 3061 RUB4,   DCA ADD
3197 13034 5635         JMP I RUB5
3198 13035 2532 RUB5,   PACX
3199 13036 1471 RUB2,   TAD I T2        /CHECK FOR EXTENDED
3200 13037 0101         AND P7700
3201 13040 1002         TAD C100
3202 13041 7640         SZA CLA
3203 13042 5224         JMP RUB3
3204 13043 3471         DCA I T2        /SAVE CORRECTION
3205 13044 5225         JMP RUB3+1
3206 13045 0334 SPLAT,  334
3207            /SYMBOL TABLE TYPEOUT ROUTINE
3208            
3209 13046 1133 TDUMP,  TAD END         /INIT POINTER FOR DUMP (DON'T DUMP SECRET)
3210 13047 3030         DCA PT1
3211 13050 1031         TAD LASTV       /TEST FOR END OF LIST
3212 13051 7041         CIA
3213 13052 1030         TAD PT1
3214 13053 7650         SNA CLA
3215 13054 5540         POPJ
3216 13055 1430         TAD I PT1       /GET THE VARIABLE
3217 13056 6201         CDF             /FOR PFOCAL
3218 13057 3714         DCA I OP+1
3219 13060 6211         CDF 10
3220 13061 1313         TAD OP          /SETUP UNPACK POINTERS
3221 13062 3017         DCA AXOUT
3222 13063 3020         DCA XCT
3223 13064 4545         GETC            /READ AND PRINT "XX("
3224 13065 4551         PRINTC
3225 13066 4545         GETC
3226 13067 4551         PRINTC
3227 13070 4545         GETC
3228 13071 4551         PRINTC
3229 13072 2030         ISZ PT1
3230 13073 1430         TAD I PT1       /PRINT SUBSCRIPT TO 99
3231 13074 4712         JMS I PRNT2
3232 13075 4545         GETC            /PRINT ")"
3233 13076 4551         PRINTC
3234 13077 2030         ISZ PT1
3235 13100 4407         FINT            /PICK UP VALUE
3236 13101 0430         FGET I PT1
3237 13102 0000         FXIT
3238 13103 4527         JMS I FOUTPUT   /PRINT VALUE
3239 13104 1077         TAD CCR
3240 13105 4551         PRINTC
3241 13106 1070         TAD GINC
3242 13107 1111         TAD M2
3243 13110 1030         TAD PT1
3244 13111 5247         JMP TDUMP+1
3245            
3246 13112 2440 PRNT2,  PRNT
3247 13113 0203 OP,     PC0+3
3248 13114 0204         PC0+4
3249 13115 0000         0
3250 13116 0000 ECHO,  0
3251 13117 3066         DCA CHAR        /SAVE IN CHAR
3252 13120 1725         TAD I PPPRNT    /DO WE WANT TO PRINT?
3253 13121 7650         SNA CLA
3254 13122 5716         JMP I ECHO      /NO
3255 13123 4551         PRINTC          /YES
3256 13124 5716         JMP I ECHO
3257 13125 2162 PPPRNT, PPRNT
3258            
3259 13126 0000 ICHARF, 0               /INPUT A CHARACTER FROM A FILE
3260 13127 6203         CIF CDF
3261 13130 4732         JMS I CHARI     /CALL LOWER FIELD
3262 13131 5726         JMP I ICHARF
3263            
3264 13132 5463 CHARI,  ICHAR
3265            
3266 13133 6202 FILER,  CIF             /FILE COMMANDS ('OPEN')
3267 13134 5735         JMP I .+1
3268 13135 5442         FILEST
3269            
3270 13136 2605 X133P,  XI33
3271            
3272 13137 0000 TERMER, 0               /CHECK FOR TERMINATOR (;, CR, SPACE,
3273 13140 4550         SORTC
3274 13141 1374                 GLIST-1
3275 13142 2337         ISZ TERMER
3276 13143 6203         CIF CDF
3277 13144 5737         JMP I TERMER
3278            
3279 13145 0000 EOF,    0               /TRYING TO READ FROM A FILE AFTER END
3280 13146 1336         TAD X133P       /(SHAME ON YOU!)
3281 13147 3064         DCA INDEV       /RESET POINTER TO TTY
3282 13150 1110         TAD P277        /PRINT A '?'
3283                    JMS XOUTL       /ON THE TELETYPE
off page        	         ^
     13151 4777 
3284 13152 4464         JMS I INDEV     /READ A CHARACTER
3285 13153 5745         JMP I EOF
3286            
3287            
3288 13154 0000 OCHAR,  0               /OUTPUT A CHARACTER
3289 13155 3071         DCA T2
3290 13156 7410 OUTECH, SKP             /ECHO ON TELETYPE?
3291 13157 5364         JMP .+5
3292 13160 1071         TAD T2          /MNO
3293 13161 7450         SNA             /YES
3294 13162 7330         CLA CLL CML RAR /LET HIM PRINT NULLS!
3295                    JMS XOUTL
off page        	        ^
     13163 4777 
3296 13164 1071         TAD T2
3297 13165 6202         CIF
3298 13166 4770         JMS I NOCARE    /OUTPUT IT
3299 13167 5754         JMP I OCHAR
3300 13170 3665 NOCARE, NOCHAR
3301            
3302 13171 0000 PRINTX, 0
3303 13172 4463         JMS I OUTDEV
3304 13173 6202         CIF
3305 13174 5771         JMP I PRINTX
3306            
3307 13177 2617         PAGE
3308            
3309            /-------------------------------------------------------------------
3310            /TEKTRONIX 4010 GRAPHICS I/O ROUTINES
3311            
3312            GS=235
3313            US=37
3314            SUB=232
3315            ENQ=205
3316            ESC=233
3317            
3318            XJ=3012
3319            YJ=3112
3320            
3321            
3322 13200 1220 FDIS,   TAD FCHKP       /CHEAT LIKE HELL!
3323 13201 3151         DCA XPRNTC      /KLUDGE PRINTC SO WE KNOW WHAT MODE WE'RE IN
3324 13202 4453         JMS I INTEGER   /CHECK FIRST ARG (FDIS(I,X,Y))
3325 13203 3244         DCA FDISI       /SAVE FOR LATER TESTING
3326 13204 1244         TAD FDISI       /ALSO TEST NOW
3327 13205 7740         SMA SZA CLA     /NEGATIVE ARG MEANG START POINT PLOTTING
3328 13206 1245         TAD FDSW        /ARE WE IN GRAPHICS MODE?
3329 13207 7640 C40,    SZA CLA
3330 13210 5215         JMP PLOT        /WE'RE IN GRAPHICS AND  I  WAS POSITIVE
3331 13211 1377         TAD (GS         /OTHERWISE, START GRAPHICS NOW
3332                    JMS XOUTL
off page        	        ^
     13212 4776 
3333 13213 3232         DCA XHIGH
3334 13214 3225         DCA YHIGH
3335 13215 4537 PLOT,   PUSHJ           /GET X COORDINATE
3336 13216 1612                 EVAL-1  /SKIP COMMA
3337 13217 4453         JMS I INTEGER
3338 13220 3274 FCHKP,  DCA FCHK        /TEMP
3339 13221 4537         PUSHJ           /GET Y COORDINATE
3340 13222 1612                 EVAL-1  /SKIP COMMA
3341 13223 4453         JMS I INTEGER
3342 13224 4245         JMS HIGH        /AREN'T WE THOUGH!!
3343 13225 0000 YHIGH,  0
3344 13226 1207         TAD C40         /ADD APPROPRIATE SIGNAL BITS
3345                    JMS XOUTL
off page        	        ^
     13227 4776 
3346 13230 1274         TAD FCHK        /SAVED X
3347 13231 4245         JMS HIGH        /DO HIGH ORDER X
3348 13232 0000 XHIGH,  0
3349 13233 3274         DCA FCHK
3350 13234 1274         TAD FCHK
3351                    JMS XOUTL
off page        	        ^
     13235 4776 
3352 13236 1244         TAD FDISI       /FIRST ARGUMENT OF FDIS
3353 13237 7700         SMA CLA
3354 13240 5535         JMP I EFUN3I    /RETURN FROM VECTOR PLOTTING:  I=0 OR 1
3355 13241 1274         TAD FCHK        /SEND XLOW AGAIN TO BRIGHTEN POINT
3356                    JMS XOUTL
off page        	        ^
     13242 4776 
3357 13243 5535         JMP I EFUN3I    /RETURN FROM POINT PLOTTING
3358            
3359 13244 0000 FDISI,  0       /SAVED VALUE OF FIRST ARGUMENT TO FDIS
3360            
3361            FDSW=.
3362 13245 0000 HIGH,   0               /SUB TO CHECK HIGH-ORDER, ONLY PRINT
3363 13246 3332         DCA FDT2        /IF DIFFERENT FROM PREVIOUS
3364 13247 1332         TAD FDT2
3365 13250 7112         CLL RTR
3366 13251 7012         RTR;RAR
     13252 7010 
3367 13253 0375         AND (37
3368 13254 1207         TAD C40
3369 13255 3355         DCA JFLOAT
3370 13256 1355         TAD JFLOAT
3371 13257 1645         TAD I HIGH      /COMPARE WITH LAST HIGH
3372 13260 7650         SNA CLA
3373 13261 5267         JMP HXIT        /OK
3374 13262 1355         TAD JFLOAT      /NOT SO GOOD, PRINT IT
3375                    JMS XOUTL
off page        	        ^
     13263 4776 
3376 13264 1355         TAD JFLOAT
3377 13265 7141         CLL CIA
3378 13266 3645         DCA I HIGH      /SAVE FOR NEXT TIME
3379 13267 2245 HXIT,   ISZ HIGH        /SKIP
3380 13270 1332         TAD FDT2
3381 13271 0375         AND (37
3382 13272 1002         TAD C100        /TAG BIT FOR LOW ORDER
3383 13273 5645         JMP I HIGH
3384            
3385 13274 0000 FCHK,   0               /PRINTC WAS CALLED, SWITCH TO NORMAL
3386 13275 3245         DCA HIGH        /SAVE CHAR IN AC
3387 13276 1374         TAD (OUT        /POINTER TO OUT
3388 13277 3151         DCA XPRNTC
3389 13300 1375         TAD (US
3390                    JMS XOUTL
off page        	        ^
     13301 4776 
3391 13302 1245         TAD HIGH        /PRINT CHAR
3392 13303 4551         PRINTC          /WE RESTORED THE POINTER, REMEMBER
3393 13304 3245         DCA FDSW        /RESET MODE SWITCH
3394 13305 5674         JMP I FCHK
3395            
3396 13306 1373 FJOY,   TAD (ESC        /SEQUENCE STARTS WITH 'ESC' (4010)
3397                    JMS XOUTL
off page        	        ^
     13307 4776 
3398 13310 4453         JMS I INTEGER   /CHECK ARG
3399 13311 7650         SNA CLA
3400 13312 1372         TAD (SUB-ENQ    /ZERO, TURN ON CURSOR AND WAIT
3401 13313 1371         TAD (ENQ        /NON-ZERO, READ IT NOW
3402                    JMS XOUTL
off page        	        ^
     13314 4776 
3403 13315 1046         TAD FLAC+2      /FOR I=1, WILL BE NO INITIAL CHAR
3404 13316 7750         SPA SNA CLA     /       THEREFORE, DON'T GET IT
3405                    JMS XI33        /READ FIRST CHAR (STATUS OR CHAR TYPED)
off page        	        ^
     13317 4770 
3406 13320 3274         DCA FCHK        /TEMP
3407 13321 1367         TAD (XJ         /X-COORDINATE GOES IN 'XJ'
3408 13322 4332         JMS JLOOK       /PUT IT THERE
3409 13323 1366         TAD (YJ         /DITTO FOR 'YJ'
3410 13324 4332         JMS JLOOK
3411                    JMS XI33        /TO GET CR (AND IGNORE IT!)
off page        	        ^
     13325 4770 
3412 13326 7300         CLA CLL
3413 13327 1274         TAD FCHK
3414 13330 4355         JMS JFLOAT      /FLOAT FIRST CHAR FOR RETURN
3415 13331 5535         JMP I EFUN3I
3416            
3417                    FDT2=.
3418 13332 0000 JLOOK,  0               /CREATES VARIABLE IF NEEDED, AND
3419 13333 3056         DCA EFOP        /FLOATS AND STORES CROSSHAIR COORDINATE
3420 13334 4537         PUSHJ
3421 13335 1431                 GS1     /CALL 'GETVAR'
3422                    JMS XI33        /GET HIGH-ORDER
off page        	        ^
     13336 4770 
3423 13337 0375         AND (37         /MASK IT
3424 13340 7106         CLL RTL;RTL;RAL
     13341 7006 
     13342 7004 
3425 13343 3045         DCA FLAC+1      /SNEAKY, ISN'T IT?
3426                    JMS XI33        /GET LOW-ORDER
off page        	        ^
     13344 4770 
3427 13345 0375         AND (37
3428 13346 1045         TAD FLAC+1
3429 13347 4355         JMS JFLOAT      /FLOAT IT
3430 13350 4407         FENT            /AND PUT IT AWAY
3431 13351 7000         FNOR
3432 13352 6430         FPUT I PT1      /SET BY 'GETVAR'
3433 13353 0000         FEXT
3434 13354 5732         JMP I JLOOK
3435            
3436 13355 0000 JFLOAT, 0               /FLOATS 12-BIT AC
3437 13356 3045         DCA FLAC+1
3438 13357 1001         TAD P13         /PROPER EXPONENT
3439 13360 3044         DCA FLAC
3440 13361 3046         DCA FLAC+2
3441 13362 3047         DCA FLAC+3      /CLEAR OTHER WORDS
3442 13363 5755         JMP I JFLOAT
3443            
3444            
3445 13366 3112         PAGE
     13367 3012 
     13370 2605 
     13371 0205 
     13372 0025 
     13373 0233 
     13374 2463 
     13375 0037 
     13376 2617 
     13377 0235 
3446            
3447            
3448                    STVAR=.
3449            *5774
3450 15774 0000 MGETC,  0               /GETC FAKE FOR LOWER FIELD
3451 15775 4545         GETC
3452 15776 6202         CIF
3453 15777 5774         JMP I MGETC
3454            *6160
3455 16160 0000 THISD,  0
3456 16161 6201         CDF
3457 16162 1423         TAD I THISLN
3458 16163 6211         CDF 10
3459 16164 5760         JMP I THISD
3460            
3461 16165 0000 PT1D,   0
3462 16166 6201         CDF
3463 16167 1430         TAD I PT1
3464 16170 6211         CDF 10
3465 16171 5765         JMP I PT1D
3466            
3467            *6311
3468 16311 4407 XRAN,   FENT            /PSEUDO-RANDOM NUMBER
3469 16312 0337         FGET RNDM       /X(1)=(2^17+3)*X(0) MOD 2^16
3470 16313 6040         FPUT EX1
3471 16314 0000         FEXT
3472 16315 1335         TAD M16
3473 16316 3337         DCA T1S
3474 16317 4526         JMS I DOUBLE
3475 16320 2337         ISZ T1S
3476 16321 5317         JMP .-2
3477 16322 4736         JMS I PADDR
3478 16323 4526         JMS I DOUBLE
3479 16324 4736         JMS I PADDR
3480 16325 4407         FINT
3481 16326 6337         FPUT RNDM
3482 16327 0000         FEXT
3483 16330 3044         DCA FLAC
3484 16331 7350         CLA CLL CMA RAR /=3777
3485 16332 0045         AND FLAC+1
3486 16333 3045         DCA FLAC+1      /BE POSITIVE IT'S POSITIVE
3487 16334 5535         JMP I EFUN3I
3488            
3489 16335 7762 M16,    -16
3490 16336 5733 PADDR,  DUBLAD
3491                    RNDM=.
3492 16337 0000 T1S,    0
3493 16340 4421         4421
3494 16341 3040         3040
3495 16342 0001         0001
3496 16343 0000 XRTD,   0
3497 16344 6201         CDF
3498 16345 1411         TAD I XRT
3499 16346 6211         CDF 10
3500 16347 5743         JMP I XRTD
3501 16350 0000 AXIND,  0
3502 16351 6201         CDF
3503 16352 3410         DCA I AXIN
3504 16353 6211         CDF 10
3505 16354 5750         JMP I AXIND
3506            
3507            /THIS IS THE "LIBRARY HEAD"
3508            *7503
3509            
3510 17503 4560 LIB,    SPNOR           /IGNORE SPACES
3511 17504 6041         TSF             /WAIT FOR OUTPUT TO FINISH
3512 17505 5304         JMP .-1         /(DECTAPE SYSTEMS REALLY NEED THIS!)
3513 17506 6203         CIF CDF         /CALL LOWER FIELD
3514 17507 5777         JMP I (LOWLIB
3515            
3516 17510 1376         TAD (JMP I GOSWITCH+1   /RETURN TO APPROPRIATE ROUTINE
3517 17511 1313         TAD GOSWITCH
3518 17512 3313         DCA GOSWITCH
3519 17513 5714 GOSWITCH,       JMP I .+1
3520            
3521 17514 0607         PROC
3522 17515 0177         START
3523 17516 1551         LGOSUB
3524 17517 0602         GOTO+1
3525            
3526 17520 4552 FIN,    READC           /SINGLE CHARACTER INPUT FUNCTION
3527 17521 1066         TAD CHAR        /FLOAT THE CHARACTER
3528 17522 3045         DCA FLAC+1
3529 17523 3046         DCA FLAC+2      /CLEAR THE REST OF FLAC
3530 17524 3047         DCA FLAC+3
3531 17525 1001         TAD P13         /AND SET THE PROPER EXPONENT
3532 17526 3044         DCA FLAC
3533 17527 5535         JMP I EFUN3I
3534            
3535 17530 2163 ECHOGO, CHIN+7
3536 17531 2163         CHIN+7
3537            
3538 17532 4453 FOUT,   JMS I INTEGER           /SINGLE CHARACTER OUTPUT FUNCTION
3539 17533 7450         SNA
3540 17534 1124         TAD P4000       /IN CASE IT'S ZERO
3541 17535 4551         PRINTC
3542 17536 5535         JMP I EFUN3I
3543            
3544 17537 0000 CPRNT,  0               /CROSS FIELD FAKES!
3545 17540 4551         PRINTC
3546 17541 6203         CIF CDF
3547 17542 5737         JMP I CPRNT
3548            
3549 17543 0000 PGETLN, 0
3550 17544 4554         GETLN
3551 17545 6203         CIF CDF
3552 17546 5743         JMP I PGETLN
3553            
3554 17547 1375 FRAN,   TAD (XRAN       /RANDOM RANDOM NUMBERS
3555 17550 3774         DCA I (PFRAN            /(FIRST CALL ONLY)
3556 17551 1016         TAD RISZ                /INITIALIZE 'RNDM'
3557 17552 3773         DCA I (RNDM+1
3558 17553 5775         JMP I (XRAN
3559            
3560 17554 1045 XSGN,   TAD FLAC+1              /REAL SIGNUM FUNCTION!!
3561 17555 7650         SNA CLA
3562 17556 5535         JMP I EFUN3I
3563 17557 4543         PUSHF
3564 17560 2405                 FLTONE
3565 17561 4544         POPF
3566 17562 0044                 FLAC
3567                    JMP XABS
off page        	       ^
     17563 5772 
3568            
3569            
3570            
3571            
3572            
3573 17572 2014         PAGE
     17573 6340 
     17574 0377 
     17575 6311 
     17576 5714 
     17577 6400 
3574            /EFLOTB -- PS/8 FOCAL FLOATING POINT PACKAGE
3575            
3576            /EXCEPT FOR NON-LISTING CODE WHICH WAS REMOVED FROM THE BEGINNING
3577            /OF THE FLOATING POINT PACKAGE, THIS SEGMENT IS IDENTICAL WITH
3578            /PFLOTA.  THE CODE REMOVED ASSEMBLED INTO 14000 BUT WAS OVERLAID
3579            /BY THE INITIALIZATION (FOCN).
3580            /DECEMBER 12, 1974
3581            
3582            /COPYRIGHT 1971  DIGITAL EQUIPMENT CORPORATION
3583            /       MAYNARD, MASSACHUSETTS 01754
3584            
3585            /
3586            /PAGE ZERO OF THE
3587            /FLOATING POINT ARITHMETIC INTERPRETER FOR FOCAL
3588            
3589            
3590            
3591                    FIELD 1
3592            
3593            *40
3594            
3595 10040 0000 EX1,    0       /OPERAND STORAGE
3596 10041 0000 AC1H,   0
3597 10042 0000 AC1L,   0
3598 10043 0000 OVER1,  0
3599            
3600            FLAC=.          /FLOATING ACCUMULATOR
3601 10044 0000 EXP,    0       /F.A.
3602 10045 0000 HORD,   0
3603 10046 0000 LORD,   0
3604 10047 0000 OVER2,  0
3605            
3606 10050 0000 SIGNF,  0               /FLOATIN SIGN
3607            
3608 10051 6603 MINSKI, ACMINS          /NEGATE FLAC SUBROUTINE
3609 10052 0000 FISW,   0               /OUTPUT FORMAT
3610 10053 6724 INTEGER,FIX             /FIX FLAC
3611            
3612            
3613            
3614            /FUNCTIONS CONTAINED IN THIS SECTION
3615            
3616                    /ARTN
3617                    /FEXP
3618                    /FLOG
3619                    /FSIN
3620                    /FCOS
3621                    /XSQRT
3622            /FLOATING POINT PACKAGE - EXPONENTIAL
3623            
3624            GETSGN=TAD FLAC+1
3625            RETURN=JMP I EFUN3I
3626            
3627            *4600+20
3628            
3629 14620 1045 FEXP,   GETSGN                  /TAKE ABSOLUTE VALUE
3630 14621 7710         SPA CLA
3631 14622 4724         JMS I NEGP
3632 14623 3033         DCA T3          /C(SIGN)=-1 IF I X2<0
3633 14624 4407         FINT
3634 14625 4313         FMUL LG2E
3635 14626 6675         FPUT I X2
3636 14627 0000         FEXT
3637 14630 4453         JMS I INTEGER   /TAKE INTEGER PART
3638 14631 3325         DCA FLAG2       /SAVE LOW ORDER DATA
3639 14632 4407         FINT
3640 14633 7000         FNOR
3641 14634 6676         FPUT I XSQ2
3642 14635 0675         FGET I X2
3643 14636 2676         FSUB I XSQ2
3644 14637 6675         FPUT I X2
3645 14640 4675         FMUL I X2
3646 14641 6676         FPUT I XSQ2
3647 14642 1310         FADD DF
3648 14643 6326         FPUT TEMP
3649 14644 0305         FGET CF
3650 14645 3326         FDIV TEMP
3651 14646 2675         FSUB I X2
3652 14647 1277         FADD AF
3653 14650 6326         FPUT TEMP
3654 14651 0302         FGET BF
3655 14652 4676         FMUL I XSQ2
3656 14653 1326         FADD TEMP
3657 14654 6326         FPUT TEMP
3658 14655 0675         FGET I X2
3659 14656 3326         FDIV TEMP
3660 14657 4321         FMUL TWO
3661 14660 1316         FADD ONE
3662 14661 0000         FEXT
3663 14662 1325         TAD FLAG2
3664 14663 1044         TAD FLAC
3665 14664 3044         DCA FLAC
3666 14665 2033         ISZ T3
3667 14666 5535         RETURN
3668 14667 4407         FINT
3669 14670 6675         FPUT I X2
3670 14671 0316         FGET ONE
3671 14672 3675         FDIV I X2
3672 14673 0000         FEXT
3673 14674 5535         RETURN
3674            
3675            /CONSTANTS FOR FEXP
3676            
3677 14675 5322 X2,     X
3678 14676 5326 XSQ2,   XSQR
3679 14677 0004 AF,     0004
3680 14700 2372         2372
3681 14701 1402         1402
3682 14702 7774 BF,     7774
3683 14703 2157         2157
3684 14704 5157         5157
3685 14705 0012 CF,     0012
3686 14706 5454         5454
3687 14707 0343         0343
3688 14710 0007 DF,     0007
3689 14711 2566         2566
3690 14712 5341         5341
3691 14713 0001 LG2E,   0001
3692 14714 2705         2705
3693 14715 2435         2435
3694 14716 0001 ONE,    0001
3695 14717 2000         2000
3696 14720 0000         0000
3697 14721 0002 TWO,    0002
3698 14722 2000         2000
3699 14723 0000         0000
3700 14724 5163 NEGP,   FNEG
3701            
3702 14725 0000 FLAG2,  0
3703 14726 0000 TEMP,   0
3704 14727 0000         0
3705 14730 0000         0
3706 14731 0000         0
3707            
3708            
3709            
3710            /MAIN ALGORITHM FOR ARCTANGENT
3711            
3712 14732 4407 ARCALG, FINT
3713 14733 0675         FGET I X2
3714 14734 4675         FMUL I X2
3715 14735 6676         FPUT I XSQ2
3716 14736 4374         FMUL BET2
3717 14737 1371         FADD BET1
3718 14740 4676         FMUL I XSQ2
3719 14741 1366         FADD BETZ
3720 14742 6326         FPUT TEMP
3721 14743 0363         FGET ALF2
3722 14744 4676         FMUL I XSQ2
3723 14745 1360         FADD ALF1
3724 14746 4676         FMUL I XSQ2
3725 14747 1355         FADD ALFZ
3726 14750 4675         FMUL I X2
3727 14751 3326         FDIV TEMP
3728 14752 0000         FEXT
3729 14753 5754         JMP I .+1
3730 14754 5024         ARCRTN
3731            
3732            
3733            
3734            /CONSTANTS - FLOATING ARC TANGENT
3735 14755 0000 ALFZ,   0000
3736 14756 2437         2437
3737 14757 1643         1643
3738 14760 7777 ALF1,   7777
3739 14761 3304         3304
3740 14762 4434         4434
3741 14763 7773 ALF2,   7773
3742 14764 3306         3306
3743 14765 5454         5454
3744 14766 0000 BETZ,   0000
3745 14767 2437         2437
3746 14770 1646         1646
3747 14771 0000 BET1,   0000
3748 14772 2427         2427
3749 14773 2323         2323
3750 14774 7775 BET2,   7775
3751 14775 3427         3427
3752 14776 7052         7052
3753            
3754            
3755            
3756            /------------------------------------------------------------
3757            /------------------------------------------------------------
3758            /FLOATING POINT ARC TANGENT
3759            
3760            *5000
3761            
3762 15000 1045 ARTN,   GETSGN          /TAKE ABSOLUTE VALUE
3763 15001 7710         SPA CLA
3764 15002 4363         JMS FNEG
3765 15003 3033         DCA T3
3766 15004 4407         FINT
3767 15005 6635         FPUT I X1
3768 15006 2637         FSUB I CON1
3769 15007 0000         FEXT
3770 15010 1045         GETSGN
3771 15011 7710         SPA CLA
3772 15012 5221         JMP GO          /LESS THAN ONE
3773 15013 4407         FINT
3774 15014 0637         FGET I CON1
3775 15015 3635         FDIV I X1
3776 15016 6635         FPUT I X1
3777 15017 0000         FEXT
3778 15020 7240         CLA CMA
3779 15021 3362 GO,     DCA FLAG1       /SIGN FLAG OF RESULT
3780 15022 5623         JMP I .+1       /CALL ALGORITHM
3781 15023 4732         ARCALG
3782 15024 2362 ARCRTN, ISZ FLAG1       /RETURN HERE
3783 15025 5634         JMP I EXIT1
3784 15026 4407         FINT
3785 15027 6635         FPUT I X1
3786 15030 0636         FGET I PI2
3787 15031 2635         FSUB I X1
3788 15032 0000         FEXT
3789 15033 5634         JMP I .+1
3790 15034 5302 EXIT1,  EXIT2
3791            
3792            /CONSTANTS FOR ARCTANGENT
3793 15035 5322 X1,     X
3794 15036 5316 PI2,    PIOT
3795 15037 4716 CON1,   ONE
3796            
3797            
3798 15040 1045 FLOG,   GETSGN          /FLOATING LOGARITHM
3799 15041 7450         SNA
3800 15042 4566         ERROR3          /ZERO ARGUEMENT FOR LOG
3801 15043 7710         SPA CLA
3802 15044 4566         ERROR3          /NEGATIVE ARGUMENT
3803 15045 4407         FINT
3804 15046 6756         FPUT I TEM
3805 15047 2637         FSUB I CON1
3806 15050 0000         FEXT
3807 15051 1045         GETSGN
3808 15052 7450         SNA
3809 15053 5535         RETURN
3810 15054 7700         SMA CLA
3811 15055 5264         JMP STARTL
3812 15056 4407         FINT
3813 15057 0637         FGET I CON1
3814 15060 3756         FDIV I TEM
3815 15061 6756         FPUT I TEM
3816 15062 0000         FEXT
3817 15063 7240         CLA CMA
3818 15064 3033 STARTL, DCA T3
3819 15065 1001         TAD P13
3820 15066 3044         DCA FLAC
3821 15067 7040         CMA
3822 15070 1756         TAD I TEM
3823 15071 3045         DCA FLAC+1
3824 15072 3046         DCA FLAC+2
3825 15073 3047         DCA FLAC+3
3826 15074 7001         IAC
3827 15075 3756         DCA I TEM
3828 15076 4407         FINT
3829 15077 4357         FMUL LOG2
3830 15100 6635         FPUT I X1
3831 15101 0756         FGET I TEM
3832 15102 2637         FSUB I CON1
3833 15103 6756         FPUT I TEM
3834 15104 4353         FMUL LOG8
3835 15105 1350         FADD LOG7
3836 15106 4756         FMUL I TEM
3837 15107 1345         FADD LOG6
3838 15110 4756         FMUL I TEM
3839 15111 1342         FADD LOG5
3840 15112 4756         FMUL I TEM
3841 15113 1337         FADD L4
3842 15114 4756         FMUL I TEM
3843 15115 1334         FADD L3
3844 15116 4756         FMUL I TEM
3845 15117 1331         FADD L2
3846 15120 4756         FMUL I TEM
3847 15121 1326         FADD L1
3848 15122 4756         FMUL I TEM
3849 15123 1635         FADD I X1
3850 15124 0000         FEXT
3851 15125 5634         JMP I EXIT1
3852            
3853            
3854 15126 0000 L1,     0000
3855 15127 3777         3777
3856 15130 7742         7742
3857 15131 7777 L2,     7777
3858 15132 4000         4000
3859 15133 4100         4100
3860 15134 7777 L3,     7777
3861 15135 2517         2517
3862 15136 0310         0310
3863 15137 7776 L4,     7776
3864 15140 4113         4113
3865 15141 7211         7211
3866            
3867            /LOGARITHM CONSTANTS
3868            
3869 15142 7776 LOG5,   7776
3870 15143 2535         2535
3871 15144 3301         3301
3872 15145 7775 LOG6,   7775
3873 15146 4746         4746
3874 15147 0771         0771
3875 15150 7774 LOG7,   7774
3876 15151 2236         2236
3877 15152 4304         4304
3878 15153 7771 LOG8,   7771
3879 15154 4544         4544
3880 15155 1735         1735
3881            
3882 15156 4726 TEM,    TEMP
3883 15157 0000 LOG2,   0
3884 15160 2613         2613
3885 15161 4414         4414
3886 15162 0000 FLAG1,  0
3887            
3888            
3889            
3890            
3891 15163 0000 FNEG,   0
3892 15164 4451         JMS I MINSKI
3893 15165 7240         CLA CMA
3894 15166 5763         JMP I FNEG
3895            
3896            
3897            /------------------------------------------------------------
3898            /------------------------------------------------------------
3899            /FLOATING POINT SINE AND COSINE
3900            
3901            *5200
3902            
3903 15200 4407 FCOS,   FINT            /COS(X)=SIN(PI/2-X)
3904 15201 6322         FPUT X
3905 15202 0316         FGET PIOT
3906 15203 2322         FSUB X
3907 15204 0000         FEXT
3908 15205 1045 FSIN,   GETSGN
3909 15206 7740         SMA SZA CLA
3910 15207 5215         JMP MOD
3911 15210 1045         GETSGN
3912 15211 7700         SMA CLA
3913 15212 5535         RETURN          /YES SIN(0)=0
3914 15213 4451         JMS I MINSKI
3915 15214 7040         CMA             /NO:SIN(-X)=-SIN(X)
3916 15215 3033 MOD,    DCA T3
3917                    /REDUCE X MODULO 2 PI
3918 15216 4407         FINT
3919 15217 3306         FDIV TWOPI
3920 15220 6326         FPUT XSQR
3921 15221 0000         FEXT
3922 15222 4453         JMS I INTEGER
3923 15223 4407         FINT
3924 15224 7000         FNOR
3925 15225 6322         FPUT X
3926 15226 0326         FGET XSQR
3927 15227 2322         FSUB X
3928 15230 4306         FMUL TWOPI
3929 15231 6322         FPUT X
3930 15232 2312         FSUB PI         /X<PI?
3931 15233 0000         FEXT
3932 15234 1045         GETSGN
3933 15235 7710         SPA CLA
3934 15236 5245         JMP PCHECK      /YES
3935 15237 4407         FINT            /NO, SIN(X-PI)=-SIN(X)
3936 15240 6322         FPUT X
3937 15241 0000         FEXT
3938 15242 1033         TAD T3          /INVERT THE SIGN
3939 15243 7040         CMA
3940 15244 3033         DCA T3
3941            
3942 15245 4407 PCHECK, FINT            /X<PI/2?
3943 15246 0322         FGET X
3944 15247 2316         FSUB PIOT
3945 15250 0000         FEXT
3946 15251 1045         GETSGN
3947 15252 7710         SPA CLA
3948 15253 5261         JMP PALG        /YES
3949 15254 4407         FINT            /NO
3950 15255 0312         FGET PI         /SIN(X)=SIN(PI-X)
3951 15256 2322         FSUB X
3952 15257 6322         FPUT X
3953 15260 0000         FEXT
3954            
3955 15261 4407 PALG,   FINT
3956 15262 0322         FGET X
3957 15263 3316         FDIV PIOT
3958 15264 6322         FPUT X
3959 15265 4322         FMUL X
3960 15266 6326         FPUT XSQR
3961 15267 0332         FGET C9
3962 15270 4326         FMUL XSQR
3963 15271 1336         FADD C7
3964 15272 4326         FMUL XSQR
3965 15273 1342         FADD C5
3966 15274 4326         FMUL XSQR
3967 15275 1346         FADD C3
3968 15276 4326         FMUL XSQR
3969 15277 1316         FADD PIOT
3970 15300 4322         FMUL X
3971 15301 0000         FEXT
3972 15302 2033 EXIT2,  ISZ T3
3973 15303 5535         RETURN
3974 15304 4451         JMS I MINSKI
3975 15305 5535         RETURN
3976            
3977            /CONSTANTS AND POINTERS
3978            
3979            
3980            
3981 15306 0003 TWOPI,  0003
3982 15307 3110         3110
3983 15310 3755         3755    /(3756) - FOR 3-WORD
3984 15311 2421         2421
3985            
3986 15312 0002 PI,     0002
3987 15313 3110         3110
3988 15314 3755         3755    /(3756) - FOR 3-WORD
3989 15315 2421         2421
3990            
3991 15316 0001 PIOT,   0001            /USED BY SINE AND COSINE
3992 15317 3110         3110
3993 15320 3755         3755    /(3756) - FOR 3-WORD
3994 15321 2421         2421
3995            
3996 15322 0000 X,      0000
3997 15323 0000         0000
3998 15324 0000         0000
3999 15325 0000         0000
4000            
4001 15326 0000 XSQR,   0000
4002 15327 0000         0000
4003 15330 0000         0000
4004 15331 0000         0000
4005            
4006            /SINE CONSTANTS
4007            
4008 15332 7764 C9,     7764
4009 15333 2501         2501
4010 15334 7015         7015
4011 15335 1042         1042
4012 15336 7771 C7,     7771
4013 15337 5464         5464
4014 15340 5514         5514
4015 15341 6150         6150
4016 15342 7775 C5,     7775
4017 15343 2431         2431
4018 15344 5361         5361
4019 15345 4736         4736
4020 15346 0000 C3,     0000
4021 15347 5325         5325
4022 15350 0414         0414
4023 15351 3167         3167
4024            
4025            /END OF EXTENDED FUNCTIONS.
4026            
4027            
4028            
4029            /------------------------------------------------------------
4030            /------------------------------------------------------------
4031            /  - INPUT/OUTPUT ROUTINES FOR THE FOCAL
4032            /FLOATING POINT PACKAGE.
4033            
4034            
4035            /IN THE COMMENTS BELOW:-
4036            / F = NUMBER OF DIGITS TO BE OUTPUT     =FISW
4037            / D = NUMBER OF DECIMAL PLACES          =DECP
4038            / E = DECIMAL EXPONENT                  =BEXP
4039            / P = NUMBER OF PLACES REMAINING TO BE
4040            /     PRINTED BEFORE DECIMAL POINT
4041            
4042            
4043            *5400
4044            
4045            DIGITS=12       /NUMBER OF DECIMAL DIGITS OUT
4046            
4047            
4048 15400 0000 TGO,    0
4049 15401 3334         DCA SCOUNT      /SAVE MAX. NUMBER OF DIGITS AVAILABLE - *SET COUNTS*
4050 15402 1052         TAD FISW
4051 15403 4557         RTL6
4052 15404 0122         AND P77
4053 15405 3032         DCA T1
4054 15406 1032         TAD T1
4055 15407 7041         CIA             /NO, COMPUTE FIELD SIZES
4056 15410 7450         SNA
4057 15411 1326         TAD MD
4058 15412 3335         DCA FCOUNT
4059 15413 1052         TAD FISW        /(JMP FPRNT) - FOR NO ROUNDGIN.
4060 15414 7450         SNA             /FLOATING OUTPUT?
4061 15415 5241         JMP R6          /YES, ROUND OFF TO MAX.NO.  PLACES
4062 15416 0122         AND P77
4063 15417 3333         DCA DECP
4064 15420 1335         TAD FCOUNT
4065 15421 1333         TAD DECP
4066 15422 7510         SPA             / F-D > 0 ?
4067 15423 5230         JMP .+5         /YES
4068 15424 7240         CLA CMA         /NO,
4069 15425 1032         TAD T1
4070 15426 3333         DCA DECP        /MAKE D = F-1
4071 15427 7040         CMA
4072 15430 1033         TAD T3          /COMPARE DECIMAL EXPONENT
4073 15431 7500         SMA             / F-D > E?
4074 15432 7200         CLA             /NO, ROUND OFF TO .F PLACES
4075 15433 1032         TAD T1          /YES
4076 15434 7510         SPA             / D+E < 0 ?     
4077 15435 5263         JMP FPRNT-2     /YES, NO ROUNDING NEEDED, GO TO PRINT
4078 15436 1326         TAD MD          /NO, ROUND TO D+E PLACES,
4079 15437 7500         SMA             /TO A MAXIMUM OF D PLACES
4080 15440 7200         CLA
4081            
4082 15441 1327 R6,     TAD RND2        / *ROUND UP *
4083 15442 3071         DCA T2          /SAVE NUMBER+1 OF PLACES TO ROUND TO.
4084 15443 1731         TAD I BUFST
4085 15444 1071         TAD T2          /SET UP BUFFER ADDRESS AT WHICH
4086 15445 3336         DCA PLCE        /ROUNDING OFF SHOULD START
4087 15446 1071         TAD T2
4088 15447 7041         CIA             /SET UP COUNT OF MAXIMUM NUMBER
4089 15450 3071         DCA T2          /OF CARRIES ALLOWABLE
4090 15451 1325         TAD K4          /LITTLE EXTRA ON FIRST DIGIT.
4091 15452 2736 RET,    ISZ I PLCE      /ADD 1 TO DIGIT AT CURRENT POSITION
4092 15453 1736         TAD I PLCE
4093 15454 1330         TAD OM12
4094 15455 7710         SPA CLA         /CARRY REQUIRED?
4095 15456 5265         JMP FPRNT       /NO, GO TO OUTPUT
4096 15457 3736         DCA I PLCE      /YES, MAKE CURRENT DIGIT ZERO
4097 15460 2071         ISZ T2          /BEGINNING OF BUFFER REACHED?
4098 15461 5321         JMP DECR        /NO, DECREMENT BUFFER ADDRESS AND REPEAT
4099 15462 2736         ISZ I PLCE      /YES, SET MANTISSA TO 0.1
4100 15463 2033         ISZ T3          /COMPENSATE BY INCREMENTING EXPONENT
4101 15464 7200         CLA
4102 15465 1052 FPRNT,  TAD FISW        /AUTO-INDEX REGISTER ALREADY SET. - *PRINT*
4103 15466 7650         SNA CLA         / F = 0 ?
4104 15467 5356         JMP FLOUT       /YES, OUTPUT AS FLOATING NUMBER
4105 15470 1335         TAD FCOUNT
4106 15471 1033         TAD T3
4107 15472 7540         SMA SZA         / E > F ?
4108 15473 5355         JMP FLOUT-1     /YES,CONVERT TO E FORMAT
4109 15474 1333         TAD DECP
4110 15475 7500         SMA             / E < F-D ?
4111 15476 7200         CLA             /NO, TAKE P = E
4112 15477 7041         CIA             /YES, TAKE P = F-D
4113 15500 1033         TAD T3
4114 15501 7041         CIA
4115 15502 3032         DCA T1          /SET UP MINUS P
4116 15503 1033 BACK,   TAD T3          /PRINT DD.DDD
4117 15504 1032         TAD T1
4118 15505 7650         SNA CLA         / P = E ?
4119 15506 5343         JMP DIG         /YES, PRINT DIGIT
4120 15507 1032         TAD T1          /NO,
4121 15510 7001         IAC
4122 15511 7710         SPA CLA         / P > 1 ?
4123 15512 1105         TAD M20 /YES, TAKE SPACE (240-260); OTHERWISE ZERO
4124 15513 4336 IN,     JMS OUTA        /PRINT CHARACTER
4125 15514 2032         ISZ T1          /P CHARACTERS PRINTED?
4126 15515 5303         JMP BACK        /NO
4127 15516 1102         TAD PER         /YES,
4128 15517 4551         PRINTC          /PRINT DECIMAL POINT
4129 15520 5303         JMP BACK
4130            
4131 15521 7040 DECR,   CMA             /BACKUP TO TOP OF BUFFER.
4132 15522 1336         TAD PLCE
4133 15523 3336         DCA PLCE
4134 15524 5252         JMP RET
4135 15525 0004 K4,     4
4136 15526 7766 MD,     -DIGITS
4137 15527 0013 RND2,   DIGITS+1
4138 15530 7766 OM12,   -12
4139 15531 6150 BUFST,  SADR
4140 15532 6154 OPUT,   OUTDG
4141 15533 0000 DECP,   0               /MODIFIABLE LOCATIONS
4142 15534 0000 SCOUNT, 0
4143 15535 0000 FCOUNT, 0
4144            PLCE=.
4145 15536 0000 OUTA,   0               /MODIFIED REGISTERS.
4146 15537 4732         JMS I OPUT      /PRINT CHARACTER
4147 15540 2335         ISZ FCOUNT      /F CHARACTERS PRINTED?
4148 15541 5736         JMP I OUTA      /NO--RETURN--
4149 15542 5600         JMP I TGO       /YES, NUMBER FINSHED
4150 15543 7040 DIG,    CMA
4151 15544 1033         TAD T3          /REDUCE E, BY 1
4152 15545 3033         DCA T3
4153 15546 2334         ISZ SCOUNT      /ARE ALL SIG. FIGS. USED?
4154 15547 5353         JMP .+4         /NO
4155 15550 7040         CMA             /YES,
4156 15551 3334         DCA SCOUNT      /RESET COUNT TO -1
4157 15552 5313         JMP IN          /AND LEAVE C(AC) = 0
4158 15553 1414         TAD I FLTXR     /TAKE NEXT DIGIT FROM BUFFER
4159 15554 5313         JMP IN
4160            /DO FLOATING OUTPUT
4161 15555 7200         CLA             /IF OUTPUT TOO LARGE,
4162 15556 4732 FLOUT,  JMS I OPUT      /PRINT "0"
4163 15557 1102         TAD PER
4164 15560 4551         PRINTC          /PRINT "."
4165 15561 2200         ISZ TGO         /SECOND RETURN
4166 15562 1414         TAD I FLTXR     /TAKE NEXT DIGIT FROM BUFFER
4167 15563 4336         JMS OUTA        /PRINT IT
4168 15564 2334         ISZ SCOUNT      /TEST FOR END OF INPUT
4169 15565 5362         JMP .-3         /AND REPEAT
4170 15566 7040         CMA
4171 15567 3334         DCA SCOUNT      /OUTPUT EXTRA ZEROS.
4172 15570 5363         JMP .-5
4173 15571 0000 ABSOLV, 0
4174 15572 1045         TAD HORD
4175 15573 3050         DCA SIGNF
4176 15574 1045         TAD HORD
4177 15575 7710         SPA CLA
4178 15576 4451         JMS I MINSKI
4179 15577 5771         JMP I ABSOLV    /--RETURN--
4180            
4181            
4182            /------------------------------------------------------------
4183            /------------------------------------------------------------
4184            /DOUBLE PRECISION DECIMAL-BINARY
4185            /INPUT AND CONVERSION FOR + OR - XXX...
4186            
4187            *5600
4188            
4189 15600 0000 DECONV, 0
4190 15601 3046         DCA LORD
4191 15602 3044         DCA EXP         /ZERO THE EXPONENT AND
4192 15603 3045         DCA HORD        /INITIALIZE FLOATING AC.
4193 15604 3047         DCA OVER2
4194 15605 3314         DCA DNUMBR
4195 15606 3050         DCA SIGNF
4196 15607 1066         TAD CHAR        /ALLOW KEYBOARD SIGN CHECKS.
4197 15610 1264         TAD MPLUS
4198 15611 7450         SNA
4199 15612 5220         JMP .+6         /+SIGN; GET NEXT
4200 15613 1111         TAD M2          /CHECK - SIGN
4201 15614 7640         SZA CLA
4202 15615 5221         JMP .+4
4203 15616 7040         CMA             /INIT SIGN CHECK TO POS.
4204 15617 3050         DCA SIGNF
4205 15620 4666         JMS I XINPUT    /GET NEXT
4206 15621 1066         TAD CHAR        /A SPACE PERHAPS?
4207 15622 1265         TAD MSPACE
4208 15623 7650         SNA CLA
4209 15624 5220         JMP .-4
4210 15625 4227         JMS DECON
4211 15626 5600         JMP I DECONV    /--RETURN--
4212            
4213            
4214 15627 0000 DECON,  0
4215 15630 1066         TAD CHAR        /TEST LEAD CHARACTER FOR TERMINATOR
4216 15631 1262         TAD MINE
4217 15632 7650         SNA CLA
4218 15633 5627         JMP I DECON     /E--RETURN--
4219 15634 4561         TESTN
4220 15635 5627         JMP I DECON     /.--RETURN--
4221 15636 5247         JMP DTST        /OTHER
4222 15637 1054         TAD SORTCN      /N
4223 15640 3313 DSAVE,  DCA DIGIT       /YES
4224 15641 4267         JMS MULT10      /REMAIN MUST =0 SINCE OVERFLOW IS CHECKED
4225 15642 2314         ISZ DNUMBR      /COUNT DIGITS
4226 15643 7640         SZA CLA
4227 15644 4566         ERROR2          /INPUT-OVERFLOW ERROR
4228 15645 4666         JMS I XINPUT
4229 15646 5230         JMP DECON+1     /CONTINUE
4230 15647 1066 DTST,   TAD CHAR        /ALLOW A-Z
4231 15650 1112         TAD MINUSA
4232 15651 7710         SPA CLA
4233 15652 5627         JMP I DECON     /--RETURN--
4234 15653 1066         TAD CHAR
4235 15654 1263         TAD MINUSZ
4236 15655 7740         SZA SMA CLA
4237 15656 5627         JMP I DECON     /USE SIX BITS OF ASCII--RETURN--
4238 15657 1066         TAD CHAR
4239 15660 0122         AND P77
4240 15661 5240         JMP DSAVE
4241 15662 7473 MINE,   -305    /(7532)- FOR AMPERSAND
4242 15663 7446 MINUSZ, -332
4243 15664 7525 MPLUS,  -253
4244 15665 7540 MSPACE, -240
4245 15666 0756 XINPUT, INPUT
4246            
4247            
4248            
4249            
4250            
4251 15667 0000 MULT10, 0       /ROUTINE TO MULTIPLY FLAC BY TEN (10)
4252 15670 1047         TAD OVER2
4253 15671 3043         DCA OVER1
4254 15672 1046         TAD LORD        /DOUBLE PRECISION WORD
4255 15673 3042         DCA AC1L        /BY TEN (DECIMAL)
4256 15674 1045         TAD HORD        /REMAIN=REMAINDER
4257 15675 3041         DCA AC1H
4258 15676 3312         DCA REMAIN      /CLEAR OVERFLOW WORD
4259 15677 4315         JMS MULT2       /CALL SUBROUTINE TO
4260 15700 4315         JMS MULT2       /MULTIPLY BY TWO
4261 15701 4333         JMS DUBLAD      /CALL DOUBLE ADD
4262 15702 4315         JMS MULT2
4263 15703 1313         TAD DIGIT       /ADD LAST DIGIT RECEIVED
4264 15704 3043         DCA OVER1
4265 15705 3042         DCA AC1L
4266 15706 3041         DCA AC1H
4267 15707 4333         JMS DUBLAD
4268 15710 1312         TAD REMAIN      /EXIT WITH REMAINDER
4269 15711 5667         JMP I MULT10    /IN AC--RETURN--
4270            
4271 15712 0000 REMAIN, 0
4272            
4273 15713 0000 DIGIT,  0       /STORAGE FOR DIGIT
4274 15714 0000 DNUMBR, 0       /=NUMBER OF DIGITS
4275 15715 0000 MULT2,  0       /MULTIPLY  OVER2, LORD, HORD BY 2
4276 15716 1047         TAD OVER2
4277 15717 7104         CLL RAL         /CARRY INSERT BIT IS IN LINK
4278 15720 3047         DCA OVER2
4279 15721 1046         TAD LORD
4280 15722 7004         RAL
4281 15723 3046         DCA LORD
4282 15724 1045         TAD HORD
4283 15725 7004         RAL
4284 15726 3045         DCA HORD
4285 15727 1312         TAD REMAIN
4286 15730 7004         RAL
4287 15731 3312         DCA REMAIN
4288 15732 5715         JMP I MULT2     /--RETURN--
4289            
4290            
4291            
4292            
4293            
4294            
4295 15733 0000 DUBLAD, 0       /TRIPLE PRECISION ADDITION
4296 15734 7300         CLA CLL
4297 15735 1047         TAD OVER2
4298 15736 1043         TAD OVER1
4299 15737 3047         DCA OVER2
4300 15740 7004         RAL
4301 15741 1046         TAD LORD
4302 15742 1042         TAD AC1L
4303 15743 3046         DCA LORD
4304 15744 7004         RAL
4305 15745 1045         TAD HORD
4306 15746 1041         TAD AC1H
4307 15747 3045         DCA HORD
4308 15750 7004         RAL
4309 15751 1312         TAD REMAIN      /WITH OVERFLOW
4310 15752 3312         DCA REMAIN
4311 15753 5733         JMP I DUBLAD    /--RETURN--
4312            
4313 15754 0000 DIV1,   0       /SHIFT OPERAND RIGHT
4314 15755 7300         CLA CLL         /TRIPLE PRECISION
4315 15756 1041         TAD AC1H
4316 15757 7510         SPA
4317 15760 7120         CLL CML
4318 15761 7010         RAR
4319 15762 3041         DCA AC1H
4320 15763 1042         TAD AC1L
4321 15764 7010         RAR
4322 15765 3042         DCA AC1L
4323 15766 1043         TAD OVER1
4324 15767 7010         RAR
4325 15770 3043         DCA OVER1
4326 15771 2040         ISZ EX1
4327 15772 5754         JMP I DIV1      /--RETURN--
4328 15773 5754         JMP I DIV1      /--RETURN--
4329            
4330            
4331            /------------------------------------------------------------
4332            /------------------------------------------------------------
4333            *6000
4334            
4335            /FLOATING OUTPUT CONVERSION ROUTINE
4336            
4337 16000 0000 FLOUTP, 0
4338 16001 1335         TAD PEQ
4339 16002 4551         PRINTC          /(CLA)_ TO SUPPRESS "="
4340 16003 1045         TAD HORD        /NUMBER>0??
4341 16004 7700         SMA CLA
4342 16005 1334         TAD SMSP        /PRINT "-" OR A SPACE.
4343 16006 1336         TAD SMIN
4344 16007 4551         PRINTC
4345 16010 4753         JMS I ABSOL2
4346 16011 3033 FGO2,   DCA T3          /INITIALIZE DECIMAL EXPONENT
4347 16012 1044         TAD EXP         /IS EXP 0 TO 4?
4348 16013 7510         SPA
4349 16014 5227         JMP FGO3        /TOO LARGE:MULTIPLY BY 1/10
4350 16015 7440         SZA
4351 16016 1341         TAD M4
4352 16017 7750         SPA SNA CLA
4353 16020 5234         JMP FGO4
4354 16021 4407         FINT
4355 16022 4744         FMUL I PPTEN
4356 16023 0000         FEXT
4357 16024 7001         IAC
4358 16025 1033         TAD T3
4359 16026 5211         JMP FGO2
4360 16027 4407 FGO3,   FINT
4361 16030 4752         FMUL I TENPT
4362 16031 0000         FEXT
4363 16032 7040         CMA
4364 16033 5225         JMP .-6
4365            
4366 16034 3745 FGO4,   DCA I DPT       /MULTIPLY BY TWO TO POSITION BIT0
4367 16035 3746         DCA I REPT      /CLEAR OVERFLOW WORD
4368 16036 1350         TAD SADR        /INIT BUFFER POINTER
4369 16037 3014         DCA FLTXR
4370 16040 1044         TAD EXP         /COMPUTE BITS IN 1ST DIGIT
4371 16041 7140         CMA CLL
4372 16042 3354         DCA OUTDG       /TEMP COUNT
4373 16043 1343         TAD DCOUNT      /SETUP COUNT OF TOTAL OUTPUT
4374 16044 3044         DCA EXP
4375 16045 4526         JMS I DOUBLE    /ROTATE OUT THE 1ST 4 BITS
4376 16046 2354         ISZ OUTDG
4377 16047 5245         JMP .-2
4378 16050 1746         TAD I REPT      /TEST FOR 10-15,0,1-9
4379 16051 7450         SNA 
4380 16052 5270         JMP FGO5        /IGNORE 1ST ZERO
4381 16053 1342         TAD FM12
4382 16054 7710         SPA CLA
4383 16055 5264         JMP .+7         /0-9
4384 16056 7001         IAC
4385 16057 3414         DCA I FLTXR     /OUTPUT A 1
4386 16060 2044         ISZ EXP         /COUNT THE DIGIT
4387 16061 1342         TAD FM12        /CORRECT REMAINDER
4388 16062 2033         ISZ T3          /BUMP DECIMAL EXPONENT
4389 16063 7000         NOP
4390 16064 1746         TAD I REPT      /COMPUTE RESULTANT OR SECOND DIGIT 
4391 16065 2033         ISZ T3
4392 16066 7000         NOP
4393 16067 7410         SKP
4394 16070 4747 FGO5,   JMS I M10PT     /IE. .672X10=6+.72.. ETC
4395 16071 3414         DCA I FLTXR
4396 16072 2044         ISZ EXP         /ALL DIGITS OUTPUT??
4397 16073 5270         JMP .-3         /NO: CONTINUE
4398 16074 1350         TAD SADR        /INIT BUFFER POINTER
4399 16075 3014         DCA FLTXR
4400 16076 1343         TAD DCOUNT
4401 16077 4751         JMS I ROUND     /OUTPUT MANTISSA
4402 16100 5600         JMP I FLOUTP    /FIXED POINT DONE--RETURN--
4403 16101 1333         TAD CHRT        /PRINT "E"
4404 16102 4551         PRINTC
4405            
4406            /OUTPUT THE EXPONENT
4407            
4408 16103 1033         TAD T3          /TAKE ABSOLUTE VALUE OF EXPONENT
4409 16104 7510         SPA
4410 16105 7041         CIA
4411 16106 3045         DCA HORD                /SAVE + POWER 
4412 16107 1033         TAD T3          /PRINT SIGN
4413 16110 7700         SMA CLA
4414 16111 1111         TAD M2
4415 16112 1336         TAD SMIN
4416 16113 4551         PRINTC
4417 16114 1045         TAD HORD
4418 16115 2044         ISZ EXP
4419 16116 1337         TAD M144
4420 16117 7500         SMA
4421 16120 5315         JMP .-3
4422 16121 1340         TAD C144
4423 16122 3045         DCA HORD                /SAVE TENS AND UNITS
4424 16123 7040         CMA             /OUTPUT HUNDREDS
4425 16124 1044         TAD EXP
4426 16125 7440         SZA             /UNLESS ZERO
4427 16126 4354         JMS OUTDG
4428 16127 1045         TAD HORD        /PRINT TWO DIGITS
4429 16130 4732         JMS I PRNTI
4430 16131 5600         JMP I FLOUTP    /--RETURN--
4431 16132 2440 PRNTI,  PRNT
4432 16133 0305 CHRT,   305     /E  (0246) - FOR AMPERSAND
4433 16134 7763 SMSP,   240-255 /
4434 16135 0240 PEQ,    240             /CHANGED FROM "=" TO SPACE
4435 16136 0255 SMIN,   255
4436 16137 7634 M144,   -144    /-100
4437 16140 0144 C144,   0144    /+100
4438 16141 7774 M4,     -4
4439 16142 7766 FM12,   -12
4440 16143 7765 DCOUNT, -DIGITS-1       /NUMBER OF DIGITS OUTPUT
4441 16144 6275 PPTEN,  PTEN    /IEI
4442 16145 5713 DPT,    DIGIT
4443 16146 5712 REPT,   REMAIN  /OVERFLOW FROM INTEGER MULTIPLY
4444 16147 5667 M10PT,  MULT10
4445 16150 7467 SADR,   BUFFER-1
4446 16151 5400 ROUND,  TGO     /ACTUAL OUTPUT ROUTINE
4447 16152 6271 TENPT,  TEN
4448 16153 5571 ABSOL2, ABSOLV
4449 16154 0000 OUTDG,  0               /OUTPUT ONE DIGIT
4450 16155 1113         TAD C260
4451 16156 4551         PRINTC
4452 16157 5754         JMP I OUTDG     /--RETURN--
4453            
4454            /USED BY 8K
4455            
4456            
4457            
4458            /------------------------------------------------------------
4459            /------------------------------------------------------------
4460            /FLOATING POINT INPUT
4461            
4462            *6200
4463            
4464 16200 0000 FLINTP, 0               /IF C(AC) = 0, USE CHAR
4465 16201 7640         SZA CLA         /IF C(AC) NON-ZERO , GET NEXT
4466 16202 4706         JMS I XIN       /GET FIRST CHAR
4467 16203 1066         TAD CHAR        /IGNORE LEADING SPACES
4468 16204 1114         TAD M240
4469 16205 7650         SNA CLA
4470 16206 5202         JMP .-4
4471 16207 4702         JMS I DPCVPT    /READ FIRST DIGIT GROUP 
4472 16210 1066         TAD CHAR        /AND SET "SIGNF"
4473 16211 1115         TAD MPER
4474 16212 7640         SZA CLA         /ENDED BY PERIOD?
4475 16213 5221         JMP FIGO1
4476 16214 4706         JMS I XIN       /YES, READ 2AND GROUP
4477 16215 3705         DCA I DPN
4478 16216 4703         JMS I DCONP
4479 16217 1705         TAD I DPN       /SAVE NUMBER OF DIGITS IN T3
4480 16220 7041         CMA IAC
4481 16221 3033 FIGO1,  DCA T3          /NO,
4482 16222 1310         TAD P43
4483 16223 3044         DCA EXP
4484 16224 4704         JMS I RESOL5
4485 16225 4707         JMS I INORM     /NORMALIZE FIRST, THEN
4486 16226 4407         FINT
4487 16227 6430         FPUT I PT1      /SAVE NUMBER
4488 16230 0000         FEXT
4489 16231 1066         TAD CHAR
4490 16232 1301         TAD MINUSE
4491 16233 7640         SZA CLA         /"E" READ IN?
4492 16234 5246         JMP ENDFI+3     /NO
4493 16235 4706         JMS I XIN       /YES, READ 3RD DIGIT GROUP
4494 16236 4702         JMS I DPCVPT    /I.E. CONVERT DECIMAL EXPONENT
4495 16237 4704         JMS I RESOL5
4496 16240 1047         TAD OVER2
4497 16241 1033         TAD T3          /C(SEXP)PLACES TO RIGHT
4498 16242 3033         DCA T3          /OF LAST DIGIT
4499            
4500            
4501            
4502            
4503            /COMPENSATE FOR DECIMAL EXPONENTS
4504            
4505 16243 4407 ENDFI,  FINT            /RESTORE MANTISSA
4506 16244 0430         FGET I PT1
4507 16245 0000         FEXT
4508 16246 1033         TAD T3          /TEST DECIMAL EXPONENT
4509 16247 7450         SNA
4510 16250 5600         JMP I FLINTP    /FINISHED--RETURN--
4511 16251 7700         SMA CLA
4512 16252 5261         JMP FIGO4
4513 16253 4407         FINT            /. IS TO THE LEFT:
4514 16254 4275         FMUL PTEN       /TIMES .1000
4515 16255 6430         FPUT I PT1
4516 16256 0000         FEXT
4517 16257 7001         IAC
4518 16260 5266         JMP .+6
4519 16261 4407 FIGO4,  FINT            /. IS TO THE RIGHT:
4520 16262 4271         FMUL TEN        /MULTIPLY BY 10
4521 16263 6430         FPUT I PT1
4522 16264 0000         FEXT
4523 16265 7040         CMA
4524 16266 1033         TAD T3
4525 16267 3033         DCA T3
4526 16270 5246         JMP ENDFI+3
4527 16271 0004 TEN,    0004
4528 16272 2400         2400
4529 16273 0000         0000
4530 16274 0000         0000
4531            
4532 16275 7775 PTEN,   7775
4533 16276 3146         3146
4534 16277 3146         3146    /(3147) - FOR 3-WORD
4535 16300 3150         3150
4536            
4537 16301 7473 MINUSE, -305    /(7532) - FOR AMPERSAND
4538            
4539 16302 5600 DPCVPT, DECONV
4540 16303 5627 DCONP,  DECON
4541 16304 7173 RESOL5, RESOLV
4542 16305 5714 DPN,    DNUMBR
4543 16306 0756 XIN,    INPUT
4544 16307 7335 INORM,  DNORM
4545 16310 0043 P43,    43
4546            
4547            /END OF FLOATING POINT INPUT
4548            
4549            /7 FREE
4550            
4551            /USED BY H.S. READER
4552            
4553            /------------------------------------------------------------
4554            /------------------------------------------------------------
4555            *6400
4556                    / FLOATING-POINT INTERPRETER FOR FOCAL.
4557            
4558 16400 0000 FPNT,   0
4559 16401 7300         CLA CLL
4560 16402 7000         NOP             /(DCA OVER2) - FOR 3-WORD
4561 16403 7000         NOP             /(DCA OVER1) - FOR 3-WORD.
4562 16404 1600         TAD I FPNT      /GET NEXT INSTRUCTION
4563 16405 7450         SNA
4564 16406 5600         JMP I FPNT      /FAST EXIT--RETURN--
4565 16407 3262         DCA JUMP
4566 16410 1262         TAD JUMP
4567 16411 0123         AND C200        /GET PAGE BIT
4568 16412 7650         SNA CLA         /PAGE ZERO?
4569 16413 5216         JMP .+3         /YES
4570 16414 1104         TAD P7600       /NO
4571 16415 0200         AND FPNT        /C(FPNT)0-4 CONTAINS PAGE BITS
4572 16416 3040         DCA ADDR
4573 16417 1106         TAD P177        /GET 7 BIT ADDRESS
4574 16420 0262         AND JUMP
4575 16421 1040         TAD ADDR
4576 16422 3040         DCA ADDR
4577 16423 1263         TAD INDRCT      /INDIRECT BIT=1?
4578 16424 0262         AND JUMP
4579 16425 7650         SNA CLA
4580 16426 5231         JMP LOOP01      /NO-GO ON
4581 16427 1440         TAD I ADDR      /YES ,DEFER ,W/O AUTO-INDEX
4582 16430 3040         DCA ADDR
4583 16431 2200 LOOP01, ISZ FPNT
4584 16432 7040         CMA
4585 16433 1040         TAD ADDR
4586 16434 3015         DCA FLTXR2
4587 16435 1262         TAD JUMP        /GET COMMAND
4588 16436 7106         CLL RTL
4589 16437 7006         RTL
4590 16440 0107         AND P17         /GET BITS 0-2,IE OPCODE
4591 16441 7450         SNA
4592 16442 5267         JMP FLGT
4593 16443 1264         TAD TABLE       /LOOKUP IN TABLE
4594 16444 3262         DCA JUMP
4595 16445 1662         TAD I JUMP
4596 16446 7450         SNA
4597 16447 5265         JMP FLPT
4598 16450 3262         DCA JUMP
4599 16451 1304         TAD CEX1        /SAVE FLOATING ARGUEMENT,UNLESS'GET' OR 'PUT'
4600 16452 3014         DCA FLTXR
4601 16453 1117         TAD MFLT
4602 16454 3057         DCA CNTR
4603 16455 1415         TAD I FLTXR2
4604 16456 3414         DCA I FLTXR
4605 16457 2057         ISZ CNTR
4606 16460 5255         JMP .-3
4607 16461 5662         JMP I JUMP      /GO THERE
4608            
4609            
4610 16462 0000 JUMP,   0
4611            
4612            ADDR=EX1
4613            
4614 16463 0400 INDRCT, 0400
4615 16464 6573 TABLE,  ITABLE
4616 16465 1303 FLPT,   TAD CEXP        /EXP TO (ADDR)
4617 16466 5273         JMP .+5
4618 16467 1303 FLGT,   TAD CEXP        /(ADDR) TO EXP
4619 16470 3015         DCA FLTXR2
4620 16471 7040         CMA
4621 16472 1040         TAD ADDR
4622 16473 3014         DCA FLTXR       /SAVE 'FROM' ADDRESS
4623 16474 1117         TAD MFLT        /3 OR 4 WORDS
4624 16475 3057         DCA CNTR
4625 16476 1414         TAD I FLTXR
4626 16477 3415         DCA I FLTXR2
4627 16500 2057         ISZ CNTR
4628 16501 5276         JMP .-3
4629 16502 5201         JMP FPNT+1
4630 16503 0043 CEXP,   EXP-1
4631 16504 0037 CEX1,   EX1-1
4632            
4633            
4634 16505 4765 FLSU,   JMS I OPMINS    /FSUB=2 - NEGATE THE OPERAND
4635 16506 4770 FLAD,   JMS I ALGN      /FLAD=1 - FIRST ALIGN EXPONENTS
4636 16507 5201         JMP FPNT+1      /RETURN IF NO ALIGNMENT IS POSSIBLE
4637 16510 4772         JMS I RAR2      /TRIPLE PRECISION ADDDITION
4638 16511 4771         JMS I RAR1      /SINCE BITS ARE SHIFTED
4639 16512 4773         JMS I TRAD      /RIGHT
4640 16513 4767 NORF,   JMS I NORM      /NORMALIZE THE RESULT
4641 16514 5201         JMP FPNT+1      /HINT:USE 700X FOR FUNCTIONS.
4642            
4643            /INTERPRETIVE POWER
4644            
4645 16515 7000         NOP     /3 FREE LOCATIONS ************
4646 16516 7000         NOP
4647 16517 7000         NOP
4648 16520 3044 ZERO,   DCA EXP         /YES
4649 16521 3045         DCA HORD
4650 16522 3046         DCA LORD
4651 16523 3047         DCA OVER2
4652 16524 5201         JMP FPNT+1
4653 16525 4543 FLEX,   PUSHF           /AC TO A + POWER
4654 16526 0044         FLAC
4655 16527 4543         PUSHF           /SETUP ARGUMENT ( THE EXPONENT)
4656 16530 0040         EX1
4657 16531 4544         POPF
4658 16532 0044         FLAC
4659 16533 4453         JMS I INTEGER   /ONLY POSITIVE, INTEGER  EXPONENTS
4660 16534 7510         SPA
4661 16535 5342         JMP .+5         /(COULD DIVIDE)
4662 16536 7040         CMA
4663 16537 3262         DCA JUMP        /TEMP STORAGE
4664 16540 7000         NOP             /(DCA OVER1) - FOR 3-WORD
4665 16541 1045         TAD HORD
4666 16542 7640         SZA CLA
4667 16543 4566         ERROR2          /TOO LARGE OR NEGATIVE EXPONENT
4668 16544 4543         PUSHF           /INITIALIZE TO ONE.
4669 16545 2405         FLTONE
4670 16546 4544         POPF
4671 16547 0044         FLAC
4672 16550 4544         POPF
4673 16551 7470         ITER1
4674 16552 5360         JMP .+6
4675 16553 4543         PUSHF
4676 16554 7470         ITER1
4677 16555 4544         POPF
4678 16556 0040         EX1
4679 16557 4766         JMS I MULT      /"MULT"
4680 16560 2262         ISZ JUMP
4681 16561 5353         JMP .-6
4682 16562 5201         JMP FPNT+1
4683 16563 4766 FLMY,  JMS I MULT      /MULTIPLY
4684 16564 5201         JMP FPNT+1
4685            /------------------------------------------------------------
4686            
4687            
4688 16565 7153 OPMINS, MINUS2
4689 16566 7004 MULT,   DMULT
4690 16567 7335 NORM,   DNORM
4691 16570 6623 ALGN,   ALIGN
4692 16571 5754 RAR1,   DIV1
4693 16572 6757 RAR2,   DIV2
4694 16573 5733 TRAD,   DUBLAD
4695            
4696            ITABLE=.-1
4697 16574 6506         FLAD
4698 16575 6505         FLSU
4699 16576 7107         FLDV
4700 16577 6563         FLMY
4701 16600 6525         FLEX
4702 16601 0000         0000
4703 16602 6513         NORF
4704            /------------------------------------------------------------
4705            
4706 16603 0000 ACMINS, 0       /ROUTINE TO  COMPLEMENT FLAC - VIA "MINSKI"
4707 16604 7300         CLL CLA         
4708 16605 1047         TAD OVER2       /TRIPLE PRECISION NEGATION
4709 16606 7041         CMA IAC         /OF FLOATING AC
4710 16607 3047         DCA OVER2
4711 16610 1046         TAD LORD
4712 16611 7040         CMA
4713 16612 7430         SZL
4714 16613 7101         IAC CLL
4715 16614 3046         DCA LORD
4716 16615 1045         TAD HORD
4717 16616 7040         CMA
4718 16617 7430         SZL
4719 16620 7101         IAC CLL
4720 16621 3045         DCA HORD
4721 16622 5603         JMP I ACMINS    /--RETURN--
4722            
4723            
4724 16623 0000 ALIGN,  0       /SUBROUTINE TO ALIGN
4725 16624 1045         TAD HORD        /BINARY POINTS
4726 16625 7450         SNA
4727 16626 1046         TAD LORD        /IS MANTISSA ZERO?
4728 16627 7650         SNA CLA
4729 16630 5311         JMP NOX1        /YES, RESULT=OPERAND
4730 16631 1041         TAD AC1H        /NO,IS OPERAND ZERO?
4731 16632 7450         SNA
4732 16633 1042         TAD AC1L
4733 16634 7450         SNA
4734 16635 1043         TAD OVER1
4735 16636 7650         SNA CLA
4736 16637 5623         JMP I ALIGN     /YES--RETURN--
4737 16640 1040         TAD EX1
4738 16641 7041         CMA IAC
4739 16642 1044         TAD EXP
4740 16643 7450         SNA             /ARE EXPONENTS EQUAL?
4741 16644 5273         JMP ADONE       /YES
4742 16645 3203         DCA ACMINS
4743 16646 1203         TAD ACMINS
4744 16647 7500         SMA             /NO
4745 16650 7041         CIA             /NEGATE AND
4746 16651 3322         DCA AMOUNT      /SAVE THE DIFFERENCE
4747 16652 1322         TAD AMOUNT
4748 16653 1336         TAD TEST2
4749 16654 7710         SPA CLA         /CAN THE EXPONENTS BE ALIGNED?
4750 16655 5275         JMP NOX         /NO, USE LARGER OF THE TWO.
4751 16656 1203         TAD ACMINS      /YES, SHIFT THE SMALLER
4752 16657 7700         SMA CLA
4753 16660 5265         JMP ASHFT
4754 16661 4357         JMS DIV2
4755 16662 2322         ISZ AMOUNT
4756 16663 5261         JMP .-2
4757 16664 5273         JMP ADONE
4758 16665 7040 ASHFT, CMA     
4759 16666 1040         TAD EX1
4760 16667 3040         DCA EX1
4761 16670 4723         JMS I TAG1
4762 16671 2322         ISZ AMOUNT
4763 16672 5270         JMP .-2
4764 16673 2223 ADONE,  ISZ ALIGN
4765 16674 5623         JMP I ALIGN     /--RETURN--
4766 16675 1040 NOX,    TAD EX1         /MISSION IMPOSSIBLE!
4767 16676 7700         SMA CLA         /CHECK FOR SIGN DIFFERENCE
4768 16677 5304         JMP NOX2
4769 16700 1044         TAD EXP
4770 16701 7700         SMA CLA
4771 16702 5623         JMP I ALIGN     /-+--RETURN--
4772 16703 5306         JMP .+3         /--
4773 16704 1044 NOX2,   TAD EXP
4774 16705 7700         SMA CLA
4775 16706 1203         TAD ACMINS      /TEMP STORAGE OF DIFFERENCE. BOTH POS EXP OR BOTH NEG.
4776 16707 7740         SMA SZA CLA
4777 16710 5623         JMP I ALIGN     /OK (+-)--RETURN--
4778 16711 1040 NOX1,   TAD EX1         /USE LARGER
4779 16712 3044         DCA EXP
4780 16713 1041         TAD AC1H
4781 16714 3045         DCA HORD
4782 16715 1042         TAD AC1L
4783 16716 3046         DCA LORD
4784 16717 1043         TAD OVER1
4785 16720 3047         DCA OVER2
4786 16721 5623         JMP I ALIGN     /--RETURN--
4787 16722 0000 AMOUNT, 0
4788 16723 5754 TAG1,   DIV1
4789            /LEAVE 12 BIT ANSWER IN AC UPON RETURN
4790            /LEAVE FLAC AS AN INTEGER,
4791            
4792 16724 0000 FIX,    0               /VIA (INTEGER)
4793 16725 4751         JMS I ABSOL
4794 16726 1044         TAD EXP         /TEST FOR FRACTION
4795 16727 7750         SPA SNA CLA
4796 16730 5353         JMP FIXM        /DOUBLE CHECK FOR MINUS ONE.
4797 16731 7001         IAC
4798 16732 3043         DCA OVER1
4799 16733 1350         TAD P27         /INIT ALIGNMENT
4800 16734 3040         DCA EX1
4801 16735 4223         JMS ALIGN       /DO THE ALIGNMENT TO AN INTEGER
4802 16736 0043 TEST2,  0043            /ALREADY DONE; (27)-FOR 3-WORD
4803 16737 2047         ISZ OVER2
4804 16740 5344         JMP .+4
4805 16741 2046         ISZ LORD
4806 16742 7410         SKP
4807 16743 2045         ISZ HORD
4808 16744 3047         DCA OVER2       /CLEAR THE FRACTION
4809 16745 4752         JMS I RESOL
4810 16746 1046         TAD LORD        /EXIT WITH LOW ORDER RESULT IN AC.
4811 16747 5724         JMP I FIX       /--RETURN--
4812 16750 0027 P27,    27
4813 16751 5571 ABSOL,  ABSOLV
4814 16752 7173 RESOL,  RESOLV
4815 16753 3044 FIXM,   DCA EXP         /CLEAR EXPONENT
4816 16754 3045         DCA HORD
4817 16755 3046         DCA LORD
4818 16756 5344         JMP TEST2+6
4819 16757 0000 DIV2,   0       /SHIFT FLAC RIGHT
4820 16760 7300         CLA CLL
4821 16761 1045         TAD HORD
4822 16762 7510         SPA
4823 16763 7020         CML
4824 16764 7010         RAR
4825 16765 3045         DCA HORD
4826 16766 1046         TAD LORD
4827 16767 7010         RAR
4828 16770 3046         DCA LORD
4829 16771 1047         TAD OVER2
4830 16772 7010         RAR
4831 16773 3047         DCA OVER2
4832 16774 2044         ISZ EXP
4833 16775 5757         JMP I DIV2      /--RETURN--
4834 16776 5757         JMP I DIV2      /--RETURN--
4835            /------------------------------------------------------------
4836            SPECIAL=.       /INPUT CHARACTERS
4837 16777 0337         337     /LEFT ARROW
4838 17000 0377         377     /RUBOUT
4839 17001 0212         212     /L.F.
4840 17002 0375         375     /ALT MODE
4841 17003 0214         214             /^L IS IGNORED IN AN "ASK" COMMAND
4842            
4843            /(A+B+C)*(D+E+F)=A*D,A*E,B*D,B*E
4844            
4845 17004 0000 DMULT,  0       /N- PRECISION MULTIPLY WITH
4846 17005 7001         IAC     /PRODUCT IN TRIPLE PRECISION
4847 17006 1040         TAD EX1 /ADD EXPONENTS+1
4848 17007 4324         JMS SIGN        /AND DETERMINE SIGN OF RESULT
4849 17010 7710         SPA CLA
4850 17011 4353         JMS MINUS2
4851 17012 3301         DCA DATUM-1     /INITIALIZE RESULT
4852 17013 3300         DCA DATUM-2
4853 17014 3277         DCA DATUM-3
4854 17015 3276         DCA DATUM-4
4855 17016 1045         TAD A           /A*D
4856 17017 3751         SAVE            /STORE IN MP2
4857 17020 1041         TAD D           /SINGLE PRECISION MULTIPLY
4858 17021 4752         MULTY
4859 17022 0002         2               /ACCUMULATE STARTING IN #2 DATA WORD
4860 17023 1042         TAD E           /A*E
4861 17024 4752         MULTY
4862 17025 0003         3
4863 17026 1046         TAD B           /B*D
4864 17027 3751         SAVE
4865 17030 1041         TAD D
4866 17031 4752         MULTY
4867 17032 0003         3
4868 17033 1042         TAD E           /B*E
4869 17034 4752         MULTY
4870 17035 0004         4
4871 17036 3275 DMULT4, DCA DATUM-5     /(JMP DMDONE)-FOR 3-WORD
4872 17037 3274         DCA DATUM-6
4873 17040 1043         TAD F           /A*F
4874 17041 3751         SAVE
4875 17042 1045         TAD A
4876 17043 4752         MULTY
4877 17044 0004         4
4878 17045 1046         TAD B           /B*F
4879 17046 4752         MULTY
4880 17047 0005         5
4881 17050 1047         TAD C           /C*D
4882 17051 3751         SAVE
4883 17052 1041         TAD D
4884 17053 4752         MULTY
4885 17054 0004         4
4886 17055 1042         TAD E           /C*E
4887 17056 4752         MULTY
4888 17057 0005         5
4889 17060 1043         TAD F           /C*F
4890 17061 4752         MULTY
4891 17062 0006         6
4892            
4893 17063 1301 DMDONE, TAD DATUM-1     /COPY RESULT
4894 17064 3045         DCA HORD
4895 17065 1300         TAD DATUM-2
4896 17066 3046         DCA LORD
4897 17067 1277         TAD DATUM-3
4898 17070 3047         DCA OVER2
4899 17071 4301         JMS MULDIV
4900 17072 7000         NOP             /(DCA OVER2) - FOR 3-WORD
4901 17073 5604         JMP I DMULT     /--RETURN--
4902            
4903            DATUM=.+6       /INTERMEDIATE STORAGE
4904            
4905            /#6-LOW ORDER RESULT
4906            /#5
4907            /#4
4908            /#3
4909            /#2
4910            /#1-HIGH ORDER RESULT
4911            
4912            *DATUM-1
4913            
4914 17101 0000 MULDIV, 0       /TERMINATE MULTIPLY AND DIVIDE.
4915 17102 2050         ISZ SIGNF               /CORRECT FOR SIGN
4916 17103 4451         JMS I MINSKI
4917 17104 4747         JMS I NORMF     /SHIFT LEFT
4918 17105 7000         NOP
4919 17106 5701         JMP I MULDIV    /--RETURN--
4920 17107 1041 FLDV,   TAD AC1H        /4:DIVIDE
4921 17110 7650         SNA CLA
4922 17111 4566         ERROR2          /DIVISION BY ZERO
4923 17112 1040         TAD EX1         /SUBTRACT EXPONENTS+1
4924 17113 7041         CMA IAC
4925 17114 7001         IAC
4926 17115 4324         JMS SIGN        /SET UP SIGNS
4927 17116 7700         SMA CLA
4928 17117 4353         JMS MINUS2      /NEGATE DIVISOR
4929 17120 4750         JMS I DIVIDE    /DIVIDE
4930 17121 4301         JMS MULDIV
4931 17122 5723         JMP I .+1
4932 17123 6401         FPNT+1
4933            
4934            /THIS SUBROUTINE PREPARES MULTIPLY AND DIVIDE
4935            /FOR ANY COMBINATION OF SIGNED ARGUMENTS AND FOR ZERO.
4936            /THE RESULT OF EITHER IS ZERO IF FLAC = 0.
4937            /RESULT OF MULTIPLY IS ZERO IF EITHER IS ZERO;
4938            /DIVISION BY ZERO IS CHECKED BEFORE THIS 
4939            /ROUTINE IS CALLED. 
4940            
4941            /THE CALLING AC CONTAINS AN UPDATE VALUE FOR THE
4942            /EXPONENT. THE RETURNING AC CONTAINS THE SIGN OF 
4943            /THE ARGUMENT FOR FURTHER TESTING BY EACH ROUTINE.
4944            
4945            
4946 17124 0000 SIGN,   0               /TEST AND SAVE SIGN OF RESULT
4947 17125 1044         TAD EXP /COMPUTE NEW EXPONENT FOR MUL-DIV.
4948 17126 3044         DCA EXP
4949 17127 1124         TAD P4000       /LOAD 4000 TO XOR THE SIGN BITS
4950 17130 0045         AND HORD
4951 17131 1041         TAD AC1H
4952 17132 7700         SMA CLA         /RESULT MAY BE ZERO
4953 17133 7040         CMA
4954 17134 3050         DCA SIGNF
4955 17135 1045         TAD HORD
4956 17136 7450         SNA
4957 17137 5746         JMP I REVIT     /ANSWER IS ZERO.
4958 17140 7710         SPA CLA         /TAKE ABSOLUTE VALUE OF FLAC
4959 17141 4451         JMS I MINSKI
4960 17142 1041         TAD AC1H
4961 17143 7450         SNA             /RESULT OF EITHER MAY BE ZERO
4962 17144 5746         JMP I REVIT
4963 17145 5724         JMP I SIGN      /--RETURN--
4964            
4965            /SIGN OF RESULT = SIGNF
4966            /+=-1
4967            /-=0
4968            
4969 17146 6520 REVIT,  ZERO
4970 17147 7335 NORMF,  DNORM
4971 17150 7261 DIVIDE, DUBDIV
4972            
4973            SAVE=DCA I .
4974 17151 7256         MP2
4975            MULTY=JMS I .
4976 17152 7200         MP4
4977            
4978            A=FLAC+1
4979            B=FLAC+2
4980            C=FLAC+3
4981            D=AC1H
4982            E=AC1L
4983            F=OVER1
4984            
4985            
4986 17153 0000 MINUS2, 0       /NEGATE OPERAND
4987 17154 7300         CLA CLL         /TRIPLE PRECISION
4988 17155 1043         TAD OVER1
4989 17156 7041         CMA IAC
4990 17157 3043         DCA OVER1
4991 17160 1042         TAD AC1L
4992 17161 7040         CMA
4993 17162 7430         SZL
4994 17163 7101         IAC CLL
4995 17164 3042         DCA AC1L
4996 17165 1041         TAD AC1H
4997 17166 7040         CMA
4998 17167 7430         SZL
4999 17170 7101         IAC CLL
5000 17171 3041         DCA AC1H
5001 17172 5753         JMP I MINUS2    /--RETURN--
5002            
5003 17173 0000 RESOLV, 0
5004 17174 1050         TAD  SIGNF
5005 17175 7710         SPA CLA
5006 17176 4451         JMS I MINSKI
5007 17177 5773         JMP I RESOLV    /--RETURN--
5008            /------------------------------------------------------------
5009            /------------------------------------------------------------
5010            *7200
5011            
5012 17200 0000 MP4,    0       /SINGLE PRECISION, UNSIGNED MULTIPLY - "MULTY"
5013 17201 7450         SNA     /NO RESULT ADDED IF ZERO
5014 17202 5600         JMP I MP4       /--RETURN--
5015            
5016            /FOR EAE INSERT THE FOLLOWING:
5017            
5018            /7203  3206  DCA .+3
5019            /7204  1256  TAD MP2
5020            /7205  7425  MQL MUY
5021            /7206  0000  0
5022            /7207  3253  DCA MP5
5023            /7210  7501  MQA
5024            /7211  3255  DCA MP3
5025            /7212  5227  JMP .+15
5026            
5027            
5028 17203 3254         DCA MP1         /12 BITS BY 12 BITS
5029 17204 3253         DCA MP5
5030 17205 1257         TAD THIR
5031 17206 3255         DCA MP3
5032 17207 7100         CLL
5033 17210 1254 MP6,    TAD MP1
5034 17211 7010         RAR
5035 17212 3254         DCA MP1
5036 17213 1253         TAD MP5
5037 17214 7420         SNL
5038 17215 5220         JMP .+3
5039 17216 7100         CLL
5040 17217 1256         TAD MP2
5041 17220 7010         RAR
5042 17221 3253         DCA MP5 /SAVE HIGH ORDER RESULT
5043 17222 2255         ISZ MP3
5044 17223 5210         JMP MP6
5045 17224 1254         TAD MP1 /CORRECT LOW ORDER RESULT
5046 17225 7010         RAR
5047 17226 3255         DCA MP3
5048 17227 1600         TAD I MP4       /PICKUP SCALE FACTOR
5049 17230 7041         CIA
5050 17231 1252         TAD DATUMA      /COMPUTE ADDRESS
5051 17232 3254         DCA MP1         /TEMP
5052 17233 1255         TAD MP3         /LOW ORDER PART
5053 17234 7100         CLL
5054 17235 1654         TAD I MP1       /ACCUMULATE
5055 17236 3654         DCA I MP1
5056 17237 2254         ISZ MP1
5057 17240 7004         RAL
5058 17241 1253         TAD MP5
5059 17242 1654         TAD I MP1
5060 17243 3654         DCA I MP1
5061 17244 7420         SNL
5062 17245 5600         JMP I MP4       /NO CARRY--RETURN--
5063 17246 2254         ISZ MP1
5064 17247 2654         ISZ I MP1
5065 17250 5600         JMP I MP4       /--RETURN
5066 17251 5246         JMP .-3         /CARRY AGAIN
5067 17252 7102 DATUMA, DATUM
5068 17253 0000 MP5,    0               /PRODUCT
5069 17254 0000 MP1,    0               /MULTIPLIER
5070 17255 0000 MP3,    0
5071 17256 0000 MP2,    0               /MULTIPLICAND
5072 17257 7764 THIR,   -14     /12 BITS
5073            
5074            
5075 17260 7735 MIF,    -43             /(-27) - FOR 3-WORD(=7751)
5076            
5077 17261 0000 DUBDIV, 0       /2 OR 3  PRECISION DIVIDE
5078 17262 3200         DCA MP4
5079 17263 3254         DCA MP1
5080 17264 1260         TAD MIF         /INIT BIT COUNTER
5081 17265 3255         DCA MP3
5082 17266 7410         SKP
5083 17267 4526 DV3,    JMS I DOUBLE    /SHIFT FLAC LEFT
5084 17270 7100         CLL
5085 17271 1043         TAD OVER1
5086 17272 1047         TAD OVER2
5087 17273 3253         DCA MP5
5088 17274 7004         RAL
5089 17275 1042         TAD AC1L        /COMBINE ONE POSITION AND (4-WORD)
5090 17276 1046         TAD LORD
5091 17277 3256         DCA MP2         /SAVE RESULT
5092 17300 7004         RAL
5093 17301 1045         TAD HORD        /ADD OVERFLOW
5094 17302 1041         TAD AC1H
5095 17303 7420         SNL             /SKIP IF OVERFLOW
5096 17304 5312         JMP .+6
5097 17305 3045         DCA HORD        /UPDATE FLAC
5098 17306 1253         TAD MP5
5099 17307 3047         DCA OVER2
5100 17310 1256         TAD MP2
5101 17311 3046         DCA LORD
5102 17312 7200         CLA             /CLEAR ACCUMULATOR
5103 17313 1254         TAD MP1         /SAVE OVERFLOW BITS CIRCULARLY
5104 17314 7004         RAL
5105 17315 3254         DCA MP1 
5106 17316 1200         TAD MP4
5107 17317 7004         RAL
5108 17320 3200         DCA MP4
5109 17321 1335         TAD DNORM
5110 17322 7004         RAL             /EXTRA FOR 4-WORD
5111 17323 3335         DCA DNORM
5112 17324 2255         ISZ MP3         /TEST FOR END OF DIVIDE
5113 17325 5267         JMP DV3
5114 17326 1335         TAD DNORM
5115 17327 3045         DCA HORD
5116 17330 1200         TAD MP4
5117 17331 3046         DCA LORD
5118 17332 1254         TAD MP1
5119 17333 3047         DCA OVER2
5120 17334 5661         JMP I DUBDIV    /--RETURN--
5121            
5122            
5123            
5124 17335 0000 DNORM,  0       /SUBROUTINE TO NORMALIZE FLAC
5125 17336 4775         JMS I ABSOL3
5126 17337 4366         JMS TEST4
5127 17340 1045         TAD HORD
5128 17341 7450         SNA             /IS MANTISSA=0?
5129 17342 1047         TAD OVER2
5130 17343 7450         SNA
5131 17344 1046         TAD LORD
5132 17345 7650         SNA CLA
5133 17346 5363         JMP EXIT3       /YES
5134 17347 1045         TAD HORD
5135 17350 7104         RAL CLL
5136 17351 7710         SPA CLA         /WILL SHIFT BE TOO FAR?
5137 17352 5360         JMP .+6
5138 17353 4526         JMS I DOUBLE
5139 17354 7140         CMA CLL
5140 17355 1044         TAD EXP
5141 17356 3044         DCA EXP
5142 17357 5347         JMP .-10
5143 17360 4776         JMS I RESOL3
5144 17361 4366         JMS TEST4       /DON'T LEAVE 4000
5145 17362 5735         JMP I DNORM     /--RETURN--
5146 17363 3044 EXIT3,  DCA EXP         /SET TO ZERO
5147 17364 5735         JMP I DNORM     /--RETURN--
5148 17365 6757 XRAR2,  DIV2
5149 17366 0000 TEST4,  0
5150 17367 1045         TAD HORD        /TEST FOR 4000
5151 17370 7510         SPA
5152 17371 7041         CIA
5153 17372 7710         SPA CLA
5154 17373 4765         JMS I XRAR2     /SHIFT BACK
5155 17374 5766         JMP I TEST4     /--RETURN--
5156            
5157 17375 5571 ABSOL3, ABSOLV
5158 17376 7173 RESOL3, RESOLV
5159            
5160            /------------------------------------------------------------
5161            /------------------------------------------------------------
5162            *7400
5163            
5164            
5165            /PAGE 18
5166            
5167                    /FLOATING SQUARE ROOT FUNCTION
5168            
5169 17400 4407 XSQRT,  FINT
5170 17401 6274         FPUT FPAC1      /VALUE
5171 17402 0000         FEXT            /NEWTON'S METHOD IS USED
5172 17403 1045         GETSGN
5173 17404 7710         SPA CLA
5174 17405 4566         ERROR2          /NUMBER IS NEGATIVE=IMAGINARY ROOTS
5175 17406 1044         TAD EXP         /LINK IS =0 FROM FINT
5176 17407 7510         SPA             /MATCH THE SIGN WITH LINK BIT
5177 17410 7020         CML
5178 17411 7010         RAR
5179 17412 3270         DCA ITER1       /MAKE FIRST APPROXIMATION
5180 17413 7430         SZL             /TEST LSB OF EXP
5181 17414 2270         ISZ ITER1
5182 17415 7000         NOP
5183 17416 1267         TAD SQCON1
5184 17417 3271         DCA ITER1+1
5185 17420 3272         DCA ITER1+2
5186 17421 3273         DCA ITER1+3
5187 17422 1275         TAD FPAC1+1
5188 17423 7450         SNA
5189 17424 1276         TAD FPAC1+2
5190 17425 7650         SNA CLA
5191 17426 5265         JMP SQEND       /NUMBER=0
5192 17427 4407 CLCU,   FINT
5193 17430 0274         FGET FPAC1
5194 17431 3270         FDIV ITER1
5195 17432 1270         FADD ITER1
5196 17433 0000         FEXT
5197            
5198            
5199            
5200            
5201 17434 7240         CLA CMA
5202 17435 1044         TAD EXP
5203 17436 3044         DCA EXP
5204 17437 1044         TAD EXP
5205 17440 7041         CMA IAC
5206 17441 1270         TAD ITER1
5207 17442 7640         SZA CLA         /ARE EXPONENTS EQUAL?
5208 17443 5261         JMP ROOTGO      /NO
5209 17444 1045         TAD HORD        /ARE HIGH-ORDER MANTISSAS EQUAL?
5210 17445 7041         CMA IAC
5211 17446 1271         TAD ITER1+1
5212 17447 7640         SZA CLA
5213 17450 5261         JMP ROOTGO      /NO
5214 17451 1046         TAD LORD
5215 17452 7041         CMA IAC 
5216 17453 1272         TAD ITER1+2     /DO LOW-ORDER MANTISSAS AGREE
5217 17454 7500         SMA
5218 17455 7041         CMA IAC         /WITHIN ONE BIT?
5219 17456 7001         IAC
5220 17457 7700         SMA CLA
5221 17460 5535         RETURN
5222 17461 4407 ROOTGO, FINT
5223 17462 6270         FPUT ITER1
5224 17463 0000         FEXT
5225 17464 5227         JMP CLCU
5226 17465 3044 SQEND,  DCA EXP
5227 17466 5535         RETURN
5228 17467 3015 SQCON1, 3015
5229            
5230            BUFFER=.
5231            
5232 17470 0000 ITER1,  0
5233 17471 0000         0
5234 17472 0000         0
5235 17473 0000         0
5236            
5237 17474 0000 FPAC1,  0
5238 17475 0000         0
5239 17476 0000         0
5240 17477 7503         BUFFER+13       /ADDRESS OF NEXT FREE LOCATION IN 10-DIGIT VERSION.
5241            
5242            
5243            
5244            
5245            /EFOCNB -- INITIALIZATION FOR PS/8 FOCAL
5246            
5247                    *176
5248 10176 4000         INIT
5249            
5250                    *4000
5251 14000 1377 INIT,   TAD (RECOVR+1
5252 14001 3176         DCA 176
5253 14002 6201         CDF
5254 14003 1776         TAD I (207      /MOVE LENGTH OF INITIAL DIALOGUE
5255 14004 6211         CDF 10
5256 14005 3060         DCA BUFR        /(JUST IN CASE)
5257 14006 6040         TFL             /MAKE FLAG SET
5258 14007 4537         PUSHJ
5259 14010 0420                 DO+1
5260 14011 1375         TAD (4300       /"#@" FOR SYSTEM STATUS
5261                    JMS LOOKUP
off page        	         ^
     14012 4774 
5262 14013 7340         CLA CLL CMA
5263 14014 1030         TAD PT1
5264 14015 3030         DCA PT1
5265 14016 4407         FINT            /GET SYSTEM STATUS VARIABLE
5266 14017 0430         FGET I PT1
5267 14020 6346         FPUT INITMP     /SAVE IT FOR LATER
5268 14021 0000         FEXT
5269 14022 1045         TAD FLAC+1      /IF IT'S ZERO, INITIAL DIALOGUE WASN'T THERE
5270 14023 7650         SNA CLA
5271 14024 5323         JMP SECRET      /ASSUME STANDARD FEATURES
5272 14025 1373 CHKLOG, TAD (100        /"A@" (KEEP SIN & COS)
5273                    JMS LOOKUP
off page        	         ^
     14026 4774 
5274 14027 7640         SZA CLA
5275 14030 5235         JMP CHKSIN
5276                    JMS CHANGE      /KILL ALL EXTENDED FUNCTIONS
off page        	          ^
     14031 4772 
5277 14032 4316                 SINADD-1
5278 14033 1371         TAD (TTAB-1     /SET VARIABLE BOTTOM
5279 14034 5244         JMP CHKFIL-1
5280 14035 1370 CHKSIN, TAD (200        /"B@" (KEEP ALL FUNCTIONS)
5281                    JMS LOOKUP
off page        	         ^
     14036 4774 
5282 14037 7640         SZA CLA
5283 14040 5245         JMP CHKFIL
5284                    JMS CHANGE      /KILL LOG, EXP, ATN
off page        	          ^
     14041 4772 
5285 14042 4322                 LOGADD-1
5286 14043 1367         TAD (5177       /AND RESET BOTTOM
5287 14044 3035         DCA BOTTOM
5288 14045 1366 CHKFIL, TAD (400        /"D@" (FILE COMMANDS)
5289                    JMS LOOKUP
off page        	         ^
     14046 4774 
5290 14047 7640         SZA CLA
5291 14050 5253         JMP CHKSP
5292                    JMS CHANGE      /KILL FILE COMMANDS
off page        	          ^
     14051 4772 
5293 14052 4307                 FILADD-1
5294 14053 1365 CHKSP,  TAD (500        /"E@" (LEADING SPACE IN TYPE [FOR FILES])
5295                    JMS LOOKUP
off page        	         ^
     14054 4774 
5296 14055 7640         SZA CLA
5297 14056 5261         JMP CHKEQ
5298                    JMS CHANGE
off page        	         ^
     14057 4772 
5299 14060 4336                 SPADD-1
5300 14061 1364 CHKEQ,  TAD (700        /"G@" ('=' IN TYPE)
5301                    JMS LOOKUP
off page        	         ^
     14062 4774 
5302 14063 7650         SNA CLA         /REVERSE SENSE ON NON-STANDARD FEATURES
5303 14064 5267         JMP CHKCOL
5304                    JMS CHANGE
off page        	         ^
     14065 4772 
5305 14066 4343                 EQADD-1
5306 14067 1363 CHKCOL, TAD (1000       /"H@" (FOR ':' IN ASK)
5307                    JMS LOOKUP
off page        	         ^
     14070 4774 
5308 14071 7650         SNA CLA
5309 14072 5275         JMP CHKAMP
5310                    JMS CHANGE
off page        	         ^
     14073 4772 
5311 14074 4331                 COLADD-1
5312 14075 1362 CHKAMP, TAD (1100       /"I@" (FOR & INSTEAD OF E)
5313                    JMS LOOKUP
off page        	         ^
     14076 4774 
5314 14077 7650         SNA CLA
5315 14100 5303         JMP CHKPRC
5316                    JMS CHANGE
off page        	         ^
     14101 4772 
5317 14102 4352                 AMPADD-1
5318 14103 1361 CHKPRC, TAD (300        /"C@" (EXTENDED PRECISION)
5319                    JMS LOOKUP
off page        	         ^
     14104 4774 
5320 14105 7640         SZA CLA
5321 14106 5323         JMP SECRET
5322                    JMS CHANGE
off page        	         ^
     14107 4772 
5323 14110 4221                 FORADD-1
5324 14111 1360         TAD (-31
5325                    DCA LOOKUP
off page        	         ^
     14112 3774 
5326 14113 1357         TAD (7270
5327 14114 3010         DCA 10
5328 14115 1356         TAD (FORFIN-1
5329 14116 3011         DCA 11
5330 14117 1411         TAD I 11
5331 14120 3410         DCA I 10
5332                    ISZ LOOKUP
off page        	         ^
     14121 2774 
5333 14122 5317         JMP .-3
5334 14123 1133 SECRET, TAD END
5335 14124 3031         DCA LASTV       /ERASE VARIABLES
5336 14125 1355         TAD (4100
5337                    JMS LOOKUP      /CREATE THE THREE SECRET VARIABLES
off page        	          ^
     14126 4774 
5338 14127 1374         TAD (4200
5339                    JMS LOOKUP
off page        	         ^
     14130 4774 
5340 14131 1375         TAD (4300
5341                    JMS LOOKUP
off page        	         ^
     14132 4774 
5342 14133 7340         CLA CLL CMA
5343 14134 1030         TAD PT1
5344 14135 3030         DCA PT1         /BACKUP PT1
5345 14136 4407         FINT            /RESTORE SYSTEM SECRET VARIABLE
5346 14137 0346         FGET INITMP
5347 14140 6430         FPUT I PT1
5348 14141 0000         FEXT
5349 14142 1031         TAD LASTV
5350 14143 3133         DCA END         /MAKE THEM SECRET
5351 14144 5745         JMP I .+1
5352 14145 2213         ERT             /ERASE ALL TEXT
5353            
5354 14146 0000 INITMP, ZBLOCK 4        /HOLDING AREA FOR '#'
     14147 0000 
     14150 0000 
     14151 0000 
5355            
5356 14155 4100         PAGE
     14156 4256 
     14157 7270 
     14160 7747 
     14161 0300 
     14162 1100 
     14163 1000 
     14164 0700 
     14165 0500 
     14166 0400 
     14167 5177 
     14170 0200 
     14171 1264 
     14172 4207 
     14173 0100 
     14174 4200 
     14175 4300 
     14176 0207 
     14177 2677 
5357 14200 0000 LOOKUP,        0
5358 14201 3056         DCA EFOP
5359 14202 4537         PUSHJ
5360 14203 1431                 GS1
5361 14204 2030         ISZ PT1
5362 14205 1430         TAD I PT1       /PICK UP FIRST SIGNIFICANT WORD
5363 14206 5600         JMP I LOOKUP
5364            
5365 14207 0000 CHANGE, 0
5366 14210 1607         TAD I CHANGE
5367 14211 2207         ISZ CHANGE
5368 14212 3010         DCA 10
5369 14213 1410 CLOOP,  TAD I 10
5370 14214 7450         SNA
5371 14215 5607         JMP I CHANGE
5372 14216 3071         DCA T2
5373 14217 1410         TAD I 10
5374 14220 3471         DCA I T2
5375 14221 5213         JMP CLOOP
5376            
5377            /THESE ARE THE LISTS TO PATCH FOCAL TO YOUR CUSTOMIZED SPECS
5378            
5379            /CHANGES FOR 6-DIGIT PRECISION
5380 14222 0070 FORADD, 70
5381 14223 0005         5
5382 14224 0117         117
5383 14225 7775         7775
5384 14226 5526         5526
5385 14227 7772         7772
5386 14230 5527         5527
5387 14231 0007         7
5388 14232 1504         VARPCH
5389 14233 7000         NOP
5390 14234 6143         6143
5391 14235 7771         7771
5392 14236 6277         6277
5393 14237 3147         3147
5394 14240 6402         6402
5395 14241 3047         3047
5396 14242 6540         6540
5397 14243 3043         3043
5398 14244 6736         6736
5399 14245 0027         27
5400 14246 7036         7036
5401 14247 5263         5263
5402 14250 7105         7105
5403 14251 2047         2047
5404 14252 7072         7072
5405 14253 3047         3047
5406 14254 7260         7260
5407 14255 7751         7751
5408 14256 0000         0
5409            
5410            /ADDITIONAL CHANGES FOR 6-DIGIT PRECISION -- NOT MADE WITH "CHANGE"
5411 14257 1042 FORFIN, 1042
5412 14260 1046         1046
5413 14261 3256         3256
5414 14262 7004         7004
5415 14263 1045         1045
5416 14264 1041         1041
5417 14265 7420         7420
5418 14266 5304         5304
5419 14267 3045         3045
5420 14270 1256         1256
5421 14271 3046         3046
5422 14272 7200         7200
5423 14273 1254         1254
5424 14274 7004         7004
5425 14275 3254         3254
5426 14276 1200         1200
5427 14277 7004         7004
5428 14300 3200         3200
5429 14301 2255         2255
5430 14302 5267         5267
5431 14303 1254         1254
5432 14304 3046         3046
5433 14305 1200         1200
5434 14306 3045         3045
5435 14307 5661         5661
5436            
5437 14310 0226 FILADD, PUSHB           /PATCH PUSHB
5438 14311 5643         MPUSHA-1+13
5439 14312 0367         PUSHB1          /PATCH PUSHB1
5440 14313 5611         5576+13
5441 14314 1201         1201            /PATCH COMGO
5442 14315 2671         ERROR5
5443 14316 0000         0
5444            
5445 14317 0405 SINADD, 405
5446 14320 2671         ERROR5
5447 14321 0406         406
5448 14322 2671         ERROR5
5449 14323 0402 LOGADD, 402
5450 14324 2671         ERROR5
5451 14325 0403         403
5452 14326 2671         ERROR5
5453 14327 0404         404
5454 14330 2671         ERROR5
5455 14331 0000         0
5456            
5457 14332 1216 COLADD, 1216
5458 14333 1371         1371            /'TAD ALIST'
5459 14334 1217         1217
5460 14335 4400         JMS I ECHOP
5461 14336 0000         0
5462            
5463 14337 6001 SPADD,  6001
5464 14340 7300         CLA CLL         /DON'T PRINT LEADING SPACE
5465 14341 6002         6002
5466 14342 7300         CLA CLL
5467 14343 0000         0
5468            
5469 14344 6001 EQADD,  6001
5470 14345 1335         1335            /'TAD PEQ'
5471 14346 6002         6002
5472 14347 4551         PRINTC
5473 14350 6135         6135
5474 14351 0275         0275            /PRINT LEADING '='
5475 14352 0000         0
5476            
5477 14353 5662 AMPADD, 5662
5478 14354 7532         7532
5479 14355 6133         6133
5480 14356 0246         246
5481 14357 6301         6301
5482 14360 7532         7532
5483 14361 0000         0
5484            
5485                    PAGE
5486            
5487            $$$$$$$$$$$

A       0045
ABSOL   6751
ABSOL2  6153
ABSOL3  7375
ABSOLV  5571
AC1H    0041
AC1L    0042
ACDF    5654
ACIF    5741
ACMINS  6603
ADD     0061
ADDR    0040
ADONE   6673
AF      4677
AGAIN   6310
ALF1    4760
ALF2    4763
ALFZ    4755
ALGN    6570
ALIGN   6623
ALIST   1367
AMOUNT  6722
AMPADD  4353
ARCALG  4732
ARCRTN  5024
ARGNXT  1723
ARTN    5000
ASHFT   6665
ASK     1211
ATEM    0036
ATLIST  1565
ATSW    1210
AUTO1   0010 unreferenced
AUTO2   0011
AUTO3   0012
AUTO4   0013
AUTO5   0014
AUTO6   0015
AUTO7   0016 unreferenced
AUTO8   0017
AXIN    0010
AXIND   6350
AXOUT   0017
AXOUTD  2573
B       0046
BACK    5503
BET1    4771
BET2    4774
BETZ    4766
BF      4702
BLKCNT  3655
BLLL    6526
BLOCK   6537
BLOKLP  7017
BOTTOM  0035
BUFFER  7470
BUFR    0060
BUFST   5531
C       0047
C100    0002
C140    2556
C144    6140
C200    0123
C260    0113
C3      5346
C40     3207
C5      5342
C7      5336
C7600   6432
C9      5332
CALL    7233
CCIF    3726
CCR     0077
CEX1    6504
CEXP    6503
CF      4705
CFRS    0132
CFRSX   0136
CHAINE  6600
CHANGE  4207
CHAR    0066
CHARI   3132
CHIN    2154
CHKAMP  4075
CHKCOL  4067
CHKEQ   4061
CHKFIL  4045
CHKLOG  4025 unreferenced
CHKPRC  4103
CHKSIN  4035
CHKSP   4053
CHKVAR  1446
CHRT    6133
CLCU    7427
CLF     0076
CLOOP   4213
CNTR    0057
CNTRC   2655
CNTRX   1310
COLADD  4332
COMBUF  0131 unreferenced
COMGO   1171
COMLIS  6355
COMLST  0774
COMMEN  0612
COMPAR  6276
CON1    5037
COUNT   7170
CPRNT   7537
CRONLY  6344
CSTAR   0225
D       0041
DATUM   7102
DATUMA  7252
DAXIN   0173
DAXOUT  0174
DCDYES  6131
DCMA    6601 unreferenced
DCONP   6303
DCONT   0470
DCOUNT  6143
DEBGSW  0026
DECODE  6116
DECON   5627
DECONV  5600
DECP    5533
DECR    5521
DELETE  4565
DERR    7303
DEVC    6242
DEVHLD  0105
DEVNO   0054
DF      4710
DGRP    0424
DGRP1   0440 unreferenced
DIG     5543
DIGIT   5713
DIGITS  0012
DIRLIS  7072 unreferenced
DISMIS  6152
DIV1    5754
DIV2    6757
DIVIDE  7150
DLOAD   6244
DMDONE  7063 unreferenced
DMPSW   0100
DMULT   7004
DMULT4  7036 unreferenced
DNORM   7335
DNUMBR  5714
DO      0417
DOK     2110
DONE    2126
DOONE   0462
DOUBLE  0126
DPC     0167
DPCVPT  6302
DPN     6305
DPT     6145
DPT1    0171
DSAVE   5640
DTHIS   0170
DTST    5647
DUBDIV  7261
DUBLAD  5733
DV3     7267
DXRT    0172
E       0042
ECALL   1601
ECHCHK  6102
ECHFLG  0047
ECHGO   6041
ECHO    3116
ECHOGO  7530
ECHOLS  1624
ECHOP   0000
EFOP    0056
EFUN    1743
EFUN2   1754
EFUN3   2017
EFUN3I  0135
ELPAR   1763
END     0133
ENDFI   6243
ENDLN   4556
ENDT    0134
ENQ     0205
ENUM    1732
EOF     3145
EPAR    1710
EPAR2   1765
EQADD   4344
ERASE   2203
ERG     2224
ERL     2221
ERR2    2672
ERROR   7244
ERROR1  4463
ERROR2  4566
ERROR3  4566
ERROR4  4566
ERROR5  2671
ERT     2213
ERVX    2236
ESC     0233
ESCA    2534
ETERM   1647
ETERM1  1627
ETERM2  1655
ETERMN  1644
EVAL    1613
EX1     0040
EXIT1   5034
EXIT2   5302
EXIT3   7363
EXP     0044
EXTENS  0031
EXTR    2312
F       0043
FADD    11000
FCDF    5670
FCHK    3274
FCHKP   3220
FCIF    5721
FCONT   1101
FCOS    5200
FCOUNT  5535
FDIS    3200
FDISI   3244
FDIV    13000
FDSW    3245
FDT2    3332
FEND3   2266
FENT    4407
FETCHE  6602
FEXP    4620
FEXT    0000
FGET    10000
FGO2    6011
FGO3    6027
FGO4    6034
FGO5    6070
FIGO1   6221
FIGO4   6261
FILADD  4310
FILER   3133
FILEST  5442
FILGO   6365
FILIST  6764
FIN     7520
FINCR   1065
FIND    0551
FIND1   0555
FINDLN  4555
FINDN   2245
FINFIN  1137
FINKP   1133
FINPUT  0130
FINT    4407
FISW    0052
FIX     6724
FIXM    6753
FJOY    3306
FL100   0302
FLAC    0044
FLAD    6506
FLAG1   5162
FLAG2   4725
FLARG   2030
FLARGP  0125
FLDSET  5743
FLDV    7107
FLEX    6525
FLGT    6467
FLIMIT  1075
FLINTP  6200
FLIST1  0575
FLIST2  0572
FLMY    6563
FLNGTH  0052
FLOG    5040
FLOP    1674
FLOUT   5556
FLOUTP  6000
FLP5    0305
FLPT    6465
FLSU    6505
FLTONE  2405
FLTXR   0014
FLTXR2  0015
FLTZER  2407
FM12    6142
FMUL    14000
FNEG    5163
FNOR    7000
FNTABF  0373
FNTABL  2164
FOCTXT  7343
FOR     1041
FORADD  4222
FORFIN  4257
FOUT    7532
FOUTPU  0127
FPAC1   7474
FPNT    6400
FPOW    15000 unreferenced
FPRNT   5465
FPUT    16000
FRAN    7547
FSIN    5205
FSUB    12000
FXIT    0000
GECALL  1556
GEND    2333
GET1    2327
GET3    2344
GETARG  1401
GETC    4545
GETDEV  7152
GETLN   4554
GETLP   1411
GETSGN  1045
GETVAR  1405
GINC    0070
GLIST   1375
GLOOP   1435
GLOOP1  1457
GNAME   6016
GO      5021
GOK     0037
GOKILL  2010
GONE    0232
GOSUB   6701
GOSUB1  6601
GOSWIT  7513
GOTO    0601
GRPTST  0744
GS      0235
GS1     1431
GSERCH  1422
GTEM    0021
GTMON   6143
GZERR   0361
HANDAD  6200
HANDOK  6265
HIGH    3245
HND     7223
HORD    0045
HXIT    3267
IBAR    0212
IBLK    5472
ICHAR   5463
ICHAR1  5503
ICHAR2  5505 unreferenced
ICHAR3  5513 unreferenced
ICHARF  3126
IECALL  1037
IF      1013
IF1     1035
IF3     1025
IGNOR   0217
ILIST   0771
IN      5513
INBLK   0067
INBUF   0034
INCHT   5545
INDEV   0064
INDRCT  6463
INFIX   2400
INHND   0073
INIT    4000
INITMP  4146
INLIST  0567
INORM   6307
INPUT   0756
INPUTX  0271
INSUB   0036
INTEGE  0053
IOPEN   5600
IOWAIT  6137
IPART   1040
IPNFLG  0051
IPNTR   5544
IRETN   0227
IRST    5615
ITABLE  6573
ITEMP   5543
ITER1   7470
JFLOAT  3355
JLOOK   3332
JUMP    6462
K4      5525
KCF     6030 unreferenced
L1      5126
L2      5131
L3      5134
L4      5137
LASTLN  0025
LASTOP  0055
LASTV   0031
LBLOCK  7023
LCON    0370 unreferenced
LENF1   6660
LEXIT   7144 unreferenced
LG2E    4713
LGOSUB  1551
LIB     7503
LIBBLK  0055
LIBDEV  6534
LIBFIL  0104
LIBHND  0061
LIBLEN  6533
LIBN    0131
LIBRAR  7000
LIBX    7060
LINE0   0210
LINE1   0224
LINENO  0067
LIST3   0077
LIST6   0073
LIST7   0075
LISTFL  0032
LISTGO  1365
LNGTH   7235
LOAD    6606 unreferenced
LOADGO  6620
LOG2    5157
LOG5    5142
LOG6    5145
LOG7    5150
LOG8    5153
LOGADD  4323
LOOKUP  4200
LOOP01  6431
LOOP2   7027
LOOP3   7142
LORD    0046
LOWLIB  6400
LPRTST  2035
M100    0101
M10PT   6147
M11     0121
M12     2413
M137    2356
M140    2560
M144    6137
M16     6335
M2      0111
M20     0105
M240    0114
M260    1524
M271    1525
M4      6141
M40     2355
M5      0120
M77     0103
MAKV1   1475
MAKVAR  1464
MBREAK  2600
MCOM    1136 unreferenced
MCR     0116
MCTRLC  2601
MD      5526
MEQ     1135
MF      0600
MFLT    0117
MGETC   5774
MGETLN  7337
MIF     7260
MINE    5662
MINSKI  0051
MINUS2  7153
MINUSA  0112
MINUSE  6301
MINUSZ  5663
MOD     5215
MODIFY  1313
MP1     7254
MP2     7256
MP3     7255
MP4     7200
MP5     7253
MP6     7210
MPD2    5656
MPD3    5705
MPER    0115
MPLUS   5664
MPOPA   5732
MPRINT  6321
MPUSHA  5631
MSEX    6761
MSORTC  5755
MSORTJ  6737
MSPACE  5665
MULDIV  7101
MULT    6566
MULT10  5667
MULT2   5715
MULTY   4752
NAGSW   0065
NAME    6000
NAMEC   6031
NAMECT  6135
NAMLOC  0026
NAMPT   7234
NEGATE  4451
NEGP    4724
NEND    7136
NEWDEV  0033
NEWLIN  6352
NLOOP   7110
NMBASE  6133
NOCARE  3170
NOCHAR  3665
NORF    6513
NORM    6567
NORMF   7147
NOSAVE  6720
NOTEQ   6221
NOX     6675
NOX1    6711
NOX2    6704
NPACK   7305
NPRNT   7132
NXTVAR  1443
O2      3724
O3      3730
O7600   3751
OBLK    3716
OCHAR   3154
OCHCT   3770
OCHK    7270
OCLCHK  7330
OCLOSE  3636
OCLOSR  6555
OLNGTH  3767
OM12    5530
ONE     4716
ONMTMP  5546
OOPEN   5400
OOVER   3742
OP      3113
OPEN    7200
OPMINS  6565
OPNEXT  1622
OPNFLG  0050
OPTABL  1731
OPTR1   3765
OPTR2   3766
OPUT    5532
ORST    5425
OSETUP  3753
OTHER   7214
OUT     2463
OUTA    5536
OUTBLK  0074
OUTCR   2473
OUTDEV  0063
OUTDG   6154
OUTECH  3156
OUTHND  0100
OVER1   0043
OVER2   0047
P13     0001
P15     1264
P17     0107
P177    0106
P2000   0372
P27     6750
P277    0110
P3      2034
P337    0075
P377    2555
P40     2554
P4000   0124
P43     6310
P7600   0104
P77     0122
P7700   0101
P7740   0371
PA1     2526
PACBUF  2504
PACKC   4546
PACKST  0027
PACX    2532
PADDR   6336
PALG    5261
PARTES  2047
PATCH   7141
PBACK   1305
PC      0022
PC0     0200
PC1     0612
PCHECK  5245
PCK1    2537
PCOMGO  6423
PD2     0476
PD3     0507
PDELET  7252
PDERR   5646
PDIGIT  7121
PDLXR   0013
PEQ     6135
PER     0102
PERD    6071
PERDSW  6134
PEXIT   0022
PFRAN   0377
PGETLN  7543
PI      5312
PI2     5036
PIOT    5316
PLCE    5536
PLOT    3215
POINT   0033
POINT4  6530
POINT6  6662
POINT7  7167 unreferenced
POPA    4542
POPF    4544
POPJ    5540
PPPRNT  3125
PPRNT   2162
PPTEN   6144
PRETRN  6540
PRINTC  4551
PRINTX  3171
PRNT    2440
PRNT2   3112
PRNTI   6132
PRNTLN  4553
PROC    0607
PROCES  0606
PS8PC   2566
PSAVE   6436
PSIN    0165 unreferenced
PT1     0030
PT1D    6165
PTABLE  7162
PTEMP   0311
PTEN    6275
PTEST   1564
PUSHA   4541
PUSHB   0226
PUSHB1  0367
PUSHF   4543
PUSHJ   4537
PUTDEV  6560
PXKSF   0634
R6      5441
RANRAN  2602
RAR1    6571
RAR2    6572
RDIV    0152
RDPTR   5525
READC   4552
RECORD  6536
RECOVR  2676
RECOVX  2704 unreferenced
RECOVY  2706
REMAIN  5712
REPT    6146
RESOL   6752
RESOL3  7376
RESOL5  6304
RESOLV  7173
RESTOR  3614
RET     5452
RETRN   1557
RETRY   6231
RETURN  5535
REVIT   7146
RISZ    0016
RND2    5527
RNDM    6337
ROOTGO  7461
ROT     2561
ROUND   6151
RT      3730
RTL6    4557
RUB1    3000
RUB2    3036
RUB3    3024
RUB4    3033
RUB5    3035
RUBIT   2557
SADR    6150
SAVBLK  6504
SAVE    3751
SAVEPT  6470
SAVER   6433
SBAR    1337
SCHAR   1330
SCONT   1325
SCOUNT  5534
SECRET  4123
SECRTV  0175
SET     1041
SEX     1166
SEXC    0740
SFOUND  1343
SGOT    1347
SHNDLR  0040
SIGN    7124
SIGNF   0050
SINADD  4317
SLOT    6206
SMIN    6136
SMSP    6134
SORTB   1142
SORTC   4550
SORTCN  0054
SORTJ   4547
SP      1526
SPACE   1312
SPADD   4337
SPECIA  6777
SPLAT   3045
SPNOR   4560
SQCON1  7467
SQEND   7465
SRETN   0261
SRNLST  1361
START   0177
STARTL  5064
STARTV  0133
STBLK   0053
STVAR   3400
SUB     0232
SUBS    1515
SWAPIN  7275
T1      0032
T1S     6337
T2      0071
T3      0033
TAB     2503
TABC    1307
TABCNT  6325
TABCPT  6354
TABLE   6464
TAG1    6723
TASK    1213
TASK4   1261
TCRLF   1257
TCRLF2  1254
TDUMP   3046
TEM     5156
TEM7    0035
TEMP    4726
TEN     6271
TENPT   6152
TERMER  3137
TERMS   1770
TEST2   6736
TEST4   7366
TESTA   0350
TESTC   4564
TESTGO  7064
TESTN   4561
TESTRM  4462
TEXTP   0017
TGETC   4441
TGETLN  4502
TGO     5400
THIR    7257
THISD   6160
THISLN  0023
THISOP  0024
TINTR   1247
TLIST   1376
TLIST2  1402
TLIST3  2376
TPOPA   4442
TPOPF   4445
TPRINT  4501
TPUSHA  4443
TPUSHF  4444
TQUOT   1240
TRAD    6573
TRND    1311
TSORTJ  4446
TSPNOR  4503
TSTGRP  4563
TSTLPR  4562
TT      6136
TTAB    1265
TTYIN   5627
TTYOUT  5440
TTYTXT  6735
TWO     4721
TWOPI   5306
TYPE    1212
TYPE2   1234
US      0037
USR     0021
UTE     2275
UTQ     2304
UTRA    2273
UTX     2315
VAL     0032
VARPCH  1504
WALL    0664
WORDS   0004
WRITE   0635
WTEST2  0653
WTESTG  0667
WX      0673
X       5322
X1      5035
X133P   3136
X2      4675
XABS    2014
XCHAR   0037
XCHIN   0566
XCNTR   0020
XCT     0020
XCTIN   0062
XDELET  2062
XENDLN  2357
XFIND   2241
XFIND1  0565
XFORM   7317
XGETC   7347
XGETLN  0315
XHIGH   3232
XI33    2605
XIN     6306
XINPUT  5666
XINT    1351
XJ      3012
XKSF    2660
XOUBRK  2627
XOUTL   2617
XPOPA   0520
XPOPJ   1561
XPRNT   2423
XPRNTC  0151
XPUSHA  1354
XPUSHJ  2414
XRAN    6311
XRAR2   7365
XRESTO  5750
XRT     0011
XRT2    0012
XRTD    6343
XRTL6   0412
XSGN    7554
XSORTC  0721
XSPNOR  1515
XSQ2    4676
XSQR    5326
XSQRT   7400
XT3     0717
XTESTC  0700
XTESTN  1531
XTSBRK  2641
XTSBSV  2640
XTSPNO  6726
XYZ     2447
YBLK    5404 unreferenced
YHIGH   3225
YINT    5402
YJ      3112
Z1467   0546
Z3      0547
ZERFND  1506
ZERO    6520
ZERROR  0543
ZERSCH  1530
ZERSW   0034
ZFOUND  0550
ZLOOP   7106
ZSERCH  0525