Retro1.org codex

COVLAY2 
* /---   FILE TYPE = E
* /---   BLOCK      COVLAY2    00 000   81/07/28  02.24 
          IDENT  COVLAY2
          LCC    OVERLAY(1,1) 
* 
          TITLE  ASSORTED OVERLAYS FOR CONDENSOR
* 
* 
          CST 
* 
* 
 COVLY2$  OVFILE
* 
* 
*         ERROR EXITS 
          EXT    ERRTAGS,ERRNAME,ERRSTOR
          EXT    ERRXYTG,ERR2MNY,ERR2FEW
          EXT    ERRTERM,ERRUARG,ERRVTYP
          EXT    ERROUTR,ERRCNTD,ERRXORQ
          EXT    ERRBAL 
*         FOLLOWING EXTERNALS ARE FOR COMMON,COMMONX,STORAGE
          EXT    COMPILE,COMPNAM,LNGUNIT
          EXT    ERRORC,NXTNAM,NXTLINE
          EXT    SYSTEST,SYSONE 
          EXT    VARFIN,PAUSE2,TWOBITS,TAGXACT
* 
*         FOLLOWING EXTERNALS FOR PUT, PUTD 
          EXT    PUTCODE,PUT= 
* 
*         FOLLOWING EXTERNALS FOR DRAW
          EXT    GETLINE,KEYTYPE,QUIKCMP,COMPSYM
          EXT    VARFINS,COMCONT
* 
*         FOLLOWING EXTERNALS FOR CHANGE COMMAND
          EXT    COMNAMS
          EXT    CONTEST,CONTAB     IN FILE CONTENT 
* 
*         FOLLOWING EXTERNALS FOR INITIALIZATIONS 
          EXT    COMNAMS
          EXT    CSYMADD
          EXT    UERRSET
* 
*         FOLLOWING EXTERNALS FOR -WRITEC-
          EXT    BRVAR,CONV2,CONV3,CONUL4 
* 
*         FOR INITIALIZATION
          EXT    CONTAB      IN FILE CONTEN 
* 
* 
* /---   BLOCK      LIB(CALL)  00 000   79/02/07  16.14 
          TITLE  LIBCALL AND CALL COMMANDS
* 
 LIBCOV   OVRLAY
* 
          SA1    OVARG1 
          SB3    X1 
          JP     B3+*+1 
* 
+         EQ     LIBIN       LIBCALL
+         EQ     CALLIN      CALL 
* 
*         -LIBCALL- AND -CALL- COMMAND READIN 
*         FIRST ARGUMENT IS -SYSLIB- UNIT NAME
*         MAY HAVE 3 MORE OPTIONAL ARGUMENTS
* 
*         -CALL- RESTRICTS COMMAND TO THE FOLLOWING 
*         -SYSLIB- UNITS';
*                ASK, CALC, KERMIT, TALK, TIME
* 
 LIBIN    RJ     SYSTEST     THIS IS THE ONLY CHECK 
 CALLIN   MX6    0           PRE-CLEAR
          SA6    VARBUF 
          SA6    VARBUF+2 
          SA6    VARBUF+3 
          SA6    VARBUF+4 
          CALL   NXTNAM      GET UNIT NAME
          ZR     X6,ERRNAME 
          MX0    8*6         UNIT NAME CANNOT EXCEED 8 CHARS
          BX0    -X0*X6 
          NZ     X0,ERRNAME 
          SA6    VARBUF+1    SAVE UNIT NAME 
          SA3    OVARG1      GET ARG FROM -COMNDS-
          ZR     X3,LIBCHK   IF -LIBCALL-, SKIP 
          SA2    CASK        FIRST TERM TO CHECK
          SB3    5           NUMBER OF TERMS TO CHECK 
 LIBTERM  BX2    X2-X6
          ZR     X2,LIBCHK   IF EQUAL TO TERM NAME, OK
          SB3    B3-1        DECREMENT CHECK
          ZR     B3,ERRNAME  IF NOT VALID NAME, ERROR OUT 
          SA2    A2+1        GET NEXT TERM
          EQ     LIBTERM     GO CHECK AGAIN 
 
 LIBCHK   ZR     X1,LIBCIN1  JUMP IF END-OF-LINE
          ZR     X3,LIBINLP  IF -LIBCALL-, SKIP 
          SA2    CTALK       GET *TALK* UNIT NAME 
          BX2    X2-X6       SEE IF *TALK* UNIT 
          ZR     X2,LIBINLP  IF *TALK*, SKIP
          SA2    CKERMIT     GET *KERMIT* UNIT NAME 
          BX2    X2-X6       SEE IF *KERMIT* UNIT 
          ZR     X2,LIBINLP  IF *KERMIT*, SKIP
          EQ     ERR2MNY     TO MANY PARAMS PASSED
* 
* /---   BLOCK      LIB(CALL)  00 000   79/02/07  16.11 
 LIBINLP  CALL   COMPILE     GET NEXT ARGUMENT
          BX6    X1 
          SA2    VARBUF 
          SA6    X2+VARBUF+2
          SA1    LASTKEY     SEE IF END-OF-LINE 
          ZR     X1,LIBCIN1 
          SX6    X2+1        INCREMENT NUMBER OF CODES
          SA6    A2 
          SX6    X6-3        ALLOW THREE ARGUMENTS
          NG     X6,LIBINLP 
          EQ     ERRTAGS
* 
 LIBCIN1  SA1    INX         INDEX IN EXTRA STORAGE 
          SX6    X1+2 
          SA6    A1 
          SA2    VARBUF+1    MOVE UNIT NAME TO EXTRA STORAGE
          BX6    X2 
          SA6    X1+INFO
          SA2    VARBUF+2    -GETVAR- CODE FOR 1ST ARGUMENT 
          LX2    60-XCODEL
          SA3    VARBUF+3    -GETVAR- CODE FOR 2ND ARGUMENT 
          LX3    60-XCODEL-XCODEL 
          BX6    X2+X3
          SA2    VARBUF+4    -GETVAR- CODE FOR 3RD ARGUMENT 
          LX2    60-XCODEL-XCODEL-XCODEL
          BX6    X2+X6
          SA6    X1+INFO+1   MOVE TO EXTRA STORAGE
          BX6    X1 
          LX6    XCMNDL      POSITION INDEX IN XSTOR
          EQ     PUTCODE
* 
 CASK     DATA   0LASK
 CCALC    DATA   0LCALC 
 CKERMIT  DATA   0LKERMIT 
 CTALK    DATA   0LTALK 
 CTIME    DATA   0LTIME 
* 
          ENDOV 
* /---   BLOCK      EXACTC     00 000   76/01/26  14.44 
          TITLE  EXACTC 
*         -EXACTC-
*         THIS READ-IN ROUTINE IS ESSENTIALLY THE ANCIENT 
*         READ-IN FOR THE ORIGINAL -WRITEC- COMMAND BEFORE
*         EMBEDDING, ETC. 
* 
* 
*            FORMAT OF COMMAND WORD --
* 
*          TOP *XCODEL* BITS = -GETVAR- CODE FOR VARIABLE 
*         NEXT    XX    BITS = UNUSED 
*         NEXT    12    BITS = NUMBER OF ENTRIES IN TABLE 
*         NEXT    12    BITS = RELATIVE ADDRESS OF LAST WORD OF TABLE 
*         LAST *XCMNDL* BITS = COMMAND CODE NUMBER
* 
* 
*           THE TABLE ENTRIES ARE IN BACK-TO-FRONT ORDER--I.E., THE LAST
*         WORD OF THE TABLE CONTAINS THE INFO FOR THE FIRST ENTRIES.
*         THERE ARE TWO ENTRIES PER WORD, EACH HOLDING THE FOLLOWING -- 
* 
*          TOP 12 BITS = RELATIVE ADDRESS OF FIRST WORD OF TEXT INFO
*         NEXT  6 BITS = SHIFT COUNT TO POSITION 1ST CHAR AT LEFT 
*         NEXT  4 BITS = NUMBER OF CHARACTERS IN 1ST TEXT WORD
*         NEXT  8 BITS = NUMBER OF CHARACTERS IN FOLLOWING WORDS
* /---   BLOCK      EXACTC     00 000   76/07/24  21.29 
* 
* 
 WRITCOV  OVRLAY
          RJ     COMPILE     DECODE ONE VARIABLE
          BX7    X1 
          LX7    60-XCODEL   LEFT-ADJUST GETVAR CODE
          SA7    BRVAR       SAVE 
* /---   BLOCK      EXACTC     00 000   76/07/25  07.57 
          SA1    INX
          BX6    X1 
          MX7    0
          SA6    CONV2       RELATIVE STARTING ADDRESS OF TEXT
          SA2    ICX
          SX6    X2-1 
          SA6    WCTADR      INITIALIZE TABLE ADDRESS POINTER 
          SA7    CONV3       NUMBER OF TABLE ENTRIES = 0
          SA7    INFO+X1     CLEAR 1ST TEXT WORD
          SA7    INFO+X6     CLEAR 1ST TABLE WORD 
          SX7    54 
          SA7    WCSHFT      INITIALIZE SHIFT COUNT MARKER
          SA2    LASTKEY
          NZ     X2,WRTCIN3  JUMP IF LINE NOT EXHAUSTED 
* 
 WRTCIN1  SA3    NEXTCOM     CHECK IF CONTINUATION
          SA4    COMCONT
          BX3    X3-X4
          ZR     X3,WRTCIN2  JUMP TO GET NEXT LINE IF CONTINUED 
* 
          SA1    CONV3       X1 = NUMBER OF TABLE ENTRIES 
          ZR     X1,ERR2FEW 
          SA2    WCTADR      X2 = CURRENT RELATIVE TABLE ADDRESS
          SA3    ICX         X3 = NEXT RELATIVE ADDRESS FOLLOWING TABLE 
          SA4    CONV2       X4 = RELATIVE ADDRESS OF LAST WORD OF TEXT 
          SA1    INFO-1+X2   A1 = ADDRESS PRECEDING TABLE 
          SB2    INFO+X4     B2 = ADDRESS OF LAST WORD OF TEXT
          IX3    X3-X2       X3 = LENGTH OF TABLE 
          SB3    B2+X3       B3 = END TEST FOR TRANSFER 
 WCTRANS  SA1    A1+B1       MOVE TABLE AFTER TEXT
          BX6    X1 
          SB2    B2+B1
          SA6    B2 
          LT     B2,B3,WCTRANS
          SB2    INFO 
          SX7    B3-B2       X7 = RELATIVE ADDRESS OF LAST WORD OF TABLE
          SA7    CONV2       STORE IN CONVENTIONAL LOCATION 
          SX6    X7          UPDATE EXTRA STORAGE POINTER 
          SA6    INX         +++ NOTE +++  STANDARD EXIT INCREMENTS IT
          SA4    COMNUM 
          BX6    X4          SET UP TO USE THIS COMMAND NUMBER
          EQ     CONUL4      --- EXIT VIA CONDITIONAL BRANCH PACK-UP
* 
* 
 WRTCIN2  RJ     GETLINE     READ IN NEXT LINE
* /---   BLOCK      EXACTC     00 000   76/01/26  14.44 
 WRTCIN3  SA2    WORDPT      X2 = STARTING ADDRESS FOR TAG SEARCH 
          SA1    X2          X1 = 1ST CHARACTER OF TAG
          ZR     X1,WRTCIN1  JUMP TO LOOK FOR CONTINUATION IF BLANK LINE
* 
 WTCLOOP  SB1    1           B1 = CONSTANT 1
          SB3    6           B3 = SHIFT COUNT DECREMENT 
          SA3    LASTKEY     GET EXPRESSION TERMINATOR
          SB4    X3 
* /---   BLOCK      EXACTC     00 000   76/07/24  21.31 
          SB4    -B4         COMPLEMENT OF TERMINATOR 
          SA3    CONV2       X3 = RELATIVE ADDRESS OF CURRENT TEXT WORD 
          SA4    INFO+X3     X4 = CURRENT TEXT INFO WORD
          SA5    WCSHFT 
          SB2    X5          B2 = SHIFT COUNT FOR NEXT CHARACTER
* /---   BLOCK      EXACTC     00 000   76/07/24  21.02 
 WTC200   SA1    A1-B1       RESET FOR LOOP 
 WTCPACK  SA1    A1+B1       X1 = NEXT CHARACTER
          LX2    X1,B2
          ZR     X1,WTCFIN   TEXT COMPLETE IF END-OF-LINE 
          SX6    X1+B4       COMPARE TERMINATOR 
          ZR     X6,WTCFIN   TEXT COMPLETE IF COMMA OR SEMICOLON
          BX4    X4+X2       ADD CHARACTER TO CURRENT TEXT WORD 
          SB2    B2-B3
          PL     B2,WTCPACK  JUMP TO CONTINUE IF NOT YET A FULL WORD
          BX7    X4 
          SA7    A4          STORE COMPLETED WORD OF TEXT INFO
          SX3    X3+1        INCREMENT TEXT STORAGE POINTER 
          SA4    A4+B1       INCREMENT TEXT WORD ADDRESS
          MX4    0           CLEAR NEXT TEXT STORAGE WORD 
          SB2    54          RESET SHIFT COUNT
          EQ     WTCPACK
* 
* /---   BLOCK      EXACTC     00 000   76/01/26  14.44 
 WTCFIN   BX7    X4 
          SA7    A4          STORE CURRENT TEXT INFO WORD 
          BX4    X3          X4 = CURRENT TEXT WORD ADDRESS 
          SA3    A3          X3 = ORIGINAL TEXT WORD ADDRESS
          BX6    X4 
          SA6    A3          UPDATE ADDRESS OF CURRENT TEXT WORD
          SX6    B2          X6 = CURRENT SHIFT COUNT (ORIGINAL IN X5)
          SA6    A5          UPDATE SHIFT COUNT 
          BX7    X3          BEGIN BUILDING INFO PACKAGE IN X7
          SX2    54 
          IX2    X2-X5       COMPUTE SHIFT COUNT NEEDED FOR EXECUTION 
          LX7    6
          BX7    X7+X2       ADD SHIFT COUNT TO INFO PACKAGE
          BX2    X5          BEGIN TRICKY EQUIVALENT OF DIVIDE BY 6 
          LX2    1           *2 
          IX5    X5+X2       *3 
          LX2    2           *8 
          IX5    X5+X2       *11
          AX5    6           /64   X5 = ORIGINAL SHIFT COUNT / 6
          BX2    X6          DO ANOTHER TRICKY DIVIDE 
          LX2    1
          IX6    X6+X2
          LX2    2
          IX6    X6+X2
          AX6    6           X6 = FINAL SHIFT COUNT / 6 
          IX4    X4-X3       X4 = FINAL STORAGE WORD POINTER - ORIGINAL 
          IX3    X5-X6       X3 = 1ST WORD CHAR COUNT IF ALL IN ONE WORD
          ZR     X4,WCSTOR   JUMP IF ALL TEXT IN ONE WORD 
          BX2    X4 
          LX4    3           *8 
          LX2    1           *2 
          IX4    X4+X2       X4 = DIFFERENCE IN TEXT POINTERS * 10
* /---   BLOCK      EXACTC     00 000   76/07/24  20.52 
          SX4    X4-1 
          IX4    X4-X6       X4 = COUNT OF CHARACTERS IN FOLLOWING WORDS
          SX3    X5+B1       X3 = COUNT OF CHARACTERS IN 1ST WORD 
 WCSTOR   LX7    4
          BX7    X7+X3       ADD CHARACTER COUNT FOR 1ST WORD 
          LX7    8
          BX7    X7+X4       ADD CHARACTER COUNT FOR FOLLOWING WORDS
          SA2    WCTADR      X2 = CURRENT TABLE ADDRESS 
          SA3    INFO+X2     X3 = CURRENT TABLE WORD
          SA4    CONV3       X4 = CURRENT NUMBER OF TABLE ENTRIES 
          BX6    X3+X7       ADD NEW ENTRY
          LX4    59 
          NG     X4,WCODD    JUMP OF ODD NUMBERED TABLE ENTRY 
          LX6    30          POSITION AT TOP
          SA6    A3          STORE UPPER (EVEN) ENTRY 
 WCNEXT   LX4    1
          SX7    X4+B1       INCREMENT NUMBER OF TABLE ENTRIES
          SA7    A4 
          ZR     X1,WRTCIN1  JUMP IF AT END-OF-LINE 
          SA1    A1+B1
          NZ     X1,WTCLOOP  JUMP TO MAIN LOOP IF NEXT CHAR NOT E-O-L 
          EQ     WRTCIN1     OTHERWISE, CHECK FOR CONTINUATION
