/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 1

             /EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES
             /VERSION FOR ETOS WITH INTERRUPTS REMOVED



             /ASSEMBLY INSTRUCTIONS:

             /.R PAL8
             /*EFOCLC,EFOCLC<EFOC0C,EFOC1C,EFLOTB,EFOCNC,DOLLAR
             /.R ABSLDR
             /*EFOCLC,INITAL=10200$
             /.SAVE SYS EFOCLC
             /.R EFOCLC

             /(DOLLAR CONTAINS DOLLAR SIGNS TO TERMINATE THE ASSEMBLY)

             /IDENTITIES TO HELP ELIMINATE INTERRUPTS
       7000          ION=NOP
       7000          IOF=NOP




       0000          FIELD 0

       0010          *10
00010  0000  AUTO1,  0               /AUTO-INDEX REGISTERS...ACTUALLY USE SOME
00011  0000  AUTO2,  0
00012  0000  AUTO3,  0
00013  0000  AUTO4,  0
00014  0000  AUTO5,  0
00015  0000  AUTO6,  0
00016  0000  AUTO7,  0
00017  0000  AUTO8,  0
00020  0000  XCNTR,  0               /GENERAL COUNTER--SUCH AS FOR MPD2,MPD3
00021  7700  USR,    7700            /POINTER TO MONITOR (200 IF IN CORE)
00022  4577  PEXIT,  JMS I [DISMIS   /NORMAL RETURN FOR PS/8 COMMANDS
00023  6213          CDF CIF 10
00024  5425          JMP I .+1
00025  7506          GOSWITCH-3

00026  0000  NAMLOC, ZBLOCK 3
00031  0000  EXTENSION,      0               /"FC" OR "FD"
00032  0000  LISTFLG,        0
00033  0000  NEWDEV, ZBLOCK 2
00035  0000  TEM7,   0
00036  0000  ATEM,   0
00037  0066  XCHAR,  CHAR
00040  7607  SHNDLR, 7607
                     /DEFINE LOWER FIELD INSTRUCTIONS . . .

       4441          TGETC=JMS I .
00041  7347          XGETC
       4442          TPOPA=JMS I .
00042  5732          MPOPA

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 1-1

       4443          TPUSHA=JMS I .
00043  5631          MPUSHA
       4444          TPUSHF=JMS I .
00044  5656          MPD2
       4445          TPOPF=JMS I .
00045  5705          MPD3
       4446          TSORTJ=JMS I .
00046  6737          MSORTJ

00047  0000  ECHFLG, 0
00050  0000  OPNFLG, 0
00051  0000  IPNFLG, 0
00052  0000  FLNGTH, 0
00053  0000  STBLK,  0
00054  0000  DEVNO,  0
00055  0000  LIBBLK, 0               /FOR DEVICE NAME
00056  0000          0
00057  7400          7400            /LOAD POINT
00060  0000          0               /FOR DEVICE #
00061  0000  LIBHND, 0               /HANDLER ENTRY
       4462          TESTRM=JMS I .
00062  5755          MSORTC
       4463          ERROR1=JMS I .
00063  7244          ERROR
       0066          *66
00066  0000  CHAR,   0               /FOR OBSCURE FAKING REASONS

00067  0000  INBLK,  0
00070  0000          0
00071  5000          5000
00072  0000          0
00073  0000  INHND,  0

00074  0000  OUTBLK, 0
00075  0000          0
00076  5200          5200
00077  0000          0
00100  0000  OUTHND, 0

       4501          TPRINTC=JMS I .
00101  6321          MPRINTC
       4502          TGETLN=JMS I .
00102  7337          MGETLN
       4503          TSPNOR=JMS I .
00103  6726          XTSPNOR
00104  0000  LIBFIL, 0
00105  0000  DEVHLD, 0

       0200          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 2

                     /INITIAL TEXT FOR PS/8 FOCAL

       0200          *200
00200  0000  PC0,    0
00201  0000          0
00202  0000          0
00203  0000          0
00204  0000          0
00205  5051          5051
00206  0060          BUFR
00207  0224          LINE1
00210  0000  LINE0,  0
00211  0000          0
00212  0355          TEXT "C-PS/8 FOCAL, 1974"
00213  2023
00214  5770
00215  4006
00216  1703
00217  0114
00220  5440
00221  6171
00222  6764
00223  0000
       0223          *.-1
00223  7715          7715            /DUMMY CR
       0224          LINE1=.
       0400          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 3

             /PS/8 FOCAL FILE ROUTINES

       3614          *3614

03614  4503  RESTORE,TSPNOR          /'OPEN RESTORE' COMMAND
03615  1066          TAD CHAR        /SAVE COMMAND CHAR (3 WORD COMMAND!)
03616  4443          TPUSHA
03617  4441          TGETC
03620  4462          TESTRM          /GO TO END OF COMMAND WORD
03621  7610          SKP CLA
03622  5217          JMP .-3
03623  7340          CLA CLL CMA     /INITIALIZE ECHO SWITCH
03624  3047          DCA ECHFLG
03625  4576          JMS I [NAME     /JUST TO SET ECHO MODE
03626  4442          TPOPA
03627  1175          TAD [-"I        /OPEN RESTORE INPUT?
03630  7450          SNA
03631  5574          JMP I [IRST     /YES
03632  1173          TAD ["I-"O      /NO, MUST BE OUTPUT
03633  7640          SZA CLA
03634  4463          ERROR1          /NEITHER ONE!
03635  5572          JMP I [ORST

03636  0000  OCLOSE, 0               /CLOSE THE OPEN OUTPUT FILE
03637  1050          TAD OPNFLG
03640  7650          SNA CLA         /DON'T BOTHER IF IT ISN'T OPEN
03641  5636          JMP I OCLOSE
03642  1171          TAD [232        /WRITE '^Z'
03643  4265          JMS NOCHAR
03644  1365          TAD OPTR1       /PAD BUFFER WITH ZEROS
03645  1377          TAD (-4400      /(AND WRITE IT OUT)
03646  7640          SZA CLA
03647  5243          JMP .-4
03650  1105          TAD DEVHLD      /SAVED DEVICE #
03651  6212          CIF 10
03652  4421          JMS I USR
03653  0004          4
03654  5546          ONMTMP          /POINTER TO SAVED NAME
03655  0000  BLKCNT, 0               /FILE LENGTH (BLOCKS)
03656  4463          ERROR1          /HUH?
03657  3050          DCA OPNFLG      /CLEAR 'FILE OPEN' FLAG
03660  6211          CDF 10
03661  1170          TAD [XOUTL      /RESTORE TELETYPE OUTPUT ROUTINE
03662  3567          DCA I [OUTDEV
03663  6201          CDF
03664  5636          JMP I OCLOSE    /DO WHATEVER ELSE NEEDS TO BE DONE

03665  0000  NOCHAR, 0               /PS/8 3/2 BUFFERED CHARACTER OUTPUT
03666  4566          JMS I [FLDSET   /CALLED FROM EITHER FIELD
03667  3326          DCA CCIF        /SAVE CALLING FIELD
03670  6201          CDF
03671  1036          TAD ATEM        /CHARACTER TO BE OUTPUT
03672  0376          AND (377        /MASK OUT GARBAGE
03673  2330          ISZ O3          /WHICH CHAR OF THREE?
03674  5324          JMP O2          /STRAIGHT PACKING

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 3-1

03675  4330          JMS RT          /HALF WORD PACKING - PACK FIRST HALF
03676  1036          TAD ATEM        /GET SAVED ARG
03677  4330          JMS RT          /PACK SECOND HALF
03700  7346          CLA CLL CMA RTL /RESET 3-WAY SWITCH
03701  3330          DCA O3
03702  2370          ISZ OCHCT       /BUFFER CAN ONLY BE FILLED WITH 3RD CHAR OF 3
03703  5326          JMP CCIF        /NOT FULL YET, RETURN TO CALLING ROUTINE
03704  4565          JMS I [PUTDEV   /TELL THE MONITOR THIS HANDLER'S IN CORE
03705  0077                  OUTHND-1        /POINTER TO DEVICE # AND ENTRY
03706  7300          CLA CLL
03707  1367          TAD OLNGTH      /-MAXIMUM ALLOWABLE LENGTH
03710  1255          TAD BLKCNT      /LENGTH SO FAR
03711  7630          SZL CLA         /HAS HE GONE TOO FAR?
03712  5342          JMP OOVER       /YES, KILL HIM
03713  4500          JMS I OUTHND    /WRITE ONE BLOCK BUFFER
03714  4200          4200
03715  4400          4400
03716  0000  OBLK,   0
03717  5564          JMP I [DERR     /DEVICE ERROR
03720  2316          ISZ OBLK        /BUMP OUTPUT BLOCK
03721  2255          ISZ BLKCNT      /AND COUNT OF BLOCKS SO FAR
03722  4353          JMS OSETUP      /RESET POINTERS FOR NEXT BUFFER
03723  5326          JMP CCIF
03724  3765  O2,     DCA I OPTR1     /NORMAL PACKING IS EASY!
03725  2365          ISZ OPTR1       /BUMP POINTER
03726  7402  CCIF,   HLT             /FILLED WITH CIF CDF
03727  5665          JMP I NOCHAR

       3730          O3=.            /WHY NOT?
03730  0000  RT,     0               /HALF-WORD PACK ROUTINE
03731  7106          CLL RTL
03732  7006          RTL
03733  3036          DCA ATEM        /SAVE FOR SECOND HALF
03734  1036          TAD ATEM
03735  0163          AND [7400
03736  1766          TAD I OPTR2     /ADD IN CHARACTER IN RIGHT HALF
03737  3766          DCA I OPTR2     /PACK IT
03740  2366          ISZ OPTR2       /BUMP POINTER AGAIN
03741  5730          JMP I RT

03742  3050  OOVER,  DCA OPNFLG      /HE BLEW IT - KILL THE FILE!!
03743  1105          TAD DEVHLD
03744  6212          CIF 10
03745  4421          JMS I USR
03746  0004          4
03747  5546          ONMTMP
03750  0000          0               /LENGTH OF ZERO TO DELETE
03751  7600  O7600,  7600            /IGNORE ERRORS
03752  4463          ERROR1          /BECAUSE WE ALREADY KNOW ABOUT THEM

03753  0000  OSETUP, 0               /RESET ALL THE POINTERS (WHAT FUN!)
03754  1315          TAD OBLK-1
03755  3365          DCA OPTR1
03756  1315          TAD OBLK-1
03757  3366          DCA OPTR2

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 3-2

03760  7346          CLA CLL CMA RTL
03761  3330          DCA O3
03762  1351          TAD O7600
03763  3370          DCA OCHCT
03764  5753          JMP I OSETUP

03765  0000  OPTR1,  0
03766  0000  OPTR2,  0
03767  0000  OLNGTH, 0
03770  0000  OCHCT,  0

03776  0377
03777  3400
       4000          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 4

       5400          *5400

05400  4562  OOPEN,  JMS I [IOWAIT   /WAIT FOR TELETYPE TO FINISH (DECTAPES ARE SLOW!)
05401  4561          JMS I [OPEN     /CALL USR, HANDLER; ENTER OUTPUT FILE
05402  0073  YINT,           OUTBLK-1        /OUTPUT HANDLER BLOCK
05403  0003                  3       /MONITOR 'ENTER' CODE
05404  5240  YBLK,   JMP TTYOUT      /'OPEN OUTPUT TTY:'
05405  5777'         JMP OCLCHK      /ERROR ON ENTER - SEE IF FILE ALREADY OPEN
05406  4577          JMS I [DISMISS  /KICK USR OUT
05407  4444          TPUSHF          /SAVE NAME AND OTHER CRAP
05410  0026                  NAMLOC
05411  4445          TPOPF
05412  5546                  ONMTMP
05413  1053          TAD STBLK       /STARTING BLOCK
05414  3776          DCA I (OBLK
05415  1052          TAD FLNGTH      /-MAXIMUM ALLOWABLE LENGTH
05416  3775          DCA I (OLNGTH
05417  4774          JMS I (OSETUP   /SET UP PACKING POINTERS
05420  7340          CLA CLL CMA     /THERE'S A FILE OPEN!
05421  3050          DCA OPNFLG
05422  1054          TAD DEVNO       /SAVE FOR CLOSE
05423  3105          DCA DEVHLD
05424  3773          DCA I (BLKCNT   /DITTO
05425  1050  ORST,   TAD OPNFLG      /ENTRY FOR 'OPEN RESTORE OUTPUT'
05426  7650          SNA CLA         /IF 'OPEN OUTPUT', FLAG IS ALREADY SET
05427  4463          ERROR1          /NO OUTPUT FILE TO RESTORE
05430  6211          CDF 10
05431  2047          ISZ ECHFLG      /SKIP IF NO ECHO
05432  1274          TAD IBLK+2
05433  3772          DCA I (OUTECH   /SET OUTPUT ROUTINE
05434  1371          TAD (OCHAR      /POINTER TO FILE OUTPUT ROUTINE
05435  6213          CIF CDF 10
05436  3567          DCA I [OUTDEV
05437  5560          JMP I [PROC     /FINISH THE LINE
05440  1170  TTYOUT, TAD [XOUTL      /SWITCH OUTPUT TO TELETYPE (INTERRUPT)
05441  5234          JMP .-5

05442  1437  FILEST, TAD I XCHAR     /HERE'S WHERE FILES START!!
05443  3066          DCA CHAR        /GET NEXT CHAR
05444  6201          CDF
05445  1370          TAD (604        /SET '.FD' ASSUMED EXTENSION
05446  3031          DCA EXTENSION
05447  4503          TSPNOR          /SKIP SPACES
05450  1066          TAD CHAR        /SAVE COMMAND CHAR
05451  4443          TPUSHA
05452  4441          TGETC
05453  4462          TESTRM          /GO TO END OF COMMAND WORD
05454  7610          SKP CLA
05455  5252          JMP .-3
05456  4442          TPOPA
05457  4446          TSORTJ          /GO DO COMMAND
05460  6763                  FILIST-1
05461  7401                  FILGO-FILIST
05462  4463          ERROR1          /OOPS - BAD 'O' COMMAND


/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 4-1

05463  0000  ICHAR,  0               /GET A CHARACTER FROM A FILE
05464  7300          CLA CLL         /MAKE SURE
05465  2345          ISZ INCHT       /DO WE NEED ANOTHER BUFFER?
05466  5725          JMP I RDPTR     /NO, UNPACK THE CHARACTER
05467  4473          JMS I INHND     /YES, GO GET IT
05470  0200          0200
05471  4000          4000
05472  0000  IBLK,   0
05473  7700          SMA CLA         /ONLY BOTHER WITH FATAL ERRORS
05474  7610          SKP CLA
05475  5564          JMP I [DERR     /WE'VE GOT ONE
05476  2272          ISZ IBLK        /BUMP TO NEXT BLOCK
05477  1271          TAD IBLK-1      /AND RESTORE POINTERS
05500  3344          DCA IPNTR
05501  1161          TAD [7200
05502  3345          DCA INCHT
05503  1744  ICHAR1, TAD I IPNTR     /STRAIGHTFORWARD UNPACK ROUTINE
05504  4325          JMS RDPTR       /DO COMMON CRAP
05505  1744  ICHAR2, TAD I IPNTR     /SAVE LEFT HALF FOR LATER
05506  0163          AND [7400
05507  3343          DCA ITEMP
05510  2344          ISZ IPNTR       /INCREMENT TO NEXT WORD
05511  1744          TAD I IPNTR     /ANOTHER EASY ONE
05512  4325          JMS RDPTR
05513  1744  ICHAR3, TAD I IPNTR     /THIS IS THE TRICKY ONE!
05514  2344          ISZ IPNTR       /GET LOW-ORDER HALF
05515  0163          AND [7400
05516  7112          CLL RTR         /SHIFT RIGHT
05517  7012          RTR
05520  1343          TAD ITEMP       /GET HIGH-ORDER HALF (REMEMBER?)
05521  7012          RTR             /SHIFT SOME MORE
05522  7012          RTR
05523  4325          JMS RDPTR       /GOT IT!
05524  5303          JMP ICHAR1      /1-2-3-1-2-3-1-2-3 ...

05525  0000  RDPTR,  0               /IF YOU DIDN'T KNOW, THIS IS A COROUTINE!
05526  0157          AND [177        /ISN'T THAT AMAZING?
05527  7450          SNA             /IGNORE NULLS AND PARITY
05530  5264          JMP ICHAR+1
05531  1367          TAD (-32        /END OF FILE? (^Z)
05532  7440          SZA
05533  5340          JMP .+5         /NO
05534  3051          DCA IPNFLG      /YES, CLEAR OPEN FILE FLAG
05535  6211          CDF 10          /AND SET UP CLEVER KLUDGE
05536  1366          TAD (EOF        /TO CHECK FOR A STUPID
05537  3556          DCA I [INDEV    /'ATTEMPT-TO-READ-PAST-EOF'!
05540  1171          TAD [232        /PASS ^Z TO PROGRAM (MIGHT COME IN HANDY)
05541  6213          CIF CDF 10
05542  5663          JMP I ICHAR

05543  0000  ITEMP,  0
05544  0000  IPNTR,  0
05545  0000  INCHT,  0
05546  0000  ONMTMP, ZBLOCK 4


/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 4-2

05566  3145
05567  7746
05570  0604
05571  3154
05572  3156
05573  3655
05574  3753
05575  3767
05576  3716
05577  7330
       5600          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 5

05600  4562  IOPEN,  JMS I [IOWAIT   /WAIT FOR TELETYPE (DECTAPES ARE STILL SLOW!)
05601  4561          JMS I [OPEN     /CALL THAT AMAZING GENERAL-PURPOSE SUBROUTINE
05602  0066                  INBLK-1
05603  0002                  2       /MONITOR 'LOOKUP'
05604  5227          JMP TTYIN       /'OPEN INPUT TTY:'
05605  4463          ERROR1          /WHOOPS - FILE NOT FOUND
05606  4577          JMS I [DISMISS  /BOOT THE USR OUT
05607  1053          TAD STBLK       /SET POINTERS AND OTHER CRAP
05610  3777          DCA I (IBLK
05611  7340          CLA CLL CMA
05612  3051          DCA IPNFLG
05613  7340          CLA CLL CMA
05614  3776          DCA I (INCHT
05615  1051  IRST,   TAD IPNFLG      /'OPEN RESTORE INPUT' COMES HERE
05616  7650          SNA CLA         /FLAG IS SET ALREADY IF 'OPEN INPUT'
05617  4463          ERROR1          /NO INPUT FILE TO RESTORE
05620  1375          TAD (ICHARF     /SET I/O POINTERS
05621  6213          CIF CDF 10
05622  3556          DCA I [INDEV
05623  2047          ISZ ECHFLG      /AND ECHO MODE
05624  1155          TAD [NOP
05625  3554          DCA I [PPRNT
05626  5560          JMP I [PROC
05627  1153  TTYIN,  TAD [XI33       /'OPEN INPUT TTY:'
05630  5220          JMP TTYIN-7

05631  0000  MPUSHA, 0               /PUSH THE AC ON THE STACK
05632  4343          JMS FLDSET      /CALLED FROM EITHER FIELD
05633  3254          DCA ACDF
05634  6211          CDF 10          /DO SOME CRAZY, MIXED-UP POINTER SCRAMBLING
05635  1774          TAD I (PDLXR
05636  3035          DCA TEM7
05637  7040          CMA
05640  1035          TAD TEM7
05641  3774          DCA I (PDLXR
05642  1035          TAD TEM7
05643  7141          CIA CLL
05644  1552          TAD I [BUFR
05645  7630          SZL CLA
05646  4463  PDERR,  ERROR1          /PUSHDOWN OVERFLOW
05647  1774          TAD I (PDLXR
05650  6201          CDF
05651  3011          DCA AUTO2
05652  1036          TAD ATEM
05653  3435          DCA I TEM7
05654  6203  ACDF,   CIF CDF
05655  5631          JMP I MPUSHA

05656  0000  MPD2,   0               /PUSH 4 WORDS ON THE STACK
05657  1656          TAD I MPD2      /GET POINTER TO FIRST WORD
05660  1151          TAD [3          /PUSH IN REVERSE ORDER
05661  3305          DCA MPD3
05662  2256          ISZ MPD2
05663  4343          JMS FLDSET
05664  3270          DCA FCDF

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 5-1

05665  6201          CDF
05666  1150          TAD [-4
05667  3020          DCA XCNTR
05670  7402  FCDF,   HLT             /CHANGE FIELD TO CALLING FIELD
05671  1705          TAD I MPD3      /GET THE NEXT WORD
05672  6203          CIF CDF
05673  4231          JMS MPUSHA      /PUSH IT
05674  7340          CLA CLL CMA     /BACK UP POINTER
05675  1305          TAD MPD3
05676  3305          DCA MPD3
05677  2020          ISZ XCNTR
05700  5270          JMP FCDF        /GET THE NEXT ONE
05701  1270          TAD FCDF
05702  3303          DCA .+1
05703  0000          0               /RESTORE CALLING FIELD
05704  5656          JMP I MPD2

05705  0000  MPD3,   0               /POP 4 WORDS
05706  7340          CLA CLL CMA     /GET POINTER-1
05707  1705          TAD I MPD3
05710  3012          DCA AUTO3
05711  2305          ISZ MPD3
05712  1373          TAD (CDF
05713  6214          RDF
05714  3321          DCA FCIF
05715  1150          TAD [-4         /FOUR WORDS
05716  3020          DCA XCNTR
05717  6201          CDF
05720  4332          JMS MPOPA       /GET ONE
05721  6201  FCIF,   CDF
05722  3412          DCA I AUTO3     /PUT IT AWAY
05723  2020          ISZ XCNTR       /ALL DONE?
05724  5317          JMP FCIF-2      /NO, GET ANOTHER
05725  7326          CLL CLA CML RTL /YES, CHANGE CDF TO CIF CDF
05726  1321          TAD FCIF
05727  3330          DCA .+1
05730  0000          0               /CHANGE FIELD AND EXIT
05731  5705          JMP I MPD3

05732  0000  MPOPA,  0               /POP A WORD
05733  4343          JMS FLDSET      /(THIS ONE'S EASY)
05734  3341          DCA ACIF
05735  6211          CDF 10
05736  2774          ISZ I (PDLXR
05737  6201          CDF
05740  1411          TAD I AUTO2
05741  6203  ACIF,   CIF CDF
05742  5732          JMP I MPOPA

05743  0000  FLDSET, 0
05744  3036          DCA ATEM
05745  1272          TAD FCDF+2
05746  6214          RDF
05747  5743          JMP I FLDSET


/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 5-2

05750  1032  XRESTOR,TAD LISTFLG     /PART OF ERROR ROUTINE TO
05751  7640          SZA CLA         /RESET I/O TO CONSOLE TERMINAL AND
05752  4772'         JMS SWAPIN      /RESTORE CORE SWAPPED BY DIRECTORY
05753  6213          CIF CDF 10      /LISTING
05754  5771'         JMP RECOVY

05755  0000  MSORTC, 0               /CHECK FOR TERMINATOR
05756  6213          CIF CDF 10
05757  4547          JMS I [TERMER
05760  2355          ISZ MSORTC
05761  5755          JMP I MSORTC

05771  2652
05772  7275
05773  6201
05774  0013
05775  3126
05776  5545
05777  5472
       6000          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 6

             /LIBRARY COMMAND PROCESSOR

                     /****** STORAGE ALLOCATION MAP ******
                     /*****                          *****
                     /*      3600    FILES (OUTPUT AND RESTORE)
                     /*      4000    INPUT BUFFER (PAGE 1)
                     /*      4200    INPUT BUFFER (PAGE 2)
                     /*      4400    OUTPUT BUFFER (PAGE 1)
                     /*      4600    OUTPUT BUFFER (PAGE 2)
                     /*      5000    INPUT HANDLER
                     /*      5200    OUTPUT HANDLER
                     /*      5400    FILES (INPUT AND OPEN)
                     /*
                     /*      5600    PUSHDOWN LIST CONTROLS
                     /*      6000    NAME, GTMON, DISMISS, IOWAIT
                     /*      6200    HANDAD, COMPARE
                     /*      6400    LOWLIB, SAVER, RETURN
                     /*      6600    CHAINER, FETCHER, GOSUB
                     /*      7000    LIBRARIAN
                     /*      7200    MISCELLANEOUS
                     /*      7400    LIBRARY HANDLER
                     /*****                          *****
                     /************************************




06000  0000  NAME,   0               /READ A DEV:FILENAME.EX STRING INTO 'NAMLOC' & 'NEWDEV'
06001  4352          JMS DISMIS      /'GETC' WON'T WITH THE USR IN CORE
06002  1377          TAD (5723       /CODE FOR 'DSK:'
06003  3033          DCA NEWDEV      /(DEFAULT DEVICE)
06004  3034          DCA NEWDEV+1
06005  4216          JMS GNAME       /GET FIRST PART (MIGHT BE DEVICE)
06006  1146          TAD ["A-":      /WAS IT A DEVICE?
06007  7640          SZA CLA
06010  5600          JMP I NAME      /NO, ALL SET UP
06011  4441          TGETC           /YES, MOVE PAST ':'
06012  1026          TAD NAMLOC      /MOVE TO DEVICE AREA
06013  3033          DCA NEWDEV
06014  1027          TAD NAMLOC+1
06015  5204          JMP NAME+4      /GET FILENAME

06016  0000  GNAME,  0               /READ A NAME INTO 'NAMLOC'
06017  3026          DCA NAMLOC      /CLEAR NAME AREA
06020  3027          DCA NAMLOC+1    /(DON'T CLEAR ASSUMED EXTENSION)
06021  3030          DCA NAMLOC+2
06022  1145          TAD [NAMLOC     /INITIALIZE POINTERS
06023  3333          DCA NMBASE
06024  7240          CLA CMA
06025  3334          DCA PERDSW
06026  3335          DCA NAMECT
06027  4503          TSPNOR
06030  7410          SKP
06031  4441  NAMEC,  TGETC           /MAIN LOOP
06032  1066          TAD CHAR        /LOWER FIELD COPY, OF COURSE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 6-1

06033  1144          TAD [-".        /EXTENSION?
06034  7450          SNA
06035  5271          JMP PERD        /YES, CLEAR DEFAULT EXTENSION
06036  1143          TAD [".-",      /COMMA?
06037  7650          SNA CLA
06040  5302          JMP ECHCHK      /YES, CHECK FOR ECHO
06041  4316  ECHGO,  JMS DECODE      /MUST BE A-Z, 0-9
06042  5616          JMP I GNAME     /IT WASN'T, MUST BE END OF NAME
06043  7430          SZL             /RESTORE CHARACTER
06044  1142          TAD [57
06045  7001          IAC
06046  3316          DCA DECODE      /TEMPORARY STORAGE
06047  1335          TAD NAMECT      /NO MORE THAN 6 CHARACTERS/NAME
06050  1173          TAD [-6
06051  7700          SMA CLA
06052  5231          JMP NAMEC
06053  1335          TAD NAMECT      /BUILD POINTER TO CHARACTER POSITION
06054  7110          CLL RAR
06055  1333          TAD NMBASE
06056  3336          DCA TT
06057  1316          TAD DECODE      /LEFT OR RIGHT HALF?
06060  7430          SZL
06061  5265          JMP .+4
06062  7106          CLL RTL         /LEFT, SHIFT OVER
06063  7006          RTL
06064  7006          RTL
06065  1736          TAD I TT        /ADD IN OTHER HALF
06066  3736          DCA I TT
06067  2335          ISZ NAMECT      /BUMP COUNT
06070  5231          JMP NAMEC       /CONTINUE LOOP

06071  1026  PERD,   TAD NAMLOC      /FOUND A PERIOD IN STRING
06072  7640          SZA CLA
06073  2334          ISZ PERDSW
06074  4463          ERROR1          /DOUBLE PERIODS OR NO FILE NAME
06075  3031          DCA EXTENSION   /CLEAR EXTENSION
06076  4441          TGETC           /MOVE PAST PERIOD
06077  2333          ISZ NMBASE      /FAKE OUT POINTERS
06100  1141          TAD [4
06101  5226          JMP NAMEC-3

06102  4441  ECHCHK, TGETC           /MOVE PAST COMMA
06103  4503          TSPNOR
06104  1066          TAD CHAR        /MUST BE FOLLOWED BY 'ECHO'
06105  1140          TAD [-"E
06106  7640          SZA CLA
06107  5616          JMP I GNAME
06110  3047          DCA ECHFLG      /SET ECHO FLAG
06111  4441          TGETC           /MOVE TO END OF WORD
06112  4316          JMS DECODE
06113  5616          JMP I GNAME
06114  7300          CLA CLL
06115  5311          JMP .-4

06116  0000  DECODE, 0               /CHECK FOR A-Z, 0-9

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 6-2

06117  1066          TAD CHAR
06120  1137          TAD [-"9-1
06121  7100          CLL
06122  1136          TAD ["9+1-"0
06123  7430          SZL
06124  5331          JMP DCDYES
06125  1135          TAD ["0-"Z-1
06126  7120          CLL CML
06127  1134          TAD ["Z-"A+1
06130  7420          SNL
06131  2316  DCDYES, ISZ DECODE      /IT WAS!
06132  5716          JMP I DECODE

06133  0000  NMBASE, 0
06134  0000  PERDSW, 0
06135  0000  NAMECT, 0
06136  0000  TT,     0

06137  0000  IOWAIT, 0               /WAIT FOR TELETYPE TO FINISH
06140  6041          TSF
06141  5340          JMP .-1
06142  5737          JMP I IOWAIT

06143  0000  GTMON,  0               /LOCK THE USR IN CORE
06144  6212          CIF 10          /(NOP IF ALREADY IN CORE)
06145  4421          JMS I USR
06146  0010          10
06147  1133          TAD [200        /SET POINTER FOR LATER CALLS
06150  3021          DCA USR
06151  5743          JMP I GTMON

06152  0000  DISMIS, 0               /IF THE USR IS IN, KICK IT OUT
06153  7300          CLA CLL
06154  1021          TAD USR         /CHECK POINTER TO FIND OUT
06155  7710          SPA CLA
06156  5752          JMP I DISMIS
06157  6212          CIF 10
06160  4421          JMS I USR
06161  0011          11
06162  1251          TAD ECHGO+10    /RESET POINTER
06163  3021          DCA USR
06164  5752          JMP I DISMIS

06177  5723
       6200          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 7

06200  0000  HANDAD, 0               /LOADS HANDLER INTO PROPER SLOT
06201  1600          TAD I HANDAD    /WHICH SLOT?
06202  2200          ISZ HANDAD
06203  3206          DCA SLOT
06204  4276          JMS COMPARE     /IF THE HANDLER HAS THE SAME NAME,
06205  7776                  -2      /DON'T LOAD IT AGAIN
06206  0000  SLOT,           0
06207  0032                  NEWDEV-1
06210  5221          JMP NOTEQ       /DIFFERENT NAMES, LOAD NEW HANDLER
06211  2014          ISZ AUTO5
06212  1414          TAD I AUTO5     /(SET BY 'COMPARE')
06213  3054          DCA DEVNO       /MOVE DEVICE # (FOR SAVE AND CLOSE)
06214  1014          TAD AUTO5       /POINTS TO DEVICE #
06215  3217          DCA .+2
06216  4565          JMS I [PUTDEV   /SO USR KNOWS IT'S IN CORE
06217  0000                  0
06220  5600          JMP I HANDAD

06221  2206  NOTEQ,  ISZ SLOT        /BUMP POINTER TO SAVE NAME
06222  1033          TAD NEWDEV      /MOVE NEW DEVICE NAME TO TABLE
06223  3606          DCA I SLOT
06224  2206          ISZ SLOT
06225  1034          TAD NEWDEV+1
06226  3606          DCA I SLOT
06227  2206          ISZ SLOT
06230  4532          JMS I [GTMON    /WE MUST CALL THE USR, MIGHT AS WELL LOCK IT IN
06231  1033  RETRY,  TAD NEWDEV      /MOVE DEVICE NAME FOR MONITOR CALL
06232  3242          DCA DEVC
06233  1034          TAD NEWDEV+1
06234  3243          DCA DEVC+1
06235  1606          TAD I SLOT      /MOVE LOAD POINT
06236  3244          DCA DLOAD
06237  6212          CIF 10
06240  4421          JMS I USR       /CALL MONITOR (ALREADY IN CORE)
06241  0001          1
06242  0000  DEVC,   0
06243  0000          0
06244  0000  DLOAD,  0
06245  4463          ERROR1          /DEVICE NOT AVAILABLE OR TWO PAGE HANDLER
06246  7100          CLL
06247  1244          TAD DLOAD       /ENTRY POINT FOR HANDLER
06250  1133          TAD [200        /IF THIS HANDLER IS IN PAGE 7600,
06251  7630          SZL CLA         /DON'T BOTHER TO CHECK FOR LEGALITY
06252  5265          JMP HANDOK      /SYSTEM HANDLER
06253  1244          TAD DLOAD       /IF THE HANDLER WAS NOT LOADED
06254  0131          AND [7600       /INTO THE PROPER PAGE, RELOAD IT!
06255  7141          CLL CIA
06256  1606          TAD I SLOT      /PROPER LOADING ADDRESS
06257  7650          SNA CLA
06260  5265          JMP HANDOK      /EVERYTHING'S ALL RIGHT
06261  3244          DCA DLOAD       /CLEAR ENTRY POINT
06262  4565          JMS I [PUTDEV   /TELL USR THE HANDLER IS NOT
06263  6243                  DEVC+1  /IN CORE ANYMORE
06264  5231          JMP RETRY       /LOAD IT THIS TIME


/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 7-1

06265  2206  HANDOK, ISZ SLOT        /BUMP POINTER TO DEVICE #
06266  1243          TAD DEVC+1      /SAVE IT
06267  3606          DCA I SLOT
06270  2206          ISZ SLOT        /MOVE TO ENTRY POINT
06271  1244          TAD DLOAD       /SAVE ENTRY
06272  3606          DCA I SLOT
06273  1243          TAD DEVC+1      /GET DEVICE #
06274  3054          DCA DEVNO       /SAVE IT AND EXIT
06275  5600          JMP I HANDAD

06276  0000  COMPARE,0               /COMPARE TWO BLOCKS OF INDEFINITE LENGTH
06277  1676          TAD I COMPARE   /CALLING SEQUENCE:
06300  2276          ISZ COMPARE     /JMS COMPARE
06301  3020          DCA XCNTR       /       -# OF WORDS TO CHECK
06302  1676          TAD I COMPARE   /       FIRST-1
06303  2276          ISZ COMPARE     /       SECOND-1
06304  3014          DCA AUTO5       /RETURN IF MATCH
06305  1676          TAD I COMPARE   /RETURN IF NO MATCH
06306  2276          ISZ COMPARE
06307  3015          DCA AUTO6
06310  1414  AGAIN,  TAD I AUTO5     /COMPARE TWO WORDS
06311  7041          CIA
06312  1415          TAD I AUTO6
06313  7640          SZA CLA
06314  5676          JMP I COMPARE   /NO MATCH
06315  2020          ISZ XCNTR       /FINISHED?
06316  5310          JMP AGAIN       /NO, CHECK NEXT TWO
06317  2276          ISZ COMPARE     /YES, BUMP RETURN POINTER
06320  5676          JMP I COMPARE

06321  0000  MPRINTC,0               /CROSS-FIELD 'PRINTC'
06322  6213          CIF CDF 10
06323  4777          JMS I (CPRNT
06324  5721          JMP I MPRINTC

06325  0000  TABCNT, 0               /TAB COUNTER (ONLY PRINTING CHARACTERS)
06326  1376          TAD (-15        /7-BIT CR MEANS RETURN ONLY
06327  7450          SNA
06330  5344          JMP CRONLY
06331  1131          TAD [-200       /CHECK FOR CR
06332  7450          SNA
06333  5352          JMP NEWLIN      /TYPE CR,LF
06334  2325          ISZ TABCNT
06335  1375          TAD (215-240
06336  7500          SMA
06337  2754          ISZ I TABCPT    /IT PRINTS, INCREMENT COUNT
06340  7000          NOP             /IT JUST MIGHT SKIP
06341  1130          TAD [240
06342  6212          CIF 10
06343  5725          JMP I TABCNT

06344  1127  CRONLY, TAD [215
06345  6212          CIF 10
06346  4526          JMS I [PRINTX
06347  3754          DCA I TABCPT

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 7-2

06350  1133          TAD [200        /NULL FOR DELAY
06351  5326          JMP TABCNT+1

06352  3754  NEWLIN, DCA I TABCPT
06353  5342          JMP CRONLY-2

06354  1305  TABCPT, TABC

06355  0323  COMLIST,"S              /SAVE
06356  0303          "C              /CALL
06357  0322          "R              /RUN
06360  0314          "L              /LIST
06361  0304          "D              /DELETE
06362  0307          "G              /GOSUB
06363  0240          "               /FAKE A 'LIBRARY RETURN' WITH A SPACE
06364  0305          "E              /EXIT

06365  5600  FILGO,  IOPEN
06366  5400          OOPEN
06367  6555          OCLOSR
06370  3614          RESTOR

06375  7755
06376  7763
06377  7535
       6400          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 8

                     /ACTUAL LIBRARY PROCESSOR
                     /STARTING WITH COMMAND DECODE:

06400  6211  LOWLIB, CDF 10          /CLEAR SWITCH FOR NORMAL RETURN
06401  3525          DCA I [GOSWITCH /I.E. TO 'PROC' FOR REST OF LINE
06402  1437          TAD I XCHAR     /MOVE CURRENT CHARACTER DOWN
06403  6201          CDF
06404  3066          DCA CHAR
06405  1066          TAD CHAR        /SAVE FOR COMMAND SORT
06406  4443          TPUSHA
06407  1124          TAD [603        /'.FC' ASSUMED EXTENSION
06410  3031          DCA EXTENSION
06411  7610          SKP CLA         /MIGHT BE A TERMINATOR ALREADY
06412  4441          TGETC           /MOVE TO END OF COMMAND WORD
06413  4462          TESTRM
06414  7410          SKP
06415  5212          JMP .-3
06416  4442          TPOPA           /RESTORE COMMAND CHAR
06417  4446          TSORTJ          /AND BRANCH TO APPROIATE ROUTINE
06420  6354                  COMLIST-1
06421  0046                  PCOMGO-COMLIST
06422  4463          ERROR1          /SORRY, CHARLIE!

06423  6433  PCOMGO, SAVER
06424  6602          FETCHER
06425  6600          CHAINER
06426  7000          LIBRARIAN
06427  7252          PDELET
06430  6701          GOSUB
06431  6540          PRETRN
06432  7600  C7600,  7600

06433  4576  SAVER,  JMS I [NAME     /GET NAME FOR SAVE
06434  4236          JMS PSAVE       /DO IT
06435  5022          JMP PEXIT       /EASY, WASN'T IT?

06436  0000  PSAVE,  0               /CALLED BY 'SAVE' AND 'GOSUB'
06437  4777'         JMS OCHK        /CLOSE OUTPUT FILE TO AVOID TROUBLE
06440  1145          TAD [NAMLOC     /POINTER TO NAME
06441  3270          DCA SAVEPT
06442  6211          CDF 10
06443  1552          TAD I [BUFR     /GET PROGRAM LENGTH
06444  6201          CDF
06445  3523          DCA I [207      /SAVE IT WITH THE PROGRAM
06446  4532          JMS I [GTMON    /CALL THE MONITOR
06447  4522          JMS I [HANDAD   /AND THE HANDLER
06450  0054                  LIBBLK-1
06451  1523          TAD I [207      /SAVED LENGTH, REMEMBER?
06452  0232          AND C7600       /MASK OFF
06453  7110          CLL RAR         /CONVERT TO PAGES
06454  3337          DCA BLOCK       /FOR HANDLER
06455  1337          TAD BLOCK       /ROUND UP TO BLOCKS
06456  1121          TAD [100
06457  0232          AND C7600
06460  7112          CLL RTR

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 8-1

06461  7010          RAR
06462  3336          DCA RECORD      /FOR MONITOR 'ENTER'
06463  1336          TAD RECORD      /GET DESIRED LENGTH
06464  1054          TAD DEVNO       /(SET BY 'HANDAD')
06465  6212          CIF 10
06466  4421          JMS I USR       /ENTER OUTPUT FILE
06467  0003          3
06470  0026  SAVEPT, NAMLOC
06471  0000          0
06472  4463          ERROR1          /NO ROOM ON DEVICE
06473  1336          TAD RECORD      /SHIFT FOR CLOSING LENGTH
06474  7112          CLL RTR
06475  7012          RTR
06476  3304          DCA SAVBLK
06477  1054          TAD DEVNO       /CLOSE THE FILE BEFORE WE WRITE IT!
06500  6212          CIF 10          /(SURE, IT'S CHEATING, BUT
06501  4421          JMS I USR       /IT SAVES TIME!)
06502  0004          4
06503  0026          NAMLOC
06504  0000  SAVBLK, 0
06505  4463          ERROR1          /IMPOSSIBLE ERROR!
06506  1304          TAD SAVBLK      /SAVE THIS CRAP TO REMEMBER
06507  7041          CIA             /WHERE THIS PROGRAM IS
06510  3333          DCA LIBLEN      /IN CASE WE WANT TO GOSUB
06511  1270          TAD SAVEPT
06512  3104          DCA LIBFIL
06513  1033          TAD NEWDEV
06514  3334          DCA LIBDEV
06515  1034          TAD NEWDEV+1
06516  3335          DCA LIBDEV+1
06517  1270          TAD SAVEPT      /MOVE STARTING BLOCK FOR WRITE
06520  3330          DCA POINT4
06521  7130          CLL CML RAR     /COMPUTE FUNCTION WORD
06522  7001          IAC             /SET TO SEARCH FORWARD
06523  1337          TAD BLOCK       /HOW MUCH TO WRITE
06524  3326          DCA BLLL
06525  4461          JMS I LIBHND
06526  0000  BLLL,   0               /WRITE (BLOCK) BLOCKS FROM FIELD 0
06527  0200          200             /FROM 200 UP
06530  0000  POINT4, 0
06531  5564          JMP I [DERR     /GO COMPLAIN ABOUT DEVICE
06532  5636          JMP I PSAVE

06533  0000  LIBLEN, 0
06534  0000  LIBDEV, ZBLOCK 2
06536  0000  RECORD, 0
06537  0000  BLOCK,  0

06540  4442  PRETRN, TPOPA           /GET BACK ALL THE JUNK WE SAVED
06541  6211          CDF 10          /FOR THE LAST GOSUB
06542  3437          DCA I XCHAR     /IN-LINE CHARACTER
06543  6201          CDF
06544  4445          TPOPF           /DEVICE NAME
06545  0033                  NEWDEV
06546  4442          TPOPA           /FILE LENGTH

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 8-2

06547  3052          DCA FLNGTH
06550  4442          TPOPA           /STARTING BLOCK
06551  3053          DCA STBLK
06552  4522          JMS I [HANDAD   /GET THE HANDLER BACK
06553  0054                  LIBBLK-1
06554  5776'         JMP LOADGO      /LOAD THE PROGRAM

06555  4520  OCLOSR, JMS I [OCLOSE   /CLOSE OUTPUT FILE
06556  6213          CIF CDF 10
06557  5560          JMP I [PROC     /ANOTHER EASY ONE!

06560  0000  PUTDEV, 0               /TELL THE MONITOR A HANDLER IS IN OR OUT
06561  1760          TAD I PUTDEV    /GET POINTER TO DEV # AND ENTRY
06562  3336          DCA RECORD
06563  1736          TAD I RECORD    /DEVICE #
06564  2336          ISZ RECORD      /BUMP POINTER TO ENTRY
06565  1375          TAD (7646       /MONITOR TABLE
06566  3337          DCA BLOCK       /POINTER TO 'HANDLER-IN-CORE' FLAG
06567  1736          TAD I RECORD    /FLAG IS HANDLER ENTRY
06570  6211          CDF 10          /TABLE IS IN FIELD 1
06571  3737          DCA I BLOCK
06572  6201          CDF
06573  2360          ISZ PUTDEV
06574  5760          JMP I PUTDEV

06575  7646
06576  6620
06577  7270
       6600          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 9

                     /LOOKUP AND LOAD ROUTINES

06600  7001  CHAINER,IAC             /THESE ALL DO THE SAME THING
06601  7001  GOSUB1, IAC             /AND THEN GO TO DIFFERENT PLACES
06602  7001  FETCHER,IAC
06603  6211          CDF 10
06604  3525          DCA I [GOSWITCH
06605  6201          CDF
06606  4561  LOAD,   JMS I [OPEN     /CALL THE HANDLER AND LOOKUP THE FILE
06607  0054                  LIBBLK-1
06610  0002                  2
06611  5216          JMP .+5         /TTY: NOT A DIRECTORY DEVICE
06612  4463          ERROR1
06613  4577          JMS I [DISMISS
06614  4777          JMS I (GETDEV   /GET DEVICE TYPE
06615  7700          SMA CLA
06616  4463          ERROR1          /NOT A DIRECTORY DEVICE
06617  4502          TGETLN          /SOME COMMANDS HAVE LINE NUMBERS
06620  4577  LOADGO, JMS I [DISMISS  /ONLY USED BY 'RETURN'
06621  1053          TAD STBLK       /BLOCK TO READ FROM
06622  3262          DCA POINT6
06623  1011          TAD AUTO2       /GET PUSHDOWN POINTER
06624  1131          TAD [-200       /DIDDLE IT
06625  0131          AND [7600
06626  7104          CLL RAL
06627  7006          RTL
06630  7006          RTL
06631  1052          TAD FLNGTH      /NOW COMPARE WITH LENGTH OF FILE
06632  7710          SPA CLA
06633  5776'         JMP PDERR       /PROGRAM TOO LONG
06634  6211          CDF 10
06635  7344          CLA CLL CMA RAL /(=-2)
06636  1525          TAD I [GOSWITCH /IS THIS A GOSUB?
06637  7640          SZA CLA
06640  5247          JMP .+7         /NO, SKIP THIS GARBAGE
06641  1437          TAD I XCHAR     /YES, SAVE PROGRAM NAME, ETC.
06642  6201          CDF
06643  4443          TPUSHA
06644  1127          TAD [215
06645  6211          CDF 10
06646  3437          DCA I XCHAR
06647  6201          CDF
06650  1052          TAD FLNGTH      /COMPUTE FUNCTION WORD
06651  7041          CIA
06652  7106          CLL RTL
06653  7006          RTL
06654  7006          RTL
06655  7124          CLL CML RAL     /SET TO SEARCH FORWARD
06656  3260          DCA LENF1
06657  4461          JMS I LIBHND    /GET THE PROGRAM
06660  3600  LENF1,  3600
06661  0200          0200
06662  0000  POINT6, 0
06663  5564          JMP I [DERR
06664  1033          TAD NEWDEV      /SAVE THIS STUFF SO WE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 9-1

06665  3775'         DCA LIBDEV      /KNOW WHERE WE ARE
06666  1034          TAD NEWDEV+1
06667  3774'         DCA LIBDEV+1
06670  1053          TAD STBLK
06671  3104          DCA LIBFIL
06672  1052          TAD FLNGTH
06673  3773'         DCA LIBLEN
06674  1523          TAD I [207      /MOVE PROGRAM LENGTH
06675  6211          CDF 10
06676  3552          DCA I [BUFR
06677  6201          CDF
06700  5022          JMP PEXIT       /GO TO APPROPRIATE ROUTINE

06701  1104  GOSUB,  TAD LIBFIL      /CHECK FOR CURRENT PROGRAM
06702  7440          SZA
06703  5320          JMP NOSAVE      /NO NEED TO SAVE CORE
06704  4444          TPUSHF          /MOVE 'FOCAL.TM' TO NAME AREA
06705  7343                  FOCTXT
06706  4445          TPOPF
06707  0026                  NAMLOC
06710  1372          TAD (5723       /DEVICE 'DSK' FOR SAVE
06711  3033          DCA NEWDEV
06712  3034          DCA NEWDEV+1
06713  4771'         JMS PSAVE       /SAVE FILE (THIS WILL LEAVE USR IN CORE)
06714  1124          TAD [603        /RESET EXTENSION TO 'FC'
06715  3031          DCA EXTENSION
06716  4577          JMS I [DISMISS  /KICK MONITOR OUT TO SAVE STARTING BLOCK
06717  1104          TAD LIBFIL
06720  4443  NOSAVE, TPUSHA          /'LIBFIL' STILL IN AC
06721  1773'         TAD LIBLEN
06722  4443          TPUSHA
06723  4444          TPUSHF
06724  6534                  LIBDEV
06725  5201          JMP GOSUB1

06726  0000  XTSPNOR,0               /DUPLICATE UPPER FIELD ROUTINE
06727  1066          TAD CHAR
06730  1117          TAD [-240
06731  7640          SZA CLA
06732  5726          JMP I XTSPNOR
06733  4441          TGETC
06734  5327          JMP XTSPNOR+1

06735  2424  TTYTXT, DEVICE TTY      /HANDY THING TO HAVE
06736  3100

06737  0000  MSORTJ, 0               /ANOTHER DUPLICATE
06740  7041          CIA
06741  3036          DCA ATEM
06742  1737          TAD I MSORTJ
06743  2337          ISZ MSORTJ
06744  3013          DCA AUTO4
06745  1413          TAD I AUTO4
06746  7510          SPA
06747  5361          JMP MSEX

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 9-2

06750  1036          TAD ATEM
06751  7640          SZA CLA
06752  5345          JMP .-5
06753  1013          TAD AUTO4
06754  1737          TAD I MSORTJ
06755  3036          DCA ATEM
06756  1436          TAD I ATEM
06757  3036          DCA ATEM
06760  5436          JMP I ATEM

06761  2337  MSEX,   ISZ MSORTJ
06762  7300          CLA CLL
06763  5737          JMP I MSORTJ

06764  0311  FILIST, "I              /INPUT
06765  0317          "O              /OUTPUT
06766  0303          "C              /CLOSE
06767  0322          "R              /RESTORE

06771  6436
06772  5723
06773  6533
06774  6535
06775  6534
06776  5646
06777  7152
       7000          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 10

                     /THIS SECTION DOES THE DIRTY WORK OF LISTING
                     /ALL "FC"'S AND "FD"'S ON THE DEVICE REFERENCED
                     /IT WAS FUN...

07000  4576  LIBRARIAN,      JMS I [NAME     /GET DEVICE TO LIST
07001  4522          JMS I [HANDAD   /GET THE HANDLER
07002  0054                  LIBBLK-1
07003  4577          JMS I [DISMISS  /KICK OUT USR (IN CASE HANDAD CALLED IT)
07004  4352          JMS GETDEV      /FIND DEVICE TYPE
07005  7700          SMA CLA
07006  4463          ERROR1          /CAN'T LIST A NON-DIRECTORY DEVICE
07007  4440          JMS I SHNDLR    /SWAP OUT CORE TO MAKE ROOM FOR DIRECTORY
07010  4200          4200
07011  1000          1000
07012  0040          40              /SYSTEM SCRATCH AREA
07013  5564          JMP I [DERR     /WHOOPS!
07014  7201          CLA IAC         /SET FLAG TO SWAP BACK IN
07015  3032          DCA LISTFLG
07016  7301          CLL CLA IAC     /DIRECTORY BEGINS WITH BLOCK 1
07017  3223  BLOKLP, DCA LBLOCK
07020  4461          JMS I LIBHND
07021  0200          0200
07022  1000          1000
07023  0001  LBLOCK, 1
07024  5564          JMP I [DERR
07025  1377          TAD (1004       /FIRST 5 WORDS ARE INFORMATION
07026  3013          DCA AUTO4
07027  1013  LOOP2,  TAD AUTO4       /SAVE FOR LATER
07030  3017          DCA AUTO8
07031  1013          TAD AUTO4
07032  3260          DCA LIBX
07033  1413          TAD I AUTO4     /LOOKING FOR .FC & .FD FILES
07034  7650          SNA CLA
07035  5341          JMP PATCH       /ZERO FILE
07036  2013          ISZ AUTO4
07037  2013          ISZ AUTO4
07040  1413          TAD I AUTO4     /PICK UP EXTENSION
07041  3223          DCA LBLOCK
07042  1777          TAD I (1004     /WASTE WORDS (NEGATIVE)
07043  7041          CIA             /THANKS FOR TELLING US, RITCHIE
07044  1013          TAD AUTO4       /SKIP TO LENGTH
07045  3013          DCA AUTO4
07046  1413          TAD I AUTO4     /ZERO LENGTH MEANS TEMPORARY FILE
07047  7450          SNA
07050  5342          JMP LOOP3       /IGNORE SUCH THINGS
07051  7141          CLL CIA
07052  3052          DCA FLNGTH      /SAVE POSITIVE LENGTH
07053  1026          TAD NAMLOC      /IF A NAME WAS GIVEN, SEE IF WE
07054  7650          SNA CLA         /HAVE REACHED IT YET
07055  5264          JMP TESTGO      /NO NAME
07056  4516          JMS I [COMPARE  /COMPARE THIS NAME WITH ARG
07057  7774                  -4
07060  0000  LIBX,           0
07061  0025                  NAMLOC-1
07062  5342          JMP LOOP3       /NON-MATCHING

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 10-1

07063  3026          DCA NAMLOC      /WE FOUND IT, DON'T CHECK ANY MORE
07064  1223  TESTGO, TAD LBLOCK      /COMPARE EXTENSION
07065  1376          TAD (-604       /DO WE WANT THIS ONE?
07066  7440          SZA
07067  7001          IAC
07070  7640          SZA CLA
07071  5342          JMP LOOP3       /GUESS NOT
07072  7346  DIRLIST,CLA CLL CMA RTL /PRINT 3 WORDS
07073  3370          DCA COUNT
07074  1417          TAD I AUTO8/SET BEFORE THIS
07075  4775'         JMS NPACK       /PRINT 2 CHARS
07076  2370          ISZ COUNT
07077  5274          JMP .-3
07100  1374          TAD (".
07101  4501          TPRINTC
07102  1417          TAD I AUTO8     /PRINT EXTENSION
07103  4775'         JMS NPACK
07104  1373          TAD (PTABLE     /SET UP FOR DECIMAL LENGTH PRINT
07105  3033          DCA POINT
07106  3034  ZLOOP,  DCA ZERSW
07107  3370          DCA COUNT
07110  1433  NLOOP,  TAD I POINT     /FINISHED ALL POWERS OF 10?
07111  7450          SNA
07112  5336          JMP NEND        /YES, ALL DONE
07113  1052          TAD FLNGTH      /NO, SUBTRACT THIS POWER
07114  7510          SPA             /UNDERFLOW?
07115  5321          JMP PDIGIT      /YES, PRINT THIS DIGIT
07116  3052          DCA FLNGTH      /NO, GO THROUGH THE LOOP AGAIN
07117  2370          ISZ COUNT       /ADD ONE TO THIS DIGIT
07120  5310          JMP NLOOP       /ANOTHER DIVIDE CYCLE

07121  7300  PDIGIT, CLA CLL         /CRAP IN AC
07122  2033          ISZ POINT       /NEXT POWER OF TEN
07123  1370          TAD COUNT       /IF THIS DIGIT IS ZERO,
07124  2034          ISZ ZERSW       /AND NO OTHER DIGITS HAVE BEEN NON-ZERO,
07125  7440          SZA             /PRINT A SPACE INSTEAD
07126  5332          JMP NPRNT
07127  1130          TAD [240
07130  4501          TPRINTC
07131  5306          JMP ZLOOP
07132  1115  NPRNT,  TAD [260        /CHANGE TO ASCII
07133  4501          TPRINTC
07134  7340          CLA CLL CMA     /SET ZERO SWITCH
07135  5306          JMP ZLOOP
07136  1127  NEND,   TAD [215        /DONE WITH THIS LINE (WHEW!)
07137  4501          TPRINTC
07140  5342          JMP LOOP3

07141  2013  PATCH,  ISZ AUTO4       /BUMP PAST EMPTY LENGTH
07142  2622  LOOP3,  ISZ I LBLOCK-1  /DONE WITH THIS BLOCK?
07143  5227          JMP LOOP2       /NO, KEEP GOING
07144  4562  LEXIT,  JMS I [IOWAIT   /WAIT FOR I/O
07145  1514          TAD I [1002     /LINK TO NEXT BLOCK
07146  7440          SZA             /LAST BLOCK?
07147  5217          JMP BLOKLP      /NO, GET THE NEXT

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 10-2

07150  4772'         JMS SWAPIN      /YES, RESTORE SWAPPED CORE AND EXIT
07151  5022          JMP PEXIT

07152  0000  GETDEV, 0               /GET DEVICE TYPE FROM MONITOR TABLE
07153  1113          TAD [7757       /DCB-1
07154  1054          TAD DEVNO
07155  3370          DCA COUNT
07156  6211          CDF 10
07157  1770          TAD I COUNT
07160  6201          CDF
07161  5752          JMP I GETDEV

                     DECIMAL
07162  6030  PTABLE, -1000
07163  7634          -100
07164  7766          -10
07165  7777          -1
07166  0000          0
                     OCTAL

       0033          POINT=NEWDEV
       0034          ZERSW=NEWDEV+1
07167  0000  POINT7, 0
07170  0000  COUNT,  0

07172  7275
07173  7162
07174  0256
07175  7305
07176  7174
07177  1004
       7200          PAGE

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 11

                     /MISCELLANEOUS GENERAL-PURPOSE ROUTINES

                     /THIS IS THE GENERAL OPEN SUBROUTINE
                     /CALLNG SEQUENCE:
                     /JMS I [OPEN
                     /HANDLER BLOCK
                     /MONITOR CALL CODE
                     /RETURN IF TTY: IS DEVICE
                     /ERROR RETURN
                     /NORMAL RETURN
                     /SETS STBLK, FLNGTH ON PAGE ZERO

07200  0000  OPEN,   0
07201  7340          CLA CLL CMA     /INITIALIZE ECHO FLAG TO OFF
07202  3047          DCA ECHFLG
07203  4576          JMS I [NAME     /GET DEVICE AND FILENAME
07204  4516          JMS I [COMPARE  /DEVICE 'TTY:' IS SPECIAL
07205  7776                  -2
07206  0032                  NEWDEV-1
07207  6734                  TTYTXT-1
07210  5214          JMP OTHER       /DEVICE OTHER THAN TTY
07211  2200          ISZ OPEN        /INCREMENT TO PROPER RETURN
07212  2200          ISZ OPEN
07213  5600          JMP I OPEN
07214  1600  OTHER,  TAD I OPEN      /GET HANDLER BLOCK TO USE
07215  3223          DCA HND
07216  2200          ISZ OPEN
07217  1145          TAD [NAMLOC     /POINTER TO NAME
07220  3234          DCA NAMPT
07221  4532          JMS I [GTMON
07222  4522          JMS I [HANDAD   /GET THE HANDLER
07223  0000  HND,            0       /SET TO HANDLER BLOCK
07224  1600          TAD I OPEN      /GET MONITOR CALL CODE (2 OR 3)
07225  2200          ISZ OPEN
07226  3233          DCA CALL
07227  3235          DCA LNGTH       /FOR MONITOR KLUDGE (IT FALLS THROUGH ON ERROR)
07230  1054          TAD DEVNO       /DO THE CALL
07231  6212          CIF 10
07232  4421          JMS I USR
07233  0000  CALL,   0
07234  0026  NAMPT,  NAMLOC
07235  0000  LNGTH,  0
07236  5212          JMP OTHER-2     /LET THE CALLING ROUTINE DECIDE ERROR PROCEDURE
07237  1235          TAD LNGTH       /MOVE PARAMETERS TO PAGE ZERO
07240  3052          DCA FLNGTH
07241  1234          TAD NAMPT
07242  3053          DCA STBLK
07243  5211          JMP OTHER-3     /AND TAKE NORMAL RETURN

07244  0000  ERROR,  0               /LOWER FIELD ERROR ROUTINE
07245  4577          JMS I [DISMIS   /MAKE SURE
07246  1244          TAD ERROR       /FAKE OUT ERROR ROUTINE
07247  6213          CIF CDF 10      /AND GO TO IT
07250  3777          DCA I (ERR2
07251  5776          JMP I (ERR2+1

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 11-1


07252  4576  PDELET, JMS I [NAME     /DELETE IS AN EASY ONE (THANK GOD!)
07253  4532          JMS I [GTMON
07254  4522          JMS I [HANDAD
07255  0054                  LIBBLK-1
07256  4270          JMS OCHK        /CLOSE ANY OPEN OUTPUT FILE
07257  6212          CIF 10          /DELETE THE FILE
07260  1054          TAD DEVNO
07261  4421          JMS I USR
07262  0004          4
07263  0026          NAMLOC
07264  0000          0
07265  4463          ERROR1
07266  3104          DCA LIBFIL      /IN CASE HE JUST DELETED THIS PROGRAM
07267  5022          JMP PEXIT

07270  0000  OCHK,   0               /IF ANY FILE EXISTS, CLOSE IT
07271  1105          TAD DEVHLD
07272  7640          SZA CLA
07273  4775'         JMS OCLOSE
07274  5670          JMP I OCHK

07275  0000  SWAPIN, 0               /RESTORE CORE AFTER DIRECTORY LIST
07276  3032          DCA LISTFLG
07277  4440          JMS I SHNDLR
07300  0200          200
07301  1000          1000
07302  0040          40
07303  4463  DERR,   ERROR1          /DEVICE ERROR
07304  5675          JMP I SWAPIN

07305  0000  NPACK,  0               /STANDARD 6-BIT UNPACK ROUTINE
07306  3270          DCA OCHK
07307  1270          TAD OCHK
07310  7012          RTR
07311  7012          RTR
07312  7012          RTR
07313  4317          JMS XFORM
07314  1270          TAD OCHK
07315  4317          JMS XFORM
07316  5705          JMP I NPACK

07317  0000  XFORM,  0
07320  0112          AND [77
07321  7440          SZA             /PRINT SPACES FOR NULLS
07322  1374          TAD (-40
07323  7510          SPA
07324  1121          TAD [100
07325  1130          TAD [240
07326  4501          TPRINTC
07327  5717          JMP I XFORM

07330  1050  OCLCHK, TAD OPNFLG      /MAKE 'OPEN OUTPUT' WITH AN ALREADY OPEN FILE
07331  7650          SNA CLA         /THE SAME AS 'OUTPUT CLOSE;OPEN OUTPUT'
07332  4463          ERROR1

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 11-2

07333  4775'         JMS OCLOSE
07334  1373          TAD (YINT       /FAKE OUT 'OPEN'
07335  3200          DCA OPEN
07336  5214          JMP OTHER

07337  0000  MGETLN, 0               /CROSS-FIELD FAKE
07340  6213          CIF CDF 10
07341  4772          JMS I (PGETLN
07342  5737          JMP I MGETLN

07343  0617  FOCTXT, FILENAME FOCAL.TM       /USED BY 'GOSUB'
07344  0301
07345  1400
07346  2415

07347  0000  XGETC,  0               /ANOTHER FAKE
07350  6213          CIF CDF 10
07351  4771          JMS I (MGETC
07352  1437          TAD I XCHAR
07353  6201          CDF
07354  3066          DCA CHAR
07355  5747          JMP I XGETC

07356  7300  RESTART,        CLA CLL         /ETOS RESTART ROUTINE
07357  6213          CIF CDF 10
07360  5761          JMP I .+1
07361  2645          RECOVR

07371  5774
07372  7541
07373  5402
07374  7740
07375  3636
07376  2642
07377  2641
       7400          PAGE

00112  0077
00113  7757
00114  1002
00115  0260
00116  6276
00117  7540
00120  3636
00121  0100
00122  6200
00123  0207
00124  0603
00125  7511
00126  3171
00127  0215
00130  0240
00131  7600
00132  6143
00133  0200

/EFOC0C -- PS/8 FOCAL LIBRARY ROUTINES    PAL8-V9H  08/28/75  PAGE 11-3

00134  0032
00135  7725
00136  0012
00137  7506
00140  7473
00141  0004
00142  0057
00143  0002
00144  7522
00145  0026
00146  0007
00147  3137
00150  7774
00151  0003
00152  0060
00153  2612
00154  2171
00155  7000
00156  0064
00157  0177
00160  0607
00161  7200
00162  6137
00163  7400
00164  7303
00165  6560
00166  5743
00167  0063
00170  2624
00171  0232
00172  5425
00173  7772
00174  5615
00175  7467
00176  6000
00177  6152
       0001          FIELD 1

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 12

             /EFOC1C -- PS/8 FOCAL MAIN INTERPRETER


             /THIS VERSION OF PS/8 FOCAL WAS DERIVED FROM THE FOLLOWING
             /       FOCAL-8 SOURCE:

             /***********************************************************************
             /DEC-8E-LFOCA-A-LA1

             /OCTOBER 1971                   RM/SM

             /COPYRIGHT 1971 DIGITAL EQUIPMENT CORPORATION
             /       MAYNARD, MASSACHUSETTS 01754

             /FOCAL IS A REGISTERED TRADEMARK OF
             /DIGITAL EQUIPMENT CORPORATION

             /FOCAL-8 IS AN ON-LINE FORMULA CALCULATOR AND
             /COMPILER FOR STATEMENTS IN ALGEBRAIC LANGUAGE
             /THIS VERSION OF FOCAL-8 IS SUPPORTED ON THE PDP-8/E

             /***********************************************************************

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 13


             /NOTES ON LISTING COMMENTS:

             /THE LIMITS OF PAGE BOUNDARY WANDERING ARE DENOTED BY:

             /-------------------------------------------------------------------
             /PAGE BOUNDARY
             /------------------------------------------------------------------

             /LOCATIONS OVERLAYED BY THE 8K OVERLAY ARE DENOTED BY     /*8K*

             /PSEUDO-FLOATING POINT INSTRUCTIONS

       5000  FIXMRI FPOW=5000
       1000  FIXMRI FADD=1000
       2000  FIXMRI FSUB=2000
       4000  FIXMRI FMUL=4000
       3000  FIXMRI FDIV=3000
       0000  FIXMRI FGET=0000
       6000  FIXMRI FPUT=6000

       7000  FNOR=7000
       0000  FEXT=0
       0000  FXIT=0
       4407  FINT=JMS I 7
       4407  FENT=JMS I 7
       6014  RFC=6014
       6101  SMP=6101
       6030  KCF=6030
       6601  DCMA=6601

       4451  NEGATE=JMS I 51

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 14



       0001          FIELD 1

             /MISCELLANEOUS ITEMS
       0000  *0
10000  3116  ECHOP,  ECHO
10001  0013  P13,    13      /CONSTANT
10002  0100  C100,   100     /CONSTANT

             /LOCATIONS 4,5,6 RESERVED FOR XODGWU

       0007  *7
10007  6400          FPNT    /ADDRESS OF FLOATING POINT INTERPRETER

             /AUTO-INDEX REGISTERS

10010  0000  AXIN,   0       /STORAGE INDEX (LOC *10)
10011  0000  XRT,    0       /EXTRA XR
10012  0000  XRT2,   0       /EXTRA XR
10013  4617  PDLXR,  FEXP-1          /PUSHDOWN LIST INDEX REGISTER.
10014  0000  FLTXR,  0       /XR FOR FLOATING POINT
10015  0000  FLTXR2, 0       /EXTRA FOR F.P.
10016  0000  RISZ,   0       /RANDOM RANDOM #'S

       0017  TEXTP=. /TEXT POINTERS (LOC *17)
10017  0000  AXOUT,  0       /OUTPUT INDEX
10020  0000  XCT,    0       /UNPACK SWITCH
10021  0000  GTEM,   0       /UNPACK STORAGE
10022  0200  PC,     PC0     /PROGRAM COUNTER                /*8K*

10023  0000  THISLN, 0       /LINE POINTER FROM 'FINDLN'
10024  0000  THISOP, 0       /CURRENT 'EVAL' OPERATION
10025  0000  LASTLN, 0       /BACK POINTER FROM 'FINDLN'
10026  0001  DEBGSW, 1       /DEBUG SWITCH  ; NON-ZERO FOR LITERAL.
10027  0000  PACKST, 0       /RUBOUT PROTECTION
10030  0000  PT1,    0       /VARIABLE POINTER
10031  3400  LASTV,  STVAR   /ADDRESS OF LAST VARIABLE       /*8K*
10032  0000  T1,     0       /TEMPORARY REGISTER - MAIN
10033  0000  T3,     0       /TEMP REGISTER FOR OUTPUT
10034  0000  INBUF,  0       /KEYBOARD INPUT BUFFER
10035  4617  BOTTOM, FEXP-1          /LAST LOCATION CURRENTLY AVAILABLE IN FIELD ZERO
10036  0000  INSUB,  0       /0= GETC; #0 = READC
10037  2017  GOK,    GOKILL  /TO KILL 'CURRENT PROGRAM SAVED' FLAG

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 15


             /  *40 = FLOATING POINT

       0054  *54

             /VARIABLES   -   INITIALIZED FOR THE DIALOGUE


10054  0000  SORTCN, 0       /NUMBER IN TABLE FROM SORTC
10055  0000  LASTOP, 0       /LAST OPERATION FOR EVAL
10056  0000  EFOP,   0               /FUNCTION CODE.
10057  7760  CNTR,   -20     /DELETE AND ERROR COUNTER(USED BY F.P. ALSO)

10060  0224  BUFR,   LINE1   /NEXT LOCATION IN BUFFER = LAST LOCATION OF TEXT/*8K*

10061  2624  ADD,    XOUTL   /CHAR. BUF. IN.  (DEBUG AIDS.SEE BELOW.)
10062  0000  XCTIN,  0       /PACK SWITCH
10063  2624  OUTDEV, XOUTL   /POINTER TO OUT. SUB.   (OUTL)-FOR DEBUGGING
10064  2612  INDEV,  XI33    /POINTER TO IN. SUB.    (I33)-FOR DEBUGGING

10065  0001  NAGSW,  0001    /NOT ALL AND/OR GROUP SWITCH(4000=ONE;1=ALL;0=GROUP);(0000)-FOR TSS-
10066  0215  CHAR,   215     /THE MOST IMPORTANT REGISTER
10067  0000  LINENO, 0000    /LINE NUMBER READ BY GETLN;(0400)-FOR TSS-8
10070  0006  GINC,   WORDS+2 /=6 FOR 4-WORD - CONSTANT

10071  0000  T2,     0       /TEMP REGISTER - FOR NEW INST. ROUTINES.




       0073          *73
10073  0214  LIST6,  214     /F.F. (^L)
10074  0207          207     /BELL
       0075  LIST7=.
10075  0337  P337,   337     /LEFT ARR
10076  0212  CLF,    212     /L.F.
       0077  LIST3=. /EXCRETION LIST
10077  0215  CCR,    215     /LIST BRANCHER.
10100  7402  DMPSW,  HLT     /(SEARCH CHARACTER)-VARIABLE
             /=0000 FOR TRACE ON.


             /THE REST OF PAGE ZERO IS PURE TO THE MULTI-USER SYSTEM

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 16


       0101  M100=.
10101  7700  P7700,  7700    /LEFT MASK
10102  0256  PER,    256     /PERIOD
10103  7701  M77,    -77     /EXTEND CODE TEST
10104  7600  P7600,  7600    /GROUP MASK
10105  7760  M20,    -20     /CONSTANT
10106  0177  P177,   177     /STEP MASK
10107  0017  P17,    17      /BCD MASK
10110  0277  P277,   277     /"?"
10111  7776  M2,     -2      /CONSTANT
10112  7477  MINUSA, -301    /CONSTANT
10113  0260  C260,   260     /ASCII FOR ZERO
10114  7540  M240,   -240    /SPACE TEST
10115  7522  MPER,   -256    /PERIOD TEST
10116  7563  MCR,    -215    /C.R. TEST
10117  7774  MFLT,   -WORDS  /= -4 FOR 4-WORD
10120  7773  M5,     -5      /PAREN TEST
10121  7767  M11,    -11     /PAREN TEST
10122  0077  P77,    77      /RIGHT MASK
10123  0200  C200,   200     /CONSTANTS
10124  4000  P4000,  4000    /NAGSW TEST CONSTANT (FOR PDP-5)

10125  2037  FLARGP, FLARG   /DATA ADDRESS
10126  5715  DOUBLE, MULT2   /MULTIPLY FLAC BY 2
10127  6000  FOUTPUT,FLOUTP  /FLOATING OUTPUT
10130  6200  FINPUT, FLINTP  /FLOATING INPUT
       0131          COMBUF=.
10131  0104  LIBN,   LIBFIL  /COMMAND BUFFER START
10132  0210  CFRS,   LINE0   /ADDRESS OF DUMMY LINE

       0133  STARTV=.
10133  3400  END,    STVAR   /VARIABLE BUFFER START
10134  0224  ENDT,   LINE1   /TEXT BUFFER START
10135  2026  EFUN3I, EFUN3   /FUNCTION RETURN
10136  2406  CFRSX,  FLTZER  /MOVED FOR ^L FUDGE


             /'FINPUT' USES CHAR AND GETC OR READC TO DEVELOP 
             /A NUMBER WHICH IS THEN STORED VIA PT1.

       0004  WORDS=4 /OR 3

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 17

             /NEW INSTRUCTIONS:

       4537  PUSHJ=JMS I .   /RECURSIVE SUBROUTINE CALLS
10137  2366          XPUSHJ
       5540  POPJ=JMP I .    /RECURSIVE RETURN
10140  1572          XPOPJ
       4541  PUSHA=JMS I .   /SAVE AC
10141  1365          XPUSHA
       4542  POPA=JMS I .    /RESTORE AC
10142  0520          XPOPA
       4543  PUSHF=JMS I .   /SAVE FP #
10143  0476          PD2
       4544  POPF=JMS I .    /RESTORE FP #
10144  0507          PD3
       4545  GETC=JMS I .    /UNPACK A CHARACTER
10145  2302          UTRA
       4546  PACKC=JMS I .   /PACK A CHARACTER
10146  2514          PACBUF
       4547  SORTJ=JMS I .   /SORT AND BRANCH ON AC OR CHAR
10147  1140          SORTB
       4550  SORTC=JMS I .   /SORT CHAR
10150  0717          XSORTC
       4551  PRINTC=JMS I .  /PRINT AC OR CHAR
10151  2472  XPRNTC, OUT
       4552  READC=JMS I .   /READ DATA INTO CHAR AND PRINT IT
10152  2163  RDIV,   CHIN
       4553  PRNTLN=JMS I .  /PRINT C(LINENO)
10153  2432          XPRNT
       4554  GETLN=JMS I .   /UNPACK AND FORM A LINENUMBER
10154  0315          XGETLN
       4555  FINDLN=JMS I .  /SEARCH FOR A GIVEN LINE
10155  2250          XFIND
       4556  ENDLN=JMS I .   /INSERT LINE POINTERS
10156  2413          XENDLN
       4557  RTL6=JMS I .    /ROTATE LEFT SIX
10157  0412          XRTL6
       4560  SPNOR=JMS I .   /IGNORE SPACES AND LEADING ZEROS
10160  1526          XSPNOR
       4561  TESTN=JMS I .   /PERIOD; OTHER; NUMBER
10161  1542          XTESTN
       4562  TSTLPR=JMS I .  /SKIP IF 5<SORTCN<= 11 (I.E. AN L-PAR)
10162  2044          LPRTST
       4563  TSTGRP=JMS I .  /SKIP IF G(AC) = G(LINENO)
10163  0742          GRPTST
       4564  TESTC=JMS I .   /TERM; NUMBER; FUNCTION; LETTER- AND IGNORE SPACES.
10164  0676          XTESTC
       4565  DELETE=JMS I .  /REMOVE OLD TEXT LINE
10165  2071  PSIN,   XDELETE
       4566  ERROR2=JMS I .  /EXCESS SOMETHING ERROR
       4566  ERROR3=JMS I .  /MISCELLANEOUS ERROR
       4566  ERROR4=JMS I .  /FORMAT ERROR
10166  2641          ERR2

10167  2600  DPC,    PS8PC   /PC
10170  6160  DTHIS,  THISD   /THISLN

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 17-1

10171  6165  DPT1,   PT1D    /PT1
10172  6343  DXRT,   XRTD    /(TAD I XRT)
10173  6350  DAXIN,  AXIND   /(DCA I AXIN)
10174  2605  DAXOUT, AXOUTD  /(TAD I AXOUT)
10175  3400  SECRTV, STVAR   /FOR SECRET VARIABLES, OF COURSE
10176  2646          RECOVR+1

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 18


             /COMMAND/INPUT DRIVER

       0177  *177
10177  7610  START,  SKP CLA         /PROGRAM START FROM SELF
10200  5576          JMP I 176       /FUDGE FOR ?00.00 PRINTOUT
10201  1123          TAD C200        /INITIALIZE PC
10202  3022          DCA PC          /FOR COMMAND MODE
10203  7001          IAC             /USE ONE IN THE AC TO
10204  3100          DCA DMPSW       /INIT UNPACK AND TRACE SWITCH
10205  3026          DCA DEBGSW      /ENABLE TRACE FOR INPUT OF (?)
10206  1226          TAD PUSHB       /OVERFLOW PROTECTION
10207  3013          DCA PDLXR       /NO PATCH TEST
10210  1225          TAD CSTAR       /TYPE * TO INDICATE COMMAND MODE
10211  4400          JMS I ECHOP     /SHOULD WE PRINT A '*'?
10212  1060  IBAR,   TAD BUFR        /COMMAND INPUT BUFFER
10213  3010          DCA AXIN        /FOR UNPACKING
10214  3062          DCA XCTIN
10215  1060          TAD BUFR        /RUBOUT PROTECTION
10216  3027          DCA PACKST
10217  4552  IGNOR,  READC           /READ COMMAND STRING
10220  4547          SORTJ
10221  0074          LIST7-1 /MOVED DOWN ONE
10222  0472          INLIST-LIST7
10223  4546          PACKC           /SAVE STRING CHARACTER.
10224  5217          JMP IGNOR

10225  0252  CSTAR,  252             /ACKNOWLEDGE CHARACTER
10226  3626  PUSHB,  RESTORE-1+13    /END FOR TEXT AND COMMAND INPUT

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 19


             /COMMAND/INPUT PROCESSOR

10227  4546  IRETN,  PACKC           /START TO PACK C.R.
10230  4546          PACKC           /FINISH C.R.
10231  1060          TAD  BUFR               /INITIALIZE FOR UNPACKING
10232  3017  GONE,   DCA AXOUT       /SETUP CURRENT LINE
10233  3020          DCA XCT
10234  4545          GETC            /READ FIRST CHARACTER.
10235  1367          TAD PUSHB1      /INIT STACK POINTER
10236  3013          DCA PDLXR
10237  4560          SPNOR           /IGNORE LEADING BLANKS
10240  4561          TESTN           /DOES THE LINE BEGIN WITH 1-9?
10241  5361          JMP GZERR       /PERIOD =ILLEGAL GROUP ZERO USAGE
10242  5271          JMP INPUTX      /NO
10243  2026          ISZ DEBGSW      /YES,DISABLE TRACE FOR REPACKING
10244  4554          GETLN           /READ THIS LINE NUMBER
10245  1124          TAD P4000       /TEST  FOR SINGLE LINE.
10246  1065          TAD NAGSW
10247  7640          SZA CLA
10250  4566          ERROR3          /ILLEGAL LINE NUMBER ON INPUT
10251  1060          TAD BUFR        /SET POINTERS
10252  3010          DCA AXIN
10253  3062          DCA XCTIN
10254  1067          TAD LINENO      /SAVE LINE #
10255  4573          JMS I DAXIN     /DCA I AXIN
10256  4560          SPNOR           /IGNORE SPACES AFTER LINE NUMBER
10257  7410          SKP
10260  4545          GETC            /READ 1ST AFTER LINENO TERMINATOR.
10261  4546  SRETN,  PACKC           /SAVE TEXT AND RESTORE DATA FIELD
10262  1066          TAD CHAR        /TEST FOR END OF INPUT STRING
10263  1116          TAD MCR
10264  7640          SZA CLA
10265  5260          JMP .-5
10266  4565          DELETE          /REMOVE OLD LINE, IF ANY.
10267  4556          ENDLN           /INSERT NEW LINE
10270  5177          JMP START       /POINTERS MUST BE REINITIALIZED
10271  4537  INPUTX, PUSHJ           /PROCESS IMMEDIATE COMMAND.
10272  0607          PROC
10273  4567          JMS I DPC       /TAD I PC
10274  7450          SNA             /END OF PROGRAM? 
10275  5177          JMP START       /YES
10276  3022          DCA PC          /SAVE NEW LINE NO.
10277  1022          TAD PC          /START NEW LINE
10300  7001          IAC
10301  5232          JMP GONE        /PROCESS OTHER COMMANDS

             /TEXT LINE BUFFER FORMAT*

             /#1 : POINTER OR ZERO IN LAST
             /#2 : LINENO
             /#3 - #N+1 : TEXT
             /#N : C.R.

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 20


             /LINE NUMBER FORMATION

10302  0007  FL100,  7
10303  3100          3100
10304  0000          0
10305  0000  FLP5,   0
10306  2000          2000
10307  0000          0
10310  0000          0
10311  0000  PTEMP,  ZBLOCK 4
10315  0000  XGETLN, 0       /COMPUTED LINE #'S
10316  4560          SPNOR   /IGNORE SPACE
10317  1066          TAD CHAR        /'A' IS SPECIAL
10320  1112          TAD MINUSA
10321  7650          SNA CLA
10322  5350          JMP TESTA
10323  4537          PUSHJ   /EVALUATE NUMBER OR EXPRESSION
10324  1622                  EVAL
10325  4407          FENT
10326  6311          FPUT PTEMP      /SAVE IT
10327  0000          FEXT
10330  4453          JMS I INTEGER           /GET GROUP PART
10331  1371          TAD P7740       /CHECK IF TOO BIG
10332  7700          SMA CLA
10333  4566          ERROR2  /BAD GROUP #
10334  1046          TAD FLAC+2      /GET GROUP AGAIN
10335  4557          RTL6
10336  7004          RAL
10337  3067          DCA LINENO      /SAVE IT
10340  4451          NEGATE
10341  4407          FENT
10342  1311          FADD PTEMP      /GET FRACTION
10343  4302          FMUL FL100
10344  1305          FADD FLP5       /ROUND UP
10345  0000          FEXT
10346  4453          JMS I INTEGER
10347  1067          TAD LINENO      /ADD GROUP
10350  3067  TESTA,  DCA LINENO
10351  7300          CLA CLL

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 21


10352  1067          TAD LINENO      /CHECK FOR ERROR
10353  0104          AND P7600
10354  7640          SZA CLA
10355  7020          CML
10356  1067          TAD LINENO
10357  0106          AND P177
10360  7460          SNL SZA
10361  4566  GZERR,  ERROR2          /ILLEGAL GROUP ZERO USAGE
10362  7640          SZA CLA         /AND SET NAGSW
10363  1372          TAD P2000
10364  7024          CML RAL
10365  3065          DCA NAGSW
10366  5715          JMP I XGETLN
10367  3611  PUSHB1, 3576+13
10370  5600  LCON,   DECONV
10371  7740  P7740,  7740
10372  2000  P2000,  2000

             /RANGE OF ACCEPTABLE LINE NUMBERS = 1.01 TO 31.99
             /NAGSW:

             /GROUP=0000
             /LINE=4000
             /ALL=0001

             /---------------------------------------------------------------------
             /LIST OF FUNCTION ADDRESSES. (NAMES ARE IN "FNTABL")

       0373  FNTABF=.
10373  2023          XABS    /FABS   -ABSOLUTE VALUE
10374  7552          XSGN    /FSGN   -SIGN PART
10375  1362          XINT    /FITR   -INTEGER PART
10376  3200          FDIS    /TEK 4010 DISPLAY FUNCTION
10377  7545  PFRAN,  FRAN    /FRAN   -RANDOM NUMBER
10400  3306          FJOY    /TEK 4010 CROSSHAIR INPUT FUNCTION
10401  5000          ARTN    /FATN   -ARCTANGENT
10402  4620          FEXP    /FEXP   -E^X
10403  5040          FLOG    /FLOG   -LN(X)
10404  5205          FSIN    /FSIN   -SINE
10405  5200          FCOS    /FCOS   -COSINE
10406  7400          XSQRT   /FSQT   -SQUARE ROOT
10407  7516          FIN     /CHARACTER INPUT FUNCTION
10410  7530          FOUT    /CHARACTER OUTPUT FUNCTION
10411  0551          FIND    /FIND FUNCTION

             /-----------------------------------------------------------------------
10412  0000  XRTL6,  0       /ROTATE AC LEFT SIX - "RTL6"
10413  7106          CLL RTL
10414  7006          RTL
10415  7006          RTL
10416  5612          JMP I XRTL6     /--RETURN--

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 22


             /RECURSIVE OPERATE, EXECUTE, OR CALL 

10417  4554  DO,     GETLN           /EXECUTE ONE LINE, A GROUP,OR ALL
10420  1022          TAD PC          /SAVE ADDRESS
10421  4541          PUSHA           /OF CURRENT LINE
10422  4543          PUSHF           /SAVE REST OF THIS LINE
10423  0017          TEXTP           /ADDRESS OF TEXT POINTERS
10424  4543  DGRP,   PUSHF           /SAVE NAGSW; CHAR; AND LINENO.
10425  0065          NAGSW
10426  1065          TAD NAGSW       /CHECK DATA FROM GETLN.
10427  7710          SPA CLA         /SKIP IF GROUP OR ALL
10430  5262          JMP DOONE       /DO ONE LINE
10431  4555          FINDLN          /INIT FOR GROUP AND SET THISLN
10432  7000          NOP
10433  1023          TAD THISLN      /TEST FOR GOOD GROUP NUMBER.
10434  3011          DCA XRT
10435  4572          JMS I DXRT      /TAD I XRT      /*8K*
10436  4563          TSTGRP
10437  4566          ERROR2          /NO SUCH GROUP NUMBER
10440  4537  DGRP1,  PUSHJ           /EXECUTE OBJECT LINE AND SET PC.
10441  0604          PROCESS-2
10442  4544          POPF            /RESTORE THE DATA
10443  0065          NAGSW
10444  4567          JMS I DPC
10445  7450          SNA
10446  5270          JMP DCONT       /ALL DONE
10447  7001          IAC
10450  3030          DCA PT1         /SAVE POINTER TO LINENO
10451  1065          TAD NAGSW       /CHECK FOR GROUP
10452  7740          SMA SZA CLA
10453  5257          JMP .+4         /DO ALL
10454  4571          JMS I DPT1      /TAD I PT1
10455  4563          TSTGRP
10456  5270          JMP DCONT       /NOT IN GROUP
10457  4571          JMS I DPT1      /TAD I PT1
10460  3067          DCA LINENO
10461  5224          JMP DGRP        /CONTINUE THE SUBROUTINE

10462  4555  DOONE,  FINDLN          /FIND THE LINE
10463  4566          ERROR2          /NO SUCH LINE NUMBER
10464  4537          PUSHJ           /EXECUTE IT
10465  0606          PROCESS
10466  4544          POPF            /RESTORE CHAR
10467  0065          NAGSW
10470  4544  DCONT,  POPF            /RESTORE TEXT POINTERS
10471  0017          TEXTP
10472  4542          POPA            /RESTORE ADDRESS OF CURRENT LINE.
10473  3022          DCA PC
10474  5675          JMP I .+1       /CONTINUE PROCESSING THIS LINE.
10475  0607          PROC

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 23


             /PUSHDOWN LIST CONTROLS

10476  0000  PD2,    0               /PUSHDOWN THE AC - "PUSHA"
10477  1676          TAD I PD2
10500  2276          ISZ PD2
10501  3304          DCA .+3
10502  6202          CIF
10503  4706          JMS I .+3
10504  0000          0
10505  5676          JMP I PD2
10506  5656          MPD2

10507  0000  PD3,    0
10510  1707          TAD I PD3
10511  3315          DCA .+4
10512  2307          ISZ PD3
10513  6202          CIF
10514  4717          JMS I .+3
10515  0000          0
10516  5707          JMP I PD3
10517  5705          MPD3

10520  0000  XPOPA,  0
10521  6202          CIF
10522  4724          JMS I .+2
10523  5720          JMP I XPOPA
10524  5732          MPOPA

10525  1133  ZSERCH, TAD STARTV
10526  1347          TAD Z3
10527  3030          DCA PT1         /POINT TO MANTISSA
10530  1031          TAD LASTV       /CHECKED ALL VARIABLES FOR 0?
10531  7141          CLL CIA
10532  1030          TAD PT1
10533  7630          SZL CLA
10534  5343          JMP ZERROR      /FAKE ERROR MESSAGE (NO CHANGE FROM FOCAL)
10535  1430          TAD I PT1       / IS THIS VARIABLE = 0?
10536  7650          SNA CLA
10537  5750          JMP I ZFOUND    /YES, CHANGE ITS NAME
10540  1030          TAD PT1         /NO, CHECK THE NEXT
10541  1070          TAD GINC
10542  5327          JMP ZSERCH+2

10543  1346  ZERROR, TAD Z1467       /FAKE ERROR ADDRESS (+1)
10544  3566          DCA I 166       /(ERROR2-JMS I 0)
10545  5566          JMP I 166       /KLUDGE

10546  1467  Z1467,  1467
10547  0003  Z3,     3
10550  1517  ZFOUND, ZERFND


10551  1365  FIND,   TAD XFIND1      /SETUP 'READC' EXIT
10552  3552          DCA I RDIV

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 23-1

10553  4453          JMS I INTEGER           /FIX ARG
10554  7200          CLA
10555  4464  FIND1,  JMS I INDEV     /GET THE NEXT CHAR
10556  3066          DCA CHAR        /SAVE IT
10557  1066          TAD CHAR
10560  7041          CIA             /IS IT THE ONE WE WANT?
10561  1046          TAD FLAC+2
10562  7640          SZA CLA
10563  5766          JMP I XCHIN     /GO FINISH 'READC' (ECHO)
10564  5535          JMP I EFUN3I

10565  0555  XFIND1, FIND1
10566  2166  XCHIN,  CHIN+3


/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 24


             /--------------------------------------------------------------------

       0567  INLIST=.        /INPUT CONTROL CHARACTERS
10567  0212          IBAR            /B.A. = RESTART
10570  0217          IGNOR           /L.F. = IGNORE
10571  0227          IRETN           /C.R. = TERMINATE STRING

10572  1073  FLIST2, FLIMIT          /,=STANDARD
10573  1135          FINFIN          /;=SHORT
10574  2640          ERROR5          /CR=DUMB

10575  1063  FLIST1, FINCR           /,=STANDARD FORMAT
10576  0606          PROCESS         /;=SET;PLUS ,..
10577  0612          PC1             /C.R.=SET COMMAND.

10600  7472  MF,     -306            /USED BY TESTC


/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 25


             /PRIMARY CONTROL AND TRANSFER

10601  4554  GOTO,   GETLN           /READ THE LINE NUMBER REQUESTED
10602  4555          FINDLN          /LOCATE IT AND RESET TEXTP
10603  4566          ERROR2          /NOT THERE
10604  1023          TAD THISLN      /SET PC
10605  3022          DCA PC
             /---------------------------------------------------------------------
10606  4545  PROCESS,GETC            /TEST FOR END OF LINE
10607  1066  PROC,   TAD CHAR        /FIRST CHARACTER READY = USE PROC
10610  1116          TAD MCR
10611  7650          SNA CLA
10612  5540  PC1,    POPJ            /EXIT "PROCESS"
10613  4550          SORTC           /IGNORE "SPACE",",", AND ";".
10614  1405          GLIST-1
10615  5206          JMP PROCESS
10616  1066          TAD CHAR        /SAVE COMMAND CHARACTER
10617  0075          AND P337        /EXECUTE LOWER CASE ALSO
10620  4541          PUSHA
10621  4545          GETC            /GO TO TERMINATOR
10622  4550          SORTC
10623  1405          GLIST-1
10624  7410          SKP
10625  5221          JMP .-4
10626  4542          POPA
10627  4547          SORTJ           /GO DO COMMAND
10630  0771          COMLST-1
10631  0175          COMGO-COMLST
10632  4566          ERROR2          /ILLEGAL COMMAND


       0612  COMMENTS=PC1            /ALSO IS CONTINUE

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 26


             /OUTPUT COMMAND TEXT

10633  4554  WRITE,  GETLN           /SET LINENO
10634  2026          ISZ DEBGSW      /DISABLE TRACE
10635  4555          FINDLN          /SEARCH FOR LINE NUMBER
10636  5265          JMP WTESTG      /NOT THERE OR GROUP
10637  1067          TAD LINENO
10640  7640          SZA CLA
10641  4553          PRNTLN          /PRINT LINE NUMBER AND A SPACE.
10642  4545          GETC
10643  4551          PRINTC          /PRINT TEXT OF A LINE.
10644  1066          TAD CHAR
10645  1116          TAD MCR
10646  7640          SZA CLA         /SKIP IF END OF LINE
10647  5242          JMP .-5
10650  4570          JMS I DTHIS     /TAD I THISLN
10651  7450  WTEST2, SNA
10652  5267          JMP WX-2
10653  7001          IAC
10654  3030          DCA PT1         /SAVE POINTER TO LINENO OF NEXT
10655  1065          TAD NAGSW
10656  7700          SMA CLA
10657  4571          JMS I DPT1      /TAD I PT1
10660  4563          TSTGRP          /TRY NEXT LINENO FOR GROUP.
10661  5271          JMP WX
10662  4571  WALL,   JMS I DPT1      /TAD I PT1
10663  3067          DCA LINENO
10664  5235          JMP WRITE+2
10665  1023  WTESTG, TAD THISLN      /INIT GROUP PRINTOUT
10666  5251          JMP WTEST2
10667  3026          DCA DEBGSW
10670  5540          POPJ
10671  1065  WX,     TAD NAGSW
10672  7750          SPA SNA CLA     /SKIP IF ALL
10673  5267          JMP WX-2
10674  4551          PRINTC          /PRINT C.R. AGAIN
10675  5262          JMP WALL


/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 27


10676  0000  XTESTC, 0       /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC"
10677  4560          SPNOR           /IGNORE SPACES
10700  4550          SORTC           /TEST THE VARIABLE TERMINATORS
10701  1776          TERMS-1
10702  5676          JMP I XTESTC    /YES - SORTCN IS SET--RETURN--
10703  1066          TAD CHAR        /NO
10704  2276          ISZ XTESTC
10705  1200          TAD MF
10706  7650          SNA CLA         /TEST FOR "F"
10707  5315          JMP XT3
10710  4561          TESTN
10711  5676          JMP I XTESTC    /.--RETURN--
10712  7410          SKP             /OTHER
10713  5676          JMP I XTESTC    /NUMBER--RETURN--
10714  2276          ISZ XTESTC
10715  2276  XT3,    ISZ XTESTC      /RETURNS:T;N;F;A
10716  5676          JMP I XTESTC    /--RETURN--

10717  0000  XSORTC, 0       /SORT CHAR AGAINST TABLE - "SORTC"
10720  1717          TAD I XSORTC
10721  3012          DCA XRT2        /1ST ARG IS LIST-1
10722  1412          TAD I XRT2
10723  7510          SPA             /LIST IS ENDED BY A NEGATIVE NUMBER
10724  5336          JMP SEXC        /2AND EXIT = NOT IN LIST
10725  7041          CIA
10726  1066          TAD CHAR
10727  7640          SZA CLA         /COMPARE
10730  5322          JMP .-6
10731  1717          TAD I XSORTC    /COMPUTE INCREMENT : 0 - N
10732  7040          CMA
10733  1012          TAD XRT2
10734  3054          DCA SORTCN
10735  7410          SKP             /1ST EXIT = YES
10736  2317  SEXC,   ISZ XSORTC
10737  2317          ISZ XSORTC
10740  7300          CLA CLL
10741  5717          JMP I XSORTC    /--RETURN--


/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 28


10742  0000  GRPTST, 0       /AC VS LINENO - "TSTGRP"
10743  0104          AND P7600
10744  7041          CIA
10745  3071          DCA T2
10746  1067          TAD LINENO
10747  0104          AND P7600
10750  1071          TAD T2
10751  7650          SNA CLA
10752  2342          ISZ GRPTST
10753  5742          JMP I GRPTST    /--RETURN--

             /INPUT FROM TEXT OR KEYBOARD;
             /IF BACK-ARROW, RESTART INPUT

10754  0000  INPUT,  0               /INPUT A CHARACTER
10755  1036          TAD INSUB       /NON-ZERO FOR KEYBOARD
10756  7640          SZA CLA
10757  5362          JMP .+3
10760  4545          GETC
10761  5754          JMP I INPUT     /--RETURN--
10762  4552          READC
10763  4547          SORTJ
10764  6776          SPECIAL-1
10765  3400          INFIX-SPECIAL
10766  5754          JMP I INPUT     /--RETURN--

             /----------------------------------------------------------------------
10767  1033  ILIST,  IF1             /,
10770  0606          PROCESS         /;
10771  0612          PC1             /CR

                             /ENGLISH-FRENCH
       0772  COMLST=.        /COMMAND DECODING LIST
10772  0323          323     /SET    - ORGANIZE
10773  0306          306     /FOR    - QUAND
10774  0311          311     /IF     - SI
10775  0304          304     /DO     - FAIZ
10776  0307          307     /GOTO   - VA
10777  0303          303     /COMMENT- COMMENTE
11000  0301          301     /ASK    - DEMANDE
11001  0324          324     /TYPE   - TAPE
11002  0314          314     /LIBRARY- ENTREPOSE
11003  0305          305     /ERASE  - BIFFE
11004  0327          327     /WRITE  - INSCRIS
11005  0315          315     /MODIFY - MODIFIE
11006  0321          321     /QUIT   - ARRETE
11007  0322          322     /RETURN - RETOURNE
11010  0317          "O              /ADD 'OPEN' COMMAND

             /THIS COMMAND LIST IS SPEED OPTIMIZED.

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 29



             /CONDITIONAL TRANSFER PROCESS.

11011  4564  IF,     TESTC           /IGNORE SPACES AND TEST
             /---------------------------------------------------------------------
11012  4635          JMS I IECALL    /T
11013  4542          POPA            /N-DUMP THE (EFOP)
11014  4636          JMS I IPART     /F-CHECK FOR PAREN MATCH
11015  1111          TAD M2          /A
11016  3032          DCA T1
11017  1045          TAD FLAC+1      /TEST -,0,+
11020  7510          SPA
11021  2032          ISZ T1          /N-TO   -1,-2,-3
11022  7750          SPA SNA CLA
11023  2032  IF3,    ISZ T1          /COUNT COMMAS
11024  7410          SKP
11025  5773          JMP I COMGO+4   /TRANSFER
11026  4547          SORTJ           /SEARCH TEXT UNTILL ,;C.R.
11027  1406          TLIST-1
11030  7360          ILIST-TLIST
11031  4545          GETC
11032  5226          JMP .-4
11033  4545  IF1,    GETC            /MOVE PAST COMMA 
11034  5223          JMP IF3
11035  1610  IECALL, ECALL
11036  2056  IPART,  PARTEST

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 30


             /LOOP CONTROL STATEMENT

       1037  SET=.                   /SUBSET OF "FOR".

11037  4537  FOR,    PUSHJ           /LOOPS, ETC.
11040  1412          GETARG          /LOOK FOR "=" NEXT
11041  4560          SPNOR           /IGNORE SPACES
11042  1066          TAD CHAR
11043  1333          TAD MEQ
11044  7440          SZA
11045  4566          ERROR4          /LEFT OF "=" IN ERROR: 'FOR' OR 'SET'
11046  1030          TAD PT1
11047  4541          PUSHA           /SAVE POINTER TO VARIABLE
11050  4537          PUSHJ
11051  1621          EVAL-1          /GET INITIAL VALUE EXPRESSION
11052  4542          POPA
11053  3030          DCA PT1
11054  4407          FINT            /INITIALIZE NOW.
11055  6430          FPUT I PT1
11056  0000          FXIT
11057  4547          SORTJ           /TEST LAST CHAR FROM "EVAL"
11060  1406          TLIST-1
11061  7166          FLIST1-TLIST
11062  4566          ERROR4          /EXCESS R-PAR
11063  1030  FINCR,  TAD PT1         /SAVE VARIABLE ADDRESS *
11064  4541          PUSHA
11065  4537          PUSHJ           /EVALUATE THE INCREMENT,IF ANY.
11066  1621          EVAL-1
11067  4547          SORTJ           /TEST TERMINATORS
11070  1406          TLIST-1
11071  7163          FLIST2-TLIST
11072  4566          ERROR4          /ILLEGAL TERMINATOR IN 'FOR'
11073  4543  FLIMIT, PUSHF           /SAVE THE INCREMENT.    *
11074  2037          FLARG
11075  4537          PUSHJ           /GET THE LIMIT(NO ERROR DETECTION AFTER LIMIT)
11076  1621          EVAL-1
11077  4543  FCONT,  PUSHF           /SAVE THE LIMIT *
11100  2037          FLARG
11101  4543          PUSHF           /SAVE TEXT OF OBJECT STATEMENTS
11102  0017          TEXTP
11103  4537          PUSHJ           /DO THE OBJECT STATEMENTS
11104  0606          PROCESS
11105  4544          POPF            /RESTORE REMAINING TEXT.
11106  0017          TEXTP
11107  4544          POPF            /GET LIMIT
11110  2037          FLARG
11111  4544          POPF            /GET INCREMENT
11112  7470          ITER1
11113  4542          POPA            /GET VARIABLE ADDRESS
11114  3030          DCA PT1

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 31

11115  4407          FINT            /INCREMENT AND TEST
11116  0430          FGET I PT1      /LOAD THE VARIABLE
11117  1731          FADD I FINKP    /INCREMENT IT
11120  6430          FPUT I PT1      /CHANGE IT
11121  2525          FSUB I FLARGP   /TEST IT
11122  0000          FXIT
11123  1045          TAD FLAC+1
11124  7740          SMA SZA CLA
11125  5540          POPJ            /END OF LOOP
11126  1030          TAD PT1
11127  4541          PUSHA           /SAVE ADDRESS *
11130  4543          PUSHF           /SAVE INCREMENT AGAIN *
11131  7470  FINKP,  ITER1
11132  5277          JMP FCONT
11133  7503  MEQ,    -275
11134  7524  MCOM,   -254
11135  4543  FINFIN, PUSHF           /SET INCREMENT TO ONE.
11136  2404          FLTONE  /MOVED FOR ^L FUDGE
11137  5277          JMP FCONT



11140  0000  SORTB,  0       /SORT AND BRANCH ROUTINE. - "SORTJ"
11141  7450          SNA
11142  1066          TAD CHAR        /ASSUME CHAR IF AC=0
11143  7041          CIA
11144  3071          DCA T2          /SAVE SORT ITEM
11145  1740          TAD I SORTB     /FIRST ARG IS LIST LESS ONE
11146  2340          ISZ SORTB       /2AND IS INTRA-LIST LENGTH
11147  3012          DCA XRT2
11150  1412          TAD I XRT2
11151  7510          SPA             /**LISTS ENDED BY NEGATIVE NUMBERS**
11152  5364          JMP SEX         /READ EXIT
11153  1071          TAD T2          /FIND ADDRESS
11154  7640          SZA CLA
11155  5350          JMP .-5
11156  1012          TAD XRT2        /MATCH FOUND.
11157  1740          TAD I SORTB
11160  3071          DCA T2
11161  1471          TAD I T2
11162  3071          DCA T2          /DEBUG : AC = ADDRESS
11163  5471          JMP I T2
11164  2340  SEX,    ISZ SORTB       /MATCH NOT FOUND.
11165  7300          CLA CLL
11166  5740          JMP I SORTB     /--RETURN--

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 32

       1167  COMGO=. /COMMAND ROUTINE ADDRESSES
11167  1037          SET
11170  1037          FOR
11171  1011          IF
11172  0417          DO
11173  0601          GOTO            /(REFERENCED)
11174  0612          COMMENT
11175  1207          ASK
11176  1210          TYPE
11177  7503          LIB
11200  2212          ERASE
11201  0633          WRITE
11202  1313          MODIFY
11203  0177          START   /RETURN TO COMMAND MODE VIA 'QUIT'
11204  1570          RETRN   /MOVE 'RETURN'
11205  3133          FILER   /ADD 'OPEN'





             /---------------------------------------------------------------------
             /INPUT-OUTPUT STATEMENTS

11206  0000  ATSW,   0               /ASK-TYPE SWITCH
11207  7240  ASK,    CLA CMA         /REMEMBER WHICH CALL.
11210  3206  TYPE,   DCA ATSW
11211  4547  TASK,   SORTJ           /SPECIAL CHARACTER? 
11212  1377          ALIST-1
11213  0176          ATLIST-ALIST
11214  2206          ISZ ATSW        /TEST QUOTE SWITCH
11215  5232          JMP TYPE2
11216  4537          PUSHJ           /DO ASK; SETUP PT1
11217  1412          GETARG
11220  1066          TAD CHAR        /SAVE IN-LINE CHARACTER.
11221  4541          PUSHA
11222  7300          CLA CLL /DON'T PRINT COLON
11223  7000          NOP
11224  2036          ISZ INSUB       /INDICATE 'READC'
11225  7001          IAC             /POINT PAST CHAR
11226  4530          JMS I FINPUT    /READ DATA AND SAVE
11227  4542          POPA            /RE-TEST LAST TERMINATOR
11230  3066          DCA CHAR
11231  5207          JMP ASK         /CONTINUE PROCESSING

11232  4537  TYPE2,  PUSHJ           /DO TYPE
11233  1622          EVAL
11234  4527          JMS I FOUTPUT   /PRINT
11235  5210          JMP TYPE

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 33

11236  2026  TQUOT,  ISZ DEBGSW      /DISABLE TRACE
11237  4545          GETC            /TYPE LITERALS
11240  4547          SORTJ
11241  1412          TLIST2-1
11242  0762          TLIST3-TLIST2
11243  4551          PRINTC
11244  5237          JMP TQUOT+1
11245  4545  TINTR,  GETC            /PASS PERCENT SIGN
11246  4554          GETLN           /READ FORMAT CONTROL: "%7.03"
11247  1067          TAD LINENO
11250  3052          DCA FISW        /SAVE FORMAT CODE
11251  5211          JMP TASK
11252  1262  TCRLF2, TAD P15 /PRINT CR ONLY
11253  4551          PRINTC          /(PRINTC HANDLES NULL FOR DELAY!)
11254  5257          JMP .+3
11255  1077  TCRLF,  TAD CCR         /EXCLAMATION POINT=CR,LF.
11256  4551          PRINTC
11257  3026  TASK4,  DCA DEBGSW      /RE-ENABLE THE TRACE
11260  4545          GETC            /MOVE TO NEXT CHARACTER
11261  5211          JMP TASK
11262  0015  P15,    15              /":"

11263  4537  TTAB,   PUSHJ           /TAB ARGUMENT IN ASK OR TYPE
11264  1621                  EVAL-1
11265  4407          FENT
11266  1707          FADD I TRND     /LET'S ROUND OFF
11267  0000          FEXT
11270  4453          JMS I INTEGER
11271  7041          CIA
11272  1305          TAD TABC
11273  7001          IAC
11274  7500          SMA
11275  5303          JMP PBACK
11276  3306          DCA CNTRX
11277  1310          TAD SPACE
11300  4551          PRINTC
11301  2306          ISZ CNTRX
11302  5277          JMP .-3
11303  7300  PBACK,  CLA CLL
11304  5211          JMP TASK

11305  0000  TABC,   0
11306  0000  CNTRX,  0
11307  0305  TRND,   FLP5
11310  0240  SPACE,  240



             /IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW"
             /       #0: DISABLE AND RETURN ALL"?" ' S.
             /IF DMPSW = 0: TRACE ON, IF ENABLED
             /       #0: TRACE OFF
             /IF BOTH = 0 : PRINT TRACE.

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 34

             /SEARCH ROUTINES

11311  2634  MSTATM, STATM           /ADDRESSES OF STATUS BLOCKS
11312  2630  MSTATN, STATN
11313  4554  MODIFY, GETLN           /READ LINE NO.
11314  4555          FINDLN          /LOOK IT UP NOW.
11315  4566          ERROR2          /NOT THERE = BAD COMMAND UNLESS ZERO.
11316  1060          TAD BUFR        /SET POINTERS
11317  3010          DCA AXIN        /FOR INPUT
11320  3062          DCA XCTIN
11321  1067          TAD LINENO      /COPY THE SAME LINE NUMBER.
11322  4573          JMS I DAXIN     /DCA I AXIN
11323  1010          TAD AXIN        /SAVE START OF NEW LINE
11324  3027          DCA PACKST
11325  1311          TAD MSTATM      /SET STATUS FOR MODIFY
11326  6047          6047            /ETOS MONITOR CALL
11327  7300          CLA CLL
11330  4464  SCONT,  JMS I INDEV     /READ THE TELETYPE INPUT SILENTLY.
11331  3100          DCA LIST3+1     /SAVE SEARCH CHARACTER
11332  2026          ISZ DEBGSW      /NO BREAKS.
11333  4545  SCHAR,  GETC            /TYPE+TEST-F.F.
11334  4551          PRINTC          /PLAYBACK THE TEXT
11335  4547          SORTJ           /LOOK FOR MATCH
11336  0076          LIST3-1
11337  1277          LISTGO-LIST3    /LISTGO HAS MOVED
11340  4546          PACKC           /SAVE NEW LINE.
11341  5333          JMP SCHAR
11342  1060  SBAR,   TAD BUFR        /RESTART-B.A.
11343  7001          IAC
11344  3010          DCA AXIN        /SET POINTERS
11345  3062          DCA XCTIN
11346  4552  SFOUND, READC           /READ FROM KEYBOARD
11347  4547          SORTJ           /TEST
11350  0072          LIST6-1
11351  1277          SRNLST-LIST6
11352  4551          PRINTC          /MODIFY MUST ECHO FOR ITSELF
11353  4546  SGOT,   PACKC           /PACK CHAR.
11354  5346          JMP SFOUND      /MORE

11355  1312  SMRETN, TAD MSTATN      /SET ETOS STATUS BACK TO NORMAL
11356  6047          6047            /ETOS MONITOR CALL
11357  7300          CLA CLL
11360  5761          JMP I .+1
11361  0261          SRETN

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 35

             /TAKE THE INTEGER PART

11362  4453  XINT,   JMS I INTEGER   /(FIX)
11363  7200          CLA
11364  5535          JMP I EFUN3I

11365  0000  XPUSHA, 0
11366  6202          CIF
11367  4771          JMS I .+2
11370  5765          JMP I XPUSHA
11371  5631          MPUSHA




             /----------------------------------------------------------------------
       1372  SRNLST=.        /'MODIFY' CONTROL CHARACTER TABLE
11372  1333          SCHAR   /F.F. = CONTINUE
11373  1330          SCONT   /BELL = CHANGE SEARCH CHARACTER
11374  1342          SBAR    /B. A. = RESTART
11375  1331          SCONT+1 /L.F. = FINISH THE LINE
11376  1355  LISTGO, SMRETN  /C.R. = END THE LINE HERE AS IS
11377  1353          SGOT    /CHAR = SEARCH CHAR.





             / ASK/TYPE LIST OF CONTROLS.
11400  0272  ALIST,  ":
11401  0245          245     /%
11402  0242          242     /"
11403  0241          241     /!
11404  0243          243     /#
11405  0244          244     /$
       1406  GLIST=.
11406  0240          240     /SPACE
       1407  TLIST=.
11407  0254          254     /,
11410  0273          273     /;
11411  0215          215     /C.R.
             /THIS LIST IS ENDED BY 'TESTC'.

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 36


             /FIND OR ENTER A VARIABLE IN THE LIST.

11412  4564  GETARG, TESTC           /FIRST LETTER OF ARG
11413  0242  TLIST2, 0242            /"
11414  0215          0215            /C.R. - FUNCTION OR NUMBER IS NOT AN ARG.
11415  4566          ERROR4          /BAD ARGUEMENT IN 'FOR', 'SET', OR 'ASK'
11416  3062  GETVAR, DCA XCTIN       /RESET PACK SWITCH
11417  4546          PACKC           /PACK FIRST CHAR
11420  1061          TAD ADD         /SAVE NAME
11421  3056          DCA EFOP        /WHERE WE CAN PUSH IT
11422  4545  GETLP,  GETC            /GET NEXT CHAR
11423  4550          SORTC           /END OF NAME?
11424  1776                  TERMS-1
11425  5233          JMP GSERCH      /YES
11426  2062          ISZ XCTIN       /IS THIS THE SECOND CHAR
11427  5222          JMP GETLP       /MORE THAN 2 CHARS, IGNORE IT
11430  1066          TAD CHAR        /PACK SECOND CHAR
11431  0122          AND P77         /MASK IT
11432  5220          JMP GETLP-2     /ADD TO NAME
11433  4562  GSERCH, TSTLPR          /CHECK FOR SUBSCRIPT
11434  5242          JMP GS1
11435  4767          JMS I GECALL    /PICK IT UP
11436  4542          POPA            /RESTORE NAME
11437  3056          DCA EFOP
11440  4775          JMS I PTEST     /CHECK PAREN MATCH
11441  4453          JMS I INTEGER           /CONVERT IT
11442  3326  GS1,    DCA SUBS        /SAVE SUBSCRIPT
11443  1056          TAD EFOP        /MAKE SURE IT'S FOUND
11444  3431          DCA I LASTV
11445  1175          TAD SECRTV      /SEARCH STARTS WITH SECRET VARIABLES
11446  3030  GLOOP,  DCA PT1
11447  1056          TAD EFOP        /IS THIS THE ONE?
11450  7041          CIA
11451  1430          TAD I PT1
11452  7650          SNA CLA
11453  5257          JMP CHKVAR      /MATCHED - CHECK SUBSCRIPT
11454  1030  NXTVAR, TAD PT1         /NO MATCH - BUMP POINTER
11455  1070          TAD GINC
11456  5246          JMP GLOOP       /TRY AGAIN
11457  2030  CHKVAR, ISZ PT1         /BUMP TO SUBSCRIPT
11460  1030          TAD PT1         /CHECK IF IT'S REALLY THERE
11461  7141          CLL CIA
11462  1031          TAD LASTV
11463  7620          SNL CLA
11464  5275          JMP MAKVAR      /NO - IT WAS THE DUMMY
11465  1326          TAD SUBS        /CHECK THE SUBSCRIPT
11466  7041          CIA
11467  1430          TAD I PT1

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 37



11470  2030  GLOOP1, ISZ PT1         /POINT TO DATA (IN CASE IT'S NEEDED)
11471  7650          SNA CLA         /SUBSCRIPT MATCH?
11472  5540          POPJ            /YES!
11473  7344          CLA CLL CMA RAL /SET AC=(-2)
11474  5254          JMP NXTVAR      /AND BUMP POINTER
11475  1035  MAKVAR, TAD BOTTOM      /CHECK FOR OVERFLOW
11476  7141          CLL CIA
11477  1031          TAD LASTV
11500  1001          TAD P13
11501  7630          SZL CLA
11502  5741          JMP I ZERSCH    /GO REPLACE A ZERO VARIABLE
11503  1031          TAD LASTV       /ADD ANOTHER VARIABLE
11504  1070          TAD GINC
11505  3031          DCA LASTV
11506  1030  MAKV1,  TAD PT1         /SAVE POINTER
11507  3011          DCA XRT
11510  1326          TAD SUBS        /INSERT SUBSCRIPT
11511  3430          DCA I PT1
11512  3411          DCA I XRT       /ZERO OUT DATA
11513  3411          DCA I XRT
11514  3411          DCA I XRT
11515  3411  VARPCH, DCA I XRT       /(NOP) - FOR 3-WORD
11516  5270          JMP GLOOP1
11517  7346  ZERFND, CLA CLL CMA RTL /SET PT1 TO START OF VARIABLE
11520  1030          TAD PT1
11521  3030          DCA PT1
11522  1056          TAD EFOP        /REPLACE THE NAME
11523  3430          DCA I PT1
11524  2030          ISZ PT1         /POINT TO SUBSCRIPT
11525  5306          JMP MAKV1       /AND FINISH UP


/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 38



       1526  SUBS=.
11526  0000  XSPNOR, 0               /IGNORE LEADING SPACES - "SPNOR"
11527  1066          TAD CHAR
11530  1114          TAD M240
11531  7640          SZA CLA
11532  5726          JMP I XSPNOR    /--RETURN--
11533  4545          GETC
11534  5327          JMP XSPNOR+1


11535  7520  M260,   -260
11536  7507  M271,   -271



11537  0240  SP,     240
11540  7504          LIB+1
11541  0525  ZERSCH, ZSERCH          /POINTER TO ERO SEACH
11542  0000  XTESTN, 0               /RETURNS: .; OTHER; NUMBER - "TESTN"
11543  1066          TAD CHAR
11544  1115          TAD MPER
11545  7640          SZA CLA
11546  2342          ISZ XTESTN
11547  1066          TAD CHAR
11550  1335          TAD M260
11551  3054          DCA SORTCN      /SAVE VALUE OF THE NUMBER
11552  1054          TAD SORTCN      /TEST IF REALLY A DIGIT.
11553  7710          SPA CLA
11554  5742          JMP I XTESTN    /--RETURN--
11555  1066          TAD CHAR
11556  1336          TAD M271
11557  7750          SPA SNA CLA
11560  2342          ISZ XTESTN      /IF A NUMBER
11561  5742          JMP I XTESTN    /--RETURN--
11562  4537  LGOSUB, PUSHJ           /EXECUTE SUBROUTINE
11563  0420                  DO+1
11564  1337          TAD SP          /LIBRARY 'SPACE' = LIBRARY RETURN!
11565  3066          DCA CHAR
11566  5740          JMP I SP+1      /SKIP 'SPNOR'
11567  1610  GECALL, ECALL
11570  1123  RETRN,  TAD C200
11571  3022          DCA PC

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 39

             /EXIT FROM A "DO" SUBROUTINE


11572  4542  XPOPJ,  POPA
11573  3071          DCA T2
11574  5471          JMP I T2
11575  2056  PTEST,  PARTEST         /USE THAT FREE LOCATION



             /ASK-TYPE CONTROL CHARACTER TABLE
11576  1263  ATLIST, TTAB
11577  1245          TINTR   /% - FORMAT DELIMITER
11600  1236          TQUOT   /" - LITERAL DELIMITER
11601  1255          TCRLF   /! - CARRIAGE RETURN AND LINE FEED
11602  1252          TCRLF2  /# - CARRIAGE RETURN ONLY
11603  3046          TDUMP   /$/- DUMP THE SYMBOL TABLE CONTENTS
11604  1257          TASK4   /SP- TERMINATOR FOR NAMES
11605  1257          TASK4   /, - TERMINATOR FOR EXPRESSIONS
11606  0606          PROCESS /; - TERMINATOR FOR COMMANDS
11607  0612          PC1     /C.R. - TERMINATOR FOR STRINGS

             /$ - FOR 'TDUMP' TERMINATES THE COMMAND.



/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 40

             /EVALUATE AN EXPRESSION WHICH
             /TERMINATES WITH AN R-PAR,; OR C.R. AND
             /LEAVE THE RESULT IN FLAC AND IN FLARG.




             /----------------------------------------------------------------------
11610  0000  ECALL,  0       /RECURSIVE CALL TO "EVAL"
11611  1054          TAD SORTCN      /SAVE 'SORTCN','LASTOP',AND 'EFOP'
11612  4541          PUSHA
11613  1055          TAD LASTOP
11614  4541          PUSHA
11615  1056          TAD EFOP        /SAVE FUNCTION CODE.
11616  4541          PUSHA
11617  1210          TAD ECALL       /RETURN TO CALLING
11620  4541          PUSHA           /ADDRESS AFTER NEXT POPJ

11621  4545          GETC            /MOVE PAST EXTRA CHARACTER
11622  3055  EVAL,   DCA LASTOP      /EVAUATION CONTROLLER (CHECKPOINT ?)
11623  4564          TESTC           /TEST CHARACTER AND IGNORE SPACES
11624  5236          JMP ETERM1      /TERMINATOR
11625  5341          JMP ENUM        /NUMBER
11626  5352          JMP EFUN        /FUNCTION
11627  4537          PUSHJ           /LETTER OF VARIABLE
11630  1416          GETVAR          /FIND OR CREATE VARIABLE;ALSO SET PT1.
11631  4564  OPNEXT, TESTC           /PT1=>ARG
11632  5253          JMP ETERMN      /T
11633  0212  ECHOLST,0212            /N-ERROR IN FORMAT
11634  0377          0377            /F
11635  5257          JMP ETERM+1     /'EVAL' FOUND A TERMINATOR WHICH WAS NOT
                                     /END OF EXPRESSION (NOT ERROR!)
11636  1136  ETERM1, TAD CFRSX       /SET PT1.
11637  3030          DCA PT1         /TO POINT TO ZERO
11640  1111          TAD M2          /TEST FOR UNARY OPERATIONS
11641  1054          TAD SORTCN
11642  7450          SNA
11643  5256          JMP ETERM       /CREATE DUMMY FOR UNARY MINUS
11644  7001          IAC
11645  7650          SNA CLA
11646  5332          JMP ARGNXT      /IGNORE UNARY PLUS
11647  1054          TAD SORTCN      /TEST FOR NULL PARENS.
11650  1121          TAD M11
11651  7710          SPA CLA
11652  5372          JMP ELPAR       /MIGHT BE AN L-PAR.
11653  4562  ETERMN, TSTLPR
11654  7410          SKP
11655  4566          ERROR4          /OPERATOR MISSING BEFORE PAREN
11656  1054  ETERM,  TAD SORTCN      /SET FROM "TESTC"-"SORTC"
11657  3024          DCA THISOP
11660  1024          TAD THISOP
11661  1121          TAD M11
11662  7700          SMA CLA         /END?
11663  3024          DCA THISOP      /"THISOP" EQUIV. TO END OF EXP.

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 41


11664  1024  ETERM2, TAD THISOP      /COMPARE PRIORITIES
11665  7041          CIA
11666  1055          TAD LASTOP
11667  7710          SPA CLA
11670  5317          JMP EPAR        /CONTINUE
11671  1055          TAD LASTOP      /FIND OPERATION
11672  7112          CLL RTR
11673  7012          RTR
11674  1340          TAD OPTABL
11675  3303          DCA FLOP
11676  1055          TAD LASTOP
11677  7640          SZA CLA         /TEST FOR END OF DATA INTO FLOATING AC.
11700  4544          POPF            /GET LAST DATA
11701  0044          FLAC
11702  4407          FINT
11703  0000  FLOP,   00              /(FLOPR I PT1)+-*/
11704  6525          FPUT I FLARGP   /SAVE RESULT
11705  0000          FXIT
11706  1125          TAD FLARGP
11707  3030          DCA PT1
11710  1024          TAD THISOP
11711  1055          TAD LASTOP      /=0?
11712  7650          SNA CLA
11713  5540          POPJ            /EXIT "EVAL"
11714  4542          POPA            /GET PRIOR OP
11715  3055          DCA LASTOP
11716  5264          JMP ETERM2      /COMPARE THIS OP
11717  4562  EPAR,   TSTLPR          /TEST FOR SUB-EXPRESSION
11720  7410          SKP
11721  5374          JMP EPAR2       /GO EVALUATE EXPRESSION
11722  1055          TAD LASTOP      /CONTINUE READING THE EXPRESSION
11723  4541          PUSHA           /SAVE "LASTOP".
11724  1030          TAD PT1
11725  3327          DCA .+2
11726  4543          PUSHF           /SAVE LAST ARGUMENT
11727  0000          00
11730  1024          TAD THISOP      /MORE TO COME
11731  3055          DCA LASTOP
11732  4545  ARGNXT, GETC            /READ 1ST CHAR OF AN ARG.
11733  4564          TESTC           /DO SPECIAL CHECK
11734  5372          JMP ELPAR       /COULD BE LEFT PAREN
11735  5341          JMP ENUM        /N
11736  5352          JMP EFUN        /F
11737  5227          JMP OPNEXT-2    /L
11740  0430  OPTABL, FGET I PT1      /BASE FOR OPERATION COMPUTATION

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 42


