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