* 
 WCODD    SA6    A3          STORE COMPLETED TABLE WORD (ODD ENTRY) 
          SX7    X2-1        DECREMENT TABLE ADDRESS
          SA7    A2 
          MX6    0
          SA6    A3-B1       CLEAR NEXT TABLE WORD
          EQ     WCNEXT 
* 
* 
 WCTADR   BSS    1           CURRENT TABLE ADDRESS (RELATIVE) 
 WCSHFT   BSS    1           SHIFT COUNT FOR NEXT CHARACTER 
 LFTFLG   DATA   0           LEFT WRITING FLAG
* 
          ENDOV 
* /---   BLOCK      INITIAL-1  00 000   81/06/07  02.16 
          TITLE  INITIALIZATIONS
* 
          EXT    MESSBUF     DAYFILE MESSAGE BUFFER 
* 
 INITOV   OVRLAY
          SA5    APLACOM     (X5) = COMMUNICATION AREA
          SX0    PC.ACC 
          IX0    X0+X5
          SA0    ACCOUNT
          RE     2           READ ACCOUNT AND LESSON NAME 
          RJ     ECSPRTY
          MX0    6
          SA1    LESSON      CHECK FOR VALID LESSON NAME
          BX1    X0*X1
          ZR     X1,CABORT2 
          SX0    PC.SYS 
          IX0    X0+X5
          SA0    SYSFLG      SYSTEM/NON-SYSTEM FLAG 
+         RE     1
          RJ     ECSPRTY
          SX0    PC.STOR     PACKED DESCRIPTORS OF CONDEN 
          IX0    X0+X5       RETURN INFO
          SA0    COPTION     CONDENSOR OPTIONS
          RE     1
          RJ     ECSPRTY
          SX0    PC.SRCA
          IX0    X0+X5
          SA0    WORK 
          RE     2           READ SOURCE FILE NAME
          RJ     ECSPRTY
          SX0    PC.BADR
          IX0    X0+X5
          SA0    CONBUFF     ADDRESS OF BUFFER FOR BINARY 
+         RE     1
          RJ     ECSPRTY
          SX0    PC.BLTH
          IX0    X0+X5
          SA0    CBLTH       LENGTH OF BINARY BUFFER
+         RE     1
          RJ     ECSPRTY
* 
          SA1    LESSON      SET UP B-DISPLAY MESSAGE 
          BX7    X1 
          SA7    MESSBUF
          CALL   S=BMSG,MESSBUF 
* 
* 
          SA1    SYSCLOK     STORE TIME AT START OF CONDENS 
          BX6    X1 
          SA6    RTBEG       STORE REAL TIME CLOCK
          CALL   S=CTIME,CTBEG  STORE CPU CLOCK 
* 
*         SET UP FILE POINTERS / OPEN FILE
* 
          SB2    FREQ        OPEN THE FILE
          SA0    CBUF 
          SA1    AFILEBF
          SA2    WORK        RETRIEVE SOURCE FILE NAME
          SA3    WORK+1      (TWO WORDS)
          RJ     =XOPEN 
          NZ     X6,CABORT2  IF CANNOT OPEN FILE
          SA1    COPTION     SET CSTOADR = ECS ADDR OF USERS
*         STORAGE FOR RETURN INFORMATION FROM CONDENSOR 
          BX2    X1 
          AX2    XCODEAL
          MX3    -24
          BX6    -X3*X2 
          SA6    CSTOADR
          BX0    X6          ZERO OUT S1 (WHICH CONTAINS
*                            BUFFER LENGTH POINTERS)
          ZR     X6,NOCSTO   UNLESS NO -STORAGE-
* 
          MX6    0
          WX6    X0 
 NOCSTO   BSS    0
          BX6    X2          CSTOLEN = LENGTH OF STORAGE
          AX6    24 
          SA6    CSTOLEN
* /---   BLOCK      INITIAL-1  00 000   81/07/28  01.50 
          IX6    X6+X0       CSTOLWA = LWA OF STORAGE 
          SA6    CSTOLWA
* 
*         OPEN OPTION BITS INTO FULL WORDS FOR FAST 
*         CHECKS DURING CONDENSE
* 
          SB3    COPTNUM     B3 = NUMBER OF OPTIONS 
          SB2    B0          B2 = OPTION POINTER
          SB1    1           B1 = 1 
          MX2    -1 
 COPTLP   BX6    -X2*X1      ISOLATE NEXT OPTION BIT
          SA6    COPTS+B2    STORE IN NEXT OPTION ELEMENT 
          SB2    B2+B1
          AX1    B1          POSTION NEXT OPTION BIT
          NE     B2,B3,COPTLP IF MORE OPTIONS BITS TO OPEN
* 
* 
* 
*         GET TRUE COPY OF COMMANDS AND HASH INFO INTO CM 
* 
          SA1    CMNDTBL
          BX0    X1 
          SA0    COMNAMS
          SA1    CMNDINF
+         RE     =XCOMNAML   READ COMMAND NAME TABLE
          RJ     ECSPRTY
          BX0    X1 
          SA0    =XCOMINFO
+         RE     =XCOMINFL   READ HASHED INFO TABLE 
          RJ     ECSPRTY
* 
* 
*         -ERRINIT-   (INITIALIZE BUFFER POINTERS)
* 
* 
          SA1    ACEBUF      ABSOLUTE ADDRESS OF CEBUF
          SX6    MAINHDL     LENGTH OF MAIN HEADER
          IX6    X1+X6
          SA6    PCEBUF      NEXT AVAILABLE LOC IN CEBUF
          SX6    B0 
          SA6    ERRCNT 
          SA6    ERRTOT 
          SA6    ZCONDOK     =0 NOTSET ZCONDOK,=1 SET IT
          SX6    1
          SA6    UBLKNM 
          SA6    ULINENM
          RJ     UERRSET     INTIALIZE *HEAD* WORD
          SX6    VARLIM-MAINHDL 
          SA6    LCEBUF      SPACE LEFT FOR SUBROUTINES 
* 
          SX7    0
          SA7    TSPECS      CLEAR SPECS FLAG 
          SA7    SAYFLAG     CLEAR SAY FLAG 
          SA3    ACLSTAT
          SX1    SCLESNS
          IX0    X3+X1
          SA0    SCONTMP     READ FROM ECS,TOTAL NUMBER OF LESSON CONDEN
+         RE     1
          RJ     =XECSPRTY
          SA1    SCONTMP
          SX3    1
          IX6    X1+X3       INCREMENT TOTAL COUNT
          SA6    A1 
+         WE     1           WRITE BACK IN ECS
          RJ     =XECSPRTY
* /---   BLOCK      INITIAL-2  00 000   81/06/07  02.18 
* 
          SA1    CONBUFF     ADDRESS OF BINARY BUFFER 
          SX6    LESHEAD
          IX0    X1+X6
          SA0    ACCOUNT
          WE     2           WRITE OUT LESSON/ACCOUNT NAMES 
          RJ     ECSPRTY
          SX7    2
          IX6    X0+X7       POINT TO NEXT WORD IN ECS
          SA6    CONDPNT     INIT NEXT AVAIL WORD IN FORMING BINARY 
* 
          SA1    AZERBUF     ZEROED ECS BUFFER
          BX0    X1 
          SA0    WORK 
+         RE     1000 
          RJ     ECSPRTY
          SA1    AGROUP      INITIALIZE -GROUP- TABLES
          BX0    X1 
+         WE     4*NKGROUP
          RJ     ECSPRTY
          SX7    0           X7 = 0 
          SA7    ECSARGS     NO ECS ARGS YET
          SA7    UEFLAG      CLEAR TO CURRENTLY DOING UNIT (NOT ENTRY)
          SA7    CUNITS      ZERO UNIT SO FAR 
          SA7    COMPNAM
          SA7    CSYMADD
          SA7    JJVOCU      SET TO NO VOCABULARY YET 
          SA7    TERMS       NUMBER OF TERMS IN LESSON RESET
          SA7    NDEFN       NUMBER OF DEFNS
          SA7    NOUNIT      NO UNIT COMMANDS YET 
          SA7    COMREFF
          SA7    CCDFLG 
          SA7    CCOMX       CLEAR -COMMONX- WORD 
          SA7    XSTORL      CLEAR XSTOR LENGTH 
          SA7    RVARL       CLEAR ROUTER VARIABLE LENGHT 
          SA7    LVARL       CLEAR LOCALS STACK SIZE
          SA7    LVARN       CLEAR NUMBER OF LOCALS 
          SA7    LOCAL       CLEAR LOCALS FLAG
          SA7    CCOMLES     SET TO NO COMMON 
          SA7    CCOMACT
          SA7    CCOMNAM
          SA7    CCOMLTH
          SA7    CCOMBIT
          SA7    USEBCNT     NUMBER OF BLOCKS USED
          SA7    =XPPTMF     PPT COMMAND MESSAGE FLAG 
* 
          SX6    VARS 
          SA6    PVARS       BASE LOCATION FOR DEFINED NAMES
          SX6    -1 
          SA6    SSSTOP      SET START/STOP SWITCH
          SA6    DSET        INITIALIZE DEFINE SET NUMBER 
          SB1    1
          SB2    TOKADDS     DEFINE DIRECTORY INITIALIATIONS
          SB3    NAMADDS
          SB4    TOKLENS
          SB5    NAMLENS
          SB6    SETNAMS
          SB7    -1          INITIALIZE NULL SET ALSO 
          SA1    ADEFNEC     ADDR OF ECS DEFINE BUFFER
          BX6    X1 
          SX1    DECSLTH     LENGTH OF DEFINED BUFFER 
          IX6    X6+X1       (X6) = END OF ECS DEF BUFF + 1 
          MX7    0
* 
* /---   BLOCK      INITIAL-3  00 000   81/06/07  02.18 
 DFADLP   BSS    0
          SA6    B2+B7       TOKADDS
          SA6    B3+B7       NAMADDS
          SA7    B4+B7       TOKLENS
          SA7    B5+B7       NAMLENS
          SA7    B6+B7       SETNAMS
          SA7    UNTLENS+B7  NUMBER OF DEFINED UNITS
          SB7    B7+B1
          SX5    B7-MAXSET
          NZ     X5,DFADLP
* 
          SA1    ADEFNEC     ADDR OF ECS DEFINE BUFFER
          BX6    X1 
          SA6    TOKADDS-1   NULL SET OPEN
* 
*         FAKE UNIT 0 = TERMS 
*         FAKE UNIT 1 = DEFNS 
*         FAKE UNIT 2 = JUDGING SYMBOLS 
*              UNIT 3 = INITIAL ENTRY UNIT
* 
          SA1    KOIEU       GET PROPER NAME FOR INITIAL ENTRY UNIT 
          BX7    X1 
          SA7    UNAME+IEUNUM  STORE AWAY IN UNIT-NAME-TABLE
          SX6    IEUNUM      X6 = UNIT NUMBER 
          SA0    A7 
          SA1    AUNAME      AND WRITE OUT TO ECS-UNIT-NAME-TABLE 
          IX0    X1+X6
+         WE     1
          RJ     ECSPRTY
* 
* 
          SA6    UNUMON      SET UNIT WORKING ON POINTER
          SA6    UNIT        LAST UNIT OR ENTRY CONDENSED 
          MX7    1           SET TOP BIT TO MARK NOT IN 
          SA7    ULOC+X6
          SX6    X6+1 
          SA6    UNUMIN      COUNT OF UNITS PROCESSED 
* 
          SA1    BLANK8 
          BX6    X1 
          SA6    =XOLDCMND   INITIALIZE OLDCMND TO 8 BLANKS 
* 
*         INITIALIZE FOR ENTRY UNIT 
* 
          SX6    INFOLTH
          SA6    ICX         INITIALIZE COMMAND POINTER 
          SX7    0
          SA7    INX         EXTRA STORAGE POINTER
          SA7    LOCARO      ARROW LOCATION (*INFO* OFFSET) 
          SA7    =XCALCACT   SET TO NO -CALC- ACTIVE
          SA7    NGLOBAL     NUMBER OF GLOBAL SYMBOLS 
          SA7    MAKESYM     FOR FAKE STATEMENT LABELS
          SA7    NDOOFF      NUMBER OF DEFERRED -DOTO-
          SA7    DOBFPNT     -DOTO- ECS POINTER 
          SA7    NDEFERR     NUMBER OF DEFERRED REFERENCES
          SA7    =XNLABELS   NUMBER OF LABELS 
          SA7    GSYMERR1    GLOBAL SYMBOL ERROR FLAGS
          SA7    GSYMERR2 
* /---   BLOCK      INITIAL-4  00 000   76/11/11  01.38 
* 
*         ZERO OUT ECS ENDINGS BUFFERS
* 
          SA1    AZERBUF     GET ADDRESS OF ZERO BUFFER 
          BX0    X1 
          SA0    WORK 
+         RE     80          ZERO OUT THE ENDINGS BUFFER
          RJ     ECSPRTY
          SA1    XBEND       ADDRESS OF ENDINGS BUFFER
          BX0    X1 
+         WE     80 
          RJ     ECSPRTY
* 
*         GET TRUE COPY OF CHARACTER SYMBOL TABLE FOR CONTENT 
* 
          SA0    CONTAB      READ CONTENT SYMBOL TABLE TO CM BUFFER 
          SA1    ACONTAB     GET ADDRESS OF ECS BUFFER
          BX0    X1 
+         RE     129         TWO 64-WORD TABLES + 1 INFO WORD 
          RJ     ECSPRTY
* 
          MX6    0           CLEAR DUMMY UNIT FOR JUDGING SYMBOLS 
          SX2    JSYMNUM
          SA6    UNAME+X2    HENCE USE SYSTEM SYMBOLS 
          SA6    ULOC+X2
* 
* 
*         CHECK ECS COMMAND CONDEN STATISTICS INFO BANK AND 
*         SET ITS CM FLAG (TSCOMFG) ACCORDINGLY.  SINCE TURN
*         ON/OFF OF COMMAND CONDEN STATISTICS IS CHECKED HERE ONLY AT 
*         ENTRY (TO MINIMIZE OVERHEAD) IT DOES NOT TAKE EFFECT UNTIL
*         NEXT START OF LESSON CONDENSING (OR FINISHING OF
*         CONDENSING IN CASE OF TURNING OFF). 
* 
 CSIST    SA3    ACDSTAT     (X3) = ECS ADDR OF STATS BUFFER
          ZR     X3,SETCFG1  EXIT IF NO STATS BUFFER
          BX0    X3          (X0) = ECS ADDR OF STATS BUFFER
          SA0    SCONTMP     (A0) = ADDR OF CM COPY 
          RE     SCOMNDH     READ PARAMETERS FROM PLATO 
          RJ     =XECSPRTY
          SA1    SCONTMP+SCOMFG1  SEE IF STATS DESIRED
          ZR     X1,SETCFG1  IF NOT REQUESTED 
          SA1    SCONTMP+SCOMLES  SEE IF FOR SPECIFIC LESSON
          SX7    1
          ZR     X1,SETCFG2  IF 0, GET STATS FOR ALL LESSONS
          CALL   FCOMPAR,(SCONTMP+SCOMACT),ACCOUNT
          ZR     X6,SETCFG2  IF YES 
 SETCFG1  MX7    0           NO STATISTICS
 SETCFG2  SA7    TSCOMFG     SET CM FLAG ACCORDINGLY
          ZR     X7,INI300   IF NOT TAKING STATISTICS 
 
          SA1    SCONTMP+SCOMZER  SEE IF SHOULD ZERO BUFFER 
          ZR     X1,INI300   IF BUFFER NOT TO BE ZEROED 
 
          SA1    AZERBUF     (X1) = ADDR OF ZERO ECS BUFFER 
          BX0    X1 
          SA0    ZBUFFER     (A0) = ADDR OF CM SCRATCH SPACE
          RE     CMNDMAX     ZERO CM BUFFER 
          RJ     ECSPRTY
          SX1    SCOMNDS     (X1) = OFFSET TO STATS 
          IX0    X1+X3       (X0) = WHERE TO START ZEROING
          WE     CMNDMAX     ZERO THE BUFFER
          RJ     ECSPRTY
 