11741  4543  ENUM,   PUSHF           /TO PROCESS A NUMBER,SAVE AC
11742  0044          FLAC
11743  1125          TAD FLARGP      /SET POINTER AS FOR A VARIABLE.
11744  3030          DCA PT1
11745  3036          DCA INSUB       /POINT TO 'GETC' AND USE CHAR
11746  4530          JMS I FINPUT    /READ TEXT NUMBER => (PT1)
11747  4544          POPF            /RESTORE THE AC
11750  0044          FLAC
11751  5231          JMP OPNEXT      /CONTINUE
11752  3056  EFUN,   DCA EFOP        /SET CODE
11753  4545          GETC            /READ FUNCTION NAME.(1,2,OR 3 LETTERS)
11754  4550          SORTC           /LOOK FOR TERMINATION CHARACTER.
11755  1776          TERMS-1
11756  5363          JMP EFUN2       /YES
11757  1056          TAD EFOP        /NO
11760  7104          CLL RAL         /MISH-MASH HASH CODE
11761  1066          TAD CHAR
11762  5352          JMP EFUN
11763  4562  EFUN2,  TSTLPR
11764  4566          ERROR4          /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT
11765  4210          JMS ECALL       /CALL "EVAL" TO COMPUTE ARGUMENT
11766  4542          POPA            /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I.
11767  4547          SORTJ
11770  2172          FNTABL-1
11771  6200          FNTABF-FNTABL
11772  4562  ELPAR,  TSTLPR          /LEFT PAREN OR FELL THROUGH FUNCTION TABLE
11773  4566          ERROR4          /DOUBLE OPERATORS OR ILLEGAL FUNCTION NAME.
11774  4210  EPAR2,  JMS ECALL       /EVALUATE NESTED EXPRESSION
             /--------------------------------------------------------------------