* /---   BLOCK      INITIAL-4  00 000   76/11/11  01.38 
          MX6    0
          SX1    SCOMZER
          IX1    X1+X3
          WX6    X1          ZERO REQUEST TO ZERO BUFFER
          SX1    SCOMNDN
          IX1    X1+X3
          WX6    X1          ZERO TOTAL COMMANDS
          SX1    SCOMNDT
          IX1    X1+X3
          WX6    X1          ZERO TOTAL TIME
 
*         GO THROUGH THE PRELIMINARY CHECKS AGAIN IN CASE 
*         PLATO CHANGED THE PARAMETERS WHILE THESE CHECKS 
*         WERE IN PROGRESS.  OTHERWISE WE COULD TAKE STATS
*         ON THE WRONG LESSON, AND THE BUFFER WOULD NOT BE
*         CLEARED AGAIN.
 
          EQ     CSIST
* /---   BLOCK      INITIAL    00 000   81/05/08  04.28 
* 
*         INITIALIZE PPT-TUTOR BUFFERS/VARIABLES
* 
 INI300   MX6    0
          SA6    PPTF        MARK NOT CONDENSING PPT-TUTOR
          SA6    CVUF        MARK CALC OVERLAYS NOT ASSIGNED
          SA6    PPTVERS     INITIALIZE VERSION 
          SA6    PUNITN      UNIT COUNTER 
          SA6    PISTU       1ST PHYSICAL UNIT NUMBER 
          SA6    IUNUM       CURRENT UNIT NUMBER
          SA6    PDEFNS      NUMBER OF DEFINED NAMES
          SA6    PSETNAM     CURRENT DEFINE SET NAME
          SA6    PVARSIZ     CURRENT VARIABLE SIZE
          SA6    NVBYTES     NUMBER VARIABLE BYTES ALLOCATED
          SA6    DEFP        DEFINE BYTE/SHIFT/ADDR WORD
          SX6    777B 
          SA6    PCHRLIM     MARK CHARSET LIMIT NOT SET YET 
          SA1    AZERBUF     X1 = ADDRESS OF ZEROED ECS BUFF
          BX0    X1 
          SA0    UNITTAB+2
+         RE     PUNITL      PRE-ZERO UNIT NAME TABLE 
          RJ     ECSPRTY
* 
* /---   BLOCK      INITIAL-5  00 000   81/06/29  12.33 
* 
*            THE FOLLOWING CODE HANDLES THE SPECIAL 
*         PROCESSING REQUIRED ON FIRST READ OF A LESSON.
* 
          SX7    0
          SA7    USEINFO     CLEAR USE FILE COUNT 
          SA7    USEFLAG     NOT PROCESSING -USE-D CODE 
          SA7    BLKCNT      INITIALIZE BLKCNT AND LINECNT
          SA7    LINECNT
          SA7    STOPFLG     ZERO MEANS *CSTART*
          SA7    INDENT      LAST LINE HAD NO INDENTING 
          SA7    PISTACK     INITIALIZE STACK POINTER 
          SA7    ISTACK      CLEAR FIRST ELEMENT OF STACK 
          SX6    -1 
          SA6    NEWBLK      FIRST LINE MAY NOT BE INDENTED 
          SA0    CBUF        BUFFER 
          SA1    AFILEBF
          BX0    X1 
          RE     BLKLTH      DIRECTORY FOR CURRENT LESSON 
          RJ     =XECSPRTY
* 
*         INITIALIZE MICRO-TUTOR RELEASE LEVEL FROM LESSON
*         DIRECTORY 
* 
          SX2    4           X2 = BIAS TO BASE OF INFO
          SB2    X2+O.APRIV  BIAS TO ACCESS PRIVILEGE WORD
          SA1    A0+B2
          LX1    60-OPV.MR+OPV.MRN-1
          MX6    -6          FORM MASK FOR M-TUTOR RELEASE
          BX6    -X6*X1      MASK OFF M-TUTOR RELEASE LEVEL 
+         NZ     X6,*+1 
          SX6    1           SET RELEASE 0 = RELEASE 1
+         SA6    MTREL       INITIALZE RELEASE LEVEL
          SX6    400B 
          BX6    X6*X1       SET M-TUTOR CENTRAL SYSTEM 
          SA6    MTCENF      EXECUTION FLAG 
          SX6    200B        SET THE CENTRAL MICRO PLATO FLAG 
          BX6    X1*X6
          SA6    CMPF 
* 
* 
*         INITIALIZE FILE UPDATE LEVEL
* 
          SB2    X2+O.UPD8   OFFSET TO UPDATE LEVEL 
          SA1    A0+B2
          SX6    X1-MINUPD8  CHECK FOR OBSOLESCENCE 
          NG     X6,=XOBSFILE 
          BX6    X1 
          SA6    FLEVEL      STORE FILE UPDATE LEVEL
* 
* /---   BLOCK      INITIAL-5  00 000   80/08/19  04.17 
* 
******    HOPEFULLY TEMPORARY CODE FOR PPT-COMMANDS 
 
          MX6    -1          MARK PPT-COMMANDS LEGAL
          SA6    =XPPTACC 
 
*         GET ACCOUNT NAME OF FILE
 
          SB2    X2+O.ACNAM  OFFSET TO ACCOUNT NAME 
          SA1    A0+B2
          MX7    42 
          BX7    X7*X1
 
*         NON-SERVICE SYSTEMS 
 
          SA1    CSYSNAM
          BX6    X1 
          SA1    PPTNAMS+0
          BX1    X6-X1
          NZ     X1,PPTM2    IF NOT FSU SYSTEM
 
          SA1    ACCNAMS+0   CHECK GOOD ACCOUNTS
          BX1    X7-X1
          ZR     X1,PPTM1 
          SA1    ACCNAMS+1
          BX1    X7-X1
          ZR     X1,PPTM1 
          SA1    ACCNAMS+2
          BX1    X7-X1
          ZR     X1,PPTM1 
          EQ     PPTM3
 
 PPTM2    SA1    PPTNAMS+1
          BX1    X6-X1
          NZ     X1,PPTM3    IF NOT UOFDEL SYSTEM 
          SA1    ACCNAMS+3
          BX1    X7-X1
          ZR     X1,PPTM1 
 
*         ALLOW IN SYSTEM LESSONS AND SPECIAL LESSONS 
 
 PPTM3    SA1    SYSFLG 
          LX1    ZPPTSHF
          NG     X1,PPTM1 
 
*         MARK ILLEGAL ELSEWHERE
 
          MX6    0
          SA6    =XPPTACC 
          EQ     PPTM1
* /---   BLOCK      INITIAL-5  00 000   81/07/29  02.50 
 
 PPTNAMS  DATA   3LFSU
          DATA   3LDL1
 
 ACCNAMS  DATA   7LARAMEAU
          DATA   6LAMUSIC 
          DATA   6LAUIMUS 
          DATA   6LUOFDEL 
 
 PPTM1    BSS    0
******    HOPEFULLY TEMPORARY CODE FOR PPT-COMMANDS 
          SA1    A0+1        GET TYPE WORD
          SA2    ROUTYPE
          BX2    X1-X2
          MX6    0           PRESET NOT A ROUTER
          NZ     X2,SETROUT 
          SX6    1
* 
 SETROUT  SA6    ROUTER      SET ROUTER LESSON FLAG 
          SA1    A0+EXTRAI+51    GET SPECIAL TYPE WORD
          SX2    APPTYPE
          MX6    0           PRESET NOT AN APPLIC LESSON
          MX0    -6          TYPE IN BOTTOM 6 BITS
          BX1    -X0*X1      ISOLATE SPECIAL TYPE 
          IX1    X1-X2       TEST TYPE
          NZ     X1,SETAPPL 
          SX6    1
 SETAPPL  SA6    APPLESS     SET APPLIC. LESSON FLAG
* 
*         SEE FILE GETLIN FOR MORE COMPLETE COMMENTS
*         A5 = POINTS TO SOURCE WORD BEING PROCESSED
*         B5 = BLOCK END TEST MARKER (ONE PAST LAST WORD) 
* 
          SB1    1           -GETCMD- ASSUMES B1 SET
          SB5    CBUF+1      B5 = END TEST MARKER 
          SA5    B5-1        SET TO FORCE READ OF NEXT BLOCK
          CALL   GETCMD      GET 1ST COMMAND (SETS *IEND*)
          SX6    A5 
          SA6    IST         SAVE POINTER TO NEXT COMMAND 
          EQ     NXTLINE
* /---   BLOCK      -ABORTC-   00 000   81/06/07  03.07 
 CABORT2  SX6    1           1 = BAD LESSON NAME
          SA6    IOBUFF 
          SA1    LESSON 
          BX6    X1 
          SA6    A6+1 
          RJ     =XABORTC 
          EQ     =XCONDENS
* 
* /---   BLOCK      FCOMPAR    00 000   80/07/14  15.01 
          TITLE  -FCOMPAR-     COMPARE FILE NAMES 
* 
*         -FCOMPAR- 
* 
*         COMPARES TWO 2-WORD FILE NAMES. 
* 
*         THE ACCOUNT PORTION OF A FILE NAME STORED WITHIN
*         PLATO HAS THE FOLLOWING FORMAT';
* 
*         42/ACCOUNT NAME, 6/ATTRIBUTE FLAGS, 12/UNDEFINED
* 
*         THE TOP ATTRIBUTE FLAG INDICATES AN ORIGINAL (OLD-STYLE)
*         FILE.  THE OTHER ATTRIBUTES ARE NOT YET USED. 
* 
*         THE SECOND NAME PASSED TO -FCOMPAR- MUST BE COMPLETE. 
*         I.E., FILE NAME, ACCOUNT NAME, AND ALL ATTRIBUTES 
*         MUST BE KNOWN.  THE FIRST NAME MAY BE INCOMPLETE, BUT 
*         THE FILE NAME MUST BE SPECIFIED.  IN ORDER FOR A
*         MATCH TO BE INDICATED, ALL KNOWN PROPERTIES OF THE
*         SECOND NAME MUST MATCH THOSE OF THE FIRST NAME. 
*         I.E., THE FILE NAMES MUST MATCH, THE ACCOUNT NAME OF
*         THE SECOND FILE (IF NON-ZERO) MUST MATCH THE FIRST
*         ACCOUNT NAME, AND ALL ATTRIBUTE FLAGS SET FOR THE 
*         SECOND NAME MUST ALSO BE SET FOR THE FIRST NAME.
* 
*         ENTRY - B1 = ADDRESS OF FIRST FILE NAME 
*                 B2 = ADDRESS OF SECOND FILE NAME
* 
*         EXIT -  X6 = 0 IF MATCH, NON-ZERO IF NOT
* 
*         USES -  A1, A2
*                 X0, X1, X2, X6
* 
* /---   BLOCK      FCOMPAR    00 000   80/07/14  15.01 
* 
* 
 FCOMPAR  EQ     *
          SA1    B1+1        LOAD FIRST FILE NAME 
          SA2    B2+1        LOAD SECOND FILE NAME
          IX6    X1-X2       COMPARE
          NZ     X6,FCOMPAR  --- EXIT IF NO MATCH 
* 
          SA1    B1          X1 = FIRST ACCOUNT WORD
          SA2    B2          X2 = SECOND ACCOUNT WORD 
          MX0    48          MASK FOR NAME + ATTRIBUTES 
          BX1    X0*X1       ELIMINATE JUNK IN LOW 12 BITS
          BX2    X0*X2
          BX6    X1-X2       COMPARE ACCOUNT WORDS
          ZR     X6,FCOMPAR  --- EXACT MATCH
* 
          BX6    X1*X2       MASK ACCOUNT WORDS TOGETHER
          BX6    X6-X1       COMPARE RESULT WITH 1ST WORD 
          NZ     X6,FCOMPAR  --- NO MATCH 
* 
          MX0    42          MASK FOR ACCOUNT NAMES ONLY
          BX6    X0*X1       1ST ACCOUNT NAME 
          ZR     X6,FCOMPAR  --- MATCH IF 1ST NAME IS ZERO
* 
          BX2    X0*X2       2ND ACCOUNT NAME 
          BX6    X6-X2       COMPARE NAMES
          EQ     FCOMPAR
* 
* 
* 
 BLANK8   VFD    60/55555555555555550000B  TO INITIALIZE OLDCMND
 ROUTYPE  VFD    60/10LROUTER   A 
 APPTYPE  EQU    2           APPLICATION LESSON TYPE
 EXTRAI   EQU    4           OFFSET INTO DIRECTORY EXTRA INFO 
 KOIEU    VFD    12/0,48/3RIEU
* 
 ZBUFFER  OVDATA CMNDMAX
* 
          ENDOV 
* /---   BLOCK      LESLIST    00 000   77/03/19  17.00 
* 
* 
          TITLE  -LESLIST- ORIENTED COMMANDS
* 
* 
 LISTOV   OVRLAY
          SA1    OVARG1 
          SB3    X1 
          JP     B3+* 
* 
+         EQ     *           UNUSED AS OF 3/14/77  --M4 
+         EQ     ADDLC
+         EQ     LNAMEC 
+         EQ     FINDLC 
* 
* 
* 
*         -ADDLST- COMMAND
*         ADDS A LESSON NAME TO *LESLIST* 
* 
* 
 ADDLC    SB1    FSADDLS     -ADDLST- IS PUBLISH ERROR
          RJ     =XPUBERRS
          RJ     COMPILE     EVALUATE NAME VARIABLE 
          NZ     B1,ERRSTOR   ERROR IF NOT STOREABLE
          BX6    X1 
          LX6    60-XCODEL   POSITION -GETVAR- CODE 
          SA2    LASTKEY
          ZR     X2,PUTCODE  EXIT IF ONLY ONE ARGUMENT
          MX2    1
          BX6    X2+X6       SET BIT FOR TWO ARGUMENT 
          SA6    VARBUF 
          CALL   COMPILE     EVALUATE INDEX 
          LX1    60-XCODEL-XCODEL 
          SA2    VARBUF 
          BX6    X1+X2       MERGE -GETVAR- CODES 
          EQ     PUTCODE
* 
* /---   BLOCK      LESLIST    00 000   76/07/25  07.58 
* 
* 
*         -LNAME- COMMAND 
*         RETURNS DISPLAY FORMATTED NAME FROM *LESLIST* 
* 
* 
 LNAMEC   CALL   COMPILE     EVALUATE NAME VARIABLE 
          NZ     B1,ERRSTOR   MUST BE STOREABLE 
          LX1    60-XCODEL   POSITION -GETVAR- CODE 
          BX6    X1 
          SA6    VARBUF 
          CALL   COMPILE     EVALUATE INDEX VARIABLE
          LX1    60-XCODEL-XCODEL 
          SA2    VARBUF 
          BX6    X1+X2       COMBINE -GETVAR- CODES 
          EQ     PUTCODE
* 
* 
* 
*         -FINDL- COMMAND 
*         CHECKS TO SEE IF LESSON IS ENTERED IN LESLIST 
* 
* 
 FINDLC   CALL   COMPILE     GET FIRST ARGUMENT 
          NZ     B1,ERRSTOR 
          BX6    X1          SAVE -GETVAR- CODE 
          SA6    VARBUF 
          CALL   PUTCOMP     COMPILE CODE TO STORE 2ND ARG
          LX1    60-XCODEL-XCODEL 
          SA2    VARBUF      LOAD FIRST -GETVAR- CODE 
          LX2    60-XCODEL
          BX6    X1+X2       COMBINE -GETVAR-/-PUTVAR- CODES
          EQ     PUTCODE
* 
* 
* 
          ENDOV 
* /---   BLOCK      CHANGE     00 000   76/10/06  03.01 
          TITLE  CHANGE 
* 
*         CHANGE COMMAND---ONLY IN CONDENSOR
* 
* 
 CHGOV    OVRLAY
* 
          RJ     NXTCH       GET FIRST ENTITY 
 CHG1     ZR     X6,ERRNAME 
* 
          SA6    CHTABX      STORE THIS WORD AT END OF SEARCH 
          SB1    1
          SA4    CHTAB-1
* 
 CHLP     SA4    A4+B1       FIND WHAT TYPE OF CHANGE COMMAND 
          BX2    X4-X6
          NZ     X2,CHLP     LOOP THRU ALL POSSIBLILIES 
          SB1    A4-CHTAB    GET INDEX
          JP     CHJP+B1     JUMP TO PROPER ROUTINE 
* 
 CHJP     EQ     CHCMD       COMMAND
          EQ     CHSYM       SYMBOL 
 .CLANG   IFGT   CLANGS,1 
          EQ     CHLANG      LANGUAGE 
          EQ     CHENDL      PUT IN SET OF NEW LANGUAGE COMMANDS
 .CLANG   ENDIF 
          EQ     ERRNAME      NO FIND 
* 
 CHTAB    DATA   8LCOMMAND   TUTOR COMMANDS 
 CHTABSL  DATA   8LSYMBOL    CHARACTER SYMBOLS IN JUDGING 
 .CLANG   IFGT   CLANGS,1 
          DATA   8LCOMMANDS  CHANGE COMMANDS TO DIFFERENT LANGUAGE
          DATA   8LENDCMNDS  PUT IN NEW SET OF COMMAND FOR DIFF LANGUAGE
 .CLANG   ENDIF 
 CHTABX   DATA   0
* 
          SPACE  6
*         CHANGE COMMAND  X  TO   Y 
*         CHANGE THE NORMAL NAME OF A TUTOR COMMAND 
*         TO SOMETHING ELSE FOR THIS CONDENSE 
*         WHERE X IS NORMAL TUTOR COMMAND AND Y IS NEW NAME 
*         (THE WORD -TO- IS OPTIONAL) 
* 
* /---   BLOCK      CH-COMMAND 00 000   81/07/17  15.09 
* 
 CHCMD    RJ     NXTCH       GET NEXT WORD
          ZR     X6,ERRNAME 
* 
* CHCMD1   SA6    CHGTEMP 
          SA6    CHGTEMP     NO DEFAULT CASE NOW.LAW7/18/76 
          RJ     NXTCH       GET NEXT ENTITY
          ZR     X6,ERRNAME 
          SA1    LTO         =8LTO
          BX2    X1-X6       FORMAT IS   -CHANGE  X TO Y
          NZ     X2,CHGIT    BUT  -CHANGE  X Y - IS ALSO OK 
          RJ     NXTCH       GET NEXT ENTITY
          ZR     X6,ERRNAME 
 CHGIT    SA2    CHGTEMP
*   COME HERE WITH X2 AND X6 SET (I.E. CHANGE X2 TO X6).
*CALL      MACROS 
 ADR      MICRO  1,,/A0/     A0 = START OF HASH TABLE 
 COM      MICRO  1,,/COMNAMS/ 
          SA0    =XCOMINFO   COMINFO IS HASH TABLE
          LIST   G
*   LOCATE OLD NAME IN TABLE
          HASH   X2,X1,A3    X1 = HASH CODE FOR *FROM* NAME 
          FIND   X2,X1,CHGITA,B2,X0,B1,B3,B4,A3 
          EQ     ERRNAME      ERROR IF NAME NOT FOUND 
*   MAKE SURE NEW NAME IS NOT IN TABLE
 CHGITA   HASH   X6,X5,A3    X5 = HASH CODE FOR *TO* NAME 
          FIND   X6,X5,ERRORC,B6,X4,B5,B3,B4,A3 
*   STORE NEW NAME IN NAME TABLE
          SA6    =XCOMNAMS+B1 
*   REMOVE LINKS TO OLD HASH INFO 
          DELLINK  B2,B3,X3,B4,B5,A4,A7 
*   ADD LINKS TO NEW HASH INFO
          SB5    X5          HASH CODE FOR NEW NAME 
          ADDLINK    B5,B3,X3,B7,A4,A7
* 
          SA2    UNUMON      WARN THAT ALL CHANGE COMMANDS
          SX3    IEUNUM         MUST BE IN IEU
          BX3    X2-X3
          ZR     X3,NXTLINE 
          SB1    69          ERROR NUMBER FOR -CONDERR- 
          RJ     =XRJERR
          EQ     NXTLINE
* 
 NXTCH    EQ     *           FIND THE NEXT ENTITY 
          SA1    WORDPT 
          SB1    X1 
          SB2    60 
          SB3    6
          MX6    0
* 
 NXSK     SA1    B1          SKIP LEADING SPACES
          SX2    X1-1R       SPACE
          NZ     X2,CNLL
          SB1    B1+1 
          EQ     NXSK 
* 
 CNLL     SA1    B1          LOAD NEXT CHAR 
          ZR     X1,CNLL5 
          SB1    B1+1 
          SX2    X1-1R       TEST FOR SPACE 
          ZR     X2,CNLL5 
          SB2    B2-B3
          GE     B3,B2,ERRNAME   BAD IF OVER 8 CHARS
          LX1    X1,B2
          BX6    X6+X1       ADD TO WORD-A-BUILDING 
          EQ     CNLL 
 CNLL5    ZR     X6,CNLL8 
 CNLL6    SB2    B2-B3       NOW FILL REST WITH SPACES TO 8 CHARS 
          GE     B3,B2,CNLL8
          SX1    1R          SPACE
          LX1    X1,B2
          BX6    X6+X1
          EQ     CNLL6
 CNLL8    SX7    B1 
          SA7    WORDPT 
          EQ     NXTCH
* 
 LTO      DATA   8LTO 
 LFTO     VFD    60/75241755555555550000B  (FONT)TO 
 CHGTEMP  BSS    1           TEMP STORAGE 
* /---   BLOCK      CH-SYMBOL  00 000   78/02/13  22.38 
          TITLE  CHANGE SYMBOL X TO Y 
* 
* 
*         CHANGE SYMBOL  X  TO  Y 
* 
*         ALTERS THE STANDARD JUDGING VALUES OF CHARACTERS
* 
 CHSYM    SA2    UNUMON      CHANGE SYMBOLS ONLY IN IEU 
          SX3    IEUNUM 
          BX3    X2-X3
          NZ     X3,CHSERR1 
          SA2    CONTEST     THIS MUST BE FIRST SYMBOL CHANGE 
          SA3    CONTAB 
          BX3    X2-X3
          NZ     X3,CHSERR2 
          SA2    LESSON      SET JUDGING SYMBOL FLAG TO THIS LESSON 
          BX6    X2 
          SA6    A3 
          SA2    COMMAND     SAVE NAME OF THIS COMMAND FOR
          BX6    X2          LATER TESTING OF CONTINUED ADDITIONAL
          SA6    CHGNAME     CHANGE COMMANDS ... THIS METHOD
*                            ALLOWS FOR -CHANGE  CHANGE TO WOW- 
 CHSYM1   RJ     NXTCH       GET NEXT ENTITY
          MX5    0           INITIALIZE FONT FLAG 
          RJ     SYMBL       GET FIRXT SYMBOL 
          BX4    X1          SAVE CHARACTER TO CHANGE 
          SB4    B2          AND SAVE SHIFT 
* 
          RJ     NXTCH       GET NEXT ENTITY
          SA1    LTO         SEE IF -TO-
          BX2    X1-X6
          ZR     X2,CHSYM3
          SA1    LFTO        SEE IF -(FONT)TO-
          BX2    X1-X6
          NZ     X2,CHSYM4   IF NOT, TRY FOR SECOND SYMBOL
          SX2    100B 
          BX5    X2-X5       TOGGLE FONT
* 
 CHSYM3   RJ     NXTCH       GET NEXT ENTITY
* 
* /---   BLOCK      CH-SYMBOL  00 000   77/12/07  12.19 
 CHSYM4   ZR     X6,ERRNAME   THERE MUST BE SOMETHING THERE 
          SA6    SYMTABX     STORE INTO END OF SEARCH LIST
          SA1    SYMTAB-1    INITIALIZE START 
          SB1    1
 SYMLP    SA1    A1+B1       LOAD SEARCH WORDS
          BX2    X1-X6
          NZ     X2,SYMLP    CONTINUE UNTIL FIND MATCH
          SB1    A1-SYMTAB   CALCULATE NUMBER MATCH 
          JP     SYMJP+B1 
 SYMJP    SX1    COPLET      SET TO LETTER (CONSONANT)
          EQ     SYMDO
+         SX1    COPVOWL     SET TO LETTER (VOWEL)
          EQ     SYMDO
+         SX1    COPPUNC     SET TO MISC. PUNCTUATION 
          EQ     SYMDO
+         SX1    COPPUWD     SET TO PUNCTUATION AND WORD
          EQ     SYMDO
+         SX1    COPNULL     SET TO NULL CODE 
          EQ     SYMDO
+         SX1    COPDIAC     SET TO DIACRITIC 
          EQ     SYMDO
+         EQ     CHSYM5      NO FIND...TRY DIRECT CHANGE
* 
 SYMTAB   DATA   8LLETTER    CHANGE TO LETTER (CONSONANT) 
          DATA   8LVOWEL     CHANGE TO LETTER (VOWEL) 
          DATA   8LPUNC      CHANGE TO PUNCTUATION
          DATA   8LPUNCWORD  CHANGE TO PUNC AND WORD
          DATA   8LNULL      CHANGE TO NULL CODE
          DATA   8LDIACRIT   CHANGE TO DIACRITIC CODE 
 SYMTABX  DATA   0
* 
 SYMDO    SA2    CONTAB+1+X4   GET OLD 15-BIT ENTRY 
          LX2    X2,B4       GET 15-BITS TO TOP 
          MX3    6
          BX3    -X3*X2      BLANK OUT OPERATION CODE 
          LX1    54          GET NEW OP CODE
          BX6    X1+X3       PUT NEW OP CODE WITH OLD INFO BITS 
          EQ     CHSUB       NOW FINISH SUBSTITUTION
* 
* 
 CHSYM5   RJ     SYMBL       GET SECOND SYMBOL
* 
          SA2    CONTAB+1+X1   GET SUBSTITUTE WORD
          LX6    X2,B2       SHIFT TO GET 15-BITS TO TOP
 CHSUB    MX7    15          NOW SUBSTITUTE NEW ENTITY FOR OLD
          BX6    X6*X7       GET 15-BITS
          SA4    X4+CONTAB+1  GET WORD TO CHANGE IN USER TABLE
          SB3    60 
          SB4    B3-B4
          LX7    X7,B4
          LX6    X6,B4
          BX4    -X7*X4      ZERO OUT CODE TO CHANGE
          BX6    X4+X6       ADD NEW SYMBOL 
          SA6    A4          AND RESTORE IN CURRENT USER TABLE
* /---   BLOCK      CH-SYMBOL  00 000   77/03/31  21.43 
* 
          SA2    WORDPT      MAKE SURE THAT THE LINE IS EXHAUSTED 
          SA2    X2 
          NZ     X2,ERRTERM 
* 
 CKSYMON  SA1    NEXTCOM     SEE IF NEXT COMMAND ANOTHER SYMBOL CHANGE
          SA2    COMCONT       TEST AGAIN A BLANK COMMAND 
          BX2    X1-X2
          ZR     X2,CHGOON
          SA2    CHGNAME     GET NAME OF CHANGE COMMAND 
          BX2    X1-X2
          ZR     X2,CHGOON
* 
          SA1    CONDPNT     GET CURRENT READ-IN ECS POINTER
          BX0    X1 
          SA0    CONTAB      GET ADDRESS OF CHANGED JUDGING SYMBOLS 
+         WE     129         PUT SYMBOLS OUT AS DUMMY UNIT
          RJ     ECSPRTY
          SX2    129         LENGTH = 1 LABEL + 2-64 WORD TABLES
          IX6    X1+X2       INCREMENT TO GET NEW LENGTH
          SA6    A1          AND STORE NEW LENGTH 
          SA3    CONBUFF     GET START OF CONDENSE BUFFER 
          IX6    X1-X3       GET RELATIVE START OF TABLE
          LX6    ULOC2
          BX6    X6+X2       PUT BIAS AND LENGTH TOGETHER 
          LX6    ULOC3+ULOC4
          BX6    X6+X2       AND AGAIN FOR TOTAL LENGTH 
          LX6    60-ULOC1-ULOC2-ULOC3-ULOC4 
          SX3    JSYMNUM     GET DUMMY UNIT NUMBER
          SA6    ULOC+X3     STORE RELATIVE ADDRESS AS UNIT NAME
          SA4    KJUDSYM     SET UNIT NAME TO -JUDGESYM-
          BX6    X4 
          SA6    UNAME+X3 
          EQ     NXTLINE     ONTO NEXT COMMAND
* 
 KJUDSYM  VFD    12/0,48/8LJUDGESYM 
* 
 CHGOON   RJ     GETLINE     GET NEXT LINE
          RJ     NXTCH       GET NEXT ENTITY
          ZR     X6,ERRNAME 
          SA2    CHTABSL     SEE IF SYMBOL
          BX2    X2-X6
          ZR     X2,CHSYM1   GO ONTO NEXT SYMBOL CHANGE 
          EQ     CHG1        SEE IF ANOTHER TYPE OF CHANGE COMMAND
* 
* 
 CHSERR1  SB1    67          ONLY IN IEU
          EQ     =XERR       NO RETURN
* 
 CHSERR2  SB1    68          ALL SYMBOL CHANGES TOGETHER
          EQ     =XERR       NO RETURN
* /---   BLOCK      CH-SYMBOL  00 000   76/05/14  01.30 
* 
          SPACE  6
*         SYMBL...RETURNS X1 WITH CHARACTER FROM 0-127
*              AND B2 WITH SHIFT TO 15-BIT PACKAGE
*         SYMBOLS ARE CHECKED FOR LEGALITY
 SYMBL    EQ     *           GET NEXT SYMBOL
* 
          SA6    SYMBLD      SEE IF SPECIAL WORD CASE 
          SA1    SYMBLT-1    PRE-SET FOR FIRST WORD TO SEARCH 
          SB1    1
* 
 SYMBLP   SA1    A1+B1       GET NEXT WORD
          BX2    X1-X6
          NZ     X2,SYMBLP   LOOP UNTIL MATCH 
          SB1    A1-SYMBLT   GET INDEX OF FOUND WORD
          SA1    SYMBLTD+B1  GET INFO WORD
          ZR     X1,SYM0     ZERO MEANS TRY EXPLICIT CHARACTER OPTION 
          SB2    X1          SET SHIFT COUNT
          AX1    30          AND SET CHARACTER
          EQ     SYMBL
* 
 SYMBLT   DATA   8LSPACE     TABLE OF SPECIAL WORDS OF INVISIBLE CHARS
          DATA   8LSUP
          DATA   8LSUB
          DATA   8LSUPLOCK
          DATA   8LSUBLOCK
          DATA   8LBKSP 
          DATA   8LCR 
* 
          DATA   8LFSPACE       F=ALTERNATE FONT CASE 
          DATA   8LFSUP 
          DATA   8LFSUB 
          DATA   8LFSUPLOCK 
          DATA   8LFSUBLOCK 
          DATA   8LFBKSP
          DATA   8LFCR
 SYMBLD   DATA   0           HOLDS PLANTED END TEST WORD
* 
 SYMBLTD  VFD    30/55B,30/0    TABLE OF CHARACTER CODE AND SHIFT 
          VFD    30/67B,30/0      THAT IS IN ONE-ONE CORRESPONDENCE 
          VFD    30/66B,30/0      TO THE PREVIOUS TABLE 
          VFD    30/67B,30/15 
          VFD    30/66B,30/15 
          VFD    30/74B,30/0
          VFD    30/71B,30/0
* 
          VFD    30/155B,30/0 
          VFD    30/167B,30/0 
          VFD    30/166B,30/0 
          VFD    30/167B,30/15
          VFD    30/166B,30/15
          VFD    30/174B,30/0 
          VFD    30/171B,30/0 
          DATA   0
* /---   BLOCK      CH-SYMBOL  00 000   76/10/06  04.08 
* 
 SYM0     SB2    B0          NO SHIFT OR ACCESS YET 
          MX0    54 
* 
 SYM1     LX6    6           GET NEXT CHARACTER 
          BX1    -X0*X6 
          BX6    X0*X6       CLEAR OUT OF X6
          ZR     X1,SYMBLRR  THERE MUST BE SOMETHING THERE
          SX2    X1-FONT     SEE IF FONT
          NZ     X2,SYM2
          SX2    100B        TOGGLE FONT
          BX5    X5-X2
          EQ     SYM1 
* 
 SYM2     SX2    X1-KUP      SEE IF SHIFT CODE
          NZ     X2,SYM3
          NZ     B2,SYM2A    SEE IF ACCESS-SHIFT
          SB2    15          SET SHIFT SHIFT
          EQ     SYM1 
 SYM2A    SX2    B2-30       MAKE SURE ONLY ACCESS BEFORE 
          NZ     X2,SYMBLRR 
          SB2    45 
          EQ     SYM1 