11775  4542          POPA            /DUMP EXTRA ARG.
11776  5535          JMP I EFUN3I

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 43


       1777  TERMS=.         /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR'
11777  0240          240             /SPACE  0
12000  0253          253             /+      1
12001  0255          255             /-      2
12002  0257          257             //      3
12003  0252          252             /*      4
12004  0336          336             /UP ARR 5
12005  0250          250             /(      6 L-PARS
12006  0333          333             /[      7
12007  0274          274             /<      10
12010  0251          251             /)      11 R-PARS
12011  0335          335             /]      12
12012  0276          276             />      13
12013  0254          254             /,      14
12014  0273          273             /;      15
12015  0215          215             /C.R.   16
12016  0275          275     /= TO END GETARG FROM 'SET'



12017  6201  GOKILL, CDF
12020  3531          DCA I LIBN      /ZERO 'CURRENT PROGRAM SAVED' FLAG
12021  6211          CDF 10
12022  5177          JMP START
             /-----------------------------------------------------------------------
12023  1240  XABS,   TAD FLARG+1     /TAKE ABSOLUTE VALUE OF FLAC
12024  7710          SPA CLA         /SKIP TO CONTINUE
12025  4451          JMS I MINSKI    /NEGATE THE FLOATING AC

             /CONTINUATION OF FUNCTION CALLS.

12026  4407  EFUN3,  FINT
12027  7000          FNOR            /NORMALIZE FUNCTION RETURN
12030  6237          FPUT FLARG      /SAVE FUNCTION VALUE
12031  0000          FXIT
12032  1125          TAD FLARGP      /SET POINTER
12033  3030          DCA PT1
12034  4256          JMS PARTEST
12035  5636          JMP I .+1       /FUNCTION RETURN IS OK
12036  1631          OPNEXT

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 44



12037  0000  FLARG,  0       /DATA TEMPORARY STORAGE
12040  0000          0
12041  0000          0
12042  0000          0

12043  0003  P3,     3
12044  0000  LPRTST, 0               /SKIP IF LEFT PAREN. - 'TSTLPR'
12045  1054          TAD SORTCN
12046  1121          TAD M11
12047  7700          SMA CLA
12050  5644          JMP I LPRTST    /--RETURN--
12051  1054          TAD SORTCN
12052  1120          TAD M5
12053  7740          SMA SZA CLA
12054  2244          ISZ LPRTST
12055  5644          JMP I LPRTST    /--RETURN--

12056  0000  PARTEST,0               /TEST THE PAREN MATCHINGS
12057  4542          POPA            /RESTORE LAST OPERATION
12060  3055          DCA LASTOP
12061  4542          POPA            /REVERSE THESE TWO INSTRUCTIONS
12062  1243          TAD P3
12063  7041          CIA             /CHECK FOR PAREN MATCH.
12064  1054          TAD SORTCN      /(STILL SET FROM THE LAST "EVAL")
12065  7640          SZA CLA         /SKIP IF MATCH  
12066  4566          ERROR4          /PAREN ERROR
12067  4545          GETC            /MOVE PAST R-PAR
12070  5656          JMP I PARTEST   /--RETURN--

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 45


             /THE DELETE A LINE ROUTINE

12071  0000  XDELETE,0               /UNCHAIN A LINE AND RECOVER THE SPACE.
12072  4555          FINDLN          /SETS "THISLN" AND "LASTLN".
12073  5671          JMP I XDELETE   /ALREADY GONE --RETURN--
12074  2026          ISZ DEBGSW      /DISABLE TRACE
12075  4545          GETC            /MEASURE LENGTH
12076  1066          TAD CHAR
12077  1116          TAD MCR
12100  7640          SZA CLA
12101  5275          JMP .-4
12102  1017          TAD AXOUT       /SAVE LAST ADDRESS
12103  7040          CMA
12104  1023          TAD THISLN
12105  3057          DCA CNTR        /LENGTH < 0
12106  1132          TAD CFRS        /IT IS ILLEGAL TO DELETE THE FIRST LINE
12107  7041          CIA
12110  1023          TAD THISLN
12111  7650          SNA CLA
12112  5177          JMP START       /JUST IGNORE SUCH COMMANDS
12113  6201          CDF             /CHANGE DATA FIELD FOR 'DELETE'
12114  1423          TAD I THISLN    /DISCONNECT
12115  3425          DCA I LASTLN
12116  1132          TAD CFRS        /START LIST AT TOP
12117  3071  DOK,    DCA T2          /EXAMINATION ADDRESS
12120  1471          TAD I T2        /GET THE NEXT ADDR.
12121  7450          SNA             /TEST FOR END
12122  5335          JMP DONE        /YES-WRAP UP ALL.
12123  3032          DCA T1          /SAVE NEXT ADDRESS.
12124  1023          TAD THISLN      /COMPARE LINE POSITIONS
12125  7141          CIA CLL
12126  1032          TAD T1
12127  7630          SZL CLA         /SKIP IF THISLN > X
12130  1057          TAD CNTR        /CHANGE (X) TO ACCOUNT FOR
12131  1032          TAD T1          /GARBAGE COLLECTION.
12132  3471          DCA I T2
12133  1032          TAD T1          /GET NEXT
12134  5317          JMP DOK

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 46


             /GARBAGE COLLECTION

12135  7040  DONE,   CMA             /BACKUP L FOR XR
12136  1023          TAD THISLN
12137  3011          DCA XRT
12140  1057          TAD CNTR        /SETUP END OF HOSE
12141  7040          CMA
12142  1023          TAD THISLN
12143  3012          DCA XRT2
12144  1057          TAD CNTR        /CORRECT END OF BUFFER POINTER.
12145  1060          TAD BUFR
12146  3060          DCA BUFR
12147  1010          TAD AXIN        /COMPUTE COUNT
12150  7040          CMA
12151  1012          TAD XRT2
12152  3032          DCA T1
12153  1010          TAD AXIN
12154  1057          TAD CNTR
12155  3010          DCA AXIN
12156  1412          TAD I XRT2      /SIPHON LOWER PART.
12157  3411          DCA I XRT
12160  2032          ISZ T1
12161  5356          JMP .-3
12162  5272          JMP XDELETE+1   /RESET 'LASTLN','THISLN', AND DATA FIELD.


12163  0000  CHIN,   0               /READ IN A CHARACTER SUBR. - "READC"
12164  4464          JMS I INDEV
12165  3066          DCA CHAR
12166  4547          SORTJ           /USE 'SORTJ' INSTEAD OF 'SORTC'
12167  1632                  ECHOLST-1       /SO 'SORTCN' DOESN'T GET KILLED
12170  5673                  ECHOGO-ECHOLST
12171  4551  PPRNT,  PRINTC          /ECHO THE INPUT
12172  5763          JMP I CHIN      /--RETURN--
             /-------------------------------------------------------------------


       2173  FNTABL=.
12173  2533          2533    /FABS
12174  2650          2650    /FSGN
12175  2636          2636    /FITR
12176  2565          2565            /FDIS
12177  2630          2630    /FRAN
12200  2637          2637            /FJOY
12201  2572          2572    /FATN
12202  2624          2624    /FEXP
12203  2625          2625    /FLOG
12204  2654          2654    /FSIN
12205  2575          2575    /FCOS
12206  2702          2702    /FSQT
12207  1140          1140            /FIN
12210  2672          2672            /FOUT
12211  2604          2604            /FIND

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 47


             /ERASE SINGLE LINES, GROUPS, OR VARIABLES

12212  4564  ERASE,  TESTC           /TEST THE SECOND WORD, IF ANY.
             /---------------------------------------------------------------------
12213  5245          JMP ERVX        /ERASE VARIABLES
12214  5230          JMP ERL         /LINES OR GROUPS
12215  5221          JMP .+4         /ERROR
12216  1066          TAD CHAR        /ALL TEXT
12217  1112          TAD MINUSA
12220  7440          SZA
12221  4566          ERROR3          /BAD ARG FOR ERASE.
12222  1134  ERT,    TAD ENDT        /ERASE ALL TEXT **
12223  3060          DCA BUFR
12224  6201          CDF
12225  3532          DCA I CFRS      /ERASE ALL TEXT
12226  5437          JMP I GOK
12227  5177          JMP START       /POINTERS MAY BE DIFFERENT NOW.
12230  4554  ERL,    GETLN           /ERASE LINES.
12231  1060          TAD BUFR        /PROTECT REST OF TEXT.
12232  3010          DCA AXIN
12233  4565  ERG,    DELETE          /EXTRACT ONE LINE
12234  2023          ISZ THISLN
12235  1065          TAD NAGSW
12236  7700          SMA CLA
12237  4570          JMS I DTHIS     /TAD I THISLN
12240  4563          TSTGRP          /DONE ERASING GROUP?
12241  5437          JMP I GOK        /YES, ERASE 'CURRENT PROGRAM SAVED' FLAG
12242  4570          JMS I DTHIS     /TAD I THISLN
12243  3067          DCA LINENO
12244  5233          JMP ERG
12245  1133  ERVX,   TAD END         /ZERO VARIABLES (BUT NOT SECRET VARIABLES)
12246  3031          DCA LASTV
12247  5540          POPJ


/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 48


             /ROUTINE CALLED VIA "FINDLN":

             /SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ]
             /1ST RETURN IF NOT FOUND,
             /2AND IF FOUND.
             /"THISLN" = FOUND LINE OR NEXT LARGER.
             /"LASTLN" = LESSER AND/OR LAST.
             /"TEXTP" IS SET

12250  0000  XFIND,  0
12251  1132          TAD CFRS        /INITIALIZE POINTERS TO FIRST LINE
12252  3025          DCA LASTLN
12253  1132          TAD CFRS
12254  3023  FINDN,  DCA THISLN      /SAVE THIS ONE
12255  1023          TAD THISLN
12256  3011          DCA XRT
12257  1067          TAD LINENO
12260  7141          CLL CMA IAC     /CLEAR LINK AND NEGATE LINENO.
12261  4572          JMS I DXRT      /TAD I XRT
12262  7450          SNA
12263  5274          JMP FEND3-1     /FOUND IT.
12264  7630          SZL CLA
12265  5275          JMP FEND3       /PAST IT.
12266  1023          TAD THISLN      /MOVE POINTERS
12267  3025          DCA LASTLN
12270  4570          JMS I DTHIS     /TAD I THISLN
12271  7440          SZA
12272  5254          JMP FINDN       /NOT YET
12273  7410          SKP
12274  2250          ISZ XFIND       /2ND EXIT = FOUND
12275  1023  FEND3,  TAD THISLN      /1ST RETURN = NOT FOUND
12276  7001          IAC
12277  3017          DCA AXOUT       /SET "TEXTP".
12300  3020          DCA XCT
12301  5650          JMP I XFIND     /--RETURN--



/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 49

12302  0000  UTRA,   0               /UNPACK CHARACTER. - "GETC"
12303  4336          JMS GET1
12304  7710  UTE,    SPA CLA         /NORM & EXTEND
12305  1002          TAD C100        /300-337 & 340-376
12306  1365          TAD M137        /240-276 & 200-236
12307  1066          TAD CHAR
12310  7450          SNA
12311  5324          JMP UTX         /"?" FOUND
12312  1075          TAD P337
12313  3066  UTQ,    DCA CHAR
12314  1026          TAD DEBGSW
12315  1100          TAD DMPSW
12316  7650          SNA CLA         /PRINT ONLY IF BOTH ARE ZERO.
12317  4551          PRINTC
12320  5702          JMP I UTRA      /--RETURN--
12321  4336  EXTR,   JMS GET1
12322  7040          CMA
12323  5304          JMP UTE
12324  1026  UTX,    TAD DEBGSW      /TEST FOR TRACE-ENABLED
12325  7640          SZA CLA
12326  5334          JMP .+6
12327  1100          TAD DMPSW       /FLIP THE TRACE FLOP
12330  7650          SNA CLA
12331  7001          IAC
12332  3100          DCA DMPSW
12333  5303          JMP UTRA+1      /GET NEXT CHARACTER INSTEAD.
12334  1110          TAD P277        /TRACE DISABLED = RETURN "?"
12335  5313          JMP UTQ
12336  0000  GET1,   0               /UNPACK 6-BITS
12337  2020          ISZ XCT         /STARTS=0
12340  5353          JMP GET3
12341  1021          TAD GTEM
12342  0122  GEND,   AND P77
12343  3066          DCA CHAR        /SAVE
12344  1066          TAD CHAR
12345  1103          TAD M77
12346  7650          SNA CLA
12347  5321          JMP EXTR        /EXTENDED
12350  1066          TAD CHAR
12351  1364          TAD M40
12352  5736          JMP I GET1      /--RETURN--
12353  4574  GET3,   JMS I DAXOUT    /TAD I AXOUT
12354  3021          DCA GTEM
12355  7040          CMA
12356  3020          DCA XCT
12357  1021          TAD GTEM
12360  7112          RTR CLL
12361  7012          RTR
12362  7012          RTR
12363  5342          JMP GEND
12364  7740  M40,    -40
12365  7641  M137,   -137

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 50

12366  0000  XPUSHJ, 0
12367  7301          CLA CLL IAC
12370  1366          TAD XPUSHJ      /BUMP RETURN ADDRESS
12371  4541          PUSHA           /SAVE IT ON THE STACK
12372  1766          TAD I XPUSHJ    /GET THE ADDRESS
12373  3366          DCA XPUSHJ      /INDIRECT INDIRECT!
12374  5766          JMP I XPUSHJ

             /---------------------------------------------------------------------



       2375  TLIST3=.        /LITERAL TERMINATORS
12375  1257          TASK4   /"
12376  0612          PC1     /C.R. = AUTOMATIC QUOTE MATCH


       2377  INFIX=.         /DATA CONTROL CHARACTERS
12377  6202          FLINTP+2        /LEFT ARROW     = KILL
12400  0755          INPUT+1         /RUBOUT         = IGNORE
12401  0755          INPUT+1         /L.F.           = IGNORE
12402  6250          ENDFI+5         /ALT MODE       = EXIT

12403  0755          INPUT+1         /^L IN ASK STATEMENT, IGNORE IT
12404  0001  FLTONE, 0001    /(NO RELATIVE REFERENCES)
12405  2000          2000
12406  0000  FLTZER, 0000
12407  0000          0000
12410  0000          0000
12411  0000          0000
12412  7766  M12,    -12     /DECIMAL CONVERSION FACTOR FOR "PRNT"
             /----------------------------------------------------------------------

12413  0000  XENDLN, 0       /TERMINATE THE BUFFERED LINE - "ENDLN"
12414  6201          CDF
12415  1425          TAD I LASTLN    /SAVE OLD POINTER
12416  3460          DCA I BUFR
12417  1060          TAD BUFR        /POINT TO NEW LAST LINE
12420  3425          DCA I LASTLN
12421  1061          TAD ADD         /CHECK FOR EXTRA INFO
12422  7440          SZA 
12423  3410          DCA I AXIN
12424  1010          TAD AXIN        /COMPUTE NEW END OF BUFFER
12425  7001          IAC
12426  3060          DCA BUFR
12427  3531          DCA I LIBN      /WE'VE ADDED A NEW LINE
12430  6211          CDF 10          /KILL 'CURRENT PROGRAM SAVED' FLAG
12431  5613          JMP I XENDLN    /--RETURN--

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 51

12432  0000  XPRNT,  0       /PRINT A LINE NUMBER - "PRNTLN"
12433  1067          TAD LINENO
12434  4557          RTL6
12435  0122          AND P77
12436  4247          JMS PRNT        /TWO DIGIT "PART" NUMBER
12437  1102          TAD PER
12440  4551          PRINTC          /PERIOD FOR SEPARATION
12441  1067          TAD LINENO
12442  4247          JMS PRNT        /TWO DIGIT "STEP" NUMBER.
12443  1370          TAD M140
12444  3066          DCA CHAR        /SAVE SPACE IN CHAR.
12445  4551          PRINTC          /PRINT TRAILING SPACE
12446  5632          JMP I XPRNT     /--RETURN--
       0032  VAL=T1
12447  0000  PRNT,   0       /PRINT TWO DECIMAL DIGITS
12450  0106          AND P177
12451  3032          DCA VAL
12452  1113          TAD C260
12453  3033          DCA T3
12454  5257          JMP .+3
12455  2033          ISZ T3
12456  3032  XYZ,    DCA VAL
12457  1032          TAD VAL
12460  1212          TAD M12
12461  7500          SMA
12462  5255          JMP XYZ-1
12463  7200          CLA
12464  1033          TAD T3
12465  4551          PRINTC
12466  1032          TAD VAL
12467  1113          TAD C260
12470  4551          PRINTC
12471  5647          JMP I PRNT      /--RETURN--

12472  0000  OUT,    0               /OUTPUT A CHARACTER - "PRINTC"
12473  7450          SNA             /USE (AC) OR (CHAR)
12474  1066          TAD CHAR
12475  6202          CIF
12476  4713          JMS I TAB       /COUNT CHARACTERS
12477  5302          JMP OUTCR       /IT WAS A CR, PRINT CR/LF
12500  4463          JMS I OUTDEV    /PRINT NORMAL CHAR
12501  5672          JMP I OUT

12502  1120  OUTCR,  TAD M5          /SET UP TO PRINT
12503  3033          DCA T3          /  5 NULLS AFTER
12504  1077          TAD CCR         /  EACH CRLF
12505  4463          JMS I OUTDEV
12506  1076          TAD CLF
12507  4463          JMS I OUTDEV
12510  2033          ISZ T3          /AC IS NOW ZERO
12511  5307          JMP .-2
12512  5300          JMP OUTCR-2
12513  6325  TAB,    TABCNT

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 52


12514  0000  PACBUF, 0               /PACK A CHARACTER - "PACKC"
12515  1110          TAD P277
12516  7041          CIA
12517  1066          TAD CHAR
12520  7450          SNA             /CHANGE 277 TO 337
12521  1364          TAD P40
12522  1101          TAD M100
12523  7450          SNA             /TEST FOR RUBOUT.
12524  5767          JMP I RUBIT
12525  1365          TAD P377
12526  3071          DCA T2          /SAVE INPUT ITEM
12527  1071          TAD T2          /SO THAT QUESTION DOESN'T MAKE
12530  0366          AND C140        /CHAR LOOK LIKE A LEFT-ARROW
12531  1370          TAD M140
12532  7440          SZA             /DATA WORD.
12533  1366          TAD C140
12534  7650          SNA CLA
12535  5344          JMP ESCA        /340-377 AND 200-237
12536  1071  PA1,    TAD T2          /240-337
12537  0122          AND P77
12540  7440          SZA             /IGNORE 300
12541  4347          JMS PCK1
12542  6211  PACX,   CDF 10          /RESTORE FIELD AFTER 'PACKC'
12543  5714          JMP I PACBUF    /--RETURN--
12544  1122  ESCA,   TAD P77
12545  4347          JMS PCK1
12546  5336          JMP PA1
12547  0000  PCK1,   0
12550  2062          ISZ XCTIN       /=0 TO START
12551  5371          JMP ROT
12552  1061          TAD ADD
12553  4573          JMS I DAXIN     /DCA I AXIN
12554  3061          DCA ADD         /CLEAR PACKING WORD     /*8K*
12555  1013          TAD PDLXR       /CHECK FOR OVERFLOW     /*8K*
12556  7141          CMA IAC CLL                     /*8K*
12557  1001          TAD P13         /RESERVATIONS FOR PUSH-DOWN LIST/*8K*
12560  1010          TAD AXIN
12561  7620          SNL CLA
12562  5747          JMP I PCK1      /--RETURN--
12563  4566          ERROR2          /FULL BUFFER
12564  0040  P40,    40
12565  0377  P377,   377
12566  0140  C140,   140
12567  3000  RUBIT,  RUB1
12570  7640  M140,   -140
12571  4557  ROT,    RTL6    /(EAE)
12572  3061          DCA ADD
12573  7040          CMA
12574  3062          DCA XCTIN
12575  5747          JMP I PCK1

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 53

       2600  *2600

12600  0000  PS8PC,  0               /PC
12601  6201          CDF
12602  1422          TAD I PC
12603  6211          CDF 10
12604  5600          JMP I PS8PC

12605  0000  AXOUTD, 0
12606  6201          CDF
12607  1417          TAD I AXOUT
12610  6211          CDF 10
12611  5605          JMP I AXOUTD

             /INPUT OUTPUT HANDLERS -- NO INTERRUPTS

12612  0000  XI33,   0               /VIA (INDEV)
12613  2016          ISZ RISZ        /BUMP RANDOM NUMBER
12614  7410          SKP
12615  5213          JMP .-2         /DON'T LEAVE ZERO
12616  6036          KRB
12617  0106          AND P177        /IGNORE PARITY BIT
12620  7450          SNA
12621  5213          JMP XI33+1      /IGNORE NULL
12622  1123          TAD C200        /FORCE PARITY BIT ON
12623  5612          JMP I XI33      /--RETURN--

12624  0000  XOUTL,  0               /VIA (OUTDEV)
12625  6046          TLS
12626  7300          CLA CLL
12627  5624          JMP I XOUTL     /--RETURN--

12630  4217  STATN,  4217            /NORMAL STATUS BLOCK -- KSTAT
12631  0600          600             /BREAK
12632  7600          7600            /CTRL/C RESTART ADDRESS
12633  7356          RESTART         /CTRL/P RESTART ADDRESS

12634  0216  STATM,  0216            /MODIFY STATUS BLOCK -- KSTAT
12635  3776          3776            /BREAK
12636  7600          7600            /CTRL/C RESTART ADDRESS
12637  7356          RESTART         /CTRL/P RESTART ADDRESS

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 54


             /ERROR RECOVERY PROCEEDURE

12640  3241  ERROR5, DCA .+1
12641  0000  ERR2,   0
12642  7340          CLA CLL CMA     /PUT ERROR CODE IN 'LINENO' FOR 'PRNTLN'
12643  1241          TAD ERR2
12644  7410          SKP
12645  1123  RECOVR, TAD C200        /TELETYPE BREAK
12646  3067          DCA LINENO
12647  3034          DCA INBUF       /CLEAR INPUT BUFFER
12650  6203  RECOVX, CIF CDF         /DO LOWER FIELD FIXES
12651  5777'         JMP XRESTOR     /IN FIELD 0
12652  1376  RECOVY, TAD (STATN      /SET STATUS JUST TO BE SURE
12653  6047          6047            /SETSTAT -- MONITOR CALL
12654  7300          CLA CLL
12655  1375          TAD (NOP        /'OPEN INPUT TTY:,ECHO; OPEN OUTPUT TTY:'
12656  3774'         DCA PPRNT
12657  1373          TAD (XI33
12660  3064          DCA INDEV
12661  1372          TAD (XOUTL
12662  3063          DCA OUTDEV
12663  1077          TAD CCR         /PRINT CR/LF BEFORE ERROR MESSAGE
12664  4551          PRINTC
12665  1110          TAD P277
12666  4551          PRINTC          /PRINT A '?'?
12667  4553          PRNTLN
12670  2022          ISZ PC
12671  4567          JMS I DPC
12672  7450          SNA
12673  5301          JMP .+6
12674  3067          DCA LINENO
12675  1101          TAD P7700
12676  4551          PRINTC
12677  4551          PRINTC
12700  4553          PRNTLN
12701  1077          TAD CCR
12702  4551          PRINTC
12703  5177          JMP START

12772  2624
12773  2612
12774  2171
12775  7000
12776  2630
12777  5750
       3000  PAGE

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 55

             /CHARACTER REMOVAL ROUTINE

13000  1062  RUB1,   TAD XCTIN       /RUBOUT ONE LETTER
13001  7640          SZA CLA
             /----------------------------------------------------------------------
13002  5210          JMP .+6
13003  1010          TAD AXIN
13004  7041          CIA
13005  1027          TAD PACKST
13006  7700          SMA CLA         /TEST NULL LINE
13007  5635          JMP I RUB5
13010  1245          TAD SPLAT       /FOR A RUBOUT ACKNOWLEDGEMENT
13011  4400          JMS I ECHOP     /SHALL WE ECHO A '\'?
13012  1010          TAD AXIN
13013  3071          DCA T2
13014  6201          CDF             /LOWER FIELD TO RUBOUT TEXT
13015  2062          ISZ XCTIN       /TEST HALF
13016  5236          JMP RUB2
13017  1471          TAD I T2        /"ADD" IS FULL.
13020  0122          AND P77
13021  1103          TAD M77
13022  7640          SZA CLA         /TEST FOR EXTEND
13023  5233          JMP RUB4
13024  7040  RUB3,   CMA             /SET SWITCH
13025  3062          DCA XCTIN
13026  7040          CMA             /BACKUP POINTER
13027  1010          TAD AXIN
13030  3010          DCA AXIN
13031  1471          TAD I T2        /RESET ADD
13032  0101          AND P7700
13033  3061  RUB4,   DCA ADD
13034  5635          JMP I RUB5
13035  2542  RUB5,   PACX
13036  1471  RUB2,   TAD I T2        /CHECK FOR EXTENDED
13037  0101          AND P7700
13040  1002          TAD C100
13041  7640          SZA CLA
13042  5224          JMP RUB3
13043  3471          DCA I T2        /SAVE CORRECTION
13044  5225          JMP RUB3+1
13045  0334  SPLAT,  334

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 56

             /SYMBOL TABLE TYPEOUT ROUTINE

13046  1133  TDUMP,  TAD END         /INIT POINTER FOR DUMP (DON'T DUMP SECRET)
13047  3030          DCA PT1
13050  1031          TAD LASTV       /TEST FOR END OF LIST
13051  7041          CIA
13052  1030          TAD PT1
13053  7650          SNA CLA
13054  5540          POPJ
13055  1430          TAD I PT1       /GET THE VARIABLE
13056  6201          CDF             /FOR PFOCAL
13057  3714          DCA I OP+1
13060  6211          CDF 10
13061  1313          TAD OP          /SETUP UNPACK POINTERS
13062  3017          DCA AXOUT
13063  3020          DCA XCT
13064  4545          GETC            /READ AND PRINT "XX("
13065  4551          PRINTC
13066  4545          GETC
13067  4551          PRINTC
13070  4545          GETC
13071  4551          PRINTC
13072  2030          ISZ PT1
13073  1430          TAD I PT1       /PRINT SUBSCRIPT TO 99
13074  4712          JMS I PRNT2
13075  4545          GETC            /PRINT ")"
13076  4551          PRINTC
13077  2030          ISZ PT1
13100  4407          FINT            /PICK UP VALUE
13101  0430          FGET I PT1
13102  0000          FXIT
13103  4527          JMS I FOUTPUT   /PRINT VALUE
13104  1077          TAD CCR
13105  4551          PRINTC
13106  1070          TAD GINC
13107  1111          TAD M2
13110  1030          TAD PT1
13111  5247          JMP TDUMP+1

13112  2447  PRNT2,  PRNT
13113  0203  OP,     PC0+3
13114  0204          PC0+4
13115  0000          0

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 57

13116  0000  ECHO,   0
13117  3066          DCA CHAR        /SAVE IN CHAR
13120  1725          TAD I PPPRNT    /DO WE WANT TO PRINT?
13121  7650          SNA CLA
13122  5716          JMP I ECHO      /NO
13123  4551          PRINTC          /YES
13124  5716          JMP I ECHO
13125  2171  PPPRNT, PPRNT

13126  0000  ICHARF, 0               /INPUT A CHARACTER FROM A FILE
13127  6203          CIF CDF
13130  4732          JMS I CHARI     /CALL LOWER FIELD
13131  5726          JMP I ICHARF

13132  5463  CHARI,  ICHAR

13133  6202  FILER,  CIF             /FILE COMMANDS ('OPEN')
13134  5735          JMP I .+1
13135  5442          FILEST

13136  2612  X133P,  XI33

13137  0000  TERMER, 0               /CHECK FOR TERMINATOR (;, CR, SPACE,
13140  4550          SORTC
13141  1405                  GLIST-1
13142  2337          ISZ TERMER
13143  6203          CIF CDF
13144  5737          JMP I TERMER

13145  0000  EOF,    0               /TRYING TO READ FROM A FILE AFTER END
13146  1336          TAD X133P       /(SHAME ON YOU!)
13147  3064          DCA INDEV       /RESET POINTER TO TTY
13150  1110          TAD P277        /PRINT A '?'
13151  4777'         JMS XOUTL       /ON THE TELETYPE
13152  4464          JMS I INDEV     /READ A CHARACTER
13153  5745          JMP I EOF


13154  0000  OCHAR,  0               /OUTPUT A CHARACTER
13155  3071          DCA T2
13156  7410  OUTECH, SKP             /ECHO ON TELETYPE?
13157  5364          JMP .+5
13160  1071          TAD T2          /MNO
13161  7450          SNA             /YES
13162  7330          CLA CLL CML RAR /LET HIM PRINT NULLS!
13163  4777'         JMS XOUTL
13164  1071          TAD T2
13165  6202          CIF
13166  4770          JMS I NOCARE    /OUTPUT IT
13167  5754          JMP I OCHAR
13170  3665  NOCARE, NOCHAR

13171  0000  PRINTX, 0
13172  4463          JMS I OUTDEV
13173  6202          CIF

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 57-1

13174  5771          JMP I PRINTX

13177  2624
       3200          PAGE

             /-------------------------------------------------------------------

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 58

             /TEKTRONIX 4010 GRAPHICS I/O ROUTINES

       0235  GS=235
       0037  US=37
       0232  SUB=232
       0205  ENQ=205
       0233  ESC=233

       3012  XJ=3012
       3112  YJ=3112


13200  1220  FDIS,   TAD FCHKP       /CHEAT LIKE HELL!
13201  3151          DCA XPRNTC      /KLUDGE PRINTC SO WE KNOW WHAT MODE WE'RE IN
13202  4453          JMS I INTEGER   /CHECK FIRST ARG (FDIS(I,X,Y))
13203  3244          DCA FDISI       /SAVE FOR LATER TESTING
13204  1244          TAD FDISI       /ALSO TEST NOW
13205  7740          SMA SZA CLA     /NEGATIVE ARG MEANG START POINT PLOTTING
13206  1245          TAD FDSW        /ARE WE IN GRAPHICS MODE?
13207  7640  C40,    SZA CLA
13210  5215          JMP PLOT        /WE'RE IN GRAPHICS AND  I  WAS POSITIVE
13211  1377          TAD (GS         /OTHERWISE, START GRAPHICS NOW
13212  4776'         JMS XOUTL
13213  3232          DCA XHIGH
13214  3225          DCA YHIGH
13215  4537  PLOT,   PUSHJ           /GET X COORDINATE
13216  1621                  EVAL-1  /SKIP COMMA
13217  4453          JMS I INTEGER
13220  3274  FCHKP,  DCA FCHK        /TEMP
13221  4537          PUSHJ           /GET Y COORDINATE
13222  1621                  EVAL-1  /SKIP COMMA
13223  4453          JMS I INTEGER
13224  4245          JMS HIGH        /AREN'T WE THOUGH!!
13225  0000  YHIGH,  0
13226  1207          TAD C40         /ADD APPROPRIATE SIGNAL BITS
13227  4776'         JMS XOUTL
13230  1274          TAD FCHK        /SAVED X
13231  4245          JMS HIGH        /DO HIGH ORDER X
13232  0000  XHIGH,  0
13233  3274          DCA FCHK
13234  1274          TAD FCHK
13235  4776'         JMS XOUTL
13236  1244          TAD FDISI       /FIRST ARGUMENT OF FDIS
13237  7700          SMA CLA
13240  5535          JMP I EFUN3I    /RETURN FROM VECTOR PLOTTING:  I=0 OR 1
13241  1274          TAD FCHK        /SEND XLOW AGAIN TO BRIGHTEN POINT
13242  4776'         JMS XOUTL
13243  5535          JMP I EFUN3I    /RETURN FROM POINT PLOTTING

13244  0000  FDISI,  0       /SAVED VALUE OF FIRST ARGUMENT TO FDIS

       3245  FDSW=.
13245  0000  HIGH,   0               /SUB TO CHECK HIGH-ORDER, ONLY PRINT
13246  3332          DCA FDT2        /IF DIFFERENT FROM PREVIOUS
13247  1332          TAD FDT2

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 58-1

13250  7112          CLL RTR
13251  7012          RTR;RAR
13252  7010
13253  0375          AND (37
13254  1207          TAD C40
13255  3355          DCA JFLOAT
13256  1355          TAD JFLOAT
13257  1645          TAD I HIGH      /COMPARE WITH LAST HIGH
13260  7650          SNA CLA
13261  5267          JMP HXIT        /OK
13262  1355          TAD JFLOAT      /NOT SO GOOD, PRINT IT
13263  4776'         JMS XOUTL
13264  1355          TAD JFLOAT
13265  7141          CLL CIA
13266  3645          DCA I HIGH      /SAVE FOR NEXT TIME
13267  2245  HXIT,   ISZ HIGH        /SKIP
13270  1332          TAD FDT2
13271  0375          AND (37
13272  1002          TAD C100        /TAG BIT FOR LOW ORDER
13273  5645          JMP I HIGH

13274  0000  FCHK,   0               /PRINTC WAS CALLED, SWITCH TO NORMAL
13275  3245          DCA HIGH        /SAVE CHAR IN AC
13276  1374          TAD (OUT        /POINTER TO OUT
13277  3151          DCA XPRNTC
13300  1375          TAD (US
13301  4776'         JMS XOUTL
13302  1245          TAD HIGH        /PRINT CHAR
13303  4551          PRINTC          /WE RESTORED THE POINTER, REMEMBER
13304  3245          DCA FDSW        /RESET MODE SWITCH
13305  5674          JMP I FCHK

13306  1373  FJOY,   TAD (ESC        /SEQUENCE STARTS WITH 'ESC' (4010)
13307  4776'         JMS XOUTL
13310  4453          JMS I INTEGER   /CHECK ARG
13311  7650          SNA CLA
13312  1372          TAD (SUB-ENQ    /ZERO, TURN ON CURSOR AND WAIT
13313  1371          TAD (ENQ        /NON-ZERO, READ IT NOW
13314  4776'         JMS XOUTL
13315  1046          TAD FLAC+2      /FOR I=1, WILL BE NO INITIAL CHAR
13316  7750          SPA SNA CLA     /       THEREFORE, DON'T GET IT
13317  4770'         JMS XI33        /READ FIRST CHAR (STATUS OR CHAR TYPED)
13320  3274          DCA FCHK        /TEMP
13321  1367          TAD (XJ         /X-COORDINATE GOES IN 'XJ'
13322  4332          JMS JLOOK       /PUT IT THERE
13323  1366          TAD (YJ         /DITTO FOR 'YJ'
13324  4332          JMS JLOOK
13325  4770'         JMS XI33        /TO GET CR (AND IGNORE IT!)
13326  7300          CLA CLL
13327  1274          TAD FCHK
13330  4355          JMS JFLOAT      /FLOAT FIRST CHAR FOR RETURN
13331  5535          JMP I EFUN3I

       3332          FDT2=.
13332  0000  JLOOK,  0               /CREATES VARIABLE IF NEEDED, AND

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 58-2

13333  3056          DCA EFOP        /FLOATS AND STORES CROSSHAIR COORDINATE
13334  4537          PUSHJ
13335  1442                  GS1     /CALL 'GETVAR'
13336  4770'         JMS XI33        /GET HIGH-ORDER
13337  0375          AND (37         /MASK IT
13340  7106          CLL RTL;RTL;RAL
13341  7006
13342  7004
13343  3045          DCA FLAC+1      /SNEAKY, ISN'T IT?
13344  4770'         JMS XI33        /GET LOW-ORDER
13345  0375          AND (37
13346  1045          TAD FLAC+1
13347  4355          JMS JFLOAT      /FLOAT IT
13350  4407          FENT            /AND PUT IT AWAY
13351  7000          FNOR
13352  6430          FPUT I PT1      /SET BY 'GETVAR'
13353  0000          FEXT
13354  5732          JMP I JLOOK

13355  0000  JFLOAT, 0               /FLOATS 12-BIT AC
13356  3045          DCA FLAC+1
13357  1001          TAD P13         /PROPER EXPONENT
13360  3044          DCA FLAC
13361  3046          DCA FLAC+2
13362  3047          DCA FLAC+3      /CLEAR OTHER WORDS
13363  5755          JMP I JFLOAT


13366  3112
13367  3012
13370  2612
13371  0205
13372  0025
13373  0233
13374  2472
13375  0037
13376  2624
13377  0235
       3400          PAGE


       3400          STVAR=.

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 59

       5774  *5774
15774  0000  MGETC,  0               /GETC FAKE FOR LOWER FIELD
15775  4545          GETC
15776  6202          CIF
15777  5774          JMP I MGETC
       6160  *6160
16160  0000  THISD,  0
16161  6201          CDF
16162  1423          TAD I THISLN
16163  6211          CDF 10
16164  5760          JMP I THISD

16165  0000  PT1D,   0
16166  6201          CDF
16167  1430          TAD I PT1
16170  6211          CDF 10
16171  5765          JMP I PT1D

       6311  *6311
16311  4407  XRAN,   FENT            /PSEUDO-RANDOM NUMBER
16312  0337          FGET RNDM       /X(1)=(2^17+3)*X(0) MOD 2^16
16313  6040          FPUT EX1
16314  0000          FEXT
16315  1335          TAD M16
16316  3337          DCA T1S
16317  4526          JMS I DOUBLE
16320  2337          ISZ T1S
16321  5317          JMP .-2
16322  4736          JMS I PADDR
16323  4526          JMS I DOUBLE
16324  4736          JMS I PADDR
16325  4407          FINT
16326  6337          FPUT RNDM
16327  0000          FEXT
16330  3044          DCA FLAC
16331  7350          CLA CLL CMA RAR /=3777
16332  0045          AND FLAC+1
16333  3045          DCA FLAC+1      /BE POSITIVE IT'S POSITIVE
16334  5535          JMP I EFUN3I

16335  7762  M16,    -16
16336  5733  PADDR,  DUBLAD
       6337          RNDM=.
16337  0000  T1S,    0
16340  4421          4421
16341  3040          3040
16342  0001          0001
16343  0000  XRTD,   0
16344  6201          CDF
16345  1411          TAD I XRT
16346  6211          CDF 10
16347  5743          JMP I XRTD
16350  0000  AXIND,  0
16351  6201          CDF
16352  3410          DCA I AXIN

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 59-1

16353  6211          CDF 10
16354  5750          JMP I AXIND

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 60


             /THIS IS THE "LIBRARY HEAD"
       7503  *7503

17503  4560  LIB,    SPNOR           /IGNORE SPACES
17504  6203          CIF CDF         /CALL LOWER FIELD
17505  5777          JMP I (LOWLIB

17506  1376          TAD (JMP I GOSWITCH+1   /RETURN TO APPROPRIATE ROUTINE
17507  1311          TAD GOSWITCH
17510  3311          DCA GOSWITCH
17511  5712  GOSWITCH,       JMP I .+1

17512  0607          PROC
17513  0177          START
17514  1562          LGOSUB
17515  0602          GOTO+1

17516  4552  FIN,    READC           /SINGLE CHARACTER INPUT FUNCTION
17517  1066          TAD CHAR        /FLOAT THE CHARACTER
17520  3045          DCA FLAC+1
17521  3046          DCA FLAC+2      /CLEAR THE REST OF FLAC
17522  3047          DCA FLAC+3
17523  1001          TAD P13         /AND SET THE PROPER EXPONENT
17524  3044          DCA FLAC
17525  5535          JMP I EFUN3I

17526  2172  ECHOGO, CHIN+7
17527  2172          CHIN+7

17530  4453  FOUT,   JMS I INTEGER           /SINGLE CHARACTER OUTPUT FUNCTION
17531  7450          SNA
17532  1124          TAD P4000       /IN CASE IT'S ZERO
17533  4551          PRINTC
17534  5535          JMP I EFUN3I

17535  0000  CPRNT,  0               /CROSS FIELD FAKES!
17536  4551          PRINTC
17537  6203          CIF CDF
17540  5735          JMP I CPRNT

17541  0000  PGETLN, 0
17542  4554          GETLN
17543  6203          CIF CDF
17544  5741          JMP I PGETLN

17545  1375  FRAN,   TAD (XRAN       /RANDOM RANDOM NUMBERS
17546  3774          DCA I (PFRAN            /(FIRST CALL ONLY)
17547  1016          TAD RISZ                /INITIALIZE 'RNDM'
17550  3773          DCA I (RNDM+1
17551  5775          JMP I (XRAN

17552  1045  XSGN,   TAD FLAC+1              /REAL SIGNUM FUNCTION!!
17553  7650          SNA CLA
17554  5535          JMP I EFUN3I

/EFOC1C -- PS/8 FOCAL MAIN INTERPRETER    PAL8-V9H  08/28/75  PAGE 60-1

17555  4543          PUSHF
17556  2404                  FLTONE
17557  4544          POPF
17560  0044                  FLAC
17561  5772'         JMP XABS





17572  2023
17573  6340
17574  0377
17575  6311
17576  5712
17577  6400
       7600'         PAGE

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 61

             /EFLOTB -- PS/8 FOCAL FLOATING POINT PACKAGE

             /EXCEPT FOR NON-LISTING CODE WHICH WAS REMOVED FROM THE BEGINNING
             /OF THE FLOATING POINT PACKAGE, THIS SEGMENT IS IDENTICAL WITH
             /PFLOTA.  THE CODE REMOVED ASSEMBLED INTO 14000 BUT WAS OVERLAID
             /BY THE INITIALIZATION (FOCN).
             /DECEMBER 12, 1974

             /COPYRIGHT 1971  DIGITAL EQUIPMENT CORPORATION
             /       MAYNARD, MASSACHUSETTS 01754

             /
             /PAGE ZERO OF THE
             /FLOATING POINT ARITHMETIC INTERPRETER FOR FOCAL



       0001          FIELD 1

       0040  *40

10040  0000  EX1,    0       /OPERAND STORAGE
10041  0000  AC1H,   0
10042  0000  AC1L,   0
10043  0000  OVER1,  0

       0044  FLAC=.          /FLOATING ACCUMULATOR
10044  0000  EXP,    0       /F.A.
10045  0000  HORD,   0
10046  0000  LORD,   0
10047  0000  OVER2,  0

10050  0000  SIGNF,  0               /FLOATIN SIGN

10051  6603  MINSKI, ACMINS          /NEGATE FLAC SUBROUTINE
10052  0000  FISW,   0               /OUTPUT FORMAT
10053  6724  INTEGER,FIX             /FIX FLAC



             /FUNCTIONS CONTAINED IN THIS SECTION

                     /ARTN
                     /FEXP
                     /FLOG
                     /FSIN
                     /FCOS
                     /XSQRT

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 62

             /FLOATING POINT PACKAGE - EXPONENTIAL

       1045  GETSGN=TAD FLAC+1
       5535  RETURN=JMP I EFUN3I

       4620  *4600+20

14620  1045  FEXP,   GETSGN                  /TAKE ABSOLUTE VALUE
14621  7710          SPA CLA
14622  4724          JMS I NEGP
14623  3033          DCA T3          /C(SIGN)=-1 IF I X2<0
14624  4407          FINT
14625  4313          FMUL LG2E
14626  6675          FPUT I X2
14627  0000          FEXT
14630  4453          JMS I INTEGER   /TAKE INTEGER PART
14631  3325          DCA FLAG2       /SAVE LOW ORDER DATA
14632  4407          FINT
14633  7000          FNOR
14634  6676          FPUT I XSQ2
14635  0675          FGET I X2
14636  2676          FSUB I XSQ2
14637  6675          FPUT I X2
14640  4675          FMUL I X2
14641  6676          FPUT I XSQ2
14642  1310          FADD DF
14643  6326          FPUT TEMP
14644  0305          FGET CF
14645  3326          FDIV TEMP
14646  2675          FSUB I X2
14647  1277          FADD AF
14650  6326          FPUT TEMP
14651  0302          FGET BF
14652  4676          FMUL I XSQ2
14653  1326          FADD TEMP
14654  6326          FPUT TEMP
14655  0675          FGET I X2
14656  3326          FDIV TEMP
14657  4321          FMUL TWO
14660  1316          FADD ONE
14661  0000          FEXT
14662  1325          TAD FLAG2
14663  1044          TAD FLAC
14664  3044          DCA FLAC
14665  2033          ISZ T3
14666  5535          RETURN
14667  4407          FINT
14670  6675          FPUT I X2
14671  0316          FGET ONE
14672  3675          FDIV I X2
14673  0000          FEXT
14674  5535          RETURN

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 63


             /CONSTANTS FOR FEXP

14675  5322  X2,     X
14676  5326  XSQ2,   XSQR
14677  0004  AF,     0004
14700  2372          2372
14701  1402          1402
14702  7774  BF,     7774
14703  2157          2157
14704  5157          5157
14705  0012  CF,     0012
14706  5454          5454
14707  0343          0343
14710  0007  DF,     0007
14711  2566          2566
14712  5341          5341
14713  0001  LG2E,   0001
14714  2705          2705
14715  2435          2435
14716  0001  ONE,    0001
14717  2000          2000
14720  0000          0000
14721  0002  TWO,    0002
14722  2000          2000
14723  0000          0000
14724  5163  NEGP,   FNEG

14725  0000  FLAG2,  0
14726  0000  TEMP,   0
14727  0000          0
14730  0000          0
14731  0000          0



/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 64


             /MAIN ALGORITHM FOR ARCTANGENT

14732  4407  ARCALG, FINT
14733  0675          FGET I X2
14734  4675          FMUL I X2
14735  6676          FPUT I XSQ2
14736  4374          FMUL BET2
14737  1371          FADD BET1
14740  4676          FMUL I XSQ2
14741  1366          FADD BETZ
14742  6326          FPUT TEMP
14743  0363          FGET ALF2
14744  4676          FMUL I XSQ2
14745  1360          FADD ALF1
14746  4676          FMUL I XSQ2
14747  1355          FADD ALFZ
14750  4675          FMUL I X2
14751  3326          FDIV TEMP
14752  0000          FEXT
14753  5754          JMP I .+1
14754  5024          ARCRTN



             /CONSTANTS - FLOATING ARC TANGENT
14755  0000  ALFZ,   0000
14756  2437          2437
14757  1643          1643
14760  7777  ALF1,   7777
14761  3304          3304
14762  4434          4434
14763  7773  ALF2,   7773
14764  3306          3306
14765  5454          5454
14766  0000  BETZ,   0000
14767  2437          2437
14770  1646          1646
14771  0000  BET1,   0000
14772  2427          2427
14773  2323          2323
14774  7775  BET2,   7775
14775  3427          3427
14776  7052          7052



/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 65


             /------------------------------------------------------------
             /------------------------------------------------------------
             /FLOATING POINT ARC TANGENT

       5000  *5000

15000  1045  ARTN,   GETSGN          /TAKE ABSOLUTE VALUE
15001  7710          SPA CLA
15002  4363          JMS FNEG
15003  3033          DCA T3
15004  4407          FINT
15005  6635          FPUT I X1
15006  2637          FSUB I CON1
15007  0000          FEXT
15010  1045          GETSGN
15011  7710          SPA CLA
15012  5221          JMP GO          /LESS THAN ONE
15013  4407          FINT
15014  0637          FGET I CON1
15015  3635          FDIV I X1
15016  6635          FPUT I X1
15017  0000          FEXT
15020  7240          CLA CMA
15021  3362  GO,     DCA FLAG1       /SIGN FLAG OF RESULT
15022  5623          JMP I .+1       /CALL ALGORITHM
15023  4732          ARCALG
15024  2362  ARCRTN, ISZ FLAG1       /RETURN HERE
15025  5634          JMP I EXIT1
15026  4407          FINT
15027  6635          FPUT I X1
15030  0636          FGET I PI2
15031  2635          FSUB I X1
15032  0000          FEXT
15033  5634          JMP I .+1
15034  5302  EXIT1,  EXIT2

             /CONSTANTS FOR ARCTANGENT
15035  5322  X1,     X
15036  5316  PI2,    PIOT
15037  4716  CON1,   ONE


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 66


15040  1045  FLOG,   GETSGN          /FLOATING LOGARITHM
15041  7450          SNA
15042  4566          ERROR3          /ZERO ARGUEMENT FOR LOG
15043  7710          SPA CLA
15044  4566          ERROR3          /NEGATIVE ARGUMENT
15045  4407          FINT
15046  6756          FPUT I TEM
15047  2637          FSUB I CON1
15050  0000          FEXT
15051  1045          GETSGN
15052  7450          SNA
15053  5535          RETURN
15054  7700          SMA CLA
15055  5264          JMP STARTL
15056  4407          FINT
15057  0637          FGET I CON1
15060  3756          FDIV I TEM
15061  6756          FPUT I TEM
15062  0000          FEXT
15063  7240          CLA CMA
15064  3033  STARTL, DCA T3
15065  1001          TAD P13
15066  3044          DCA FLAC
15067  7040          CMA
15070  1756          TAD I TEM
15071  3045          DCA FLAC+1
15072  3046          DCA FLAC+2
15073  3047          DCA FLAC+3
15074  7001          IAC
15075  3756          DCA I TEM
15076  4407          FINT
15077  4357          FMUL LOG2
15100  6635          FPUT I X1
15101  0756          FGET I TEM
15102  2637          FSUB I CON1
15103  6756          FPUT I TEM
15104  4353          FMUL LOG8
15105  1350          FADD LOG7
15106  4756          FMUL I TEM
15107  1345          FADD LOG6
15110  4756          FMUL I TEM
15111  1342          FADD LOG5
15112  4756          FMUL I TEM
15113  1337          FADD L4
15114  4756          FMUL I TEM
15115  1334          FADD L3
15116  4756          FMUL I TEM
15117  1331          FADD L2
15120  4756          FMUL I TEM
15121  1326          FADD L1
15122  4756          FMUL I TEM
15123  1635          FADD I X1
15124  0000          FEXT
15125  5634          JMP I EXIT1

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 67



15126  0000  L1,     0000
15127  3777          3777
15130  7742          7742
15131  7777  L2,     7777
15132  4000          4000
15133  4100          4100
15134  7777  L3,     7777
15135  2517          2517
15136  0310          0310
15137  7776  L4,     7776
15140  4113          4113
15141  7211          7211

             /LOGARITHM CONSTANTS

15142  7776  LOG5,   7776
15143  2535          2535
15144  3301          3301
15145  7775  LOG6,   7775
15146  4746          4746
15147  0771          0771
15150  7774  LOG7,   7774
15151  2236          2236
15152  4304          4304
15153  7771  LOG8,   7771
15154  4544          4544
15155  1735          1735

15156  4726  TEM,    TEMP
15157  0000  LOG2,   0
15160  2613          2613
15161  4414          4414
15162  0000  FLAG1,  0




15163  0000  FNEG,   0
15164  4451          JMS I MINSKI
15165  7240          CLA CMA
15166  5763          JMP I FNEG


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 68


             /------------------------------------------------------------
             /------------------------------------------------------------
             /FLOATING POINT SINE AND COSINE

       5200  *5200

15200  4407  FCOS,   FINT            /COS(X)=SIN(PI/2-X)
15201  6322          FPUT X
15202  0316          FGET PIOT
15203  2322          FSUB X
15204  0000          FEXT
15205  1045  FSIN,   GETSGN
15206  7740          SMA SZA CLA
15207  5215          JMP MOD
15210  1045          GETSGN
15211  7700          SMA CLA
15212  5535          RETURN          /YES SIN(0)=0
15213  4451          JMS I MINSKI
15214  7040          CMA             /NO:SIN(-X)=-SIN(X)
15215  3033  MOD,    DCA T3
                     /REDUCE X MODULO 2 PI
15216  4407          FINT
15217  3306          FDIV TWOPI
15220  6326          FPUT XSQR
15221  0000          FEXT
15222  4453          JMS I INTEGER
15223  4407          FINT
15224  7000          FNOR
15225  6322          FPUT X
15226  0326          FGET XSQR
15227  2322          FSUB X
15230  4306          FMUL TWOPI
15231  6322          FPUT X
15232  2312          FSUB PI         /X<PI?
15233  0000          FEXT
15234  1045          GETSGN
15235  7710          SPA CLA
15236  5245          JMP PCHECK      /YES
15237  4407          FINT            /NO, SIN(X-PI)=-SIN(X)
15240  6322          FPUT X
15241  0000          FEXT
15242  1033          TAD T3          /INVERT THE SIGN
15243  7040          CMA
15244  3033          DCA T3

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 69


15245  4407  PCHECK, FINT            /X<PI/2?
15246  0322          FGET X
15247  2316          FSUB PIOT
15250  0000          FEXT
15251  1045          GETSGN
15252  7710          SPA CLA
15253  5261          JMP PALG        /YES
15254  4407          FINT            /NO
15255  0312          FGET PI         /SIN(X)=SIN(PI-X)
15256  2322          FSUB X
15257  6322          FPUT X
15260  0000          FEXT

15261  4407  PALG,   FINT
15262  0322          FGET X
15263  3316          FDIV PIOT
15264  6322          FPUT X
15265  4322          FMUL X
15266  6326          FPUT XSQR
15267  0332          FGET C9
15270  4326          FMUL XSQR
15271  1336          FADD C7
15272  4326          FMUL XSQR
15273  1342          FADD C5
15274  4326          FMUL XSQR
15275  1346          FADD C3
15276  4326          FMUL XSQR
15277  1316          FADD PIOT
15300  4322          FMUL X
15301  0000          FEXT
15302  2033  EXIT2,  ISZ T3
15303  5535          RETURN
15304  4451          JMS I MINSKI
15305  5535          RETURN

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 70


             /CONSTANTS AND POINTERS



15306  0003  TWOPI,  0003
15307  3110          3110
15310  3755          3755    /(3756) - FOR 3-WORD
15311  2421          2421

15312  0002  PI,     0002
15313  3110          3110
15314  3755          3755    /(3756) - FOR 3-WORD
15315  2421          2421

15316  0001  PIOT,   0001            /USED BY SINE AND COSINE
15317  3110          3110
15320  3755          3755    /(3756) - FOR 3-WORD
15321  2421          2421

15322  0000  X,      0000
15323  0000          0000
15324  0000          0000
15325  0000          0000

15326  0000  XSQR,   0000
15327  0000          0000
15330  0000          0000
15331  0000          0000

             /SINE CONSTANTS

15332  7764  C9,     7764
15333  2501          2501
15334  7015          7015
15335  1042          1042
15336  7771  C7,     7771
15337  5464          5464
15340  5514          5514
15341  6150          6150
15342  7775  C5,     7775
15343  2431          2431
15344  5361          5361
15345  4736          4736
15346  0000  C3,     0000
15347  5325          5325
15350  0414          0414
15351  3167          3167

             /END OF EXTENDED FUNCTIONS.


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 71



             /------------------------------------------------------------
             /------------------------------------------------------------
             /  - INPUT/OUTPUT ROUTINES FOR THE FOCAL
             /FLOATING POINT PACKAGE.


             /IN THE COMMENTS BELOW:-
             / F = NUMBER OF DIGITS TO BE OUTPUT     =FISW
             / D = NUMBER OF DECIMAL PLACES          =DECP
             / E = DECIMAL EXPONENT                  =BEXP
             / P = NUMBER OF PLACES REMAINING TO BE
             /     PRINTED BEFORE DECIMAL POINT


       5400  *5400

       0012  DIGITS=12       /NUMBER OF DECIMAL DIGITS OUT


15400  0000  TGO,    0
15401  3334          DCA SCOUNT      /SAVE MAX. NUMBER OF DIGITS AVAILABLE - *SET COUNTS*
15402  1052          TAD FISW
15403  4557          RTL6
15404  0122          AND P77
15405  3032          DCA T1
15406  1032          TAD T1
15407  7041          CIA             /NO, COMPUTE FIELD SIZES
15410  7450          SNA
15411  1326          TAD MD
15412  3335          DCA FCOUNT
15413  1052          TAD FISW        /(JMP FPRNT) - FOR NO ROUNDGIN.
15414  7450          SNA             /FLOATING OUTPUT?
15415  5241          JMP R6          /YES, ROUND OFF TO MAX.NO.  PLACES
15416  0122          AND P77
15417  3333          DCA DECP
15420  1335          TAD FCOUNT
15421  1333          TAD DECP
15422  7510          SPA             / F-D > 0 ?
15423  5230          JMP .+5         /YES
15424  7240          CLA CMA         /NO,
15425  1032          TAD T1
15426  3333          DCA DECP        /MAKE D = F-1
15427  7040          CMA
15430  1033          TAD T3          /COMPARE DECIMAL EXPONENT
15431  7500          SMA             / F-D > E?
15432  7200          CLA             /NO, ROUND OFF TO .F PLACES
15433  1032          TAD T1          /YES
15434  7510          SPA             / D+E < 0 ?     
15435  5263          JMP FPRNT-2     /YES, NO ROUNDING NEEDED, GO TO PRINT
15436  1326          TAD MD          /NO, ROUND TO D+E PLACES,
15437  7500          SMA             /TO A MAXIMUM OF D PLACES
15440  7200          CLA

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 72


15441  1327  R6,     TAD RND2        / *ROUND UP *
15442  3071          DCA T2          /SAVE NUMBER+1 OF PLACES TO ROUND TO.
15443  1731          TAD I BUFST
15444  1071          TAD T2          /SET UP BUFFER ADDRESS AT WHICH
15445  3336          DCA PLCE        /ROUNDING OFF SHOULD START
15446  1071          TAD T2
15447  7041          CIA             /SET UP COUNT OF MAXIMUM NUMBER
15450  3071          DCA T2          /OF CARRIES ALLOWABLE
15451  1325          TAD K4          /LITTLE EXTRA ON FIRST DIGIT.
15452  2736  RET,    ISZ I PLCE      /ADD 1 TO DIGIT AT CURRENT POSITION
15453  1736          TAD I PLCE
15454  1330          TAD OM12
15455  7710          SPA CLA         /CARRY REQUIRED?
15456  5265          JMP FPRNT       /NO, GO TO OUTPUT
15457  3736          DCA I PLCE      /YES, MAKE CURRENT DIGIT ZERO
15460  2071          ISZ T2          /BEGINNING OF BUFFER REACHED?
15461  5321          JMP DECR        /NO, DECREMENT BUFFER ADDRESS AND REPEAT
15462  2736          ISZ I PLCE      /YES, SET MANTISSA TO 0.1
15463  2033          ISZ T3          /COMPENSATE BY INCREMENTING EXPONENT
15464  7200          CLA
15465  1052  FPRNT,  TAD FISW        /AUTO-INDEX REGISTER ALREADY SET. - *PRINT*
15466  7650          SNA CLA         / F = 0 ?
15467  5356          JMP FLOUT       /YES, OUTPUT AS FLOATING NUMBER
15470  1335          TAD FCOUNT
15471  1033          TAD T3
15472  7540          SMA SZA         / E > F ?
15473  5355          JMP FLOUT-1     /YES,CONVERT TO E FORMAT
15474  1333          TAD DECP
15475  7500          SMA             / E < F-D ?
15476  7200          CLA             /NO, TAKE P = E
15477  7041          CIA             /YES, TAKE P = F-D
15500  1033          TAD T3
15501  7041          CIA
15502  3032          DCA T1          /SET UP MINUS P
15503  1033  BACK,   TAD T3          /PRINT DD.DDD
15504  1032          TAD T1
15505  7650          SNA CLA         / P = E ?
15506  5343          JMP DIG         /YES, PRINT DIGIT
15507  1032          TAD T1          /NO,
15510  7001          IAC
15511  7710          SPA CLA         / P > 1 ?
15512  1105          TAD M20 /YES, TAKE SPACE (240-260); OTHERWISE ZERO
15513  4336  IN,     JMS OUTA        /PRINT CHARACTER
15514  2032          ISZ T1          /P CHARACTERS PRINTED?
15515  5303          JMP BACK        /NO
15516  1102          TAD PER         /YES,
15517  4551          PRINTC          /PRINT DECIMAL POINT
15520  5303          JMP BACK

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 73


15521  7040  DECR,   CMA             /BACKUP TO TOP OF BUFFER.
15522  1336          TAD PLCE
15523  3336          DCA PLCE
15524  5252          JMP RET
15525  0004  K4,     4
15526  7766  MD,     -DIGITS
15527  0013  RND2,   DIGITS+1
15530  7766  OM12,   -12
15531  6150  BUFST,  SADR
15532  6154  OPUT,   OUTDG
15533  0000  DECP,   0               /MODIFIABLE LOCATIONS
15534  0000  SCOUNT, 0
15535  0000  FCOUNT, 0
       5536  PLCE=.
15536  0000  OUTA,   0               /MODIFIED REGISTERS.
15537  4732          JMS I OPUT      /PRINT CHARACTER
15540  2335          ISZ FCOUNT      /F CHARACTERS PRINTED?
15541  5736          JMP I OUTA      /NO--RETURN--
15542  5600          JMP I TGO       /YES, NUMBER FINSHED
15543  7040  DIG,    CMA
15544  1033          TAD T3          /REDUCE E, BY 1
15545  3033          DCA T3
15546  2334          ISZ SCOUNT      /ARE ALL SIG. FIGS. USED?
15547  5353          JMP .+4         /NO
15550  7040          CMA             /YES,
15551  3334          DCA SCOUNT      /RESET COUNT TO -1
15552  5313          JMP IN          /AND LEAVE C(AC) = 0
15553  1414          TAD I FLTXR     /TAKE NEXT DIGIT FROM BUFFER
15554  5313          JMP IN
             /DO FLOATING OUTPUT
15555  7200          CLA             /IF OUTPUT TOO LARGE,
15556  4732  FLOUT,  JMS I OPUT      /PRINT "0"
15557  1102          TAD PER
15560  4551          PRINTC          /PRINT "."
15561  2200          ISZ TGO         /SECOND RETURN
15562  1414          TAD I FLTXR     /TAKE NEXT DIGIT FROM BUFFER
15563  4336          JMS OUTA        /PRINT IT
15564  2334          ISZ SCOUNT      /TEST FOR END OF INPUT
15565  5362          JMP .-3         /AND REPEAT
15566  7040          CMA
15567  3334          DCA SCOUNT      /OUTPUT EXTRA ZEROS.
15570  5363          JMP .-5
15571  0000  ABSOLV, 0
15572  1045          TAD HORD
15573  3050          DCA SIGNF
15574  1045          TAD HORD
15575  7710          SPA CLA
15576  4451          JMS I MINSKI
15577  5771          JMP I ABSOLV    /--RETURN--


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 74


             /------------------------------------------------------------
             /------------------------------------------------------------
             /DOUBLE PRECISION DECIMAL-BINARY
             /INPUT AND CONVERSION FOR + OR - XXX...

       5600  *5600

15600  0000  DECONV, 0
15601  3046          DCA LORD
15602  3044          DCA EXP         /ZERO THE EXPONENT AND
15603  3045          DCA HORD        /INITIALIZE FLOATING AC.
15604  3047          DCA OVER2
15605  3314          DCA DNUMBR
15606  3050          DCA SIGNF
15607  1066          TAD CHAR        /ALLOW KEYBOARD SIGN CHECKS.
15610  1264          TAD MPLUS
15611  7450          SNA
15612  5220          JMP .+6         /+SIGN; GET NEXT
15613  1111          TAD M2          /CHECK - SIGN
15614  7640          SZA CLA
15615  5221          JMP .+4
15616  7040          CMA             /INIT SIGN CHECK TO POS.
15617  3050          DCA SIGNF
15620  4666          JMS I XINPUT    /GET NEXT
15621  1066          TAD CHAR        /A SPACE PERHAPS?
15622  1265          TAD MSPACE
15623  7650          SNA CLA
15624  5220          JMP .-4
15625  4227          JMS DECON
15626  5600          JMP I DECONV    /--RETURN--

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 75



15627  0000  DECON,  0
15630  1066          TAD CHAR        /TEST LEAD CHARACTER FOR TERMINATOR
15631  1262          TAD MINE
15632  7650          SNA CLA
15633  5627          JMP I DECON     /E--RETURN--
15634  4561          TESTN
15635  5627          JMP I DECON     /.--RETURN--
15636  5247          JMP DTST        /OTHER
15637  1054          TAD SORTCN      /N
15640  3313  DSAVE,  DCA DIGIT       /YES
15641  4267          JMS MULT10      /REMAIN MUST =0 SINCE OVERFLOW IS CHECKED
15642  2314          ISZ DNUMBR      /COUNT DIGITS
15643  7640          SZA CLA
15644  4566          ERROR2          /INPUT-OVERFLOW ERROR
15645  4666          JMS I XINPUT
15646  5230          JMP DECON+1     /CONTINUE
15647  1066  DTST,   TAD CHAR        /ALLOW A-Z
15650  1112          TAD MINUSA
15651  7710          SPA CLA
15652  5627          JMP I DECON     /--RETURN--
15653  1066          TAD CHAR
15654  1263          TAD MINUSZ
15655  7740          SZA SMA CLA
15656  5627          JMP I DECON     /USE SIX BITS OF ASCII--RETURN--
15657  1066          TAD CHAR
15660  0122          AND P77
15661  5240          JMP DSAVE
15662  7473  MINE,   -305    /(7532)- FOR AMPERSAND
15663  7446  MINUSZ, -332
15664  7525  MPLUS,  -253
15665  7540  MSPACE, -240
15666  0754  XINPUT, INPUT


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 76





15667  0000  MULT10, 0       /ROUTINE TO MULTIPLY FLAC BY TEN (10)
15670  1047          TAD OVER2
15671  3043          DCA OVER1
15672  1046          TAD LORD        /DOUBLE PRECISION WORD
15673  3042          DCA AC1L        /BY TEN (DECIMAL)
15674  1045          TAD HORD        /REMAIN=REMAINDER
15675  3041          DCA AC1H
15676  3312          DCA REMAIN      /CLEAR OVERFLOW WORD
15677  4315          JMS MULT2       /CALL SUBROUTINE TO
15700  4315          JMS MULT2       /MULTIPLY BY TWO
15701  4333          JMS DUBLAD      /CALL DOUBLE ADD
15702  4315          JMS MULT2
15703  1313          TAD DIGIT       /ADD LAST DIGIT RECEIVED
15704  3043          DCA OVER1
15705  3042          DCA AC1L
15706  3041          DCA AC1H
15707  4333          JMS DUBLAD
15710  1312          TAD REMAIN      /EXIT WITH REMAINDER
15711  5667          JMP I MULT10    /IN AC--RETURN--

15712  0000  REMAIN, 0

15713  0000  DIGIT,  0       /STORAGE FOR DIGIT
15714  0000  DNUMBR, 0       /=NUMBER OF DIGITS
15715  0000  MULT2,  0       /MULTIPLY  OVER2, LORD, HORD BY 2
15716  1047          TAD OVER2
15717  7104          CLL RAL         /CARRY INSERT BIT IS IN LINK
15720  3047          DCA OVER2
15721  1046          TAD LORD
15722  7004          RAL
15723  3046          DCA LORD
15724  1045          TAD HORD
15725  7004          RAL
15726  3045          DCA HORD
15727  1312          TAD REMAIN
15730  7004          RAL
15731  3312          DCA REMAIN
15732  5715          JMP I MULT2     /--RETURN--


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 77






15733  0000  DUBLAD, 0       /TRIPLE PRECISION ADDITION
15734  7300          CLA CLL
15735  1047          TAD OVER2
15736  1043          TAD OVER1
15737  3047          DCA OVER2
15740  7004          RAL
15741  1046          TAD LORD
15742  1042          TAD AC1L
15743  3046          DCA LORD
15744  7004          RAL
15745  1045          TAD HORD
15746  1041          TAD AC1H
15747  3045          DCA HORD
15750  7004          RAL
15751  1312          TAD REMAIN      /WITH OVERFLOW
15752  3312          DCA REMAIN
15753  5733          JMP I DUBLAD    /--RETURN--

15754  0000  DIV1,   0       /SHIFT OPERAND RIGHT
15755  7300          CLA CLL         /TRIPLE PRECISION
15756  1041          TAD AC1H
15757  7510          SPA
15760  7120          CLL CML
15761  7010          RAR
15762  3041          DCA AC1H
15763  1042          TAD AC1L
15764  7010          RAR
15765  3042          DCA AC1L
15766  1043          TAD OVER1
15767  7010          RAR
15770  3043          DCA OVER1
15771  2040          ISZ EX1
15772  5754          JMP I DIV1      /--RETURN--
15773  5754          JMP I DIV1      /--RETURN--


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 78


             /------------------------------------------------------------
             /------------------------------------------------------------
       6000  *6000

             /FLOATING OUTPUT CONVERSION ROUTINE

16000  0000  FLOUTP, 0
16001  1335          TAD PEQ
16002  4551          PRINTC          /(CLA)_ TO SUPPRESS "="
16003  1045          TAD HORD        /NUMBER>0??
16004  7700          SMA CLA
16005  1334          TAD SMSP        /PRINT "-" OR A SPACE.
16006  1336          TAD SMIN
16007  4551          PRINTC
16010  4753          JMS I ABSOL2
16011  3033  FGO2,   DCA T3          /INITIALIZE DECIMAL EXPONENT
16012  1044          TAD EXP         /IS EXP 0 TO 4?
16013  7510          SPA
16014  5227          JMP FGO3        /TOO LARGE:MULTIPLY BY 1/10
16015  7440          SZA
16016  1341          TAD M4
16017  7750          SPA SNA CLA
16020  5234          JMP FGO4
16021  4407          FINT
16022  4744          FMUL I PPTEN
16023  0000          FEXT
16024  7001          IAC
16025  1033          TAD T3
16026  5211          JMP FGO2
16027  4407  FGO3,   FINT
16030  4752          FMUL I TENPT
16031  0000          FEXT
16032  7040          CMA
16033  5225          JMP .-6

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 79


16034  3745  FGO4,   DCA I DPT       /MULTIPLY BY TWO TO POSITION BIT0
16035  3746          DCA I REPT      /CLEAR OVERFLOW WORD
16036  1350          TAD SADR        /INIT BUFFER POINTER
16037  3014          DCA FLTXR
16040  1044          TAD EXP         /COMPUTE BITS IN 1ST DIGIT
16041  7140          CMA CLL
16042  3354          DCA OUTDG       /TEMP COUNT
16043  1343          TAD DCOUNT      /SETUP COUNT OF TOTAL OUTPUT
16044  3044          DCA EXP
16045  4526          JMS I DOUBLE    /ROTATE OUT THE 1ST 4 BITS
16046  2354          ISZ OUTDG
16047  5245          JMP .-2
16050  1746          TAD I REPT      /TEST FOR 10-15,0,1-9
16051  7450          SNA 
16052  5270          JMP FGO5        /IGNORE 1ST ZERO
16053  1342          TAD FM12
16054  7710          SPA CLA
16055  5264          JMP .+7         /0-9
16056  7001          IAC
16057  3414          DCA I FLTXR     /OUTPUT A 1
16060  2044          ISZ EXP         /COUNT THE DIGIT
16061  1342          TAD FM12        /CORRECT REMAINDER
16062  2033          ISZ T3          /BUMP DECIMAL EXPONENT
16063  7000          NOP
16064  1746          TAD I REPT      /COMPUTE RESULTANT OR SECOND DIGIT 
16065  2033          ISZ T3
16066  7000          NOP
16067  7410          SKP
16070  4747  FGO5,   JMS I M10PT     /IE. .672X10=6+.72.. ETC
16071  3414          DCA I FLTXR
16072  2044          ISZ EXP         /ALL DIGITS OUTPUT??
16073  5270          JMP .-3         /NO: CONTINUE
16074  1350          TAD SADR        /INIT BUFFER POINTER
16075  3014          DCA FLTXR
16076  1343          TAD DCOUNT
16077  4751          JMS I ROUND     /OUTPUT MANTISSA
16100  5600          JMP I FLOUTP    /FIXED POINT DONE--RETURN--
16101  1333          TAD CHRT        /PRINT "E"
16102  4551          PRINTC

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 80


             /OUTPUT THE EXPONENT

16103  1033          TAD T3          /TAKE ABSOLUTE VALUE OF EXPONENT
16104  7510          SPA
16105  7041          CIA
16106  3045          DCA HORD                /SAVE + POWER 
16107  1033          TAD T3          /PRINT SIGN
16110  7700          SMA CLA
16111  1111          TAD M2
16112  1336          TAD SMIN
16113  4551          PRINTC
16114  1045          TAD HORD
16115  2044          ISZ EXP
16116  1337          TAD M144
16117  7500          SMA
16120  5315          JMP .-3
16121  1340          TAD C144
16122  3045          DCA HORD                /SAVE TENS AND UNITS
16123  7040          CMA             /OUTPUT HUNDREDS
16124  1044          TAD EXP
16125  7440          SZA             /UNLESS ZERO
16126  4354          JMS OUTDG
16127  1045          TAD HORD        /PRINT TWO DIGITS
16130  4732          JMS I PRNTI
16131  5600          JMP I FLOUTP    /--RETURN--
16132  2447  PRNTI,  PRNT
16133  0305  CHRT,   305     /E  (0246) - FOR AMPERSAND
16134  7763  SMSP,   240-255 /
16135  0240  PEQ,    240             /CHANGED FROM "=" TO SPACE
16136  0255  SMIN,   255
16137  7634  M144,   -144    /-100
16140  0144  C144,   0144    /+100
16141  7774  M4,     -4
16142  7766  FM12,   -12
16143  7765  DCOUNT, -DIGITS-1       /NUMBER OF DIGITS OUTPUT
16144  6275  PPTEN,  PTEN    /IEI
16145  5713  DPT,    DIGIT
16146  5712  REPT,   REMAIN  /OVERFLOW FROM INTEGER MULTIPLY
16147  5667  M10PT,  MULT10
16150  7467  SADR,   BUFFER-1
16151  5400  ROUND,  TGO     /ACTUAL OUTPUT ROUTINE
16152  6271  TENPT,  TEN
16153  5571  ABSOL2, ABSOLV
16154  0000  OUTDG,  0               /OUTPUT ONE DIGIT
16155  1113          TAD C260
16156  4551          PRINTC
16157  5754          JMP I OUTDG     /--RETURN--

             /USED BY 8K


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 81



             /------------------------------------------------------------
             /------------------------------------------------------------
             /FLOATING POINT INPUT

       6200  *6200

16200  0000  FLINTP, 0               /IF C(AC) = 0, USE CHAR
16201  7640          SZA CLA         /IF C(AC) NON-ZERO , GET NEXT
16202  4706          JMS I XIN       /GET FIRST CHAR
16203  1066          TAD CHAR        /IGNORE LEADING SPACES
16204  1114          TAD M240
16205  7650          SNA CLA
16206  5202          JMP .-4
16207  4702          JMS I DPCVPT    /READ FIRST DIGIT GROUP 
16210  1066          TAD CHAR        /AND SET "SIGNF"
16211  1115          TAD MPER
16212  7640          SZA CLA         /ENDED BY PERIOD?
16213  5221          JMP FIGO1
16214  4706          JMS I XIN       /YES, READ 2AND GROUP
16215  3705          DCA I DPN
16216  4703          JMS I DCONP
16217  1705          TAD I DPN       /SAVE NUMBER OF DIGITS IN T3
16220  7041          CMA IAC
16221  3033  FIGO1,  DCA T3          /NO,
16222  1310          TAD P43
16223  3044          DCA EXP
16224  4704          JMS I RESOL5
16225  4707          JMS I INORM     /NORMALIZE FIRST, THEN
16226  4407          FINT
16227  6430          FPUT I PT1      /SAVE NUMBER
16230  0000          FEXT
16231  1066          TAD CHAR
16232  1301          TAD MINUSE
16233  7640          SZA CLA         /"E" READ IN?
16234  5246          JMP ENDFI+3     /NO
16235  4706          JMS I XIN       /YES, READ 3RD DIGIT GROUP
16236  4702          JMS I DPCVPT    /I.E. CONVERT DECIMAL EXPONENT
16237  4704          JMS I RESOL5
16240  1047          TAD OVER2
16241  1033          TAD T3          /C(SEXP)PLACES TO RIGHT
16242  3033          DCA T3          /OF LAST DIGIT




/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 82


             /COMPENSATE FOR DECIMAL EXPONENTS

16243  4407  ENDFI,  FINT            /RESTORE MANTISSA
16244  0430          FGET I PT1
16245  0000          FEXT
16246  1033          TAD T3          /TEST DECIMAL EXPONENT
16247  7450          SNA
16250  5600          JMP I FLINTP    /FINISHED--RETURN--
16251  7700          SMA CLA
16252  5261          JMP FIGO4
16253  4407          FINT            /. IS TO THE LEFT:
16254  4275          FMUL PTEN       /TIMES .1000
16255  6430          FPUT I PT1
16256  0000          FEXT
16257  7001          IAC
16260  5266          JMP .+6
16261  4407  FIGO4,  FINT            /. IS TO THE RIGHT:
16262  4271          FMUL TEN        /MULTIPLY BY 10
16263  6430          FPUT I PT1
16264  0000          FEXT
16265  7040          CMA
16266  1033          TAD T3
16267  3033          DCA T3
16270  5246          JMP ENDFI+3
16271  0004  TEN,    0004
16272  2400          2400
16273  0000          0000
16274  0000          0000

16275  7775  PTEN,   7775
16276  3146          3146
16277  3146          3146    /(3147) - FOR 3-WORD
16300  3150          3150

16301  7473  MINUSE, -305    /(7532) - FOR AMPERSAND

16302  5600  DPCVPT, DECONV
16303  5627  DCONP,  DECON
16304  7173  RESOL5, RESOLV
16305  5714  DPN,    DNUMBR
16306  0754  XIN,    INPUT
16307  7335  INORM,  DNORM
16310  0043  P43,    43

             /END OF FLOATING POINT INPUT

             /7 FREE

             /USED BY H.S. READER

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 83


             /------------------------------------------------------------
             /------------------------------------------------------------
       6400  *6400
                     / FLOATING-POINT INTERPRETER FOR FOCAL.

16400  0000  FPNT,   0
16401  7300          CLA CLL
16402  7000          NOP             /(DCA OVER2) - FOR 3-WORD
16403  7000          NOP             /(DCA OVER1) - FOR 3-WORD.
16404  1600          TAD I FPNT      /GET NEXT INSTRUCTION
16405  7450          SNA
16406  5600          JMP I FPNT      /FAST EXIT--RETURN--
16407  3262          DCA JUMP
16410  1262          TAD JUMP
16411  0123          AND C200        /GET PAGE BIT
16412  7650          SNA CLA         /PAGE ZERO?
16413  5216          JMP .+3         /YES
16414  1104          TAD P7600       /NO
16415  0200          AND FPNT        /C(FPNT)0-4 CONTAINS PAGE BITS
16416  3040          DCA ADDR
16417  1106          TAD P177        /GET 7 BIT ADDRESS
16420  0262          AND JUMP
16421  1040          TAD ADDR
16422  3040          DCA ADDR
16423  1263          TAD INDRCT      /INDIRECT BIT=1?
16424  0262          AND JUMP
16425  7650          SNA CLA
16426  5231          JMP LOOP01      /NO-GO ON
16427  1440          TAD I ADDR      /YES ,DEFER ,W/O AUTO-INDEX
16430  3040          DCA ADDR
16431  2200  LOOP01, ISZ FPNT
16432  7040          CMA
16433  1040          TAD ADDR
16434  3015          DCA FLTXR2
16435  1262          TAD JUMP        /GET COMMAND
16436  7106          CLL RTL
16437  7006          RTL
16440  0107          AND P17         /GET BITS 0-2,IE OPCODE
16441  7450          SNA
16442  5267          JMP FLGT
16443  1264          TAD TABLE       /LOOKUP IN TABLE
16444  3262          DCA JUMP
16445  1662          TAD I JUMP
16446  7450          SNA
16447  5265          JMP FLPT
16450  3262          DCA JUMP
16451  1304          TAD CEX1        /SAVE FLOATING ARGUEMENT,UNLESS'GET' OR 'PUT'
16452  3014          DCA FLTXR
16453  1117          TAD MFLT
16454  3057          DCA CNTR
16455  1415          TAD I FLTXR2
16456  3414          DCA I FLTXR
16457  2057          ISZ CNTR
16460  5255          JMP .-3

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 83-1

16461  5662          JMP I JUMP      /GO THERE


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 84


16462  0000  JUMP,   0

       0040  ADDR=EX1

16463  0400  INDRCT, 0400
16464  6573  TABLE,  ITABLE
16465  1303  FLPT,   TAD CEXP        /EXP TO (ADDR)
16466  5273          JMP .+5
16467  1303  FLGT,   TAD CEXP        /(ADDR) TO EXP
16470  3015          DCA FLTXR2
16471  7040          CMA
16472  1040          TAD ADDR
16473  3014          DCA FLTXR       /SAVE 'FROM' ADDRESS
16474  1117          TAD MFLT        /3 OR 4 WORDS
16475  3057          DCA CNTR
16476  1414          TAD I FLTXR
16477  3415          DCA I FLTXR2
16500  2057          ISZ CNTR
16501  5276          JMP .-3
16502  5201          JMP FPNT+1
16503  0043  CEXP,   EXP-1
16504  0037  CEX1,   EX1-1


16505  4765  FLSU,   JMS I OPMINS    /FSUB=2 - NEGATE THE OPERAND
16506  4770  FLAD,   JMS I ALGN      /FLAD=1 - FIRST ALIGN EXPONENTS
16507  5201          JMP FPNT+1      /RETURN IF NO ALIGNMENT IS POSSIBLE
16510  4772          JMS I RAR2      /TRIPLE PRECISION ADDDITION
16511  4771          JMS I RAR1      /SINCE BITS ARE SHIFTED
16512  4773          JMS I TRAD      /RIGHT
16513  4767  NORF,   JMS I NORM      /NORMALIZE THE RESULT
16514  5201          JMP FPNT+1      /HINT:USE 700X FOR FUNCTIONS.

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 85


             /INTERPRETIVE POWER

16515  7000          NOP     /3 FREE LOCATIONS ************
16516  7000          NOP
16517  7000          NOP
16520  3044  ZERO,   DCA EXP         /YES
16521  3045          DCA HORD
16522  3046          DCA LORD
16523  3047          DCA OVER2
16524  5201          JMP FPNT+1
16525  4543  FLEX,   PUSHF           /AC TO A + POWER
16526  0044          FLAC
16527  4543          PUSHF           /SETUP ARGUMENT ( THE EXPONENT)
16530  0040          EX1
16531  4544          POPF
16532  0044          FLAC
16533  4453          JMS I INTEGER   /ONLY POSITIVE, INTEGER  EXPONENTS
16534  7510          SPA
16535  5342          JMP .+5         /(COULD DIVIDE)
16536  7040          CMA
16537  3262          DCA JUMP        /TEMP STORAGE
16540  7000          NOP             /(DCA OVER1) - FOR 3-WORD
16541  1045          TAD HORD
16542  7640          SZA CLA
16543  4566          ERROR2          /TOO LARGE OR NEGATIVE EXPONENT
16544  4543          PUSHF           /INITIALIZE TO ONE.
16545  2404          FLTONE
16546  4544          POPF
16547  0044          FLAC
16550  4544          POPF
16551  7470          ITER1
16552  5360          JMP .+6
16553  4543          PUSHF
16554  7470          ITER1
16555  4544          POPF
16556  0040          EX1
16557  4766          JMS I MULT      /"MULT"
16560  2262          ISZ JUMP
16561  5353          JMP .-6
16562  5201          JMP FPNT+1

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 86

16563  4766  FLMY,   JMS I MULT      /MULTIPLY
16564  5201          JMP FPNT+1
             /------------------------------------------------------------


16565  7153  OPMINS, MINUS2
16566  7004  MULT,   DMULT
16567  7335  NORM,   DNORM
16570  6623  ALGN,   ALIGN
16571  5754  RAR1,   DIV1
16572  6757  RAR2,   DIV2
16573  5733  TRAD,   DUBLAD

       6573  ITABLE=.-1
16574  6506          FLAD
16575  6505          FLSU
16576  7107          FLDV
16577  6563          FLMY
16600  6525          FLEX
16601  0000          0000
16602  6513          NORF
             /------------------------------------------------------------

16603  0000  ACMINS, 0       /ROUTINE TO  COMPLEMENT FLAC - VIA "MINSKI"
16604  7300          CLL CLA         
16605  1047          TAD OVER2       /TRIPLE PRECISION NEGATION
16606  7041          CMA IAC         /OF FLOATING AC
16607  3047          DCA OVER2
16610  1046          TAD LORD
16611  7040          CMA
16612  7430          SZL
16613  7101          IAC CLL
16614  3046          DCA LORD
16615  1045          TAD HORD
16616  7040          CMA
16617  7430          SZL
16620  7101          IAC CLL
16621  3045          DCA HORD
16622  5603          JMP I ACMINS    /--RETURN--


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 87


16623  0000  ALIGN,  0       /SUBROUTINE TO ALIGN
16624  1045          TAD HORD        /BINARY POINTS
16625  7450          SNA
16626  1046          TAD LORD        /IS MANTISSA ZERO?
16627  7650          SNA CLA
16630  5311          JMP NOX1        /YES, RESULT=OPERAND
16631  1041          TAD AC1H        /NO,IS OPERAND ZERO?
16632  7450          SNA
16633  1042          TAD AC1L
16634  7450          SNA
16635  1043          TAD OVER1
16636  7650          SNA CLA
16637  5623          JMP I ALIGN     /YES--RETURN--
16640  1040          TAD EX1
16641  7041          CMA IAC
16642  1044          TAD EXP
16643  7450          SNA             /ARE EXPONENTS EQUAL?
16644  5273          JMP ADONE       /YES
16645  3203          DCA ACMINS
16646  1203          TAD ACMINS
16647  7500          SMA             /NO
16650  7041          CIA             /NEGATE AND
16651  3322          DCA AMOUNT      /SAVE THE DIFFERENCE
16652  1322          TAD AMOUNT
16653  1336          TAD TEST2
16654  7710          SPA CLA         /CAN THE EXPONENTS BE ALIGNED?
16655  5275          JMP NOX         /NO, USE LARGER OF THE TWO.
16656  1203          TAD ACMINS      /YES, SHIFT THE SMALLER
16657  7700          SMA CLA
16660  5265          JMP ASHFT
16661  4357          JMS DIV2
16662  2322          ISZ AMOUNT
16663  5261          JMP .-2
16664  5273          JMP ADONE

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 88

16665  7040  ASHFT,  CMA     
16666  1040          TAD EX1
16667  3040          DCA EX1
16670  4723          JMS I TAG1
16671  2322          ISZ AMOUNT
16672  5270          JMP .-2
16673  2223  ADONE,  ISZ ALIGN
16674  5623          JMP I ALIGN     /--RETURN--
16675  1040  NOX,    TAD EX1         /MISSION IMPOSSIBLE!
16676  7700          SMA CLA         /CHECK FOR SIGN DIFFERENCE
16677  5304          JMP NOX2
16700  1044          TAD EXP
16701  7700          SMA CLA
16702  5623          JMP I ALIGN     /-+--RETURN--
16703  5306          JMP .+3         /--
16704  1044  NOX2,   TAD EXP
16705  7700          SMA CLA
16706  1203          TAD ACMINS      /TEMP STORAGE OF DIFFERENCE. BOTH POS EXP OR BOTH NEG.
16707  7740          SMA SZA CLA
16710  5623          JMP I ALIGN     /OK (+-)--RETURN--
16711  1040  NOX1,   TAD EX1         /USE LARGER
16712  3044          DCA EXP
16713  1041          TAD AC1H
16714  3045          DCA HORD
16715  1042          TAD AC1L
16716  3046          DCA LORD
16717  1043          TAD OVER1
16720  3047          DCA OVER2
16721  5623          JMP I ALIGN     /--RETURN--
16722  0000  AMOUNT, 0
16723  5754  TAG1,   DIV1

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 89

             /LEAVE 12 BIT ANSWER IN AC UPON RETURN
             /LEAVE FLAC AS AN INTEGER,

16724  0000  FIX,    0               /VIA (INTEGER)
16725  4751          JMS I ABSOL
16726  1044          TAD EXP         /TEST FOR FRACTION
16727  7750          SPA SNA CLA
16730  5353          JMP FIXM        /DOUBLE CHECK FOR MINUS ONE.
16731  7001          IAC
16732  3043          DCA OVER1
16733  1350          TAD P27         /INIT ALIGNMENT
16734  3040          DCA EX1
16735  4223          JMS ALIGN       /DO THE ALIGNMENT TO AN INTEGER
16736  0043  TEST2,  0043            /ALREADY DONE; (27)-FOR 3-WORD
16737  2047          ISZ OVER2
16740  5344          JMP .+4
16741  2046          ISZ LORD
16742  7410          SKP
16743  2045          ISZ HORD
16744  3047          DCA OVER2       /CLEAR THE FRACTION
16745  4752          JMS I RESOL
16746  1046          TAD LORD        /EXIT WITH LOW ORDER RESULT IN AC.
16747  5724          JMP I FIX       /--RETURN--
16750  0027  P27,    27
16751  5571  ABSOL,  ABSOLV
16752  7173  RESOL,  RESOLV
16753  3044  FIXM,   DCA EXP         /CLEAR EXPONENT
16754  3045          DCA HORD
16755  3046          DCA LORD
16756  5344          JMP TEST2+6
16757  0000  DIV2,   0       /SHIFT FLAC RIGHT
16760  7300          CLA CLL
16761  1045          TAD HORD
16762  7510          SPA
16763  7020          CML
16764  7010          RAR
16765  3045          DCA HORD
16766  1046          TAD LORD
16767  7010          RAR
16770  3046          DCA LORD
16771  1047          TAD OVER2
16772  7010          RAR
16773  3047          DCA OVER2
16774  2044          ISZ EXP
16775  5757          JMP I DIV2      /--RETURN--
16776  5757          JMP I DIV2      /--RETURN--
             /------------------------------------------------------------
       6777  SPECIAL=.       /INPUT CHARACTERS
16777  0337          337     /LEFT ARROW
17000  0377          377     /RUBOUT
17001  0212          212     /L.F.
17002  0375          375     /ALT MODE
17003  0214          214             /^L IS IGNORED IN AN "ASK" COMMAND

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 90


             /(A+B+C)*(D+E+F)=A*D,A*E,B*D,B*E

17004  0000  DMULT,  0       /N- PRECISION MULTIPLY WITH
17005  7001          IAC     /PRODUCT IN TRIPLE PRECISION
17006  1040          TAD EX1 /ADD EXPONENTS+1
17007  4324          JMS SIGN        /AND DETERMINE SIGN OF RESULT
17010  7710          SPA CLA
17011  4353          JMS MINUS2
17012  3301          DCA DATUM-1     /INITIALIZE RESULT
17013  3300          DCA DATUM-2
17014  3277          DCA DATUM-3
17015  3276          DCA DATUM-4
17016  1045          TAD A           /A*D
17017  3751          SAVE            /STORE IN MP2
17020  1041          TAD D           /SINGLE PRECISION MULTIPLY
17021  4752          MULTY
17022  0002          2               /ACCUMULATE STARTING IN #2 DATA WORD
17023  1042          TAD E           /A*E
17024  4752          MULTY
17025  0003          3
17026  1046          TAD B           /B*D
17027  3751          SAVE
17030  1041          TAD D
17031  4752          MULTY
17032  0003          3
17033  1042          TAD E           /B*E
17034  4752          MULTY
17035  0004          4
17036  3275  DMULT4, DCA DATUM-5     /(JMP DMDONE)-FOR 3-WORD
17037  3274          DCA DATUM-6
17040  1043          TAD F           /A*F
17041  3751          SAVE
17042  1045          TAD A
17043  4752          MULTY
17044  0004          4
17045  1046          TAD B           /B*F
17046  4752          MULTY
17047  0005          5
17050  1047          TAD C           /C*D
17051  3751          SAVE
17052  1041          TAD D
17053  4752          MULTY
17054  0004          4
17055  1042          TAD E           /C*E
17056  4752          MULTY
17057  0005          5
17060  1043          TAD F           /C*F
17061  4752          MULTY
17062  0006          6

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 91


17063  1301  DMDONE, TAD DATUM-1     /COPY RESULT
17064  3045          DCA HORD
17065  1300          TAD DATUM-2
17066  3046          DCA LORD
17067  1277          TAD DATUM-3
17070  3047          DCA OVER2
17071  4301          JMS MULDIV
17072  7000          NOP             /(DCA OVER2) - FOR 3-WORD
17073  5604          JMP I DMULT     /--RETURN--

       7102  DATUM=.+6       /INTERMEDIATE STORAGE

             /#6-LOW ORDER RESULT
             /#5
             /#4
             /#3
             /#2
             /#1-HIGH ORDER RESULT

       7101  *DATUM-1

17101  0000  MULDIV, 0       /TERMINATE MULTIPLY AND DIVIDE.
17102  2050          ISZ SIGNF               /CORRECT FOR SIGN
17103  4451          JMS I MINSKI
17104  4747          JMS I NORMF     /SHIFT LEFT
17105  7000          NOP
17106  5701          JMP I MULDIV    /--RETURN--
17107  1041  FLDV,   TAD AC1H        /4:DIVIDE
17110  7650          SNA CLA
17111  4566          ERROR2          /DIVISION BY ZERO
17112  1040          TAD EX1         /SUBTRACT EXPONENTS+1
17113  7041          CMA IAC
17114  7001          IAC
17115  4324          JMS SIGN        /SET UP SIGNS
17116  7700          SMA CLA
17117  4353          JMS MINUS2      /NEGATE DIVISOR
17120  4750          JMS I DIVIDE    /DIVIDE
17121  4301          JMS MULDIV
17122  5723          JMP I .+1
17123  6401          FPNT+1

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 92


             /THIS SUBROUTINE PREPARES MULTIPLY AND DIVIDE
             /FOR ANY COMBINATION OF SIGNED ARGUMENTS AND FOR ZERO.
             /THE RESULT OF EITHER IS ZERO IF FLAC = 0.
             /RESULT OF MULTIPLY IS ZERO IF EITHER IS ZERO;
             /DIVISION BY ZERO IS CHECKED BEFORE THIS 
             /ROUTINE IS CALLED. 

             /THE CALLING AC CONTAINS AN UPDATE VALUE FOR THE
             /EXPONENT. THE RETURNING AC CONTAINS THE SIGN OF 
             /THE ARGUMENT FOR FURTHER TESTING BY EACH ROUTINE.


17124  0000  SIGN,   0               /TEST AND SAVE SIGN OF RESULT
17125  1044          TAD EXP /COMPUTE NEW EXPONENT FOR MUL-DIV.
17126  3044          DCA EXP
17127  1124          TAD P4000       /LOAD 4000 TO XOR THE SIGN BITS
17130  0045          AND HORD
17131  1041          TAD AC1H
17132  7700          SMA CLA         /RESULT MAY BE ZERO
17133  7040          CMA
17134  3050          DCA SIGNF
17135  1045          TAD HORD
17136  7450          SNA
17137  5746          JMP I REVIT     /ANSWER IS ZERO.
17140  7710          SPA CLA         /TAKE ABSOLUTE VALUE OF FLAC
17141  4451          JMS I MINSKI
17142  1041          TAD AC1H
17143  7450          SNA             /RESULT OF EITHER MAY BE ZERO
17144  5746          JMP I REVIT
17145  5724          JMP I SIGN      /--RETURN--

             /SIGN OF RESULT = SIGNF
             /+=-1
             /-=0

17146  6520  REVIT,  ZERO
17147  7335  NORMF,  DNORM
17150  7261  DIVIDE, DUBDIV

       3751  SAVE=DCA I .
17151  7256          MP2
       4752  MULTY=JMS I .
17152  7200          MP4

       0045  A=FLAC+1
       0046  B=FLAC+2
       0047  C=FLAC+3
       0041  D=AC1H
       0042  E=AC1L
       0043  F=OVER1

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 93



17153  0000  MINUS2, 0       /NEGATE OPERAND
17154  7300          CLA CLL         /TRIPLE PRECISION
17155  1043          TAD OVER1
17156  7041          CMA IAC
17157  3043          DCA OVER1
17160  1042          TAD AC1L
17161  7040          CMA
17162  7430          SZL
17163  7101          IAC CLL
17164  3042          DCA AC1L
17165  1041          TAD AC1H
17166  7040          CMA
17167  7430          SZL
17170  7101          IAC CLL
17171  3041          DCA AC1H
17172  5753          JMP I MINUS2    /--RETURN--

17173  0000  RESOLV, 0
17174  1050          TAD  SIGNF
17175  7710          SPA CLA
17176  4451          JMS I MINSKI
17177  5773          JMP I RESOLV    /--RETURN--
             /------------------------------------------------------------
             /------------------------------------------------------------
       7200  *7200

17200  0000  MP4,    0       /SINGLE PRECISION, UNSIGNED MULTIPLY - "MULTY"
17201  7450          SNA     /NO RESULT ADDED IF ZERO
17202  5600          JMP I MP4       /--RETURN--

             /FOR EAE INSERT THE FOLLOWING:

             /7203  3206  DCA .+3
             /7204  1256  TAD MP2
             /7205  7425  MQL MUY
             /7206  0000  0
             /7207  3253  DCA MP5
             /7210  7501  MQA
             /7211  3255  DCA MP3
             /7212  5227  JMP .+15


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 94


17203  3254          DCA MP1         /12 BITS BY 12 BITS
17204  3253          DCA MP5
17205  1257          TAD THIR
17206  3255          DCA MP3
17207  7100          CLL
17210  1254  MP6,    TAD MP1
17211  7010          RAR
17212  3254          DCA MP1
17213  1253          TAD MP5
17214  7420          SNL
17215  5220          JMP .+3
17216  7100          CLL
17217  1256          TAD MP2
17220  7010          RAR
17221  3253          DCA MP5 /SAVE HIGH ORDER RESULT
17222  2255          ISZ MP3
17223  5210          JMP MP6
17224  1254          TAD MP1 /CORRECT LOW ORDER RESULT
17225  7010          RAR
17226  3255          DCA MP3
17227  1600          TAD I MP4       /PICKUP SCALE FACTOR
17230  7041          CIA
17231  1252          TAD DATUMA      /COMPUTE ADDRESS
17232  3254          DCA MP1         /TEMP
17233  1255          TAD MP3         /LOW ORDER PART
17234  7100          CLL
17235  1654          TAD I MP1       /ACCUMULATE
17236  3654          DCA I MP1
17237  2254          ISZ MP1
17240  7004          RAL
17241  1253          TAD MP5
17242  1654          TAD I MP1
17243  3654          DCA I MP1
17244  7420          SNL
17245  5600          JMP I MP4       /NO CARRY--RETURN--
17246  2254          ISZ MP1
17247  2654          ISZ I MP1
17250  5600          JMP I MP4       /--RETURN
17251  5246          JMP .-3         /CARRY AGAIN
17252  7102  DATUMA, DATUM
17253  0000  MP5,    0               /PRODUCT
17254  0000  MP1,    0               /MULTIPLIER
17255  0000  MP3,    0
17256  0000  MP2,    0               /MULTIPLICAND
17257  7764  THIR,   -14     /12 BITS

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 95



17260  7735  MIF,    -43             /(-27) - FOR 3-WORD(=7751)

17261  0000  DUBDIV, 0       /2 OR 3  PRECISION DIVIDE
17262  3200          DCA MP4
17263  3254          DCA MP1
17264  1260          TAD MIF         /INIT BIT COUNTER
17265  3255          DCA MP3
17266  7410          SKP
17267  4526  DV3,    JMS I DOUBLE    /SHIFT FLAC LEFT
17270  7100          CLL
17271  1043          TAD OVER1
17272  1047          TAD OVER2
17273  3253          DCA MP5
17274  7004          RAL
17275  1042          TAD AC1L        /COMBINE ONE POSITION AND (4-WORD)
17276  1046          TAD LORD
17277  3256          DCA MP2         /SAVE RESULT
17300  7004          RAL
17301  1045          TAD HORD        /ADD OVERFLOW
17302  1041          TAD AC1H
17303  7420          SNL             /SKIP IF OVERFLOW
17304  5312          JMP .+6
17305  3045          DCA HORD        /UPDATE FLAC
17306  1253          TAD MP5
17307  3047          DCA OVER2
17310  1256          TAD MP2
17311  3046          DCA LORD
17312  7200          CLA             /CLEAR ACCUMULATOR
17313  1254          TAD MP1         /SAVE OVERFLOW BITS CIRCULARLY
17314  7004          RAL
17315  3254          DCA MP1 
17316  1200          TAD MP4
17317  7004          RAL
17320  3200          DCA MP4
17321  1335          TAD DNORM
17322  7004          RAL             /EXTRA FOR 4-WORD
17323  3335          DCA DNORM
17324  2255          ISZ MP3         /TEST FOR END OF DIVIDE
17325  5267          JMP DV3
17326  1335          TAD DNORM
17327  3045          DCA HORD
17330  1200          TAD MP4
17331  3046          DCA LORD
17332  1254          TAD MP1
17333  3047          DCA OVER2
17334  5661          JMP I DUBDIV    /--RETURN--


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 96



17335  0000  DNORM,  0       /SUBROUTINE TO NORMALIZE FLAC
17336  4775          JMS I ABSOL3
17337  4366          JMS TEST4
17340  1045          TAD HORD
17341  7450          SNA             /IS MANTISSA=0?
17342  1047          TAD OVER2
17343  7450          SNA
17344  1046          TAD LORD
17345  7650          SNA CLA
17346  5363          JMP EXIT3       /YES
17347  1045          TAD HORD
17350  7104          RAL CLL
17351  7710          SPA CLA         /WILL SHIFT BE TOO FAR?
17352  5360          JMP .+6
17353  4526          JMS I DOUBLE
17354  7140          CMA CLL
17355  1044          TAD EXP
17356  3044          DCA EXP
17357  5347          JMP .-10
17360  4776          JMS I RESOL3
17361  4366          JMS TEST4       /DON'T LEAVE 4000
17362  5735          JMP I DNORM     /--RETURN--
17363  3044  EXIT3,  DCA EXP         /SET TO ZERO
17364  5735          JMP I DNORM     /--RETURN--
17365  6757  XRAR2,  DIV2
17366  0000  TEST4,  0
17367  1045          TAD HORD        /TEST FOR 4000
17370  7510          SPA
17371  7041          CIA
17372  7710          SPA CLA
17373  4765          JMS I XRAR2     /SHIFT BACK
17374  5766          JMP I TEST4     /--RETURN--

17375  5571  ABSOL3, ABSOLV
17376  7173  RESOL3, RESOLV

/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 97


             /------------------------------------------------------------
             /------------------------------------------------------------
       7400  *7400


             /PAGE 18

                     /FLOATING SQUARE ROOT FUNCTION

17400  4407  XSQRT,  FINT
17401  6274          FPUT FPAC1      /VALUE
17402  0000          FEXT            /NEWTON'S METHOD IS USED
17403  1045          GETSGN
17404  7710          SPA CLA
17405  4566          ERROR2          /NUMBER IS NEGATIVE=IMAGINARY ROOTS
17406  1044          TAD EXP         /LINK IS =0 FROM FINT
17407  7510          SPA             /MATCH THE SIGN WITH LINK BIT
17410  7020          CML
17411  7010          RAR
17412  3270          DCA ITER1       /MAKE FIRST APPROXIMATION
17413  7430          SZL             /TEST LSB OF EXP
17414  2270          ISZ ITER1
17415  7000          NOP
17416  1267          TAD SQCON1
17417  3271          DCA ITER1+1
17420  3272          DCA ITER1+2
17421  3273          DCA ITER1+3
17422  1275          TAD FPAC1+1
17423  7450          SNA
17424  1276          TAD FPAC1+2
17425  7650          SNA CLA
17426  5265          JMP SQEND       /NUMBER=0
17427  4407  CLCU,   FINT
17430  0274          FGET FPAC1
17431  3270          FDIV ITER1
17432  1270          FADD ITER1
17433  0000          FEXT


/EFLOTB -- PS/8 FOCAL FLOATING POINT PA   PAL8-V9H  08/28/75  PAGE 98




17434  7240          CLA CMA
17435  1044          TAD EXP
17436  3044          DCA EXP
17437  1044          TAD EXP
17440  7041          CMA IAC
17441  1270          TAD ITER1
17442  7640          SZA CLA         /ARE EXPONENTS EQUAL?
17443  5261          JMP ROOTGO      /NO
17444  1045          TAD HORD        /ARE HIGH-ORDER MANTISSAS EQUAL?
17445  7041          CMA IAC
17446  1271          TAD ITER1+1
17447  7640          SZA CLA
17450  5261          JMP ROOTGO      /NO
17451  1046          TAD LORD
17452  7041          CMA IAC 
17453  1272          TAD ITER1+2     /DO LOW-ORDER MANTISSAS AGREE
17454  7500          SMA
17455  7041          CMA IAC         /WITHIN ONE BIT?
17456  7001          IAC
17457  7700          SMA CLA
17460  5535          RETURN
17461  4407  ROOTGO, FINT
17462  6270          FPUT ITER1
17463  0000          FEXT
17464  5227          JMP CLCU
17465  3044  SQEND,  DCA EXP
17466  5535          RETURN
17467  3015  SQCON1, 3015

       7470  BUFFER=.

17470  0000  ITER1,  0
17471  0000          0
17472  0000          0
17473  0000          0

17474  0000  FPAC1,  0
17475  0000          0
17476  0000          0
17477  7503          BUFFER+13       /ADDRESS OF NEXT FREE LOCATION IN 10-DIGIT VERSION.





/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 99

             /EFOCNC -- INITIALIZATION FOR PS/8 FOCAL

       0176          *176
10176  4002          INIT

       4000          *4000
14000  2646  INRECV, RECOVR+1        /ERROR RECOVERY ADDRESS
14001  2630  INSTAT, STATN           /NORMAL STATUS BLOCK ADDRESS
14002  1200  INIT,   TAD INRECV
14003  3176          DCA 176
14004  1201          TAD INSTAT      /SET USER STATUS
14005  6047          6047            /SET USER STATUS
14006  7300          CLA CLL
14007  6201          CDF
14010  1777          TAD I (207      /MOVE LENGTH OF INITIAL DIALOGUE
14011  6211          CDF 10
14012  3060          DCA BUFR        /(JUST IN CASE)
14013  4537          PUSHJ
14014  0420                  DO+1
14015  1376          TAD (4300       /"#@" FOR SYSTEM STATUS
14016  4775'         JMS LOOKUP
14017  7340          CLA CLL CMA
14020  1030          TAD PT1
14021  3030          DCA PT1
14022  4407          FINT            /GET SYSTEM STATUS VARIABLE
14023  0430          FGET I PT1
14024  6352          FPUT INITMP     /SAVE IT FOR LATER
14025  0000          FEXT
14026  1045          TAD FLAC+1      /IF IT'S ZERO, INITIAL DIALOGUE WASN'T THERE
14027  7650          SNA CLA
14030  5327          JMP SECRET      /ASSUME STANDARD FEATURES
14031  1374  CHKLOG, TAD (100        /"A@" (KEEP SIN & COS)
14032  4775'         JMS LOOKUP
14033  7640          SZA CLA
14034  5241          JMP CHKSIN
14035  4773'         JMS CHANGE      /KILL ALL EXTENDED FUNCTIONS
14036  4316                  SINADD-1
14037  1372          TAD (TTAB-1     /SET VARIABLE BOTTOM
14040  5250          JMP CHKFIL-1
14041  1371  CHKSIN, TAD (200        /"B@" (KEEP ALL FUNCTIONS)
14042  4775'         JMS LOOKUP
14043  7640          SZA CLA
14044  5251          JMP CHKFIL
14045  4773'         JMS CHANGE      /KILL LOG, EXP, ATN
14046  4322                  LOGADD-1
14047  1370          TAD (5177       /AND RESET BOTTOM
14050  3035          DCA BOTTOM
14051  1367  CHKFIL, TAD (400        /"D@" (FILE COMMANDS)
14052  4775'         JMS LOOKUP
14053  7640          SZA CLA
14054  5257          JMP CHKSP
14055  4773'         JMS CHANGE      /KILL FILE COMMANDS
14056  4307                  FILADD-1
14057  1366  CHKSP,  TAD (500        /"E@" (LEADING SPACE IN TYPE [FOR FILES])
14060  4775'         JMS LOOKUP

/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 99-1

14061  7640          SZA CLA
14062  5265          JMP CHKEQ
14063  4773'         JMS CHANGE
14064  4336                  SPADD-1
14065  1365  CHKEQ,  TAD (700        /"G@" ('=' IN TYPE)
14066  4775'         JMS LOOKUP
14067  7650          SNA CLA         /REVERSE SENSE ON NON-STANDARD FEATURES
14070  5273          JMP CHKCOL
14071  4773'         JMS CHANGE
14072  4343                  EQADD-1
14073  1364  CHKCOL, TAD (1000       /"H@" (FOR ':' IN ASK)
14074  4775'         JMS LOOKUP
14075  7650          SNA CLA
14076  5301          JMP CHKAMP
14077  4773'         JMS CHANGE
14100  4331                  COLADD-1
14101  1363  CHKAMP, TAD (1100       /"I@" (FOR & INSTEAD OF E)
14102  4775'         JMS LOOKUP
14103  7650          SNA CLA
14104  5307          JMP CHKPRC
14105  4773'         JMS CHANGE
14106  4352                  AMPADD-1
14107  1362  CHKPRC, TAD (300        /"C@" (EXTENDED PRECISION)
14110  4775'         JMS LOOKUP
14111  7640          SZA CLA
14112  5327          JMP SECRET
14113  4773'         JMS CHANGE
14114  4221                  FORADD-1
14115  1361          TAD (-31
14116  3775'         DCA LOOKUP
14117  1360          TAD (7270
14120  3010          DCA 10
14121  1357          TAD (FORFIN-1
14122  3011          DCA 11
14123  1411          TAD I 11
14124  3410          DCA I 10
14125  2775'         ISZ LOOKUP
14126  5323          JMP .-3
14127  1133  SECRET, TAD END
14130  3031          DCA LASTV       /ERASE VARIABLES
14131  1356          TAD (4100
14132  4775'         JMS LOOKUP      /CREATE THE THREE SECRET VARIABLES
14133  1375          TAD (4200
14134  4775'         JMS LOOKUP
14135  1376          TAD (4300
14136  4775'         JMS LOOKUP
14137  7340          CLA CLL CMA
14140  1030          TAD PT1
14141  3030          DCA PT1         /BACKUP PT1
14142  4407          FINT            /RESTORE SYSTEM SECRET VARIABLE
14143  0352          FGET INITMP
14144  6430          FPUT I PT1
14145  0000          FEXT
14146  1031          TAD LASTV
14147  3133          DCA END         /MAKE THEM SECRET

/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 99-2

14150  5751          JMP I .+1
14151  2222          ERT             /ERASE ALL TEXT

14152  0000  INITMP, ZBLOCK 4        /HOLDING AREA FOR '#'

14156  4100
14157  4256
14160  7270
14161  7747
14162  0300
14163  1100
14164  1000
14165  0700
14166  0500
14167  0400
14170  5177
14171  0200
14172  1262
14173  4207
14174  0100
14175  4200
14176  4300
14177  0207
       4200          PAGE

/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 100

14200  0000  LOOKUP, 0
14201  3056          DCA EFOP
14202  4537          PUSHJ
14203  1442                  GS1
14204  2030          ISZ PT1
14205  1430          TAD I PT1       /PICK UP FIRST SIGNIFICANT WORD
14206  5600          JMP I LOOKUP

14207  0000  CHANGE, 0
14210  1607          TAD I CHANGE
14211  2207          ISZ CHANGE
14212  3010          DCA 10
14213  1410  CLOOP,  TAD I 10
14214  7450          SNA
14215  5607          JMP I CHANGE
14216  3071          DCA T2
14217  1410          TAD I 10
14220  3471          DCA I T2
14221  5213          JMP CLOOP

             /THESE ARE THE LISTS TO PATCH FOCAL TO YOUR CUSTOMIZED SPECS

             /CHANGES FOR 6-DIGIT PRECISION
14222  0070  FORADD, 70
14223  0005          5
14224  0117          117
14225  7775          7775
14226  5526          5526
14227  7772          7772
14230  5527          5527
14231  0007          7
14232  1515          VARPCH
14233  7000          NOP
14234  6143          6143
14235  7771          7771
14236  6277          6277
14237  3147          3147
14240  6402          6402
14241  3047          3047
14242  6540          6540
14243  3043          3043
14244  6736          6736
14245  0027          27
14246  7036          7036
14247  5263          5263
14250  7105          7105
14251  2047          2047
14252  7072          7072
14253  3047          3047
14254  7260          7260
14255  7751          7751
14256  0000          0

             /ADDITIONAL CHANGES FOR 6-DIGIT PRECISION -- NOT MADE WITH "CHANGE"
14257  1042  FORFIN, 1042

/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 100-1

14260  1046          1046
14261  3256          3256
14262  7004          7004
14263  1045          1045
14264  1041          1041
14265  7420          7420
14266  5304          5304
14267  3045          3045
14270  1256          1256
14271  3046          3046
14272  7200          7200
14273  1254          1254
14274  7004          7004
14275  3254          3254
14276  1200          1200
14277  7004          7004
14300  3200          3200
14301  2255          2255
14302  5267          5267
14303  1254          1254
14304  3046          3046
14305  1200          1200
14306  3045          3045
14307  5661          5661

14310  0226  FILADD, PUSHB           /PATCH PUSHB
14311  5643          MPUSHA-1+13
14312  0367          PUSHB1          /PATCH PUSHB1
14313  5611          5576+13
14314  1201          1201            /PATCH COMGO
14315  2640          ERROR5
14316  0000          0

14317  0405  SINADD, 405
14320  2640          ERROR5
14321  0406          406
14322  2640          ERROR5
14323  0402  LOGADD, 402
14324  2640          ERROR5
14325  0403          403
14326  2640          ERROR5
14327  0404          404
14330  2640          ERROR5
14331  0000          0

14332  1216  COLADD, 1216
14333  1371          1371            /'TAD ALIST'
14334  1217          1217
14335  4400          JMS I ECHOP
14336  0000          0

14337  6001  SPADD,  6001
14340  7300          CLA CLL         /DON'T PRINT LEADING SPACE
14341  6002          6002
14342  7300          CLA CLL

/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 100-2

14343  0000          0

14344  6001  EQADD,  6001
14345  1335          1335            /'TAD PEQ'
14346  6002          6002
14347  4551          PRINTC
14350  6135          6135
14351  0275          0275            /PRINT LEADING '='
14352  0000          0

14353  5662  AMPADD, 5662
14354  7532          7532
14355  6133          6133
14356  0246          246
14357  6301          6301
14360  7532          7532
14361  0000          0

       4400          PAGE

             $$$$$$$$$$$

/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 101

A      0045      BUFFER 7470      D      0041      DXRT   0172
ABSOL  6751      BUFR   0060      DATUM  7102      E      0042
ABSOLV 5571      BUFST  5531      DATUMA 7252      ECALL  1610
ABSOL2 6153      C      0047      DAXIN  0173      ECHCHK 6102
ABSOL3 7375      CALL   7233      DAXOUT 0174      ECHFLG 0047
ACDF   5654      CCIF   3726      DCDYES 6131      ECHGO  6041
ACIF   5741      CCR    0077      DCMA   6601      ECHO   3116
ACMINS 6603      CEXP   6503      DCONP  6303      ECHOGO 7526
AC1H   0041      CEX1   6504      DCONT  0470      ECHOLS 1633
AC1L   0042      CF     4705      DCOUNT 6143      ECHOP  0000
ADD    0061      CFRS   0132      DEBGSW 0026      EFOP   0056
ADDR   0040      CFRSX  0136      DECODE 6116      EFUN   1752
ADONE  6673      CHAINE 6600      DECON  5627      EFUN2  1763
AF     4677      CHANGE 4207      DECONV 5600      EFUN3  2026
AGAIN  6310      CHAR   0066      DECP   5533      EFUN3I 0135
ALFZ   4755      CHARI  3132      DECR   5521      ELPAR  1772
ALF1   4760      CHIN   2163      DELETE 4565      END    0133
ALF2   4763      CHKAMP 4101      DERR   7303      ENDFI  6243
ALGN   6570      CHKCOL 4073      DEVC   6242      ENDLN  4556
ALIGN  6623      CHKEQ  4065      DEVHLD 0105      ENDT   0134
ALIST  1400      CHKFIL 4051      DEVNO  0054      ENQ    0205
AMOUNT 6722      CHKLOG 4031      DF     4710      ENUM   1741
AMPADD 4353      CHKPRC 4107      DGRP   0424      EOF    3145
ARCALG 4732      CHKSIN 4041      DGRP1  0440      EPAR   1717
ARCRTN 5024      CHKSP  4057      DIG    5543      EPAR2  1774
ARGNXT 1732      CHKVAR 1457      DIGIT  5713      EQADD  4344
ARTN   5000      CHRT   6133      DIGITS 0012      ERASE  2212
ASHFT  6665      CLCU   7427      DIRLIS 7072      ERG    2233
ASK    1207      CLF    0076      DISMIS 6152      ERL    2230
ATEM   0036      CLOOP  4213      DIVIDE 7150      ERROR  7244
ATLIST 1576      CNTR   0057      DIV1   5754      ERROR1 4463
ATSW   1206      CNTRX  1306      DIV2   6757      ERROR2 4566
AUTO1  0010      COLADD 4332      DLOAD  6244      ERROR3 4566
AUTO2  0011      COMBUF 0131      DMDONE 7063      ERROR4 4566
AUTO3  0012      COMGO  1167      DMPSW  0100      ERROR5 2640
AUTO4  0013      COMLIS 6355      DMULT  7004      ERR2   2641
AUTO5  0014      COMLST 0772      DMULT4 7036      ERT    2222
AUTO6  0015      COMMEN 0612      DNORM  7335      ERVX   2245
AUTO7  0016      COMPAR 6276      DNUMBR 5714      ESC    0233
AUTO8  0017      CON1   5037      DO     0417      ESCA   2544
AXIN   0010      COUNT  7170      DOK    2117      ETERM  1656
AXIND  6350      CPRNT  7535      DONE   2135      ETERMN 1653
AXOUT  0017      CRONLY 6344      DOONE  0462      ETERM1 1636
AXOUTD 2605      CSTAR  0225      DOUBLE 0126      ETERM2 1664
B      0046      C100   0002      DPC    0167      EVAL   1622
BACK   5503      C140   2566      DPCVPT 6302      EXIT1  5034
BETZ   4766      C144   6140      DPN    6305      EXIT2  5302
BET1   4771      C200   0123      DPT    6145      EXIT3  7363
BET2   4774      C260   0113      DPT1   0171      EXP    0044
BF     4702      C3     5346      DSAVE  5640      EXTENS 0031
BLKCNT 3655      C40    3207      DTHIS  0170      EXTR   2321
BLLL   6526      C5     5342      DTST   5647      EX1    0040
BLOCK  6537      C7     5336      DUBDIV 7261      F      0043
BLOKLP 7017      C7600  6432      DUBLAD 5733      FADD   1000
BOTTOM 0035      C9     5332      DV3    7267      FCDF   5670

/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 101-1

FCHK   3274      FLIST2 0572      GONE   0232      IRST   5615
FCHKP  3220      FLMY   6563      GOSUB  6701      ITABLE 6573
FCIF   5721      FLNGTH 0052      GOSUB1 6601      ITEMP  5543
FCONT  1077      FLOG   5040      GOSWIT 7511      ITER1  7470
FCOS   5200      FLOP   1703      GOTO   0601      JFLOAT 3355
FCOUNT 5535      FLOUT  5556      GRPTST 0742      JLOOK  3332
FDIS   3200      FLOUTP 6000      GS     0235      JUMP   6462
FDISI  3244      FLPT   6465      GSERCH 1433      K4     5525
FDIV   3000      FLP5   0305      GS1    1442      LASTLN 0025
FDSW   3245      FLSU   6505      GTEM   0021      LASTOP 0055
FDT2   3332      FLTONE 2404      GTMON  6143      LASTV  0031
FEND3  2275      FLTXR  0014      GZERR  0361      LBLOCK 7023
FENT   4407      FLTXR2 0015      HANDAD 6200      LCON   0370
FETCHE 6602      FLTZER 2406      HANDOK 6265      LENF1  6660
FEXP   4620      FL100  0302      HIGH   3245      LEXIT  7144
FEXT   0000      FMUL   4000      HND    7223      LGOSUB 1562
FGET   0000      FM12   6142      HORD   0045      LG2E   4713
FGO2   6011      FNEG   5163      HXIT   3267      LIB    7503
FGO3   6027      FNOR   7000      IBAR   0212      LIBBLK 0055
FGO4   6034      FNTABF 0373      IBLK   5472      LIBDEV 6534
FGO5   6070      FNTABL 2173      ICHAR  5463      LIBFIL 0104
FIGO1  6221      FOCTXT 7343      ICHARF 3126      LIBHND 0061
FIGO4  6261      FOR    1037      ICHAR1 5503      LIBLEN 6533
FILADD 4310      FORADD 4222      ICHAR2 5505      LIBN   0131
FILER  3133      FORFIN 4257      ICHAR3 5513      LIBRAR 7000
FILEST 5442      FOUT   7530      IECALL 1035      LIBX   7060
FILGO  6365      FOUTPU 0127      IF     1011      LINENO 0067
FILIST 6764      FPAC1  7474      IF1    1033      LINE0  0210
FIN    7516      FPNT   6400      IF3    1023      LINE1  0224
FINCR  1063      FPOW   5000      IGNOR  0217      LISTFL 0032
FIND   0551      FPRNT  5465      ILIST  0767      LISTGO 1376
FINDLN 4555      FPUT   6000      IN     5513      LIST3  0077
FINDN  2254      FRAN   7545      INBLK  0067      LIST6  0073
FIND1  0555      FSIN   5205      INBUF  0034      LIST7  0075
FINFIN 1135      FSUB   2000      INCHT  5545      LNGTH  7235
FINKP  1131      FXIT   0000      INDEV  0064      LOAD   6606
FINPUT 0130      GECALL 1567      INDRCT 6463      LOADGO 6620
FINT   4407      GEND   2342      INFIX  2377      LOGADD 4323
FISW   0052      GETARG 1412      INHND  0073      LOG2   5157
FIX    6724      GETC   4545      INIT   4002      LOG5   5142
FIXM   6753      GETDEV 7152      INITMP 4152      LOG6   5145
FJOY   3306      GETLN  4554      INLIST 0567      LOG7   5150
FLAC   0044      GETLP  1422      INORM  6307      LOG8   5153
FLAD   6506      GETSGN 1045      INPUT  0754      LOOKUP 4200
FLAG1  5162      GETVAR 1416      INPUTX 0271      LOOP01 6431
FLAG2  4725      GET1   2336      INRECV 4000      LOOP2  7027
FLARG  2037      GET3   2353      INSTAT 4001      LOOP3  7142
FLARGP 0125      GINC   0070      INSUB  0036      LORD   0046
FLDSET 5743      GLIST  1406      INTEGE 0053      LOWLIB 6400
FLDV   7107      GLOOP  1446      IOPEN  5600      LPRTST 2044
FLEX   6525      GLOOP1 1470      IOWAIT 6137      L1     5126
FLGT   6467      GNAME  6016      IPART  1036      L2     5131
FLIMIT 1073      GO     5021      IPNFLG 0051      L3     5134
FLINTP 6200      GOK    0037      IPNTR  5544      L4     5137
FLIST1 0575      GOKILL 2017      IRETN  0227      MAKVAR 1475

/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 101-2

MAKV1  1506      M4     6141      OUT    2472      PPRNT  2171
MCOM   1134      M40    2364      OUTA   5536      PPTEN  6144
MCR    0116      M5     0120      OUTBLK 0074      PRETRN 6540
MD     5526      M77    0103      OUTCR  2502      PRINTC 4551
MEQ    1133      NAGSW  0065      OUTDEV 0063      PRINTX 3171
MF     0600      NAME   6000      OUTDG  6154      PRNT   2447
MFLT   0117      NAMEC  6031      OUTECH 3156      PRNTI  6132
MGETC  5774      NAMECT 6135      OUTHND 0100      PRNTLN 4553
MGETLN 7337      NAMLOC 0026      OVER1  0043      PRNT2  3112
MIF    7260      NAMPT  7234      OVER2  0047      PROC   0607
MINE   5662      NEGATE 4451      O2     3724      PROCES 0606
MINSKI 0051      NEGP   4724      O3     3730      PSAVE  6436
MINUSA 0112      NEND   7136      O7600  3751      PSIN   0165
MINUSE 6301      NEWDEV 0033      PACBUF 2514      PS8PC  2600
MINUSZ 5663      NEWLIN 6352      PACKC  4546      PTABLE 7162
MINUS2 7153      NLOOP  7110      PACKST 0027      PTEMP  0311
MOD    5215      NMBASE 6133      PACX   2542      PTEN   6275
MODIFY 1313      NOCARE 3170      PADDR  6336      PTEST  1575
MPD2   5656      NOCHAR 3665      PALG   5261      PT1    0030
MPD3   5705      NORF   6513      PARTES 2056      PT1D   6165
MPER   0115      NORM   6567      PATCH  7141      PUSHA  4541
MPLUS  5664      NORMF  7147      PA1    2536      PUSHB  0226
MPOPA  5732      NOSAVE 6720      PBACK  1303      PUSHB1 0367
MPRINT 6321      NOTEQ  6221      PC     0022      PUSHF  4543
MPUSHA 5631      NOX    6675      PCHECK 5245      PUSHJ  4537
MP1    7254      NOX1   6711      PCK1   2547      PUTDEV 6560
MP2    7256      NOX2   6704      PCOMGO 6423      P13    0001
MP3    7255      NPACK  7305      PC0    0200      P15    1262
MP4    7200      NPRNT  7132      PC1    0612      P17    0107
MP5    7253      NXTVAR 1454      PDELET 7252      P177   0106
MP6    7210      OBLK   3716      PDERR  5646      P2000  0372
MSEX   6761      OCHAR  3154      PDIGIT 7121      P27    6750
MSORTC 5755      OCHCT  3770      PDLXR  0013      P277   0110
MSORTJ 6737      OCHK   7270      PD2    0476      P3     2043
MSPACE 5665      OCLCHK 7330      PD3    0507      P337   0075
MSTATM 1311      OCLOSE 3636      PEQ    6135      P377   2565
MSTATN 1312      OCLOSR 6555      PER    0102      P40    2564
MULDIV 7101      OLNGTH 3767      PERD   6071      P4000  0124
MULT   6566      OM12   5530      PERDSW 6134      P43    6310
MULTY  4752      ONE    4716      PEXIT  0022      P7600  0104
MULT10 5667      ONMTMP 5546      PFRAN  0377      P77    0122
MULT2  5715      OOPEN  5400      PGETLN 7541      P7700  0101
M10PT  6147      OOVER  3742      PI     5312      P7740  0371
M100   0101      OP     3113      PIOT   5316      RAR1   6571
M11    0121      OPEN   7200      PI2    5036      RAR2   6572
M12    2412      OPMINS 6565      PLCE   5536      RDIV   0152
M137   2365      OPNEXT 1631      PLOT   3215      RDPTR  5525
M140   2570      OPNFLG 0050      POINT  0033      READC  4552
M144   6137      OPTABL 1740      POINT4 6530      RECORD 6536
M16    6335      OPTR1  3765      POINT6 6662      RECOVR 2645
M2     0111      OPTR2  3766      POINT7 7167      RECOVX 2650
M20    0105      OPUT   5532      POPA   4542      RECOVY 2652
M240   0114      ORST   5425      POPF   4544      REMAIN 5712
M260   1535      OSETUP 3753      POPJ   5540      REPT   6146
M271   1536      OTHER  7214      PPPRNT 3125      RESOL  6752

/EFOCNC -- INITIALIZATION FOR PS/8 FOCA   PAL8-V9H  08/28/75  PAGE 101-3

RESOLV 7173      SPACE  1310      TLIST3 2375      XIN    6306
RESOL3 7376      SPADD  4337      TPOPA  4442      XINPUT 5666
RESOL5 6304      SPECIA 6777      TPOPF  4445      XINT   1362
RESTAR 7356      SPLAT  3045      TPRINT 4501      XI33   2612
RESTOR 3614      SPNOR  4560      TPUSHA 4443      XJ     3012
RET    5452      SQCON1 7467      TPUSHF 4444      XOUTL  2624
RETRN  1570      SQEND  7465      TQUOT  1236      XPOPA  0520
RETRY  6231      SRETN  0261      TRAD   6573      XPOPJ  1572
RETURN 5535      SRNLST 1372      TRND   1307      XPRNT  2432
REVIT  7146      START  0177      TSORTJ 4446      XPRNTC 0151
RISZ   0016      STARTL 5064      TSPNOR 4503      XPUSHA 1365
RNDM   6337      STARTV 0133      TSTGRP 4563      XPUSHJ 2366
RND2   5527      STATM  2634      TSTLPR 4562      XRAN   6311
ROOTGO 7461      STATN  2630      TT     6136      XRAR2  7365
ROT    2571      STBLK  0053      TTAB   1263      XRESTO 5750
ROUND  6151      STVAR  3400      TTYIN  5627      XRT    0011
RT     3730      SUB    0232      TTYOUT 5440      XRTD   6343
RTL6   4557      SUBS   1526      TTYTXT 6735      XRTL6  0412
RUBIT  2567      SWAPIN 7275      TWO    4721      XRT2   0012
RUB1   3000      TAB    2513      TWOPI  5306      XSGN   7552
RUB2   3036      TABC   1305      TYPE   1210      XSORTC 0717
RUB3   3024      TABCNT 6325      TYPE2  1232      XSPNOR 1526
RUB4   3033      TABCPT 6354      T1     0032      XSQR   5326
RUB5   3035      TABLE  6464      T1S    6337      XSQRT  7400
R6     5441      TAG1   6723      T2     0071      XSQ2   4676
SADR   6150      TASK   1211      T3     0033      XTESTC 0676
SAVBLK 6504      TASK4  1257      US     0037      XTESTN 1542
SAVE   3751      TCRLF  1255      USR    0021      XTSPNO 6726
SAVEPT 6470      TCRLF2 1252      UTE    2304      XT3    0715
SAVER  6433      TDUMP  3046      UTQ    2313      XYZ    2456
SBAR   1342      TEM    5156      UTRA   2302      X1     5035
SCHAR  1333      TEMP   4726      UTX    2324      X133P  3136
SCONT  1330      TEM7   0035      VAL    0032      X2     4675
SCOUNT 5534      TEN    6271      VARPCH 1515      YBLK   5404
SECRET 4127      TENPT  6152      WALL   0662      YHIGH  3225
SECRTV 0175      TERMER 3137      WORDS  0004      YINT   5402
SET    1037      TERMS  1777      WRITE  0633      YJ     3112
SEX    1164      TESTA  0350      WTESTG 0665      ZERFND 1517
SEXC   0736      TESTC  4564      WTEST2 0651      ZERO   6520
SFOUND 1346      TESTGO 7064      WX     0671      ZERROR 0543
SGOT   1353      TESTN  4561      X      5322      ZERSCH 1541
SHNDLR 0040      TESTRM 4462      XABS   2023      ZERSW  0034
SIGN   7124      TEST2  6736      XCHAR  0037      ZFOUND 0550
SIGNF  0050      TEST4  7366      XCHIN  0566      ZLOOP  7106
SINADD 4317      TEXTP  0017      XCNTR  0020      ZSERCH 0525
SLOT   6206      TGETC  4441      XCT    0020      Z1467  0546
SMIN   6136      TGETLN 4502      XCTIN  0062      Z3     0547
SMP    6101      TGO    5400      XDELET 2071
SMRETN 1355      THIR   7257      XENDLN 2413
SMSP   6134      THISD  6160      XFIND  2250
SORTB  1140      THISLN 0023      XFIND1 0565
SORTC  4550      THISOP 0024      XFORM  7317
SORTCN 0054      TINTR  1245      XGETC  7347
SORTJ  4547      TLIST  1407      XGETLN 0315
SP     1537      TLIST2 1413      XHIGH  3232



ERRORS DETECTED: 0
LINKS GENERATED: 55