* 
 SYM3     SX2    X1-ACCESS   SEE IF ACCESS CODE 
          NZ     X2,SYM4
          SB2    30          SET FOR ACCESS SHIFT 
          EQ     SYM1 
* 
 SYM4     IX1    X1+X5       ADD IN FONT TOGGLE 
* 
 SYM5     LX6    6           ONLY SPACES LEFT 
          BX2    -X0*X6 
          ZR     X2,SYMBL 
          SX3    X2-1R
          ZR     X3,SYMBL 
          SX3    X2-FONT     ALLOW FONT AND DO TOGGLE 
          NZ     X3,SYMBLRR 
          SX2    100B 
          BX5    X5-X2
          EQ     SYM5 
* 
* 
 SYMBLRR  SB1    66          SET TO SPECIAL MESSAGE 
          RJ     =XRJERR
          EQ     CKSYMON     AND CONTINUE TO NEXT LINE
* 
 CHGNAME  BSS    1           THIS IS STORED INTO NEAR CHSYM 
* /---   BLOCK      CH-LANGS   00 000   76/10/07  00.57 
 .CLANG   IFGT   CLANGS,1 
          TITLE  CHANGE COMMANDS TO LANGUAGEX 
* 
*         CHANGE  ENDCMNDS  LANGUAGEX 
* 
 CHENDL   RJ     NXTCH       GET NAME OF LANGUAGE 
          ZR     X6,ERRORC
* 
          SA3    LESSON 
          SA4    KS0LANG     LEGAL ONLY IN LESSON S0LANG
          BX4    X3-X4
          NZ     X4,ERRORC
          SA4    ACCOUNT
          LX4    42          SHIFT TO OLD-STYLE FLAG
          PL     X4,ERRORC   MUST BE AN OLD-STYLE FILE
* 
 CHEND1   SA1    CMNDLGS     GET ECS ADDRESS OF LANGUAGE NAMES
          BX0    X1 
          SA0    CHWORK 
          SB1    1
          SB2    CLANGS      NUMBER OF POSSIBLE LANGUAGES 
          SX7    B1 
          MX2    0           BIAS TO THIS LANGUAGES TABLES
          SX3    CMNDMAX
* 
 CHENDLP  RE     1           GET LANGUAGE NAME
          RJ     ECSPRTY
          SA4    A0 
          ZR     X4,CHENDF   SEE IF FIND EMPTY SPOT 
          BX4    X4-X6       SEE IF SHOULD CHANGE EXISTING TABLES 
          ZR     X4,CHENDF
          IX2    X2+X3       INCREMENT BIAS INTO TABLES 
          SB2    B2-B1
          IX0    X0+X7       INCREMENT
          NZ     B2,CHENDLP 
          EQ     ERRORC 
* 
 CHENDF   SA6    A0          NOW STORE AWAY NEW LANGUAGE NAME 
+         WE     B1 
          RJ     ECSPRTY
          SA1    CMNDTBL     AND STORE AWAY CURRENT TABLES
          IX0    X1+X2         WITH PROPER BIAS 
          SA0    COMNAMS
+         WE     =XCOMNAML
          RJ     ECSPRTY
          SA1    CMNDINF
          IX0    X1+X2
          SA0    =XCOMINFO
+         WE     =XCOMINFL
          RJ     ECSPRTY
* 
*         NOW GET TRUE COPY OF COMMANDS AND HASH INFO INTO CM 
*         SO WE GO ON WITH FRESH ENGLISH TABLES 
* 
          SA1    CMNDTBL
          BX0    X1 
          SA0    COMNAMS
+         RE     =XCOMNAML   READ COMMAND NAME TABLE
          RJ     ECSPRTY
          SA1    CMNDINF
          BX0    X1 
          SA0    =XCOMINFO
+         RE     =XCOMINFL   READ HASHED INFO TABLE 
          RJ     ECSPRTY
          EQ     NXTLINE     AND ONTO NEXT LINE 
* 
* 
 CHWORK   BSS    1
* /---   BLOCK      CH-LANGS   00 000   76/10/06  23.15 
          TITLE  CHANGE COMMANDS TO LANGUAGEX 
* 
 CHLANG   RJ     NXTCH       GET NEXT ENTITY
          ZR     X6,ERRORC
          SA1    LTO         SEE IF -TO-
          BX2    X1-X6
          NZ     X2,CHLANG1 
          RJ     NXTCH
          ZR     X6,ERRORC
* 
*                            NOW SEARCH FOR DESIRED LANGUAGE NAME 
* 
 CHLANG1  SA1    CMNDLGS     GET ECS ADDRESS OF LANGUAGE NAMES
          BX0    X1 
          SA0    CHWORK 
          SX7    1
          MX2    0           BIAS TO THIS LANGUAGES TABLES
          SX3    CMNDMAX
* 
 CHLANGL  RE     1           GET NEXT LANGUAGE NAME 
          RJ     ECSPRTY
          SA4    A0 
          ZR     X4,ERRORC   CANNOT FIND NAME...ZERO GUARANTEED END TEST
          BX4    X4-X6       SEE IF NAME LOOKING FOR
          ZR     X4,CHLANG3 
          IX2    X2+X3       INCREMENT BIAS INTO TABLES 
          IX0    X0+X7       INCREMENT
          EQ     CHLANGL
* 
 CHLANG3  SA1    CMNDTBL     NOW GET TABLES FOR THIS LANGUAGE 
          IX0    X1+X2         WITH PROPER BIAS 
          SA0    COMNAMS
+         RE     =XCOMNAML
          RJ     ECSPRTY
          SA1    CMNDINF
          IX0    X1+X2
          SA0    =XCOMINFO
+         RE     =XCOMINFL
          RJ     ECSPRTY
* 
          EQ     NXTLINE     NOW ON WITH NEW COMMANDS 
 .CLANG   ENDIF 
* 
          ENDOV 
* /---   BLOCK      DRAW       00 000   79/12/15  22.06 
          TITLE  CONDENSE DRAW COMMANDS 
* 
* DRAW  P1;P2;P3;P4   -OR-   DRAW  ;P1;P2;P3 WHICH IS 
* EQUIVALENT TO DRAW  WHERE;P1;P2;P3 .  THIS CONTINUED
* DRAW IS FLAGGED WITH SIGN BIT OF COMMAND WORD.
* ALSO USED FOR GDRAW -- FROM -ORIGIN- AND SCALED.
* ALSO USED FOR RDRAW -- RELATIVE, ROTATED, AND SIZED.
* OVARG1 = 0 FOR DRAW 
*          1 FOR GDRAW
*          2 FOR RDRAW
* 
* THE VERTICES ARE PACKED UP INTO ONE OR TWO 20 BIT 
* PACKAGES.  THE FIRST TWO PACKAGES ARE IN THE COMMAND
* WORD, THE REST ARE IN EXTRA STORAGE.  THE FIRST PACKAGE 
* CONTAINS THE NUMBER OF PACKAGES.
* THE FIRST PACKAGE HAS LEFT BIT SET IF CONTINUED 
* COMMAND, NEXT BIT SET IF ALL VERTICES ARE PACKED 9BIT 
* CODES.  REST OF PACKAGES ARE 2 BITS OF TYPE, 18 BITS
* OF GETVAR CODE. 2BIT TYPE CODE AS FOLLOWS'; 
*  00=COARSE GRID -GETVAR- CODE 
*  01=FINE GRID -GETVAR- CODE  (ONLY X-COORD MARKED)
*  10=18 BIT CODE IS 9BIT-X,9BIT-Y
*  11=SKIP
* 
          EXT    RCTOXY 
* 
 DRAWOV   OVRLAY
          SA2    WORDPT      SKIP OVER LEADING BLANKS 
          SA1    X2-1 
          SX2    1R 
          SB1    1
 DRAWC1   SA1    A1+B1       LOOK AT NEXT CHARACTER 
          IX7    X1-X2
          ZR     X7,DRAWC1   LOOP TILL NON BLANK
* 
          ZR     X1,ERR2FEW   IF NO TAGS
          SX7    A1          X7 = NEW VALUE FOR WORDPT
          MX6    0           ASSUME NOT CONTINUED DRAW
          SX2    X1-KSEMIC
          NZ     X2,DRAWC2   IF NOT CONTINUED 
          SX7    X7+B1       MOVE WORDPT PAST TERMINATOR
          MX6    1           CONTINUED DRAW 
          LX6    XCODEL 
 DRAWC2   SA6    TDRAW       TYPE OF DRAW COMMAND 
          SA7    A2          UPDATE WORDPT
* 
          RJ     CONDRAW     GETVAR CODES INTO VARBUF 
* 
          SA1    LASTYPE
          NG     X1,ERRXYTG  -- ERROR, FINE X WITHOUT Y 
          ZR     X1,DRAWC3   -- OK, COARSE GRID 
*         -SKIP- IS LAST TAG, BACKUP COUNTERS TO IGNORE IT
          SA1    VARBUF      NUMBER OF GETVAR CODES 
          SA2    VERTEX      NUMBER OF VERTICES 
          SX6    X1-1 
          SX7    X2-1 
          SA6    A1 
          SA7    A2 
 DRAWC3   BSS    0
* 
          SA1    VERTEX 
          LX1    1           TWICE THE VERTICES 
          SX2    X1-SHAREL   BUFFER FOR (X,Y) VALUES
          PL     X2,ERR2MNY   NOT ENOUGH EXECUTION ROOM 
* 
          SA4    VARBUF      A4 HOLDS ADR OF FIRST 20 BIT PACKAGE 
          SX2    X1-2 
          SA1    TDRAW       FLAG FOR FIRST ARG BLANK 
          NZ     X2,DRAWIN2  JUMP IF MORE THAN ONE VERTEX 
          NZ     X1,DRAWIN2  JUMP IF FIRST ARG BLANK
* 
* IF ONLY ONE VERTEX, NEED TO DRAW A LINE FROM STARTING 
* POINT TO ENDING POINT (THAT IS, A DOT).  FOLLOWING
* CODE CAUSES PROBLEMS IF THE ARGUMENTS SPECIFYING THE
* DOT CONTAIN ASSIGNMENTS, FOR THE ASSIGNMENTS WILL BE
* /---   BLOCK      DRAW       00 000   79/12/15  22.06 
* EXECUTED TWICE.  PROCEDURE SHOULD BE CHANGED. 
* 
          SX2    X4-1 
* /---   BLOCK      DRAW       00 000   76/08/21  17.05 
          ZR     X2,DDOTC    JUMP IF COARSE SINGLE VERTEX 
          SA2    A4+1        MOCKUP  DRAW  X1,Y1;X1,Y1
          BX7    X2 
          SA7    A4+3 
          SA2    A4+2 
          BX7    X2 
          SA7    A4+4 
          SX4    4
          EQ     DRAWIN2
 DDOTC    SA2    A4+1        MOCKUP  DRAW   RC1;RC1 
          BX7    X2 
          SA7    A4+2 
          SX4    2
 DRAWIN2  SX2    X4+1        X2 HOLDS COUNT OF 20 BIT PACKAGES
          BX4    X1+X4
          SA1    SFFLAG      FLAG FOR ALL PACKED TAGS 
          BX4    X4+X1
          BX1    X2          ALLOW ANY NUMBER OF VARIABLES
          RJ     VARFINS     USE STANDARD VARFIN PROCESSOR
          EQ     NXTLINE
* 
* - - - - SUBROUTINE TO HANDLE DRAW COMMAND - - - - 
*            USES SEMICOLON FOR ARG TERMINATOR
*         FORMAT IS -- DRAW  P1;P2;P3;P4
*         WHERE P2 MAY BE COARSE (1512) OR FINE (100,200).
* 
*         VARBUF(0) RETURNED WITH NUMBER OF VARIABLES 
*         VARBUF(N) RETURNED WITH -GETVAR- CODE FOR NTH VARIABLE
* 
*         ****NOTE**** WORDPT IS ASSUMED TO POINT TO
*            THE CHAR TO PROCESS FIRST. 
* 
*         THE SUBROUTINE VARFIN WILL HANDLE THE PACKING UP OF THESE VARS
* 
*         20-BIT CODE FOR EACH VAR IS AS FOLLOWS--
*           TOP 2 BITS'; 0=COARSE,1=FINE,2=PACKED FINE,3=SKIP 
*           LOWER 18 BITS -- GETVAR CODE OR PACKED FINE GRID
* 
* 
 CONDRAW  EQ     *
          MX6    0
          SA6    VARBUF      ZERO VARBUF(0) - NO VARS YET 
          SA6    VERTEX      COUNT NUMBER OF VERTICES 
          SA6    LASTYPE     INDICATE DONE WITH LAST VERTEX 
          SA1    OVARG1      0 IF WANT TO PACK (-DRAW-) 
          NZ     X1,NOPACK
          SX6    1
          LX6    XCODEL-2    NEXT TO TOP BIT IF ALL PACKED
 NOPACK   SA6    SFFLAG      WILL BE MERGED INTO CMND WORD
 CDRAW    RJ     CONDRAW2    GET CODE FOR NEXT VARIABLE 
          SA1    WORDPT      CHECK FOR END-OF-LINE
          SA1    X1 
          NZ     X1,CDRAW    JUMP IF NOT EOL
          SA1    NEXTCOM     CHECK FOR CONTINUATION 
          SA2    COMCONT
          BX3    X1-X2
          NZ     X3,CONDRAW  --- EXIT IF NOT CONTINUED
          RJ     GETLINE     READ IN NEXT LINE
          EQ     CDRAW
* 
* 
* /---   BLOCK      DRAW       00 000   76/08/21  17.12 
* 
* - - - - SUBROUTINE TO GET NEXT VARIABLE - - - - 
*            USES STANDARD LEXICAL SEPARATORS 
* 
 CONDRAW2 EQ     *
 CODRW0   BSS    0
          SA1    WORDPT      POINTER TO FIRST CHARACTER 
          SA1    X1 
          ZR     X1,CONDRAW2  IF END-OF-LINE
          SX2    X1-1R
          NZ     X2,CODRW1   IF NOT BLANK 
          SA1    WORDPT      ADVANCE CHARACTER POINTER
          SX6    X1+1 
          SA6    A1 
          EQ     CODRW0 
 
 CODRW1   BSS    0
          SA1    X1+KEYTYPE  GET TYPE OF FIRST CHARACTER
          NZ     X1,CODRW2   JUMP IF NOT NUMERIC
          CALL   QUIKCMP     FOR QUICK COMPILE OF NUMBER
          EQ     CODRW3 
* 
 CODRW2   CALL   COMPSYM,SKIP,1  WILL CHANGE CODE LATER 
 CODRW3   SA2    VARBUF      X2 HOLDS CURRENT NO. OF ARGS 
          SX7    X2+1        X7 HOLDS NEW NO. OF ARGUMENTS
          SX2    X7-VARBUFL  SUBTRACT OFF SIZE OF VARBUF
          PL     X2,ERR2MNY   EXIT IF READINBF FULL 
          SA7    A2          NEW VARIABLE COUNT IN VARBUF(0)
*  X1=GETVAR CODE, X7=OFFSET IN VARBUF TO PLACE CODE
          SA3    VERTEX      COUNT VERTICES 
          SX6    X3+1 
          SA6    A3 
* 
          SA2    LASTKEY     CHECK FOR TERMINATOR TYPE
          SX2    X2-1R, 
          SA4    LASTYPE     PICK UP PREVIOUS GETVAR TYPE 
          BX0    X1 
          AX0    XCODEAL     CHECK FOR -SKIP- OPTION
          SX6    X0-7 
          NZ     X6,CODRW4   IF NOT -SKIP- OPTION 
* 
* -SKIP- OPTION --- 
          ZR     X2,ERRTERM   COMMA MUST NOT FOLLOW SKIP
          NZ     X4,ERRXYTG   -,SKIP- AND -SKIP;SKIP- ILLEGAL 
*  (IF ONLY WANT -,SKIP- ILLEGAL, MAKE IT -NG X4,ERRXYTG-)
          SX6    1           INDICATE SKIP
          SA6    A4 
          MX1    2           SKIP HAS TOP TWO BITS SET
          LX1    XCODEL 
          EQ     CODRW9 
* 
 CODRW4   NZ     X2,CODRW5   IF DOESNT TERMINATE WITH -,- 
* 
*  NOT -SKIP-, AND TERMINATES WITH -,-
          NG     X4,ERRXYTG   IF LAST WAS ALSO -X- COORD
          MX6    -1          INDICATE X OF FINE GRID
          SA6    A4 
          MX6    1
          LX6    XCODEL-1    NEXT TO TOP BIT FOR X-COORD
          BX1    X1+X6
          EQ     CODRW9 
* 
* /---   BLOCK      DRAW       00 000   76/08/21  21.46 
 CODRW5   MX6    0
          SA6    A4          INDICATE DONE WITH VERTEX
          NG     X4,CODRW6   IF LAST WAS -X- COORD
* 
*  CURRENT ARG IS COARSE GRID --- 
          SA2    OVARG1      = 1 FOR GDRAW
          SX6    X2-1 
          ZR     X6,ERRXYTG  GDRAW CANNOT HAVE COARSE GRID
          NZ     X0,CODRW8   ALL DONE IF NOT SHORT LITERAL
          NZ     X2,CODRW9   C/F CONVERSION ONLY FOR DRAW 
          BX0    X7          SAVE POINTER INTO VARBUF 
          RJ     RCTOXY      X6=X, X7=Y, X0-X1 UNCHANGED
          BX3    X7          Y-COORDINATE 
          BX7    X0          RESTORE VARBUF OFFSET
          MX4    -9 
          BX0    X4*X6
          NZ     X0,CODRW8   IF WONT FIT IN 9 BITS
          BX0    X4*X3
          NZ     X0,CODRW8   IF WONT FIT IN 9 BITS
          LX6    9           THEY FIT, PACK THEM UP 
          BX1    X6+X3
          MX6    1           INDICATE X-Y PACKED FORMAT 
          LX6    XCODEL 
          BX1    X1+X6
          EQ     CODRW9 
* 
*   -Y- COORDINATE.  SEE IF CAN PACK WITH -X- COORDINATE
 CODRW6   SA2    VERTEX 
          SX6    X2-1 
          SA6    A2 
          NZ     X0,CODRW8   NOPE, -Y- IS NOT SHORT LITERAL 
          SA2    OVARG1      0 FOR DRAW 
          NZ     X2,CODRW8
          SA2    VARBUF+X7-1 GETVAR CODE FOR -X- COORD
          MX0    -18         IGNORE BIT 'I PUT ON 
          BX2    -X0*X2 
          MX4    -9          ONLY USE 9 BITS NOW
          BX0    X4*X1
          NZ     X0,CODRW8   IF WONT FIT IN 9 BITS
          BX0    X4*X2
          NZ     X0,CODRW8   IF WONT FIT IN 9 BITS
          LX2    9           THEY FIT, PACK THEM UP 
          BX1    X1+X2
          MX6    1           INDICATE X-Y PACKED FORMAT 
          LX6    XCODEL 
          BX1    X1+X6
          SA2    VARBUF      DECREMENT VARBUF COUNT 
          SX7    X2-1 
          SA7    A2 
          EQ     CODRW9      AND OUTPUT 
 
* 
 CODRW8   SX6    0           INDICATE NOT ALL PACKED UP 
          SA6    SFFLAG 
* 
 CODRW9   BX6    X1 
          SA6    X7+VARBUF   STORE IN NEXT LOC OF VARBUF
          EQ     CONDRAW2 
* 
 LASTYPE  BSS    1           -1=X OF FINE, 0=OK, 1=SKIP 
 TDRAW    BSS    1           TEMP FOR DRAW COMMAND
 VERTEX   BSS    1           COUNT NUMBER OF VERTICES 
 SFFLAG   BSS    1           FLAG FOR ALL PACKED UP 
 SKIP     VFD    42/4LSKIP,1/1,17/0   -JUMP-TYPE GETVAR CODE
* 
* 
          ENDOV 
* /---   BLOCK      PUT        00 000   76/07/25  08.08 
          TITLE  PUT AND PUTD COMMANDS
 PUTOV    OVRLAY
* 
          SA1    OVARG1 
          SB3    X1 
* 
          JP     *+B3 
* 
+         EQ     PUT
+         EQ     PUTD 
* 
********* 
* 
*         -PUT-  (CODE=26)
* 
* 
 PUT      SA1    TAGCNT 
          ZR     X1,ERR2FEW   ERROR IF BLANK TAG
* 
          SB1    1
          SX2    1R=
*         ENTRY FOR PUT WITH DELIMITERS 
 PUTDENT  SB2    B0          START SEARCH AT 2ND CHAR 
 VORN     SB2    B2+B1
          SA1    B2+TAG 
          ZR     X1,ERRPUT   WILL BE PUTS ON VARIABLES JUMP 
          IX3    X2-X1
          NZ     X3,VORN     GO SEE IF EQUALS IS LATER
* 
* 
* 
*       B2=CHAR COUNTER 
*       B3=CHAR PER WORD COUNTER
*       B7=XTRA STORAGE WORD COUNTER
* 
*         CONSTRUCT IN STRING 
* 
          SA3    INX         X3=XTRA STORAGE POINTER
          BX6    X3 
          LX6    12          START COMMAND WORD WITH XTRA POINTER--INADD
          LX2    54          LEFT JUSTIFY *=* 
          MX0    6
          SB3    10          CHAR/WORD PRESET 
          SB2    B0 
          SB7    X3+INFO     GET ABSOLUTE START OF XTRA STORAGE 
          SX3    B7          AND PUT IN X3
          SB7    B0          SET OFFSET FROM HERE TO ZERO 
          SX7    B0          CLEAR X7 
* 
* 
 PEQLP    SA1    B2+TAG      LOAD CHAR
          SB2    B2+B1
          LX1    54          LEFT JUSTIFY 
          BX1    X1*X0       MAKE SURE THAT IS ONLY BITS
          BX7    X1+X7       AND ADD TO EXISTING WORD 
          LX7    6           PUT IN RIGHT OF EXISTING WORD
          SB3    B3-B1       CHAR/WORD DECREMENT
          IX4    X2-X1
          ZR     X4,PEQJUS   DONE IF *=* FOUND
          NZ     B3,PEQLP    GO TILL WORD FULL
          SA7    X3+B7       STORE FULL WORD
          SB7    B7+B1
          SB3    10          RESET CHAR/WORD
          SX7    B0 
          EQ     PEQLP       GO DO NEXT WORD
* 
* 
 PEQJUS   ZR     B3,PINLTH
          LX7    6           LEFT JUSTIFY LAST WORD 
          SB3    B3-B1
          EQ     PEQJUS 
 PINLTH   SX1    B7+B1
          SA5    INX
          IX1    X1+X5       POINTER TO OUTSTR IN 2ND BYTE
          BX6    X6+X1       OF COMMAND WORD
          LX6    12 
* /---   BLOCK      PUTD       00 000   76/07/25  08.27 
          SX1    B2-B1       X1=CHAR CNT-1 FOR *=*
          BX6    X6+X1       3RD BYTE OF COMMAND WORD = INLTH 
          LX6    12 
 
          SA7    X3+B7       STORE LAST IN WORD 
          SB7    B7+B1
          SB4    B2          SAVE INLTH+1 TO CALCULATE OUTLTH 
          SB3    10 
          SX7    B0 
* 
* 
*         CONSTRUCT OUT STRING
* 
 PUTSLP   SA1    TAG+B2      LOAD CHAR
          SB2    B2+B1
          LX1    54 
          BX1    X1*X0       CLEAN EXTRANEOUS BITS
          BX7    X1+X7
          LX7    6
          SB3    B3-B1
          ZR     X1,POUTJUS  CHECK FOR ZERO TERMINATOR
          NZ     B3,PUTSLP   LOOP IF WORD NOT FULL
          SA7    X3+B7       STORE WORD 
          SX7    B0          CLEAR X7 
          SB7    B7+B1
          SB3    10 
          EQ     PUTSLP 
* 
* 
 POUTJUS  ZR     B3,POUTLTH 
          LX7    6
          SB3    B3-B1
          EQ     POUTJUS
* 
 POUTLTH  SA7    X3+B7       STORE LAST OUT WORD
          SB7    B7+B1       SET INX TO POINT AT NEXT WORD
          SA1    INX
          SX2    B7 
          IX7    X1+X2
          SA7    INX         UPDATED INX STORED 
          SB2    B2-B1       SUTRACT ONE FOR TERMINATOR 
          SX1    B2-B4       OUTLTH TO X1 
          BX6    X6+X1       PUT OUTLTH IN COMMAND WORD 
          LX6    12 
          EQ     PUTCODE     GO TACK ON COMMAND CODE AND STORE
* 
***************** 
*         -PUTD- COMMAND
* 
*                            *PUTD* 
 PUTD     SA1    TAGCNT 
          SB3    X1-4 
          NG     B3,ERRPUT    ERROR IF LESS THAN 4 CHARS IN TAG 
          SB3    X1-1 
          SB1    1           UNIVERSAL INCREMENT CONSTANT TO B1 
* 
          SX6    PUT=        *** NUMBER OF *PUT* COMMAND ***
          SA6    COMNUM      FAKE OUT PUTCODE 
* 
          SA2    TAG         LOAD FIRST DELIMITER 
          SA3    B3+TAG      LOAD LAST DELIMITER
          IX3    X2-X3
          NZ     X3,ERRPUT   DELIMITER DISAGREEMENT ERROR 
          SX6    B0 
          SA6    A3          STORE FINAL ZERO OVER LAST DELIMITER 
          SB2    B1 
* 
 PUTDLP   SA1    B2+TAG      LOAD CHAR
          BX6    X1 
          SA6    A1-B1       AND STORE IT ONE BACK
          SB2    B2+B1
          NZ     X6,PUTDLP
          EQ     PUTDENT     DONE--FINAL ZERO FOUND 
* 
 ERRPUT   SB1    87 
          EQ     =XERR
* 
          ENDOV 
* 
* /---   BLOCK      COMMON     00 000   80/08/07  01.50 
          TITLE  COMMON, STORAGE, ROUTVAR 
* 
* 
 COMMOV   OVRLAY
          SA1    OVARG1 
          SB3    X1 
          JP     *+B3 
* 
+         EQ     COMM        -COMMON- (NON-EX)
+         EQ     NONSYS      -COMMONX-
+         EQ     STOR        -STORAGE-
+         EQ     RVAR        -ROUTVAR-
+         EQ     SCOMX       -SYSCOMX-
+         EQ     LVAR        -LVARS-
* 
* /---   BLOCK      COMMON     00 000   80/10/16  21.34 
          TITLE  COMMON 
* 
*         -COMMON-  (NOT EXECUTEABLE) 
* 
*         MAY HAVE ONE TO FIVE ARGUMENTS
* 
*         IF ONE ARGUMENT - 
*         SPECIAL COMMON IS SET UP - ECS RESIDENT ONLY
*         ARGUMENT IS THE LENGTH
* 
*         IF MULTIPLE ARGUMENTS - 
*         1ST ARGUMENT = ACCOUNT NAME 
*         2ND ARGUMENT = LESSON NAME
*         3RD ARGUMENT = COMMON BLOCK NAME
*         4TH ARGUMENT = LENGTH OF COMMON 
* 
*         LAST ARGUMENT MAY INDICATE SPECIAL OPTIONS
* 
*         SETS *CCOMACT* = ACCOUNT NAME 
*              *CCOMLES* = LESSON NAME
*              *CCOMNAM* = COMMON NAME
*              *CCOMLTH* = LENGTH OF COMMON 
*              *CCOMBIT* = SPECIAL OPTION BITS
* 
 COMM     BSS    0
          SA1    CCOMLES     SEE IF ALREADY A COMMON
          NZ     X1,ERRCOMM   ERROR IF SO 
          SA1    TAGCNT 
          ZR     X1,ERR2FEW   ERROR IF NO TAG 
          SA1    COMACNT
          SX1    X1-2 
          NG     X1,TEMPCOM 
          CALL   ACCFILE,COMACT,-1    GET ACCOUNT;FILE
          NZ     X1,COMHAV   JUMP IF LESSON SPECIFIED 
          SA1    ACCOUNT     ACCOUNT OF THIS LESSON 
          SA2    LESSON      NAME OF THIS LESSON
          MX6    1
          LX6    18          SET ORIGINAL FILE FLAG 
          BX6    X1+X6
          BX7    X2 
          SA6    COMACT 
          SA7    COMLES 
* 
 COMHAV   BSS    0
          RJ     BLKNAM      GET SECOND ARGUMENT
          ZR     X6,ERRNAME 
          SA6    COMNAM 
          RJ     GETCLTH     GET COMMON LENGTH
          NZ     X6,ERRNAME 
          BX7    X1 
          SX1    MAXCOM+1 
          IX1    X7-X1
          NG     X7,ERRNAME 
          ZR     X7,ERRNAME 
          PL     X1,ERRNAME 
          SA7    COMLTH 
          SA1    COMACNT
          SX1    X1-3 
          NG     X1,COMM3 
          EQ     COMLAST     PROCESS LAST ARGUMENT
* /---   BLOCK      COMMON     00 000   80/08/16  18.25 
* 
 TEMPCOM  MX6    0           CLEAR 2ND WORD OF NAME 
          SA6    COMNAM 
          RJ     GETCLTH     GET LENGTH OF COMMON 
          NZ     X6,ERRNAME 
          BX7    X1 
          SX1    TCLTH+1
          IX1    X7-X1
          NG     X7,ERRNAME 
          ZR     X7,ERRNAME 
          PL     X1,ERRNAME 
          SA7    COMLTH 
          SA1    TMPCMNM     LESSON NAME FOR TEMP COMMON
          BX6    X1 
          SA6    COMLES 
          SA1    COMACNT
          ZR     X1,COMM3 
* 
 COMLAST  CALL   NXTNAME     GET OPTION NAME(S) ****
          ZR     X6,ERRNAME 
          SB1    B0 
* 
 COMM1    SA1    B1+COMOLST  LOAD NEXT OPTION NAME
          ZR     X1,ERRNAME 
          BX2    X6-X1       SEE IF NAMES MATCH 
          ZR     X2,COMM2 
          SB1    B1+1 
          EQ     COMM1       KEEP SEARCHING 
* 
 COMM2    SA1    B1+COMBLST  LOAD BIT PATTERN 
          SA2    COMBIT 
          BX6    X1+X2       MERGE COMMON OPTION BITS 
          SA6    A2 
          SA1    WORDPT 
          SA1    X1          LOAD ENDING CHARACTER
          NZ     X1,COMLAST 
 
*         TRANSFER ARGUMENTS TO GLOBAL VARIABLES
 
 COMM3    SB1    1
          SA1    COMACT 
          SA2    A1+B1       *COMLES* 
          BX6    X1 
          SA1    A2+B1       *COMNAM* 
          BX7    X2 
          SA6    CCOMACT
          SA7    CCOMLES
          SA2    A1+B1       *COMLTH* 
          BX6    X1 
          BX7    X2 
          SA1    A2+B1       *COMBIT* 
          SA6    CCOMNAM
          SA7    CCOMLTH
          BX6    X1 
          SA6    CCOMBIT
          EQ     NXTLINE
          SPACE  3
*         BLKNAM - GET BLOCK NAME FOR -COMMON-
 
 BLKNXIT  SX7    A1          UPDATE WORDPT
          SA7    WORDPT 
* 
 BLKNAM   EQ     *
          SA1    WORDPT      GET POINTER TO FIRST CHARACTER 
* 
 BLKN100  SA2    X1          LOAD NEXT CHARACTER
          SX0    X2-1R       STRIP OFF LEADING SPACES 
          NZ     X0,BLKN110 
          SX1    X1+1        ADVANCE CHARACTER POINTER
          EQ     BLKN100
* 
*         COLLECT CHARACTERS OF ALPHA LITERAL 
* 
 BLKN110  SB1    60          INITIALIZE SHIFT 
          MX6    0           INITIALIZE WORD BUILDING 
          SA1    X1-1        INITIALIZE READ REGISTER 
* 
 BLKN120  SA1    A1+1        LOAD NEXT CHARACTER
          ZR     X1,BLKNXIT  IF END-OF-LINE 
          SA2    X1+KEYTYPE 
          SX0    X2-OPCOMMA  CHECK IF COMMA 
          ZR     X0,BLKN140 
          SB1    B1-6        DECREMENT SHIFT COUNT
          PL     B1,BLKN130 
          MX6    0           RETURN ZERO NAME FOR ERROR 
          EQ     BLKNXIT
* 
 BLKN130  LX1    X1,B1       POSITION NEXT CHARACTER
          BX6    X1+X6       MERGE WITH WORD BUILDING 
          EQ     BLKN120
* 
* /---   BLOCK      COMMON     00 000   80/08/16  18.25 
 BLKN140  SX7    A1+1        UPDATE *WORDPT* FOR COMMA
          SA7    WORDPT 
          EQ     BLKNAM 
* /---   BLOCK      COMMON     00 000   80/08/07  01.54 
          SPACE  3
*         GETCLTH - GET LENGTH FOR -COMMON- 
* 
 GETCLTH  EQ     *
          CALL   COMPILE
          BX5    X1          SAVE -GETVAR- CODE 
          MX6    0           SET NO ERROR 
          AX1    XCODEAL
          MX0    -XCODEAL 
          ZR     X1,GETCL1   JUMP IF SHORT LITERAL
          SX2    X1-1 
          ZR     X2,GETCL2   JUMP IF LONG INTEGER LITERAL 
          SX2    X1-9 
          ZR     X2,GETCL3   JUMP IF FLOATING LITERAL 
          MX6    -1          ERROR RETURN 
          EQ     GETCLTH
* 
 GETCL1   BX1    -X0*X5      MASK OFF SHORT LITERAL 
          EQ     GETCLTH
* 
 GETCL2   BX1    -X0*X5 
          SA1    X1+INFO     LOAD LONG LITERAL
          EQ     GETCLTH
* 
 GETCL3   BX1    -X0*X5 
          SA1    X1+INFO     LOAD LONG LITERAL
          SA2    HALF 
          PL     X1,GETCL3A 
          BX2    -X2         SUB .5 IF ARGUMENT NEGATIVE
 GETCL3A  RX3    X1+X2
          UX3    X3,B1       FIX THE ARGUMENT 
          LX3    X3,B1
          MX6    0           ZERO FOR NO ERROR
          IX1    X3+X6       CHANGE -0 TO +0
          EQ     GETCLTH
* 
* 
*  THE ORDER OF THE FOLLOWING CELLS IS IMPORTANT
* 
 COMACT   BSSZ   1
 COMLES   BSSZ   1
 COMNAM   BSSZ   1
 COMLTH   BSSZ   1
 COMBIT   BSSZ   1
* 
* 
 COMOLST  DATA   2LNL 
          DATA   2LRO 
          DATA   4LRONL 
          DATA   7LNO LOAD
          DATA   9LREAD ONLY
          DATA   0LCHECKPT
          DATA   0
* 
 COMBLST  VFD    12/4000B,48/0
+         VFD    12/2000B,48/0
+         VFD    12/6000B,48/0
+         VFD    12/4000B,48/0
+         VFD    12/2000B,48/0
+         VFD    12/1000B,48/0
* 
* 
 HALF     DATA   .5 
* 
 ERRCOMM  SB1    86 
          EQ     =XERR
* 
* /---   BLOCK      SYSCOMX    00 000   80/02/15  22.06 
* 
          TITLE  -SYSCOMX- COMMAND
*         -SYSCOMX- 
*         EXECUTABLE -COMMON- COMMAND 
* 
 SCOMX    BSS    0
          CALL   SYSTEST     SYSTEM LESSONS ONLY
          SA1    TAGCNT 
          ZR     X1,PAUSE2   SET SIGN BIT FOR BLANK TAG 
          SA1    CXDROP 
          CALL   TAGXACT     CHECK FOR ',DROP', TAG 
          NG     X1,TWOBITS  IF DROP, GO SET TOP 2 BITS 
* 
          CALL   FILEBLK     GET ACCOUNT';FILE, BLOCK 
* 
          SA1    LASTKEY     CHECK FOR END-OF-LINE
          ZR     X1,COMX05
          CALL   COMPILE     GET THIRD ARGUMENT  (LENGTH) 
* 
 COMX05   BX6    X1 
          SA6    VARBUF+4 
          SA1    LASTKEY     CHECK FOR END-OF-LINE
          ZR     X1,COMX06
          CALL   COMPILE     GET 4TH ARGUMENT (FILE TYPE) 
 COMX06   BX6    X1 
          SA6    VARBUF+5 
          SX6    5           5 ARGUMENTS IN BUFFER
          SA6    VARBUF 
          SA1    LASTKEY     MAKE SURE NO MORE ARGUMENTS
          NZ     X1,ERR2MNY 
          BX1    X6          5 ARGUMENTS LEGAL FOR VARFIN 
          EQ     VARFIN      -- EXIT TO PACK UP AND STORE 
* 
 CXDROP   DATA   4LDROP 
* 
* /---   BLOCK      COMMONX    00 000   80/02/15  22.06 
* 
          TITLE  -COMMONX- CONDENSE ROUTINE 
* 
*         ALLOWABLE FORMS ARE'; 
* 
*         COMMONX    (BLANK TAG)
*         COMMONX    ACCOUNT';LESSON,BLOCK,LENGTH 
*         COMMONX    ,BLOCK,LENGTH  (THIS LESSON) 
* 
*         NOTE--LENGTH ARGUMENT IS OPTIONAL.
* 
 NONSYS   SX6    -1 
          SA6    CCOMX       MARK COMMONX ENCOUNTERED 
* 
          CALL   FILEBLK     GET ACCOUNT';FILE, BLOCK 
          ZR     X1,PAUSE2   JUMP IF BLANK TAG
* 
* 
          SA1    LASTKEY     CHECK FOR END-OF-LINE
          ZR     X1,NS350    JUMP IF E-O-L
          SA1    WORDPT      X1 = POINTER TO NEXT CHARACTER 
          SA2    X1          GET NEXT CHARACTER 
          SX2    X2-1R,      CHECK FOR COMMA
          NZ     X2,NS360    JUMP IF 3RD ARGUMENT NON-BLANK 
          SX6    X1+1        ADVANCE WORDPT 
          SA6    A1 
* 
 NS350    MX6    0           SET LENGTH ARGUMENT 0
          EQ     NS400
* 
 NS360    CALL   COMPILE     GET THIRD ARGUMENT  (LENGTH) 
          BX6    X1 
* /---   BLOCK      COMMONX    00 000   80/02/15  22.06 
* 
 NS400    SA6    VARBUF+4 
          MX6    0           FAKE UP 5TH ARG (FILE TYPE)
          SA6    VARBUF+5 
          SA1    LASTKEY     SEE IF MORE ARGUMENTS
          ZR     X1,NS500    BLANK CODEWORD 
* 
          SA1    WORDPT      NEXT CHAR POINTER
          SA2    X1          GET CHARACTER
          SA2    X2+KEYTYPE  CHECK FOR COMMA - NO CODE
          SX0    X2-OPCOMMA 
          NZ     X0,NS450    CODEWORD INCLUDED
          SX6    X1+1        INCREMENT WORDPT 
          SA6    A1 
          MX1    0           PUT 0 FOR CODEWORD 
          EQ     NS500
* 
 NS450    CALL   COMPNAM     GET CODEWORD 
 NS500    BX6    X1 
          SA6    VARBUF+6    STORE CODEWORD 
* 
* 
* NOW SET OPTION BITS FOR READ ONLY, NO LOAD
* 
          MX7    0           CLEAR OPTION BITS
          SA7    COMOPT 
* 
 NS590    CALL   NXTNAME     GET OPTION NAME
          ZR     X6,NSFIN    NO OPTIONS SPECIFIED 
* 
          SB1    0
 NS600    SA1    COMOLST+B1 
          ZR     X1,ERRNAME  NOT ON LIST
          BX2    X6-X1       LOOK FOR MATCH 
          ZR     X2,NS610    FOUND MATCH
          SB1    B1+1 
          EQ     NS600       KEEP LOOKING 
* 
 NS610    SA1    COMOPT      GET CURRENT OPTION BITS
          SA2    B1+COMBLST  GET NEW OPTION BITS
          BX6    X2+X1       MERGE
          SA6    A1          STORE
          EQ     NS590       SEE IF MORE OPTIONS
* 
 NSFIN    SA1    COMOPT      GET OPTION BITS
          BX6    X1 
          LX6    12          SHIFT TO LOWER BITS
          SA6    VARBUF+7    STORE BITS 
          SX6    7           SPECIFY 7 ARGUMENTS
          SA6    VARBUF 
          BX1    X6          7 ARGUMENTS LEGAL FOR VARFIN 
          EQ     VARFIN      GO PACK UP AND STORE 
* 
 COMOPT   BSS    1           COMMON OPTION BITS 
* 
* /---   BLOCK      LVARS      00 000   80/05/20  11.15 
* 
* 
* 
*         -LVARS- 
* 
*         SPECIFY NUMBER OF WORDS IN LOCAL VAR STACK
* 
 LVAR     BSS    0
          SA1    LVARL       ONLY ONE -LVARS- COMMAND 
          NG     X1,LVARERR  -LVAR- ILLEGAL HERE
* 
          NZ     X1,ERRCOMM 
* 
          CALL   GETCLTH
          NG     X6,ERRCOMM  EXIT IF NOT LITERAL
* 
          NG     X1,ERRCOMM  OR 0 OR -
* 
          ZR     X1,ERRCOMM 
 
*         GET MAXIMUM NUMBER OF LOCAL VARIABLES.
 
          SX6    X1-LVMAX-1 
          PL     X6,ERRCOMM 
* 
          BX6    X1 
          SA6    LVARL       SAVE SIZE OF LOCALS STACK
          EQ     NXTLINE
* 
 LVARERR  SB1    774         ILLEGAL -LVAR- 
          EQ     =XERR
* /---   BLOCK      ++STORAGE  00 000   80/05/20  23.53 
* 
* 
* 
*         -STORAGE-  (CODE=128) 
* 
*         SYSTEM LESSON EXECUTABLE COMMAND FORMAT --
* 
*           STORAGE (AMOUNT)
* 
*         USER LESSON COMMAND FORMAT, WHICH SETS INFO 
*         IN LESSON HEADER -- 
* 
*           STORAGE (AMOUNT)
*           STORAGE (AMOUNT),EXACTLY
*           STORAGE (AMOUNT),MINIMUM
* 
* 
 STOR     SA1    SYSFLG      SEE IF SYSTEM LESSON 
          LX1    ZSLDSHF
          NG     X1,SYSONE   IF YES 
          SA1    XSTORL 
          NZ     X1,ERRCOMM   ONE -STORAGE- PER LESSON
          RJ     GETCLTH     GET LENGTH OF STORAGE
          NZ     X6,ERRCOMM   IF NOT LITERAL
          NG     X1,ERRCOMM    IF - 
          ZR     X1,ERRCOMM   IF 0
          SX2    MAXSTO      MAXIMUM STORAGE SIZE 
          IX2    X2-X1
          NG     X2,ERRCOMM    IF TOO BIG 
          BX7    X1 
          SA7    XSTOTMP     SAVE TEMPORARILY 
          SA1    LASTKEY     SEE IF ADDITIONAL TAG
          ZR     X1,STOSET   -- EXIT IF E-O-L (X7 = LENGTH) 
          SX1    X1-1R, 
          NZ     X1,ERRCOMM  -- ERROR IF NOT A COMMA
          CALL   NXTNAME     GET TAG
          ZR     X6,ERRCOMM  -- ERROR IF NOTHING THERE
          SX7    4           ASSUME -EXACTLY- TAG 
          SA1    TCEXACT
          BX1    X1-X6
          ZR     X1,STOGO 
          SA1    TCMIN       OR MAYBE -MINIMUM- 
          BX1    X1-X6
          NZ     X1,ERRCOMM  -- ERROR IF FUNNY TAG
          SX7    2
 STOGO    LX7    SEXACTF-2   MOVE OPTION BITS TO LSTOUSE LOC
          SA1    XSTOTMP
          BX7    X1+X7       X7 = LENGTH PLUS OPTION BITS 
* 
*       SAVE RESULTS -- X7 = LENGTH + OPTION BITS, AS 
*                            WILL BE -OR-ED INTO *LSTOUSE*
* 
 STOSET   SA7    XSTORL      SAVE STORAGE LENGTH / FLAGS
          EQ     NXTLINE
* 
 TCEXACT  DATA   7LEXACTLY
 TCMIN    DATA   7LMINIMUM
 XSTOTMP  BSS    1           SAVED STORAGE LENGTH 
* 
* /---   BLOCK      ROUTVAR    00 000   76/07/25  08.34 
* 
* 
* 
*         -ROUTVAR- COMMAND 
*         SPECIFIES NUMBER OF ROUTER VARIABLES  (NR1-NR(N)) 
* 
* 
 RVAR     SA1    ROUTER      SEE IF -ROUTER- LESSON 
          ZR     X1,ERROUTR 
          SA1    RVARL       ONLY ONE -ROUTVAR- COMMAND 
          NZ     X1,ERRCOMM 
          CALL   GETCLTH
          NG     X6,ERRCOMM   EXIT IF NOT LITERAL 
          NG     X1,ERRCOMM   OR 0 OR - 
          ZR     X1,ERRCOMM 
          SX6    RVARLIM+1
          IX6    X1-X6       SEE IF TOO MANY VARIABLES
          PL     X6,ERRCOMM 
          BX6    X1 
          SA6    RVARL       SAVE NUMBER OF ROUTER VARIABLES
          EQ     NXTLINE
* 
          ENDOV 
* /---   BLOCK      SORT       00 000   76/08/16  22.33 
          TITLE  -SORT- / -SORTA- COMMAND READ-INS
* 
* 
* 
*         SORT   LIST,LENGTH,INCREMENT,1ST BIT,NUM BITS,MASK
*                LIST,INCREMENT 
* 
*         SORTA  LIST,LENGTH,INC,1ST CHAR,NUM CHARS,MASK
*                LIST,INCREMENT 
* 
* MASK IS OPTIONAL.  'NOTE THAT MASK IS PUT IN THIRD WORD 
* OF GVAR CODES, OUT OF ORDER.
* 
* 
 SORTOV   OVRLAY
          SA1    WORDPT      SAVE *WORDPT*
          BX6    X1 
          SA6    OLDPT
          MX6    0           PRE-SET ASSOCIATED LIST FLAG 
          SA6    SASSOC 
          SA6    SORTMSK     SORT MASK
          SA6    VARBUF+5 
          SA6    VARBUF+6 
* 
*         EVALUATE LIST TYPE / LOCATION 
* 
          CALL   NXTNAM      GET FIRST ENTRY
          SX0    X1-1R, 
          NZ     X0,SORT150  JUMP IF MAY BE CM BUFFER 
          MX0    42 
          SA1    SORTLST-1   SET UP FOR BUFFER TYPE SEARCH
* 
 SORT110  SA1    A1+1        LOAD NEXT LIST ENTRY 
          ZR     X1,SORT150  CHECK IF CM BUFFER 
          BX2    X0*X1       MASK OFF BUFFER TYPE NAME
          IX2    X2-X6
          NZ     X2,SORT110 
          SX6    X1          PICK UP BUFFER TYPE CODE 
          LX6    60-6 
          SA6    SORTWK 
          CALL   COMPILE     EVALUATE POSITION EXPRESSION 
          LX1    60-6-XCODEL      POSITION -GETVAR- CODE
          SA2    SORTWK 
          BX6    X1+X2       MERGE TYPE/POSITION
          SA6    A2 
          SA1    LASTKEY     MUST END WITH A SEMI-COLON 
          SX0    X1-KSEMIC
          ZR     X0,SORT200 
          EQ     ERRORC 
* 
* /---   BLOCK      SORT       00 000   76/08/16  22.56 
* 
 SORT150  SA1    OLDPT       RESTORE *WORDPT* 
          BX6    X1 
          SA6    WORDPT 
          CALL   COMPILE     EVALUATE BUFFER EXPRESSION 
          NZ     B1,ERRSTOR   ERROR IF NOT STOREABLE
          BX6    X1 
          LX6    60-6-XCODEL      POSITION -GETVAR- CODE
          SA6    SORTWK 
          SA1    LASTKEY     MUST END WITH A SEMI-COLON 
          SX0    X1-KSEMIC
          NZ     X0,ERRTERM 
* 
*         PROCESS REMAINING ARGUMENTS 
* 
 SORT200  CALL   VARDO       EVALUATE ARGUMENTS 
          SA1    VARBUF 
          SX1    X1-4        MUST BE 4 OR 5 TAGS
          NG     X1,ERR2FEW  NOT ENOUGH TAGS
          ZR     X1,SORT210  EXACTLY 4 TAGS 
* 
          SX1    X1-1 
          NZ     X1,ERR2MNY  TOO MANY TAGS
* 
* PROCESS MASK GETVAR CODE
* 
          SA1    VARBUF+5 
          MX0    -XCODEL
          BX6    -X0*X1      MASK OFF GETVAR CODE 
          ZR     X6,ERRORC   ERROR IF MASK IS ZERO ('.) 
          LX6    60-XCODEL   LEFT JUST GVAR CODE
          SA6    SORTMSK     AND STORE IT 
* 
          SX6    4
          SA6    VARBUF      THEN RESET VARBUF COUNTER
* 
* 
*         CHECK IF COMMAND CONTINUED
* 
 SORT210  SA1    NEXTCOM
          SA2    COMCONT     SEE IF CONTINUED 
          BX2    X1-X2
          NZ     X2,SORT300 
          CALL   GETLINE     GET NEXT LINE OF TEXT
          SA1    NEXTCOM
          SA2    COMCONT     SEE IF CONTINUED 
          BX2    X1-X2
          ZR     X2,ERRCNTD   ERROR IF CONTINUED FURTHER
* 
*         PROCESS ASSOCIATED LIST TYPE / LOCATION 
* 
          SA1    WORDPT      SAVE *WORDPT*
          BX6    X1 
          SA6    OLDPT
          CALL   NXTNAM      GET FIRST ENTRY
          SX0    X1-1R, 
          NZ     X0,SORT250  JUMP IF MAY BE CM BUFFER 
          MX0    42 
          SA1    SORTLST-1   SET UP FOR BUFFER TYPE SEARCH
* 
 SORT220  SA1    A1+1        LOAD NEXT LIST ENTRY 
          ZR     X1,SORT250  CHECK IF CM BUFFER 
          BX2    X0*X1       MASK OFF BUFFER TYPE NAME
          IX2    X2-X6
          NZ     X2,SORT220 
          SX6    X1+40B      PICK UP BUFFER TYPE CODE 
          SA6    SASSOC 
          CALL   VARDO2      EVALUATE LOCATION ARGUMENT 
          EQ     SORT260
* 
* /---   BLOCK      SORT       00 000   76/07/25  08.42 
* 
 SORT250  SA1    OLDPT       RESTORE *WORDPT* 
          BX6    X1 
          SA6    WORDPT 
          SX6    40B         SET BUFFER TYPE CODE 
          SA6    SASSOC 
          CALL   VARDO2      EVALUATE BUFFER EXPRESSION 
          SA1    VARBUF 
          SA1    X1+VARBUF   LOAD BUFFER -GETVAR- CODE
          NG     X1,ERRSTOR   MUST BE STORE-ABLE
* 
 SORT260  SA1    LASTKEY     MUST END WITH A SEMI-COLON 
          SX0    X1-KSEMIC
          NZ     X0,ERRTERM 
* 
*         EVALUATE ENTRY DIMENSION EXPRESSION 
* 
          CALL   VARDO2      EVALUATE DIMENSION EXPRESSION
          SA1    LASTKEY
          NZ     X1,ERRTERM   ERROR IF NOT END-OF-LINE
          SA1    SORTWK 
          SA2    SASSOC      ATTACH ASSOC BUFFER TYPE TO
          LX2    XCMNDL      COMMAND WORD 
          BX6    X1+X2
          SA6    A1 
* 
*         ATTACH INDEX IN XSTOR TO COMMAND WORD 
* 
 SORT300  SA1    INX         GET INDEX IN EXTRA STORAGE 
          BX6    X1 
          LX6    60-6-XCODEL-12   POSITION XSTOR INDEX
          SA2    SORTWK 
          BX6    X2+X6       X6 = PARTIAL COMMAND WORD
* 
* /---   BLOCK      SORT       00 000   76/08/18  16.00 
* 
*         PACK UP REMAINING -GETVAR- CODES
* 
          MX0    -XCODEL
          SA2    VARBUF+1    LOAD LENGTH -GETVAR- CODE
          SA3    VARBUF+2    LOAD INCREMENT -GETVAR- CODE 
          SA4    VARBUF+3    LOAD IST CHAR -GETVAR- CODE
          BX2    -X0*X2 
          BX3    -X0*X3 
          BX4    -X0*X4 
          LX2    60-XCODEL   POSITION -GETVAR- CODES
          LX3    60-2*XCODEL
          LX4    60-3*XCODEL
          BX7    X2+X3       COMBINE -GETVAR- CODES 
          BX7    X4+X7
          SA7    X1+INFO     STORE 1ST XSTOR WORD 
          SA2    VARBUF+4    LOAD NUM CHARS -GETVAR- CODE 
          SA3    VARBUF+5    LOAD ASSOC BUFF -GETVAR- CODE
          SA4    VARBUF+6    LOAD INCREMENT -GETVAR- CODE 
          BX2    -X0*X2 
          BX3    -X0*X3 
          BX4    -X0*X4 
          LX2    60-XCODEL   POSITION -GETVAR- CODES
          LX3    60-2*XCODEL
          LX4    60-3*XCODEL
          BX7    X2+X3       COMBINE -GETVAR- CODES 
          BX7    X4+X7
          SA7    X1+INFO+1   STORE 2ND XSTOR WORD 
* 
          SA2    SORTMSK     GET MASK GETVAR CODE 
          BX7    X2 
          SA7    X1+INFO+2   AND STORE IT 
* 
          SX7    X1+3 
          SA7    INX         INCREMENT *INX*
          SA1    ICX
          IX1    X7-X1       CHECK FOR UNIT BUFFER OVERFLOW 
          PL     X1,LNGUNIT 
          EQ     PUTCODE     EXIT 
* 
* 
 SORTLST  VFD    42/0LSTORAGE,18/2
+         VFD    42/0LS,18/2
+         VFD    42/0LCOMMON,18/1 
+         VFD    42/0LC,18/1
          DATA   0
* 
 SORTWK   BSS    1
 SORTMSK  BSS    1
 SASSOC   BSS    1
* 
          ENDOV 
* 
* 
* /---   BLOCK      TALKREQ    00 000   81/03/23  00.29 
          TITLE  -TALKREQ- READIN 
* 
**        -TALKREQ-  (CODE=374) 
* 
*         HANDLE TERM-TALK AND OTHER OUTPUT MASTER-SLAVE
*         REQUESTS, USING PROCESS INTERLOCK *I.TALK* AND
*         STATUS BUFFER *ATALK* 
* 
*         TALKREQ [KEYWORD]            $$ OWN STATN ACTION
*         TALKREQ [KEYWORD],STATN      $$ OTHER STATN ACTION
*         TALKREQ STATUS,STATN,RETRN   $$ OTHER STATN STATUS
* 
*         CERTAIN REQUESTS CAN ONLY BE PERFORMED ON YOUR
*         OWN STATION; OTHERS CAN BE DONE TO ANY STATION; 
*         AND -STATUS- RETURNS THE STATUS TO A SPECIFIED
*         VARIABLE. 
* 
*         COMMAND WORD FORMAT --
*                20 / GETVAR CODE FOR STATN 
*                20 / GETVAR CODE FOR BUFFER
*                11 / REQUEST TYPE
*                 9 / -TALKREQ- COMMAND 
* 
* 
 TRQCOV   OVRLAY
          CALL   SYSTEST     SYSTEM LESSONS ONLY
* 
*         GET REQUEST TYPE KEYWORD
* 
          CALL   NXTNAME
          MX0    42          LIMIT TO 7 CHARACTERS
          BX1    -X0*X6 
          NZ     X1,ERRTAGS 
* 
*         SEARCH FOR KEYWORD IN TABLE 
* 
          SA1    TRQNAMS
 TRQLP    BX2    X0*X1       X2 = POSSIBLE KEYWORD
          BX2    X2-X6       COMPARE
          ZR     X2,TRQFND   -- FOUND IT
          SA1    A1+1        GET NEXT KEYWORD 
          NZ     X1,TRQLP    AND LOOP UNTIL WE RUN OUT
          EQ     ERRTAGS     -- ERROR EXIT IF NOT FOUND 
* 
*         SAVE KEYWORD ORDINAL IN COMMAND WORD, AND 
*         CHECK FOR REQUIRED ARGUMENTS
* 
 TRQFND   SX6    A1-TRQNAMS 
          LX6    XCMNDL      PUT IN INFO POINTER FIELD
          BX7    -X0*X1      ISOLATE KEYWORD TYPE (0,1,2) 
          ZR     X7,TRQFIN   TYPE 0 = KEYWORD ONLY
          SA7    TRQATYP     SAVE TYPE
          SA6    TRQCMND     SAVE BUILDING COMMAND
          SA1    WORDPT      CHECK FOR TAG PRESENT
          SA1    X1 
          ZR     X1,ERR2FEW  -- IF NOT ENOUGH TAGS
 
 
* /---   BLOCK      TALKREQ    00 000   81/04/19  16.56 
* 
*         GET SECOND ARGUMENT (TARGET STATION)
* 
          CALL   COMPILE
          LX1    -XCODEL     ALIGN AS TOP GETVAR CODE 
          SA2    TRQCMND
          BX6    X1+X2       ADD IN TO COMMAND WORD 
          SA1    TRQATYP
          SX1    X1-1        CHECK FOR TYPE 1 KEYWORD 
          ZR     X1,TRQFIN   -- DONE IF TYPE 1
          SA6    TRQCMND     SAVE BUILDING COMMAND
* 
*         GET THIRD ARGUMENT (WHERE APPLICABLE) 
* 
          CALL   COMPILE
          NZ     B1,ERRSTOR  ARGUMENT MUST BE STOREABLE 
          LX1    60-XCODEL-XCODEL  ALIGN AS 2ND GETVAR CODE 
          SA2    TRQCMND
          BX6    X1+X2       ADD INTO COMMAND WORD
* 
*         COMPLETE -TALKREQ- READIN -- MAKE SURE NOTHING
*         LEFT IN TAG.  X6 = FINAL COMMAND WORD 
* 
 TRQFIN   SA1    WORDPT 
          SA1    X1          X1 = NEXT CHARACTER
          NZ     X1,ERR2MNY  -- ERROR IF MORE IN TAG
          EQ     PUTCODE     GO STORE COMMAND WORD
 
 
* 
*         KEYWORD TABLE 
* 
*         EACH ENTRY IS OF THE FORM 
* 
*             42/KEYWORD
*             18/TYPE -- 0 = KEYWORD ONLY 
*                        1 = KEYWORD,STATN
*                        2 = KEYWORD,STATN,BUFFER 
* 
*         NOTE -- THIS TABLE MUST MATCH CORRESPONDING 
*         ====    EXECUTION-TIME TABLE IN -EXEC6- 
* 
 TRQNAMS  VFD    42/0LREQUEST,18/1    0 
          VFD    42/0LCANCEL,18/0     1 
          VFD    42/0LANSWER,18/0     2 
          VFD    42/0LSETSLIB,18/0    3 
          VFD    42/0LMONITOR,18/1    4 
          VFD    42/0LMASTER,18/1     5 
          VFD    42/0LTLK2MON,18/0    6 
          VFD    42/0LMON2TLK,18/0    7 
          VFD    42/0LSTATUS,18/1     8 
          VFD    42/0LJOIN,18/1       9 
          VFD    42/0LCONFER,18/1    10 
          VFD    42/0LPAGE,18/1      11 
          VFD    42/0LUNPAGE,18/1    12 
          VFD    42/0LPASS,18/1      13 
          DATA   0
 
* 
*         STORAGE 
* 
 TRQCMND  DATA   0           COMMAND WORD BEING BUILT 
 TRQATYP  DATA   0           KEYWORD TYPE 
 
          ENDOV 
* /---   BLOCK      END        00 000   77/07/30  01.33 
* 
          TITLE  FONT COMMAND 
* 
 FONTCOV  OVRLAY
* 
          MX6    0           PRE-CLEAR
          SA6    VARBUF+1 
          SA6    VARBUF+2 
          SA6    VARBUF+3 
          SX6    3           NUMBER OF ARGUMENTS FOR FONT 
          SA6    VARBUF 
          CALL   NXTNAM      GET FONT NAME
          ZR     X6,ERR2FEW  IF NO TAGS, TOO FEW
          MX0    8*6         FONT NAME CANNOT EXCEED 8 CHARS
          BX0    -X0*X6 
          NZ     X0,ERRNAME 
          SA2    FONTNAM     FIRST TERM TO CHECK
          SB3    NFONTS      NUMBER OF FONTS TO CHECK 
 FONTLP1  BX2    X2-X6
          ZR     X2,FONTOK   IF EQUAL TO FONT NAME, OK
          SB3    B3-1        DECREMENT CHECK
          ZR     B3,ERRNAME  IF NOT VALID NAME, ERROR OUT 
          SA2    A2+1        GET NEXT TERM
          EQ     FONTLP1     GO CHECK AGAIN 
 
 FONTOK   SX6    B3          GET FONT SLOT NUMBER 
          SA6    VARBUF+1    SAVE FONT SLOT NUMBER
          ZR     X1,FONTDEF  IF NO SEPARATOR, DEFAULT 
 
          CALL   COMPILE     GET NEXT ARGUMENT
          BX6    X1          SAVE -GETVAR- CODE 
          SA6    VARBUF+2 
          SA2    LASTKEY     SEE IF END-OF-LINE 
          ZR     X2,FONTREG  IF ONLY TWO PARAMS, DEFAULT
 
          SX6    NMODES      MAX EXTRA ARGS 
          SA6    FARGMAX     SAVE MAX ARGS
 
 FONTLP2  CALL   NXTNAM      GET LITERAL TAG IN X6
          ZR     X6,FONTGO   IF END OF ARGS, GO STORE 
          BX0    X6          SAVE NAME IN *X0*
          SA2    FARGMAX     GET REMAINING ARG COUNT
          SX6    X2-1        SUBTRACT ONE 
          SA6    A2          REPLACE IT 
          NG     X6,ERR2MNY  TOO MANY ARGUMENTS 
          SX1    1           SET BIT 0
          SA2    FONTMOD     FIRST MODE TO CHECK
          SB3    NMODES      NUMBER OF MODES TO CHECK 
 FONTLP3  BX2    X2-X0
          ZR     X2,FONTOK2  IF EQUAL TO FONT MODE, OK
          SB3    B3-1        DECREMENT CHECK
          ZR     B3,ERRNAME  IF NOT VALID NAME, ERROR OUT 
          SA2    A2+1        GET NEXT TERM
          LX1    1           POSITION TO NEXT BIT 
          EQ     FONTLP3     GO CHECK AGAIN 
 
 FONTOK2  SA2    VARBUF+3    GET CURRENT MODE WORD
          BX0    X1*X2       SEE IF BIT ALREADY SET 
          NZ     X0,ERR2MNY  DUPLICATE TAG
          BX6    X2+X1       SET BIT
          SA6    A2          SAVE NEW SETTING 
          EQ     FONTLP2
 
* /---   BLOCK      FONT       00 000   79/07/19  23.36 
 FONTDEF  SX6    0           DEFAULT FONT SIZE
          SA6    VARBUF+2 
 FONTREG  SX6    0           DEFAULT FONT MODE
          SA6    VARBUF+3 
 
 FONTGO   BSS    0
          SA1    VARBUF      GET NUMBER OF ARGS FOR -VARFIN-
          EQ     VARFIN      GO PACK AND STORE ARGS 
 
 NFONTS   EQU    19          NUMBER OF FONT SLOTS 
 FONTNAM  BSS    0
          DATA   0LMSSANS    FONT 19
          DATA   0LSCRIPT    FONT 18
          DATA   0LNTROMAN   FONT 17
          DATA   0LARIAL     FONT 16
          CON    0           FONT 15
          CON    0           FONT 14
          CON    0           FONT 13
          CON    0           FONT 12
          CON    0           FONT 11
          CON    0           FONT 10
          CON    0           FONT  9
          CON    0           FONT  8
          CON    0           FONT  7
          DATA   0LCOURNEW   FONT  6
          DATA   0LCOURIER   FONT  5
          DATA   0LUOL816    FONT  4
          DATA   0LUOL814    FONT  3
          DATA   0LTERMINAL  FONT  2
          DATA   0LDEFAULT   FONT  1
* 
 NMODES   EQU    4
 FONTMOD  BSS    0
          DATA   6LITALIC 
          DATA   4LBOLD 
          DATA   6LSTRIKE 
          DATA   7LUNDERLN
* 
 FARGMAX  BSS    1           MAXIMUM ARGUMENT COUNT 
* 
          ENDOV 
* /---   BLOCK      END        00 000   77/07/30  01.33 
* 
* 
          OVTABLE 
* 
* 
          END    COVLY2$