Retro1.org codex

COVLAY3 
* /---   FILE TYPE = E
* /---   BLOCK      COVLAY3    00 000   81/07/13  01.09 
          IDENT  COVLAY3
          LCC    OVERLAY(1,1) 
* 
          TITLE  OVERLAYS FOR COMMAND READINS 
* 
* 
          CST 
* 
* 
 COVLY3$  OVFILE
* 
* 
          EXT    ECSPRTY
          EXT    KEYTYPE,VARFIN,VARFINM 
          EXT    ERRORC,PUTCODE,ALTCODE,CALCODE 
          EXT    NXTNAM,SYSTEST,SYSTST1 
          EXT    LNGUNIT
          EXT    COMCONT
          EXT    ERRTAGS,ERRNAME,ERRSTOR
          EXT    ERRXYTG,ERR2MNY,ERR2FEW
          EXT    ERRTERM,ERRUARG,ERRVTYP
          EXT    ERROUTR,ERRCNTD,ERRXORQ
          EXT    ERRBAL,ERR 
          EXT    NXTNAMP,MRKLAST
          EXT    VARDO,VARDO1,COMPILE,NXTNAME 
          EXT    ADDLES=
          EXT    ONE2IN 
* 
* 
* /---   BLOCK      PACK       00 000   77/06/12  16.40 
**
**
**
          TITLE  PACK COMMANDS
* 
 PACKOV   OVRLAY
          SB1    FSPACK      LOG TEXT FOR PUBLICATION 
          RJ     =XPUBTEXT
* 
* TO DO'; 
*         RETURN SCREEN LENGTH
*         ALLOW 5000 CHARS (MAYBE) BY PACKING IN *INFO* 
*         MULTIPLE LINES FOR *PACK* 
* 
*  PACK COMMAND WITH EMBEDS'; 
* 
* 
*         FIRST *XCODEL* BITS ARE VAR STORING INTO
*         SECOND *XCODEL* BITS ARE CHAR COUNT (0 IF NO) 
*         NEXT 11 BITS LOCATION OF TABLE IN EXTRA STORAGE 
*         NEXT *XCMNDL* BITS ARE COMMAND CODE NUMBER
* 
*  TABLE ENTRIES ARE SET UP IN ROUTINE -PACKER- 
* 
          SA1    TAGCNT      MAKE SURE SOME TAG 
          ZR     X1,ERR2FEW 
* 
* OVARG1 = 0 (PACK), 1 (PACKC), 2 (SAY), 3 (SAYC) 
          SA1    OVARG1 
          SB1    X1 
          JP     PACKOJ+B1
 PACKOJ   EQ     PACK00      PACK 
+         EQ     PACKC0      PACKC
+         EQ     SAY00       SAY
+         EQ     SAYC0       SAYC 
* 
 SAY00    MX7    0           NO GETVAR CODES FOR -SAY-
          SA7    PCWORD 
          EQ     PACK0
* 
 PACK00   CALL   COMPILE     EVALUATE FIRST TAG 
          NZ     B1,ERRSTOR   MAKE SURE ITS STORABLE
          LX1    60-XCODEL   LEFT JUSTIFY GETVAR CODE 
          MX7    1
          LX7    2*XCODEL    FAKE GVAR CODE FOR SECOND ARG
          BX7    X1+X7       MERGE LOC GVAR + FAKE GVAR 
          SA7    PCWORD      SAVE CODES 
* 
* SEE IF TWO COMMAS NEXT TO EACH OTHER (TWO ARG COMMAND)
* 
* 
          SA1    WORDPT      SAVE CURRENT POSITION
          BX6    X1 
          SA6    OLDPT
          CALL   NEXTKEY
          SA1    X2+KEYTYPE  LOAD KEYTYPE FOR NEXT KEY
          SX3    X1-OPCOMMA 
          ZR     X3,PACK0    IF SEPARATER 
* 
* 
          SA1    OLDPT
          BX6    X1          RESTORE WORDPT 
          SA6    WORDPT 
* 
          CALL   PUTCOMP
          NG     B1,ERRSTOR   MAKE SURE SECOND ARG STORABLE 
          LX1    60-2*XCODEL  AND PUT IN CENTER 
          SA2    PCWORD      FETCH LOC GVAR CODE
          MX7    XCODEL 
          BX7    X7*X2       INCLUDE ONLY 1ST GETVAR CODE 
          BX7    X7+X1       MERGE THEM 
          SA7    PCWORD      AND STORE
* 
 PACK0    CALL   PACKER      RETURNS START OF TABLE IN B3 
          ZR     B2,ERR2FEW   AND LENGTH IN B2
* 
          SA1    PCWORD 
          SX2    B3          GET SAVED START OF TABLE 
          LX2    XCMNDL 
          BX6    X2+X1
          EQ     PUTCODE     AND PUT IN COMMAND CODE
* 
* 
* /---   BLOCK      PACKC0     00 000   77/06/19  12.56 
* 
* PACKC COMMAND';  ( MAX OF 100 CHAR STRINGS )
* 
* COMMAND WORD';
*          FIRST *XCODEL* BITS';  STRING DESTINATION
*          NEXT  *XCODEL* BITS';  CHAR CNT RETURN 
*          NEXT    11     BITS';  START OF TAG TABLE
*          LAST  *XCMNDL* BITS';  COMMAND NUMBER
**
* FIRST WORD OF TAG TABLE'; 
*         FIRST *XCODEL* BITS'; CONDITIONAL EXPRESSSION GVAR
*         BOTTOM   10    BITS'; NUMBER OF TAG ENTRIES 
* 
* TAG TABLE ENTRIES'; 
*         30 BIT ENTRIES, TWO PER WORD
* 
*         BOTTOM 12 BITS'; ADDRESS OF SECONDARY TABLE 
*         NEXT   9 BITS'; NUMBER OF ENTRIES IN SEC. TABLE 
* 
* TAG TABLE IS FORMATTED INTO BUFFER '7SHOWOUT'7 (100WDS LONG)
* 
*  (SECONDARY TABLE SET UP IN ROUTINE -PACKER-) 
* 
 SAYC0    CALL   COMPILE     GET CONDITIONAL EXPRESSION 
          BX6    X1 
          SA6    PCWORD 
          EQ     PACKC4 
* 
 PACKC0   CALL   VARDO1      FIRST EXPRESSION 
          CALL   VARDO2      SECOND EXPRESSION
* 
* CHECK FOR ADJACENT SEPARATORS'; NOT RETURNING CCOUNT
* 
          SA1    WORDPT      SAVE CURRENT POSITION
          BX6    X1 
          SA6    OLDPT
          CALL   NEXTKEY
          SA1    X2+KEYTYPE  LOAD KEYTYPE FOR NEXT KEY
* 
          SX3    X1-OPCOMMA 
          ZR     X3,PACKC1   IF A SEPARATOR 
* 
          SX3    X1-EOL 
          NZ     X3,PACKC2   IF NOT END OF LINE 
* 
 PACKC1   BX7    X2 
          SA7    LASTKEY
          MX3    1
          LX3    XCODEL      FAKE GVAR CODE FOR THIRD ARG 
          EQ     PACKC3 
* 
*  RESTORE WORDPT AND PROCESS CHAR COUNT DESTINATION
* 
 PACKC2   SA1    OLDPT
          BX6    X1 
          SA6    WORDPT 
* 
          CALL   PUTCOMP
          NG     B1,ERRSTOR   MUST STORE INTO-ABLE
          BX3    X1          SAVE IT
* 
* /---   BLOCK      PACKC3     00 000   77/06/12  17.11 
* 
* STORE THREE GVAR CODES IN *PCWORD* FOR NOW
* 
 PACKC3   SA1    VARBUF+1    CONDITIONAL EXPRESSION 
          MX0    -XCODEL
          BX1    -X0*X1      MASK OFF TOP BIT 
* 
          SA2    VARBUF+2    STRING DESTINATION 
          NG     X2,ERRSTOR   CANNOT BE STORED INTO 
          LX2    XCODEL+XCODEL  PUT ON FAR LEFT SIDE
* 
          LX3    XCODEL      PUT IN MIDDLE
* 
          BX6    X1+X2       NOW MERGE ALL THREE
          BX6    X6+X3
          SA6    PCWORD 
* 
* DETERMINE STRING TERMINATOR 
* 
 PACKC4   SA2    LASTKEY
          ZR     X2,PACKC5   IF TERMINATOR IS END-OF-LINE 
* 
          SA1    WORDPT      POINTS JUST PAST LAST CHAR 
          SA3    X1-2        CHAR PRECEDING LASTKEY 
          SX4    X3-ACCESS
          NZ     X4,PACKC5   IF ACCESS NOT PART OF TERMINATR
* 
          LX3    6
          BX2    X2+X3       MERGE ACCESS+LAST CHAR 
* 
 PACKC5   BX7    X2 
          SA7    TERMSAV     AND STORE IT 
* 
* INITIALIZATIONS BEFORE MAIN LOOP
* 
          MX6    0
          SA6    SHOWOUT     INITIALIZE TAG TABLE COUNTER 
          ZR     X7,PLINE0   IF EOL TERMINATOR, NEXT LINE 
          SA2    X1          GET LAST CHAR
          NZ     X2,PLINE1   JUMP IF LINE NOT EXHAUSTED 
* 
* /---   BLOCK      PACKC      00 000   76/07/25  08.46 
* 
* BRINGS IN CONTINUATION LINE IF THERE IS ONE 
* 
 PLINE0   SA1    NEXTCOM     CHECK IF CONTINUATION
          SA2    COMCONT
          BX2    X1-X2
          NZ     X2,PCEND0   DONE PROCESSING IF NOT CONT. 
* 
          CALL   GETLINE     READ IN NEXT LINE
* 
* 
* MAIN LOOP. -PACKER- RETURNS'; B3=TABLE START, B2=LENGTH 
* 
* 
 PLINE1   CALL   PACKER      EVALUATE NEXT CHAR STRING
* 
          SA1    SHOWOUT
          SX7    X1+1        INCREMENT SHOWOUT COUNTER
          SA7    SHOWOUT     AND STORE INCREMENTED COUNTER
* 
          SX2    X1-100      LENGTH OF SHOWOUT = 100 WORDS
          PL     X2,ERR2MNY   TOO MANY TAGS 
* 
          SX5    B3          START OF TABLE IN BOTTOM 12 BTS
          SX6    B2          LENGTH OF TABLE
          LX6    12 
          BX6    X5+X6       MERGE LENGTH + INDEX 
          SA6    X7+SHOWOUT   AND STORE ENTRY 
* 
* FIND OUT WHETHER IT NEEDS NEW LINE OR NOT 
* 
          SA1    WORDPT 
          SA2    X1 
          ZR     X2,PLINE0   -PACKER- STOPPED ON EOL
* 
          SX7    X1+1        INCREMENT WORDPT 
          SA2    X7          AND READ NEXT CHAR 
          ZR     X2,PLINE0   IF EMPTY, READ NEXT LINE 
          SA7    WORDPT      OTHERWISE, UPDATE WORDPT 
          EQ     PLINE1 
* 
* 
* /---   BLOCK      PACKC      00 000   76/07/25  08.47 
* 
* ALL DONE'; STORE FIRST WORD OF TABLE, AND COMMAND WORD
* 
 PCEND0   SA1    PCWORD 
          LX1    XCODEL+XCODEL GET COND. EXPR. ON TOP 
          MX0    XCODEL 
          BX6    X0*X1       AND PUT IT INTO X6 
          SA2    SHOWOUT
          BX7    X6+X2       MERGE GVAR + NUMBER OF ENTRIES 
          SA2    INX
          SA7    X2+INFO     STORE AS 1ST WORD OF TABLE 
          SX7    X2+1        INCREMENT XSTOR POINTER
          SA7    INX
* 
          BX1    X1-X6       REMOVE GVAR CODE FROM CMND WD. 
          LX1    XCODEL      AND RESTORE WORD 
          LX2    XCMNDL      MERGE WITH LOC OF TABLE
          BX6    X1+X2
          SA6    PCWORD      AND STORE IT AGAIN 
* 
* NOW PUT TAG TABLE INTO XSTORAGE 
* 
          SA1    ICX
          SA0    X1-1        MARKER FOR END OF UNIT 
          SA1    SHOWOUT     LOAD NUMBER OF ENTRIES 
          ZR     X1,ERR2FEW   NOTHING THERE 
          MX6    0
          SA6    X1+SHOWOUT+1 CLEAR LAST WORD 
          SB4    X1-1        B4=END TEST
          SA2    INX
          SB2    X2          B2=INDEX INTO XSTORAGE 
          SA2    SHOWOUT-1   A2=INDEX INTO SHOWOUT BUFFER 
* 
* 
 PCEND1   SA2    A2+2 
          LX2    30 
          SA3    A2+1 
          BX6    X2+X3       MERGE TWO TABLE ENTRIES
          SA6    B2+INFO     B2 IS INDEX INTO XSTOR 
* 
          SX3    A0-B2
          NG     X3,LNGUNIT 
* 
          SB2    B2+1        INCREMENT POINTER INTO SHOWOUT 
          SB4    B4-2        DECREMENT END TEST 
          PL     B4,PCEND1   AND LOOP BACK
* 
* 
          SX6    B2 
          SA6    INX         UPDATE XSTOR POINTER 
* 
          SA1    PCWORD 
          BX6    X1 
          EQ     PUTCODE     DONE 
* 
* 
* /---   BLOCK      PACKER     00 000   78/11/02  11.27 
* 
*  PACKER EVALUATES LAST TAG (TEXT) OR CONTINUATION LINE';
*  RETURNS START OF TABLE IN B3, LENGTH IN B2 
* 
* 
* TABLE ENTRIES'; 30 BITS APIECE';
* 
* FOR PACK, FIRST ENTRY IS NUMBER OF ENTRIES ( NOT SO,PACKC)
* 
* 
* FOR TEXT';
*         BOTTOM 12 BITS'; INDEX OF TEXT IN XSTORAGE
*         NEXT 6 BITS '; 0 ( AS FLAG THAT THIS IS TEXT )
*         NEXT 9 BITS '; LENGTH OF TEXT 
* FOR SHOWS'; 
*         BOTTOM 12 BITS'; INDEX OF GETVAR CODES IN XSTORAGE
*         NEXT 6 BITS '; TYPE OF SHOW (1 TO 6)
*         NEXT 6 BITS'; NUMBER OF GETVAR CODES IN XSTOR WORD
* 
* GETVAR CODES IN XSTORAGE ARE THREE PER WORD 
*         SIGN BIT ON MEANS GETVAR ENTITY CAN BE STORED INTO
*         NOTE ASSUMPTION THAT SHOW COMMANDS HAVE NO MORE 
*          THAN THREE ARGUMENTS 
* 
* 
*  OVARG1 = 0 (PACK), 1 (PACKC), 2 (SAY), 3 (SAYC)
* 
 PACKER   EQ     *
          MX6    0
          SA6    VARBUF      INITIALIZE ^$ OF ENTRIES 
* 
 PL       SA1    INX         INX IS BUFFER
          SB2    X1          B2= XSTORAGE POINTER 
          SB3    B0          B3= WORD COUNT 
          SA1    WORDPT 
          SX7    X1-1        X7= WORDPT POINTER 
          SA1    OVARG1 
          MX0    59 
          BX0    -X0*X1      X0=0 (PACK,SAY), =1 (PACKC, SAYC)
          SA1    TERMSAV     X1= TERMINATOR (FOR PACKC) 
          SA2    ICX
          SA0    X2-1        A0= END OF UNIT
          SB7    1           B7=FONT FLAG, 1=NORM,-1=ALT
* 
* /---   BLOCK      PL0        00 000   78/11/01  11.17 
* 
* NOW FOR MAIN LOOP 
* 
 PL0      MX6    0           X6= WORD BUILDING VAR
          SB1    60          B1= SHIFT COUNTER
* 
* 
 PL1      SX7    X7+1        NEXT CHARACTER 
          SA2    X7          X2=NEXT CHARACTER
          ZR     X2,PEOL     FOUND END OF LINE
* 
* 
          ZR     X0,PL1B     FOLLOWING CHECKS FOR TERMINATOR
          BX3    X1-X2       CHECK FOR SINGLE CHAR TERMNTR
          ZR     X3,PEOL     FOUND TERMINATOR 
* 
* 
 PL1B     SX3    X2-FONT     CHECK FOR FONT 
          NZ     X3,PL1C
          SB7    -B7         FLIP FONT FLAG 
* 
 PL1C     SX3    X2-ACCESS   START CHECK FOR EMBEDS 
          NZ     X3,PL2 
          SA3    X7+1 
* 
          NG     B7,PL1D     DO NOT CHECK FOR ^0 IN ALT.FONT
* 
          SX4    X3-1R0      LEFT EMBED SYMBOL
          ZR     X4,PEMBED   FOUND EMBED SYMBOL 
* 
 PL1D     ZR     X0,PL2      FOR PACKC ONLY 
          SX4    X2          COPY 
          LX4    6           MOVE ACCESS OVER 
          BX4    X3+X4       MERGE ACCESS + NEXT CHAR 
          BX4    X4-X1       COMPARE WITH 2-CHAR TEMINATOR
          NZ     X4,PL2      FOUND TERMINATOR'/ 
          SX7    X7+1        INCREMENT WORDPT 
          EQ     PEOL 
* 
* 
 PL2      SB1    B1-6        SHIFT COUNT
          LX2    X2,B1       SHIFT KEY OVER 
          BX6    X2+X6       MERGE WITH WORD BUFFER 
          NZ     B1,PL1      GET NEXT KEY IF WORD NOT DONE
* 
          SX3    A0-B2       AT END OF UNIT'/ 
          NG     X3,LNGUNIT 
* 
          SA6    B2+INFO     STORE COMPLETED TEXT WORD
          SB2    B2+1        INCREMENT XSTOR POINTER
          SB3    B3+1        INCREMENT WORD COUNT 
          EQ     PL0         END OF MAIN LOOP 
* 
* 
* /---   BLOCK      PEMBED     00 000   76/07/25  08.47 
* 
* HIT EMBED SYMBOL';  PROCESS WHATEVER IS INSIDE
* 
 PEMBED   SX7    X7+2        UPDATE WORDPT
          SA7    WORDPT 
          CALL   PTEXT       UPDATES CURRENT TEXT 
* 
          CALL   NXTNAME      GET TAG OF EMBED (RETURNS X6) 
          ZR     X6,BADEMB   IF NO TAG
          SB4    0           LOOP COUNTER 
          MX0    42          FIRST MASK 
          MX1    6           SECOND MASK
* 
*  FIND MATCH IN SHOW TABLE OF FIRST TAG
* 
 PE2      SA2    PACKLST+B4  READ NEXT ENTRY
          ZR     X2,BADEMB   IF NO MATCH
          BX3    X0*X2       MASK OFF TOP 7 CHARS 
          BX3    X6-X3       AND COMPARE WITH NXTNAM
          ZR     X3,PE3 
          LX2    54          TAKE A LOOK AT BOTTOM CHAR 
          BX2    X1*X2       MASK OFF ONE CHAR
          BX2    X6-X2       AND MATCH IT 
          ZR     X2,PE3 
          SB4    B4+1 
          EQ     PE2
* 
* /---   BLOCK      PE3        00 000   78/11/02  13.49 
* 
 PE3      SX6    B4+1        *SHOW* CODE FOR TABLE
          SA6    PSHOW
          SX6    0           GETVAR COUNT 
          SA6    PCODES 
          SA6    PTEMP       GETVAR CODES 
          SX6    60          SHIFT COUNT
          SA6    PSHFT
* 
* 
 PE4      CALL COMPILE       EVALUATE NEXT TAG
* 
          SA2    LASTKEY
          ZR     X2,ERRTERM   HIT EOL INSTEAD OF R. EMBED 
* 
          MX0    -XCODEL     MASK 
          BX2    -X0*X1      MASK OFF GETVAR CODE 
* 
          ZR     B1,PE5      WAS EXPRESSION STORABLE'/
          MX1    1
          LX1    XCODEL      SET TOP BIT OF GVAR CODE 
          BX2    X2+X1       AS A FLAG
* 
 PE5      SA1    PCODES      GETVAR COUNTER 
          SX6    X1+1        AND UPDATE IT
          SA6    PCODES 
* 
          SA1    PSHFT       SHIFT COUNTER
          SX6    X1-XCODEL   UPDATE IT
          SB1    X6          AND SAVE IT IN B1
          NG     B1,ERRTAGS   MORE THAN 3 TAGS
          SA6    PSHFT
* 
          SA1    PTEMP       CONTAINS GETVAR CODES
          LX6    X2,B1       SHIFT CURRENT GETVAR CODE
          BX6    X6+X1       AND MERGE WITH OLD GVAR CODES
          SA6    A1 
* 
* 
          SA1    WORDPT      CHECK IF HIT R. EMBED OR NOT 
          SA2    X1-2        BACK UP TWO CHARS
          SX2    X2-ACCESS
          NZ     X2,PE4      NEXT TO LAST SYMBOL NOT EMBED
          SA2    X1-1 
          SX2    X2-1R1      CHECK FOR ACCESS 1 (RT. EMBED) 
          NZ     X2,PE4      IF CHECKS, THEN DONE 
* 
*         MAKE TABLE ENTRY FOR *SHOW* 
* 
          SA1    PTEMP
          BX6    X1 
          SA1    INX
          SA6    X1+INFO     ADD GETVAR CODES TO CM ARGS
          SX6    X1+1        INCREMENT CM ARG POINTER 
          SA6    A1 
* 
          SX6    X1          BOTTOM 12 BITS'; ADDR OF GVARS 
* 
          SA1    PSHOW       NEXT 6 BITS'; TYPE OF SHOW 
          LX1    12 
          BX6    X1+X6
* 
          SA1    PCODES      NEXT 6 BITS'; NUMBR OF GVARS 
          LX1    12+6 
          BX6    X1+X6
* 
          SA1    VARBUF 
          SX7    X1+1        INCREMENT NUMBER OF TABLE ENTRY
          SA7    VARBUF 
* 
          SA6    X7+VARBUF   NOW WRITE WORD TO TABLE
* 
          SX1    X7-VARBUFL+2 
          PL     X1,ERR2MNY   MAKE SURE TABLE DOESNT OVERFLOW 
          EQ     PL 
* 
* /---   BLOCK      PEOL       00 000   76/05/26  16.27 
* 
* REACHED END OF LINE, OR TERMINATOR (FOR PACKC)'; PUT
* VARBUF TABLE INTO XSTORAGE, TWO PER WORD
* EXPECTS X0= PACKC FLAG, A0 = END OF UNIT MARKER 
* AND B2= XSTORAGE POINTER
* 
 PEOL     SA7    WORDPT      UPDATE WORDPT
          CALL   PTEXT       UPDATE TEXT
* 
          SA1    VARBUF      LOAD NUMBER OF ENTRIES 
          ZR     X1,PO4      NOTHING HERE 
          MX6    0
          SA6    X1+VARBUF+1 CLEAR LAST WORD
          SB3    B2          B3= START OF TABLE 
          SB4    X1          B4= END TEST 
          SA2    VARBUF-2    A2= INDEX INTO VARBUF BUFFER 
* 
          ZR     X0,PO3      -PACK- COMMAND 
          SA2    A2+1        DO NOT RETURN LENGTH 
          SB4    B4-1        IN FIRST TABLE ENTRY 
* 
* 
PO3       SA2    A2+2 
          LX2    30 
          SA3    A2+1 
          BX6    X2+X3       MERGE TWO TABLE ENTRIES
* 
          SA6    B2+INFO     B2= INDEX INTO XSTORAGE
* 
          SX3    A0-B2       STILL IN UNIT'/
          NG     X3,LNGUNIT 
* 
          SB2    B2+1 
          SB4    B4-2        DECREMENT END TEST 
          PL     B4,PO3      AND LOOP BACK
* 
* 
          SX6    B2          UPDATE XSTOR POINTER 
          SA6    INX
* 
 PO4      SA1    VARBUF      GET NUMBER OF ENTRIES
          SB2    X1 
          EQ     PACKER      DONE 
* 
* 
*         BAD FORMAT SPECIFICATION
* 
 BADEMB   SB1    154
          EQ     =XERR
* 
* 
* /---   BLOCK      PTEXT      00 000   78/09/12  00.28 
* 
* STORES LAST TEXT WORD, UPDATES TABLE ENTRY
* 
* ENTERS WITH X6=LAST TEXT WD, B3=WORD CNT, B2=XSTORAGE INDX
*   A0= END OF UNIT MARKER, X0 = PACKC FLAG 
* 
 PTEXT    EQ     *
          ZR     X6,PT0      JUMP IF CURRENT WORD EMPTY 
* 
          SX4    A0-B2       AT END OF UNIT'/ 
          NG     X4,LNGUNIT 
* 
          SA6    B2+INFO     DUMP CURRENT WORD INTO XSTOR 
          SB2    B2+1        UPDATE XSTOR COUNTER 
          SB3    B3+1        UPDATE WORD COUNTER
* 
 PT0      ZR     B3,PT1     NO TEXT HERE
          SA1    VARBUF      UPDATE NUMBER OF TABLE ENTRIES 
          SX6    X1+1 
          SA6    A1 
* 
          SA1    INX         BEGINNING INDEX OF TEXT
          SX2    B3          NUMBER OF WORDS OF TEXT
          LX2    12+6 
          BX7    X1+X2       MERGE INDEX AND LENGTH 
          SA7    X6+VARBUF   AND PUT INTO TABLE 
* 
          SX1    X6-VARBUFL+2 
          PL     X1,ERR2MNY   MAKE SURE TABLE DOESNT OVERFLOW 
* 
 PT1      SX6    B2          UPDATE XSTOR POINTER 
          SA6    INX
* 
          EQ     PTEXT
* 
* 
 PACKLST  VFD    42/0LSHOWZ,18/1RZ
          VFD    42/0LSHOW,18/1RS 
          VFD    42/0LSHOWT,18/1RT
          VFD    42/0LSHOWO,18/1RO
          VFD    42/0LSHOWE,18/1RE
          VFD    42/0LSHOWA,18/1RA
          VFD    42/0LSHOWH,18/1RH
          VFD    42/0LHIDDEN,18/0 
          VFD    42/0LSHOWK,18/1RK
 ZR       DATA   0
* 
 PCWORD   BSS    1           COMMAND WORD 
 PCODES   BSS    1           NUMBER OF GETVAR CODES 
 PSHFT    BSS    1           SHIFT COUNT
 PSHOW    BSS    1           SHOW CODE
 PTEMP    BSS    2           TEMPORARIES
 TERMSAV  BSS    1           SAVE TERMINATOR CODE(S)
* 
* 
          ENDOV 
 
* /---   BLOCK      SETDAT     00 000   76/07/25  08.49 
* 
          TITLE  -SETDAT- COMMAND 
* 
*         SET VALUE OF STUDENT DATA RESERVED WORD 
*         SETDAT   WORD_EXPRESSION
* 
 SETROV   OVRLAY
          CALL   NXTNAME      GET TAG ****
*         RETURNS TAG ENTRY IN X6,
*         SEPARATOR IN X1, SEPARATOR TYPE IN X2 
          SX1    X1-KASSIGN  CHECK FOR ASSIGN ARROW 
          NZ     X1,ERRTERM   IF NOT GIVE CONDENSE ERROR
          MX0    6*7
          BX2    -X0*X6      CHECK FOR OVER 7 CHARS 
          NZ     X2,ERRNAME 
          SA6    ENDLST      PLANT END TEST FOR SEARCH
          SA2    RSVLST-1    INITIALIZE SEARCH
 RSV100   SA2    A2+1 
          IX3    X6-X2
          NZ     X3,RSV100
          SB1    A2-ENDLST
          ZR     B1,ERRNAME   NOT FOUND IN LIST 
          SB1    A2-RSVLST   COMPUTE INDEX IN LIST
          SX7    B1          STORE INDEX IN LIST
          SA7    SRTEMP 
          CALL   COMPILE     GET VALUE OF NEXT ARGUMENT 
          MX0    -XCODEL
          BX6    -X0*X1      ONLY GETVAR CODE 
          LX6    60-2*XCODEL
          SA1    SRTEMP      PICK UP WORD NUMBER
          SX1    X1          LIMIT TO 18 BITS 
          LX1    60-XCODEL   PUT IN TOP BITS
          BX6    X6+X1       COMBINE WITH GETVAR CODE 
          EQ     PUTCODE
* 
 RSVLST   DATA   7LAARROWS
          DATA   3LAOK
          DATA   6LAOKIST 
          DATA   4LASNO 
          DATA   4LAUNO 
          DATA   5LAHELP
          DATA   6LAHELPN 
          DATA   5LATERM
          DATA   6LATERMN 
          DATA   5LAAREA
          DATA   5LATIME
 ENDLST   BSS    1
* 
 SRTEMP   BSS    1
* 
          ENDOV 
* /---   BLOCK      SUBMITM    00 000   80/12/15  22.22 
          TITLE  -SUBMITM- / -SUBMITX- COMMANDS 
* 
* 
* 
*         -SUBMITM- COMMAND 
*         1ST ARGUMENT = MAIN-FRAME NUMBER
*         2ND          = ACCOUNT NAME 
*         3RD          = FILE NAME
*         4TH          = BLOCK NAME 
*         5TH (OPT)    = SECURITY INFORMATION BUFFER
* 
*         -SUBMITX- COMMAND 
*         1ST ARGUMENT = MAIN-FRAME NUMBER
*         2ND          = CONTROL CARD BUFFER
*         3RD          = LENGTH OF CONTROL CARD BUFFER
*         4TH          = (UNUSED) 
*         5TH (OPT)    = SECURITY INFORMATION BUFFER
* 
* 
 SUBMOV   OVRLAY
          CALL   VARDO1      GET MAINFRAME ARGUMENT 
          SX6    0           PRE-ZERO 4TH AND 5TH ARGUMENTS 
          SA6    VARBUF+4 
          SA6    VARBUF+5 
          SA1    OVARG1 
          NZ     X1,SUBMITX  --- JUMP IF SUBMITX
* 
*         -SUBMITM- COMMAND 
* 
          CALL   ACCFILE,VARBUF+2,0 
          ZR     X1,ERR2FEW 
          CALL   COMPNAM     GET BLOCK NAME 
          BX6    X1 
          SA6    VARBUF+4 
          EQ     SECURE 
* 
*         -SUBMITX- COMMAND 
* 
 SUBMITX  CALL   VARDO2      CONTROL CARD BUFFER
          NG     X6,ERRSTOR  --- ERROR IF NOT STOREABLE 
          CALL   VARDO2      BUFFER LENGTH
* 
* 
*         CHECK FOR SECURITY INFORMATION BUFFER ARGUMENT
* 
 SECURE   SX6    4           4 ARGUMENTS SO FAR 
          SA6    VARBUF 
          SA1    LASTKEY
          ZR     X1,SBMEND   --- IF END OF LINE 
          CALL   VARDO2 
          NG     X6,ERRSTOR  --- ERROR IF NOT STOREABLE 
          SA1    LASTKEY
          NZ     X1,ERR2MNY 
* 
 SBMEND   SX6    5           5 ARGUMENTS
          SA6    VARBUF 
          BX1    X6 
          EQ     VARFIN 
          ENDOV 
* 
* 
* /---   BLOCK      FINDS      00 000   76/08/29  21.54 
* 
* 
          TITLE  -FINDS-/-FINDSA- COMMAND READINS 
* 
*         -FINDS- 
* 
*         READIN IS MODIFIED FROM -SORT- COMMAND READIN 
* 
* COMMAND WORD CONSISTS OF';
*         6 BITS TYPE';  0 N,NC VAR 
*                       1 ECS COMMON VAR
*                       2 ECS STORAGE VAR 
*         *XCODEL* BITS LIST GETVAR CODE'; ADDRESS IN CM/ECS
*         12 BITS POSITION OF EXTRA GETVAR CODES IN XSTORAGE
* 
*         3 WORDS OF EXTRA STORAGE GVAR CODES'; 
*         OBJECT,LENGTH,INCREMENT,1STBIT,NUMBITS,RETURN,MASK
* 
* 
*  FINDS  OBJECT,LIST;LTH,INC,1ST BIT,NUM BITS,RETURN,MASK
*  FINDSA OBJECT,LIST;LTH,INC,1ST CHAR,NUM CHARS,RETURN,MASK
* 
* NOTE THAT ONLY THE LAST ARGUMENT, *MASK*, IS OPTIONAL 
* 
* NOTE ALSO THAT TOP BIT OF OBJECT GETVAR CODE IS SET IF
* IT IS NON-STORABLE
* 
* 
 FINDSOV  OVRLAY
* 
          CALL   VARDO1      EVALUATE OBJECT GVAR CODE
* 
          SA1    WORDPT      SAVE *WORDPT*
          BX6    X1 
          SA6    OLDPT
* 
          MX6    0
          SA6    VARBUF+7    INITIALIZE MASK ENTRY
* 
* EVALUATE LIST TYPE / LOCATION 
* 
          CALL   NXTNAM      GET FIRST ENTRY
          SX0    X1-1R, 
          NZ     X0,FIND150  JUMP IF MAY BE CM BUFFER 
          MX0    42 
          SA1    FINDLST-1   SET UP FOR BUFFER TYPE SEARCH
* 
 FIND110  SA1    A1+1        LOAD NEXT LIST ENTRY 
          ZR     X1,FIND150  CHECK IF CM BUFFER 
          BX2    X0*X1       MASK OFF BUFFER TYPE NAME
          IX2    X2-X6       COMPARE WITH NXTNAM RETURN 
          NZ     X2,FIND110  LOOP BACK
* 
* PROCESS HERE IF FORM -FINDS S,3;- OR -FINDS C,10;-
* 
          SX6    X1          PICK UP BUFFER TYPE NAME 
          LX6    60-6        AND LEFT-JUST IT 
          SA6    FINDWK 
* 
          CALL   COMPILE     EVALUATE POSITION EXPRESSION 
          LX1    60-6-XCODEL POSITION GVAR CODE 
* 
          SA2    FINDWK 
          BX6    X1+X2       MERGE TYPE/POSITION
          SA6    A2          STORE IT 
* 
          SA1    LASTKEY     MUST END WITH SEMI-COLON 
          SX0    X1-KSEMIC
          ZR     X0,FIND200 
          EQ     ERRTERM     SEMICOLON NOT FOUND
* /---   BLOCK      FINDS      00 000   76/09/12  21.14 
* 
* PROCESS HERE IF OF FORM -FINDS  N1;- OR -FINDS NC1;-
* 
 FIND150  SA1    OLDPT       RESTORE WORDPT 
          BX6    X1 
          SA6    WORDPT 
* 
          CALL   COMPILE     EVALUATE BUFFER EXPRESSION 
          NZ     B1,ERRSTOR  ERROR IF NOT STORABLE
          LX1    60-6-XCODEL POSITION GVAR CODE 
* 
          BX6    X1 
          SA6    FINDWK      AND STORE IT 
* 
          SA1    LASTKEY     MUST END WITH SEMI-COLON 
          SX0    X1-KSEMIC
          NZ     X0,ERRTERM  SEMI-COLON NOT FOUND 
* 
* 
* PROCESS REMAINING ARGUMENTS 
* 
 FIND200  CALL   VARDO2      LENGTH 
          CALL   VARDO2      INCREMENT
          CALL   VARDO2      1ST BIT
          CALL   VARDO2      NUM BITS 
* 
          CALL   PUTCOMP     *RETURN* 
          NG     B1,ERRSTOR   MUST BE STORABLE
          BX6    X1          STORE CODE IN VARBUF 
          SA6    VARBUF+6 
          SX6    6           INCREMENT VARBUF 
          SA6    VARBUF 
* 
          SA1    LASTKEY     SEE IF ANOTHER ARGMUENT
          ZR     X1,FIND210  NO MORE ARGUMENTS
          CALL   VARDO2      GET MASK GETVAR CODE 
* 
          SA1    VARBUF+7 
          MX0    -XCODEL
          BX1    -X0*X1      GIVE ERROR IF MASK IS ZERO 
          ZR     X1,ERRORC
* 
          SA1    LASTKEY
          NZ     X1,ERR2MNY  TOO MANY TAGS
* 
 FIND210  SA1    VARBUF+1    FETCH OBJECT GVAR CODE 
          MX0    1           SET TOP BIT IF NOT STORABLE
          BX2    X0*X1       GET TOP BIT
          LX2    XCODEL 
          BX6    X1+X2       AND MERGE WITH GVAR CODE 
          SA6    VARBUF+1 
* 
* /---   BLOCK      FINDS      00 000   76/09/12  21.09 
* 
* NOW STORE ALL GVAR CODES AND WRAP IT UP 
* 
          SA1    INX         GET INDEX IN EXTRA STORAGE 
          BX6    X1          X1 = INX 
          LX6    60-6-XCODEL-12   POSITION XSTOR INDEX
          SA2    FINDWK 
          BX6    X2+X6       X6 = COMMAND WORD
          MX0    -XCODEL     X0 = XCODEL MASK 
* 
          SA2    VARBUF+1    OBJECT GVAR CODE 
          SA3    VARBUF+2    LENGTH GVAR CODE 
          SA4    VARBUF+3    INCREMENT GVAR CODE
* 
          BX2    -X0*X2      MASK OFF 
          BX3    -X0*X3 
          BX4    -X0*X4 
* 
          LX2    60-1*XCODEL  AND POSITION THEM 
          LX3    60-2*XCODEL
          LX4    60-3*XCODEL
* 
          BX7    X2+X3       NOW MERGE AND STORE
          BX7    X7+X4
          SA7    X1+INFO     STORE
* 
          SA2    VARBUF+4    1ST BIT GVAR CODE (1ST CHAR) 
          SA3    VARBUF+5    NUM BITS GVAR CODE (NUM CHARS) 
          SA4    VARBUF+6    *RETURN* GVAR CODE 
* 
          BX2    -X0*X2      MASK 
          BX3    -X0*X3 
          BX4    -X0*X4 
* 
          LX2    60-1*XCODEL POSITION 
          LX3    60-2*XCODEL
          LX4    60-3*XCODEL
* 
          BX7    X2+X3       MERGE AND STORE
          BX7    X7+X4
          SA7    X1+INFO+1
* 
          SA2    VARBUF+7    FIND MASK GVAR CODE
          BX7    -X0*X2      MASK MASK CODE (HEHE)
          LX7    60-XCODEL   POSITION IT
          SA7    X1+INFO+2   STORE
* 
          SX7    X1+3        INCREMENT INX POINTER
          SA7    INX
          SA1    ICX
          IX1    X7-X1       CHECK FOR UNIT BUFFER OVERFLOW 
          PL     X1,LNGUNIT 
          EQ     PUTCODE     EXIT 
* 
* FINDLST IS USED BY FINDS,FINDSA,INSERTS,DELETES 
* 
 FINDLST  VFD    42/0LSTORAGE,18/2
          VFD    42/0LS,18/2
          VFD    42/0LCOMMON,18/1 
          VFD    42/0LC,18/1
          DATA   0
* 
 FINDWK   BSS    1
* 
          ENDOV 
* /---   BLOCK      INSERTS    00 000   77/01/11  17.12 
* 
          TITLE  -INSERTS- COMMAND
* 
*         READIN IS MODIFIED FROM -SORT- COMMAND READIN 
* 
*INSERTS  BUFFER,LIST;LENGTH,INCREMENT,POSIT,NUMBER (OPT.)
*         BUFF2,LIST2;INC2
* 
* COMMAND WD';                6 BITS LIST TYPE CODE 
*                            20 BITS LIST GVAR CODE 
*                            12 BITS XSTOR POSIT OF GVAR CDS
*                            6 BITS ASSOC. LIST TYPE CODE 
* 
* TYPE CODE IS 0=CM,1=ECS COMMON,2=ECS STORAGE
* ASSOCIATED LIST TYPE CODE IS SAME AS ABOVE, EXCEPT TOP
* BIT OF 6 BIT CODE IS SET AS FLAG THAT THERE IS ASSOC. LIST
* 
*XSTOR GETVAR WORDS (3) 
* 
*         WD1'; BUFFER,LENGTH,INCREMENT 
*         WD2'; POSIT,NUMBER,BUFFER2
*         WD3'; LIST2,INCREMENT2
* 
* 
 INSRTOV  OVRLAY
* 
          SA1    OVARG1 
          NZ     X1,DELETOV  FOR -DELETES- COMMAND
* 
          CALL   VARDO1      EVALUATE OBJECT GVAR CODE
          SA1    VARBUF+1 
          NG     X1,ERRSTOR  BUFFER MUST BE LOCATION
          CALL   SLINE1      EVALUATE REST OF LINE
* 
* 
          SA1    NEXTCOM
          SA2    COMCONT     SEE IF CONTINUED 
          BX2    X1-X2
          NZ     X2,INSRT10  NOT CONTINUED
* 
          CALL   GETLINE     GET NEXT LINE OF TEXT
          SA1    NEXTCOM
          SA2    COMCONT     SEE IF CONTINUED 
          BX2    X1-X2
          ZR     X2,ERRCNTD  ERROR IF CONTINUED FURTHER 
* 
* 
          CALL   VARDO2      EVALUATE ASSOC. LIST OBJECT
          SA1    VARBUF 
          SA1    X1+VARBUF
          NG     X1,ERRSTOR  BUFFER MUST BE LOCATION
          CALL   SLINE2      EVALUATE REST OF ASSOC. LIST 
* 
 INSRT10  EQ     LSTFIN      STORE GVAR CODES AND WRAP UP 
* 
* /---   BLOCK      DELETES    00 000   77/01/11  17.15 
* 
          TITLE  -DELETES- COMMAND
* 
*         READIN IS MODIFIED FROM -SORT- COMMAND READIN 
* 
*DELETES  LIST;LENGTH,INCREMENT,POSIT,NUMBER (OPT.) 
*         LIST2;INC2
* 
* COMMAND WD';                6 BITS LIST TYPE CODE 
*                            20 BITS LIST GVAR CODE 
*                            12 BITS XSTOR POSIT OF GVAR CDS
*                            3 BITS 0 
*                            6 BITS ASSOC. LIST TYPE CODE 
*                            9 BITS COMMAND NUMBER
* 
* TYPE CODE IS 0=CM,1=ECS COMMON,2=ECS STORAGE
* ASSOCIATED LIST TYPE CODE IS SAME AS ABOVE, EXCEPT TOP
* BIT OF 6 BIT CODE IS SET AS FLAG THAT THERE IS ASSOC. LIST
* 
*XSTOR GETVAR WORDS (3) 
* 
*         WD1'; 0,LENGTH,INCREMENT
*         WD2'; POSIT,NUMBER,0
*         WD3'; LIST2,INCREMENT2
* 
* THE 0 GETVAR CODES ARE SO FORMAT IS EXACTLY LIKE THE
* -INSERTS- COMMAND 
* 
* 
* 
 DELETOV  SX6    1
          SA6    VARBUF      INCREMENT VARBUF CAUSE NO BUFF 
          MX6    0
          SA6    A6+1        ZERO BUFFER GVAR CODE
          CALL   SLINE1      EVALUATE FIRST LINE
* 
* 
          SA1    NEXTCOM
          SA2    COMCONT     SEE IF CONTINUED 
          BX2    X1-X2
          NZ     X2,DELET10  NOT CONTINUED
* 
          CALL   GETLINE     GET NEXT LINE OF TEXT
          SA1    NEXTCOM
          SA2    COMCONT     SEE IF CONTINUED 
          BX2    X1-X2
          ZR     X2,ERRCNTD  ERROR IF CONTINUED FURTHER 
* 
* 
          SA1    VARBUF 
          SX6    X1+1        INCREMENT VARBUF (NO BUFF2)
          SA6    VARBUF 
          MX7    0
          SB1    A6 
          SA7    X6+B1       STORE ZERO AS GVAR CODE
          CALL   SLINE2      EVALUATE REST OF ASSOC. LIST 
* 
 DELET10  EQ     LSTFIN      STORE XSTOR GVARS AND WRAP UP
* 
* /---   BLOCK      INSERTS-1  00 000   77/03/30  22.24 
          TITLE  -INSERTS- ROUTINES 
* 
* PROCESS FIRST LINE OF INSERTS AND DELETES COMMANDS
* 
 SLINE1   EQ     *
* 
          SA1    WORDPT 
          BX6    X1 
          SA6    OLDPT       SAVE WORDPT
* 
          CALL   NXTNAM      GET FIRST ENTRY
          SX0    X1-1R, 
          NZ     X0,SLIN150  JUMP IF MAY BE CM BUFFER 
          MX0    42 
          SA1    INSTLST-1   SET UP FOR BUFFER TYPE SEARCH
* 
 SLIN110  SA1    A1+1        LOAD NEXT ENTRY
          ZR     X1,SLIN150  CHECK IF CM BUFFER 
          BX2    X0*X1       MASK OFF BUFFER TYPE NAME
          IX2    X2-X6
          NZ     X2,SLIN110 
* 
          SX6    X1          PICK UP BUFFER TYPE CODE 
          LX6    60-6 
          SA6    CMNDWD      STORE FOR NOW
          CALL   COMPILE     EVALUATE POSITION EXPRESSION 
          LX1    60-6-XCODEL POSITION GVAR CODE 
          SA2    CMNDWD 
          BX6    X1+X2       MERGE TYPE/POSITION
          SA6    A2 
          SA1    LASTKEY     MUST END WITH SEMICOLON
          SX0    X1-KSEMIC
          ZR     X0,SLIN200 
          EQ     ERRTERM
* 
* 
 SLIN150  SA1    OLDPT       RESTORE WORDPT 
          BX6    X1 
          SA6    WORDPT 
          CALL   COMPILE     EVALUATE BUFFER EXPRESSION 
          NZ     B1,ERRSTOR  ERROR IF NOT STORABLE
          BX6    X1 
          LX6    60-6-XCODEL POSITION GVAR CODE 
          SA6    CMNDWD      SAVE 
          SA1    LASTKEY     MUST END WITH A SEMI-COLON 
          SX0    X1-KSEMIC
          NZ     X0,ERRTERM 
* 
* PROCESS REMAINING ARGUMENTS 
* 
 SLIN200  CALL   VARDO2      LENGTH OF LIST 
          CALL   VARDO2      INCREMENT OF EACH ENTRY
          CALL   VARDO2      POSITION TO ADD
          SA1    LASTKEY
          NZ     X1,SLIN201  GET LAST ARGUMENT
* 
          SA1    VARBUF 
          SX6    X1+1        INCREMENT VARBUF (NO NUMBER) 
          SA6    VARBUF 
          SX7    1           DEFAULT OF 1 ITEM TO INSERT
          SB1    A6 
          SA7    X6+B1       STORE ZERO FOR NUMBER
          EQ     SLINE1      DONE 
* 
* 
 SLIN201  CALL   VARDO2      GET NUMBER GVAR CODE 
          SA1    LASTKEY
          NZ     X1,ERR2MNY  TOO MANY TAGS
          EQ     SLINE1 
* 
* 
* /---   BLOCK      INSERTS-2  00 000   76/09/13  13.45 
* 
* PROCESS THE SECOND LINE FOR INSERTS AND DELETES 
* 
 SLINE2   EQ     *
* 
          SA1    WORDPT      SAVE WORDPT
          BX6    X1 
          SA6    OLDPT
* 
          CALL   NXTNAM      GET FIRST ENTRY
          SX0    X1-1R, 
          NZ     X0,SLIN250  JUMP IF MAY BE CM BUFFER 
          MX0    42 
          SA1    INSTLST-1   SET UP FOR BUFFER TYPE SEARCH
* 
 SLIN220  SA1    A1+1        LOAD NEXT LIST ENTRY 
          ZR     X1,SLIN250  CHECK IF CM BUFFER 
          BX2    X0*X1       MASK OFF BUFFER TYPE NAME
          IX2    X2-X6
          NZ     X2,SLIN220 
* 
          SX6    X1+40B      PICK UP BUFFER TYPE CODE 
          LX6    XCMNDL 
          SA1    CMNDWD      PICK UP COMMAND WORD 
          BX6    X1+X6       MERGE
          SA6    CMNDWD      AND STORE
          CALL   VARDO2      EVALUATE LOCATION ARGUMENT 
          EQ     SLIN260
* 
* 
 SLIN250  SA1    OLDPT       RESTORE WORDPT 
          BX6    X1 
          SA6    WORDPT 
* 
          SX6    40B         SET BUFFER TYPE CODE 
          LX6    XCMNDL      MOVE OVER
          SA1    CMNDWD      PICK UP COMMAND WORD 
          BX6    X1+X6       MERGE
          SA6    CMNDWD      AND STORE
* 
          CALL   VARDO2      EVALUATE BUFFER EXPRESSION 
          SA1    VARBUF 
          SA1    X1+VARBUF   LOAD BUFFER GETVAR CODE
          NG     X1,ERRSTOR  MUST BE STOREABLE
* 
 SLIN260  SA1    LASTKEY     MUST END IWTH A SEMICOLON
          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 
          EQ     SLINE2 
* 
* 
* 
* /---   BLOCK      INSERTS-3  00 000   77/01/11  17.22 
* 
* FINAL PROCESSING FOR INSERTS AND DELETES COMMANDS 
* 
 LSTFIN   SA1    INX         GET INDEX IN EXTRA STORAGE 
          BX6    X1 
          LX6    60-6-XCODEL-12     POSITION XSTOR INDEX
          SA2    CMNDWD 
          BX6    X2+X6       X6 = PARTIAL COMMAND WORD
* 
* PACK UP REMAINING GETVAR CODES
* 
          MX0    -XCODEL
* 
          SA2    VARBUF+1    LOAD BUFFER -GETVAR- CODE
          SA3    VARBUF+2    LOAD LENGTH -GETVAR- CODE
          SA4    VARBUF+3    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     STORE 1ST XSTOR WORD 
* 
          SA2    VARBUF+4    LOAD POSITION -GETVAR- CODE
          SA3    VARBUF+5    LOAD NUMBER -GETVAR- CODE
          SA4    VARBUF+6    LOAD ASSOC BUFF -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    VARBUF+7    LOAD ASSOC LST -GETVAR- CODE 
          SA3    VARBUF+8    LOAD ASSOC INCREMNT GETVAR CODE
          BX2    -X0*X2 
          BX3    -X0*X3 
          LX2    60-XCODEL   POSITION -GETVAR- CODE 
          LX3    60-2*XCODEL
          BX7    X2+X3
          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 
* 
 INSTLST  VFD    42/0LSTORAGE,18/2
          VFD    42/0LS,18/2
          VFD    42/0LCOMMON,18/1 
          VFD    42/0LC,18/1
          DATA   0
* 
 CMNDWD   BSS    1           PARTIAL COMMAND WORD 
* 
          ENDOV 
* /---   BLOCK      COVL3      00 000   80/10/01  03.12 
          TITLE  COVL3       COMMAND READ-INS 
* 
* 
* 
 COVL3    OVRLAY
          SA1    OVARG1      GET OVERLAY ARGUMENT 
          SB1    X1 
          JP     B1+*+1      JUMP TO APPROPRIATE COMMAND
* 
+         EQ     INHIBC       0 = -INHIBIT-  COMMAND
+         EQ     FORCEIN      1 = -FORCE-    COMMAND
+         EQ     RANDUIN      2 = -RANDU-    COMMAND
+         EQ     RANDPIN      3 = -RANDP-    COMMAND
+         EQ     ANSVC        4 = -ANSV-     COMMAND
+         EQ     RESTIN       5 = -RESTART-  COMMAND
+         EQ     EXCHIN       6 = -EXCHANG-  COMMAND
+         EQ     STATSIN      7 = -STATS-    COMMAND
+         EQ     GETWDC       8 = -GETWORD-  COMMAND
+         EQ     GETLOCC      9 = -GETLOC-   COMMAND
+         EQ     SEARCHC     10 = -SEARCH-   COMMAND
+         EQ     COMPUIN     11 = -COMPUTE-  COMMAND
+         EQ     CALCSIN     12 = -CALCS-    COMMAND
+         EQ     CSLOOP      13 = *CSLOOP*   ROUTINE
+         EQ     COLORIN     14 = -COLOR-    COMMAND
+         EQ     CTIMEIN     15 = -CTIME-, -CDATE- COMMANDS 
* 
* 
* /---   BLOCK      -INHIBIT-  00 000   79/01/05  01.47 
          TITLE  -INHIBIT- COMMAND READ-IN
* 
* 
* 
*         -INHIBIT- COMMAND READ-IN 
* 
 INHIBC   SB1    HIBLIST     SET UP ARGUMENTS 
          SB2    HIBEND 
          MX5    60          FULL WORD MASK 
          CALL   SCANNER     SCAN INHIBIT NAME LIST 
          NZ     X0,ERRNAME  SEE IF ANY ERROR 
 
*         CHECK FOR SYSTEM-LESSON-ONLY KEYWORDS.
 
          SA1    SYSHIBS
          BX1    X1*X6
          ZR     X1,PUTCODE  IF NO SYSTEM-LESSON-ONLY BITS
 
*         SYSTEM-LESSON-ONLY KEYWORDS SELECTED - MAKE SURE
*         THIS IS A SYSTEM LESSON.
 
          RJ     SYSTEST
 
          EQ     PUTCODE
 
 
          PURGMAC INHIB 
          MACREF INHIB$ 
 INHIB    MACRO  NAME,SYS 
          MACREF INHIB
+         VFD    60/0L_NAME 
 SYSHIB   RMT 
 SYSIF    IFC    EQ,*SYS**
          VFD    1/0
 SYSIF    ELSE
          VFD    1/1
 SYSIF    ENDIF 
 SYSHIB   RMT 
          ENDM
 
 HIBLIST  INHIB  ERASE       DONT DO FULL SCREEN ERASE
          INHIB  ARROW       DONT PLOT ARROW
          INHIB  ANSERASE    ANS CONTG WRITING ERASURE
          INHIB  NEXT        NEXT 
          INHIB  NOMOVE      DONT MOVE ARROW UNTIL ANS OK 
          INHIB  BLANKS      DISALLOW BLANK STUDENT INPUT 
          INHIB  CHARCLEAR   DONT UNSET CHARSET FLAG ON -CHAR- COMMAND
          INHIB  DROPSTOR    DONT DROP XSTOR ON JUMPOUT 
          INHIB  UNLOAD      DONT UNLOAD ON CON/STO LOAD
          INHIB  LOAD        DONT LOAD ON CON/STO LOAD
          INHIB  JUMPCHK     DONT DO ECS CHECK ON JUMPOUT 
          INHIB  EDIT        DISABLE -EDIT- KEY FUNCTIONS 
          INHIB  FROM        DONT SET *FROM* ON JUMPOUT 
          INHIB  TERM        DISABLE -TERM- FUNCTIONS 
          INHIB  ADVANCE     NO AUTO ADVANCE WHEN ARROW SATISFIED 
          INHIB  CLEAR       CLEAR BEFORE SET 
          INHIB  DROPFILE    DONT DROP DATASET/NAMESET
          INHIB  DROPCOM     DONT DROP COMMON 
          INHIB  DROPLIST,SYS DONT DROP LESLIST 
          INHIB  ARETURN,SYS DISABLE RETURNING TO ARROW 
 HIBEND   BSS    1           SCRATCH FOR SCANNER ROUTINE
 
*         SYSTEM-LESSON-ONLY FLAGS. 
 
 SYSHIBS  BSS    0
          LIST   G
 SYSHIB   HERE
          LIST   *
* /---   BLOCK      -INHIBIT-  00 000   81/07/22  20.52 
* 
* 
*         -FORCE- COMMAND READ-IN 
*         SAME FORMAT AS -INHIBIT- BUT ENABLES RATHER THAN
*         DISABLES
* 
 FORCEIN  SB1    FOLIST 
          SB2    FOEND
          MX5    60          FULL WORD MASK 
          RJ     SCANNER
          ZR     X0,PUTCODE  SEE IF ANY ERROR 
          EQ     ERRNAME      ELSE ERROR
* 
 FOLIST   VFD    60/4LLONG   FORCE JUDGING ON CHAR LIMIT
          VFD    60/4LFONT   FORCE FONT AS CHAR 1 
          VFD    60/5LMICRO  FORCE CONTINUOUS MICRO OPTION
          VFD    60/10LFIRSTERASE  IF ANSWER WRONG, ERASE 
*         ENTIRE INPUT WHEN NEXT CHARACTER IS ENTERED 
          VFD    60/4LLEFT   FORCE LEFT WRITING 
          VFD    60/0LCLEAR      CLEAR BEFORE SET 
          VFD    60/0LBOLD   FORCE BOLD WRITTING
          VFD    60/0LCAPS     ALL CAPS 
 FOEND    BSS    1
* 
* /---   BLOCK      -RANDU-    00 000   79/01/05  01.59 
          TITLE  -RANDU- COMMAND READ-IN
* 
* 
* 
*         -RANDU- COMMAND READ-IN 
*         IF ONE VARIABLE, SPECIFIES A VARIABLE 
*         IN WHICH A RANDOM NUMBER IN (0,1) IS TO BE
*         STORED.  IF TWO VARIABLES, THE FIRST IS 
*         A STORAGE VARIABLE FOR AN INTEGER BETWEEN 
*         ONE AND THE VALUE OF THE SECOND VARIABLE. 
* 
 RANDUIN  CALL   PUTCOMP     COMPILE FIRST TAG
          SA2    LASTKEY
          ZR     X2,CALCODE  DONE IF ONE TAG--CODE IN X1
          BX6    X1 
          LX6    -XCODEL     POSITION -PUTVAR- CODE 
          SA6    VARBUF      AND SAVE IT. 
          CALL   COMPILE     COMPILE NEXT TAG 
 RANDU1   SA2    LASTKEY     *** ENTRY FROM RANDPIN 
          NZ     X2,ERR2MNY   ERROR IF MORE THAN 2 TAGS 
          SA2    VARBUF      PREPARE COMMAND WORD 
          LX1    -XCODEL-XCODEL 
          BX6    X1+X2       WITH BOTH CODES
          SA1    COMNUM      AND INCREMENTED COMMAND NUMBER 
          SX1    X1+1 
          BX6    X6+X1
          EQ     ALTCODE
* 
* 
* 
*         -RANDP- COMMAND READ-IN 
* 
 RANDPIN  CALL   PUTCOMP     COMPILE FIRST TAG
          SA2    LASTKEY
          ZR     X2,CALCODE  DONE IF ONE TAG--CODE IN X1
          BX6    X1 
          LX6    -XCODEL     POSITION -PUTVAR- CODE 
          SA6    VARBUF      AND SAVE IT. 
          CALL   COMPILE     COMPILE NEXT TAG 
          NZ     B1,ERRSTOR   ERROR IF NON-STOREABLE
          EQ     RANDU1      OTHERWISE FINISH COMPILING 
* 
* 
* /---   BLOCK      -ANSV-     00 000   79/01/05  02.22 
          TITLE  -ANSV- COMMAND READIN
* 
* 
* 
*         -ANSV- COMMAND READ-IN
* 
 ANSVC    SA1    TAGCNT      X1 = NUM CHARACTERS IN TAG 
          ZR     X1,ERR2FEW   ERROR EXIT IF NO TAG
          SX6    0
          SA6    APTSW       PRE-SET TO ABS TOLERANCE 
          SA2    TAG-1+X1    X2 = LAST CHARACTER
          SX3    X2-KPCT     CHECK FOR PER CENT SIGN
          NZ     X3,ANSVIN1  JUMP IF ABSOLUTE TOLERANCE 
          MX7    0
          SA7    A2          OVERWRITE PERCENT SIGN WITH EOL
          MX6    1
          LX6    60-2*XCODEL
          SA6    A6          RE-SET TO PERCENT TOLERANCE
 ANSVIN1  SA1    OVARG2      CHECK FOR ANSU OR ANSV 
          ZR     X1,ANSVIN2  JUMP IF ANSV 
          CALL   COMPILU     COMPILE UNIT DIMENSIONS
          EQ     ANSVIN3
 ANSVIN2  CALL   COMPILE     COMPILE WITHOUT UNIT DIMENSIONS
 ANSVIN3  SA2    LASTKEY
          LX1    60-XCODEL
          ZR     X2,ANSVIN4  JUMP IF END OF LINE
          BX7    X1 
          SA7    VARBUF      SAVE GETVAR CODE 
          RJ     COMPILE     GET SECOND ARG (TOLERANCE) 
          SA2    LASTKEY
          NZ     X2,ERR2MNY   TWO ARGS MAX
          SA2    VARBUF      FIRST ARG
          LX1    60-2*XCODEL
 ANSVIN4  BX6    X1+X2       MERGE BOTH ARGS
          SA3    APTSW
          BX6    X6+X3       ADD ABS/PERCENT TOLERANCE FLAG 
          SA1    OVARG2 
          ZR     X1,PUTCODE  JUMP IF ANSV 
          BX6    X1+X6       MERGE COMMAND NUMBER 
          SA1    NDEFU       NUMBER OF UNITS DEFINED
          SB1    X1 
          SA1    ATEMPEC
          BX0    X1 
          SA0    UADS        UNIT COEFFICIENTS
+         WE     B1 
          RJ     ECSPRTY
          SA1    INX
          SX7    X1+B1       INCREMENT INX
          SA7    A1 
          SA0    X1+INFO     ADDRESS FOR UNIT COEFFS
+         RE     B1 
          RJ     ECSPRTY
          SX1    X1+1        INSURE NZ TO DISTINGUISH ANSU
          LX1    XCMNDL      POSITION POINTER TO UNIT COEFFS
          BX6    X1+X6       MERGE WITH ARGS
          EQ     ALTCODE
* 
 APTSW    BSS    1           ABSOLUTE / PERCENT TOLER FLAG
* 
* /---   BLOCK      -RESTART-  00 000   80/02/02  23.45 
          TITLE  -RESTART- COMMAND READ-IN
* 
* 
* 
*         -RESTART- COMMAND READ-IN 
*         A. NO ARGS. MEANS USE CURRENT LESSON, CURRENT UNIT
*         B. ONE ARG. MEANS USE CURRENT LESSON, THIS UNIT 
*         C. TWO ARGS. MEANS USE THIS LESSON, THIS UNIT 
* 
 RESTIN   CALL   ACCFILE,VARBUF+1,0 
          ZR     X1,=XPAUSE2 --- IF BLANK TAG 
          SA2    LASTKEY
          NZ     X2,REST2    --- IF MORE THAN ONE ARGUMENT
* 
*         SINGLE-ARGUMENT FORM (UNIT NAME ONLY) 
* 
          SX0    X1-1 
          NZ     X0,ERRTAGS  ERROR IF ARGUMENT IS LESSON NAME 
          SA2    VARBUF+2    LOAD GETVAR CODE 
          LX2    60-XCODEL   POSITION GETVAR CODE 
          LX1    58 
          BX6    X1+X2       SET 2ND BIT OF GETVAR CODE 
          EQ     PUTCODE
* 
*         LESSON AND UNIT SPECIFIED 
* 
 REST2    CALL   COMPNAM     GET UNIT NAME
          BX6    X1 
          SA6    VARBUF+3 
          SA1    LASTKEY
          NZ     X1,ERR2MNY  ERROR IF NOT END-OF-LINE 
          SX6    3
          SA6    VARBUF      SET NUMBER OF ARGUMENTS
          BX1    X6 
          EQ     VARFIN 
* 
* /---   BLOCK      -STATS-    00 000   80/04/07  21.32 
          TITLE  -STATS- COMMAND READ-IN
* 
* 
* 
 STATSIN  CALL   SYSTEST
          CALL   VARDO1      GET TYPE OF STATISTICS 
          SA2    LASTKEY     SEE IF EOL 
          NZ     X2,STATS1   IF ACCOUNT';FILE PRESENT 
          SA1    VARBUF+1 
          MX6    1
          LX6    XCODEL 
          BX6    X1+X6       SET TOP BIT IF ONLY ONE ARG. 
          SA6    A1 
          SX1    1           ONE GETVAR CODE
          EQ     =XVARFIN 
 
 STATS1   CALL   ACCFILE,(VARBUF+2),0  PROCESS ACCOUNT';FILE
          SA1    LASTKEY
          NZ     X1,ERR2MNY  ERROR IF NOT EOL 
          SX6    3
          SA6    VARBUF      ADJUST NUMBER OF ARGUMENTS 
          SX1    3           THREE GETVAR CODES 
          EQ     =XVARFIN 
* /---   BLOCK      -EXCHANG-  00 000   80/05/15  20.20 
          TITLE  -EXCHANG- COMMAND READ-IN
* 
* 
*         TAG ON -EXCHANG- COMMAND SPECIFIES IF THE 
*         LOGICAL SITE CONTROLLER IS TO BE BYPASSED.
* 
 EXCHIN   CALL   SYSTEST
          SA1    LESSON 
          SA2    KPLAT       CHECK FOR LESSON -PLATO- 
          BX2    X1-X2
          ZR     X2,EXCHANC 
          SA2    KNPLAT 
          BX2    X1-X2       CHECK FOR LESSON -NPLATO-
          NZ     X2,ERRORC
* 
 EXCHANC  MX6    0           PRESET X6
          SA1    TAGCNT      CHECK FOR BLANK TAG
          ZR     X1,PUTCODE  -- ASSUME BLANK = 0
          EQ     ONE2IN      IN ',CONDC', 
          EQ     PUTCODE
* 
 KPLAT    DATA   5LPLATO
 KNPLAT   DATA   6LNPLATO 
* 
* 
* /---   BLOCK      -GETWORD-  00 000   79/01/23  01.06 
          TITLE  -GETWORD- COMMAND READ-IN
* 
* 
* 
*         -GETWORD- COMMAND READ-IN 
*         GET THE N-TH WORD OUT OF THE STUDENT ANSWER 
*         AND PUT INTO THE STATED BUFFER. 
* 
*         GETWORD   VAR1,VAR2,VAR3,VAR4 
*         VAR1 = WORD WANTED
*         VAR2 = ADDRESS TO PUT WORD PACKED 10 CHARS / WORD 
*         VAR3 = RETURN ACTUAL CHARACTER COUNT
*         VAR4 = MAXIMUM ALLOWABLE NUMBER OF CHARACTERS 
*                (IF ABSENT, SET TO DEFAULT 10) 
* 
 GETWDC   CALL   VARDO       GET COMMA SEPARATED VARS 
          SA1    VARBUF+2    VAR2 MUST BE STORABLE
          NG     X1,ERRSTOR 
          SA1    VARBUF+3    DITTO FOR VAR3 
          NG     X1,ERRSTOR 
          SA1    VARBUF      SEE IF RIGHT NUMBER OF ARGS
          SX2    X1-4 
          ZR     X2,VARFIN   GO TO STANDARD PACK-UP ROUTINE 
          SX2    X1-3        SEE IF NEED TO GENERATE 4TH ARG
          NZ     X2,ERRTAGS  ALL ELSE AN ERROR IN FORM
          SX6    10          SET DEFAULT SMALL CONSTANT 10
          SA6    VARBUF+4    AS FOURTH ARG
          SX6    4           AND RESET VARBUF TO 4 ARGS 
          SA6    VARBUF 
          BX1    X6          AND X1 ALSO SET TO 4 ARGS
          EQ     VARFIN      EXIT TO STANDARD PACK ROUTINE
* 
* /---   BLOCK      -GETLOC-   00 000   79/01/23  01.08 
          TITLE  -GETLOC- COMMAND READ-IN 
* 
* 
* 
*         -GETLOC- COMMAND READ-IN
*         GET THE SCREEN LOCATION OF STUDENT WORDS
* 
*         GETLOC   ARG1,ARG2,ARG3,(ARG4,ARG5) 
*         ARG1 = WORD WANTED
*         ARG2 = STARTING X 
*         ARG3 = STARTING Y 
*         ARG4 = ENDING X --OPTIONAL
*         ARG5 = ENDING Y --OPTIONAL
* 
 GETLOCC  CALL   VARDO       GET COMMA SEPARATED VARS 
          SA1    VARBUF+2    VAR2 MUST BE STORABLE
          NG     X1,ERRSTOR 
          SA1    VARBUF+3    DITTO FOR VAR3 
          NG     X1,ERRSTOR 
          SA1    VARBUF      SEE IF RIGHT NUMBER OF ARGS
          SX2    X1-3 
          NZ     X2,GETLC1   IF 3 ARGS MUST ADD DUMMY 2 MORE
          MX6    0
          SA6    VARBUF+4 
          SA6    VARBUF+5 
          SX6    5
          SA6    VARBUF 
          BX1    X6 
          EQ     VARFIN 
* 
 GETLC1   SX2    X1-5        SEE IF ENDING LOCATION WANTED
          NZ     X2,ERRTAGS  ALL ELSE AN ERROR IN FORM
          SA2    VARBUF+4    VAR4 MUST BE STORABLE
          NG     X2,ERRSTOR 
          SA2    VARBUF+5    DITTO FOR VAR5 
          NG     X2,ERRSTOR 
          EQ     VARFIN 
* 
* /---   BLOCK      -SEARCH-   00 000   79/01/23  01.19 
          TITLE  -SEARCH- COMMAND READ-IN 
* 
* 
* 
*         -SEARCH- COMMAND READ-IN
* 
*         TAG HAS 6 (OR OPTIONALLY, 7) ENTRIES. 
*         1ST = OBJECT (LEFT-JUSTIFIED) 
*         2ND = OBJECT LENGTH IN CHARS
*         3RD = BASE ADDRESS FOR SEARCH 
*         4TH = INFORMATION LENGTH IN CHARS 
*         5TH = STARTING CHAR FOR SEARCH (OFFSET FROM BASE) 
*         6TH = VARIABLE FOR STORAGE OF RETURN CODE-- 
*               -1=NOT FOUND  1-N=FOUND STARTING AT CHAR N
*         7TH = LENGTH OF RETURN LIST (REPEATED SEARCHES) 
* 
 SEARCHC  CALL   VARDO       COMMA SEPARATED VARIABLES
          SA1    VARBUF+3    BASE ADDRESS 
          NG     X1,SCERR    ERROR IF NOT STORE-ABLE
          SA1    VARBUF+6    CODE FOR RETURN VARIABLE 
          NG     X1,SCERR    ERROR IF NOT STORE-ABLE
          SA1    VARBUF+1    CODE FOR STRING
          MX0    1
          LX0    XCODEL-XFBIT 
          BX6    -X0*X1      MASK OUT I/F BIT (SET INTEGER) 
          SA6    A1 
          SX1    7           7 VARIABLES REQUIRED 
          SA2    VARBUF      X2 = NUMBER OF VARIABLES 
          SX3    X2-6 
          NZ     X3,VARFIN   EXIT IF NOT 6 VARIABLES
          BX6    X1 
          SA6    A2          RESET VARIABLE COUNT TO 7
          MX7    1
          LX7    XCODEL      PREPARE DUMMY CODE FOR 7TH ARG 
          SA7    VARBUF+7    STORE AS 7TH ARGUMENT
          EQ     VARFIN 
* 
 SCERR    SB1    70          NON-STOREABLE VARIABLE 
          EQ     ERR
* 
* /---   BLOCK      -COMPUTE-  00 000   79/07/15  15.19 
          TITLE  -COMPUTE- COMMAND READ-IN
* 
* 
* 
*         -COMPUTE- COMMAND READ-IN 
*         COMPUTE   RESULT,STRING,CHAR COUNT,POINTER
*                                            (OPTIONAL) 
* 
* THE 4 TAG COMPUTE COMMAND IS SIMILAR TO A STORE COMMAND,
* EXCEPT THE COMPILED MACHINE CODE IS SAVED IN AN ECS 
* BUFFER FOR LATER REUSE.  POINTER IS SET TO POINT AT THIS
* COMPILED CODE, AND SUCCEEDING EXECUTIONS OF THE COMPUTE 
* COMMAND WITH THIS POINTER WILL CAUSE SIMPLE FETCHES OF
* THE MACHINE CODE FROM ECS.
* 
* THE 3 TAG VERSION FUNCTIONS THE SAME AS THE 4 TAG VERSION,
* EXCEPT THAT THE CODE IS NOT STORED FOR LATER REUSE.  'IT
* PROVIDES A WAY OF EVALUATING EXPRESSIONS OUTSIDE OF JUDGE 
* STATE.
 COMPUIN  CALL   PUTCOMP     DECODE FIRST VARIABLE
          BX6    X1 
          SA6    VARBUF+1    STORE FIRST -GETVAR- CODE
          SX6    1
          SA6    VARBUF      INITIALIZE *VARBUF*
          MX6    0
          SA6    VARBUF+5 
          CALL   VARDO2      DECODE REMAINING VARS
          CALL   VARDO2 
          SA2    LASTKEY     CHECK FOR E-O-L
          ZR     X2,ONLY3    JUMP IF ONLY 3 ARGS
          CALL   VARDO2 
          SA1    LASTKEY     MUST BE END-OF-LINE
          NZ     X1,ERR2MNY 
          SB1    4           CHECK POINTER ADDRESS
          RJ     JUSTAD      CHECK FOR STORABILITY
 ALLDONE  SB1    2           CHECK STRING ADDRESS 
          RJ     JUSTAD 
          SX1    4
          EQ     VARFIN 
* 
 ONLY3    SX6    4
          SA6    VARBUF      SET ARGUMENT COUNT IN VARBUF 
          MX6    0           SET 4TH GETVAR CODE TO 0 TO
          SA6    VARBUF+4    INDICATE LACK OF 4TH ARGUMENT
          EQ     ALLDONE
* 
 JUSTAD   EQ     *           CHECK (VARBUF+B1) STORE-ABLE 
* AND CLEAN OUT I/F BIT, SINCE AT EXECUTION TIME WE NEED
* ONLY THE ADDRESS, NOT THE VALUE.
          SA1    VARBUF+B1   GET THE CODE 
          NG     X1,ERRSTOR  ERROR IF NOT STORE-ABLE
          MX6    61-XCODEL+XFBIT   MASK OUT I/F BIT 
          BX6    -X6*X1 
          SA6    A1 
          EQ     JUSTAD 
* 
* 
* /---   BLOCK      -CALCS-    00 000   80/10/01  04.18 
          TITLE  -CALCS- COMMAND READ-IN
* 
* 
* 
*         -CALCS- COMMAND READ-IN 
*         FOUR TO N VARS LEGAL
* 
*         EXAMPLE OF USAGE -
*            CALCS V2+2,V1= 5,7,V8
*         V1 IS SET TO  5 IF (V2+2) IS NEQATIVE 
*         V1 IS SET TO  7 IF (V2+2) IS ZERO 
*         V1 IS SET TO V8 IF (V2+2) IS POSITIVE 
* 
 CALCSIN  CALL   VARDO1      GET FIRST VAR
          SA1    WORDPT      POINTER TO NEXT CHARACTER
          SX0    KASSIGN     ACCEPT ASSIGNMENT AS TERMINATOR
          CALL   PSCAN
          ZR     X1,ERR2FEW  ERROR IF END OF LINE 
          SX6    1R,
          SA6    B1          REPLACE WITH COMMA 
          CALL   PUTCOMP     DECODE VARIABLE TO STORE INTO
          BX6    X1 
          SA6    VARBUF+2    STORE -GETVAR- CODE
          SX6    2
          SA6    VARBUF      UPDATE NUMBER OF CODES 
 
* 
*         -CSLOOP-
*         BUILD LIST OF EXPRESSIONS INTO *VARBUF*, ASSUMING 
*         THAT 1) THE ARGUMENTS CAN BE BLANK, IN WHICH CASE 
*         A SPECIAL BIT IS SET, AND 2) THE COMMAND MAY BE 
*         CONTINUED ACROSS SOURCE LINES 
* 
*         EXITS TO -VARFINM- WHEN DONE
* 
 CSLOOP   CALL   GETBARG     GET (POSSIBLY BLANK) ARGUMENT
          NZ     X3,CSLOOP   AND LOOP WHILE ARGUMENTS FOUND 
          ZR     X2,CSNEXT   GET NEW LINE IF E-O-L
* 
*         PUT DUMMY GETVAR CODE (1/1,19/0) INTO *VARBUF*
* 
          SA1    VARBUF 
          SX6    X1+1        ADVANCE *VARBUF* POINTER 
          SX1    X6-VARBUFL 
          PL     X1,ERR2MNY  ERROR IF BUFFER FULL 
          SA6    A1 
          MX7    1           SET UP SPECIAL GETVAR CODE 
          LX7    XCODEL 
          SA7    X6+VARBUF   STORE IT 
          EQ     CSLOOP 
* 
 CSNEXT   SA1    NEXTCOM     CHECK FOR CONTINUATION 
          SA2    COMCONT
          BX3    X1-X2
          NZ     X3,CSEND    JUMP IF NOT CONTINUED
          CALL   GETLINE     READ IN NEXT LINE
          EQ     CSLOOP 
* 
 CSEND    SA1    VARBUF 
          SX1    X1-3        MUST BE AT LEAST 3 VARS
          PL     X1,VARFINM 
          EQ     ERR2FEW
* 
* /---   BLOCK      GETBARG    00 000   80/10/01  04.19 
          TITLE  -GETBARG-  GET POSSIBLY BLANK ARGUMENT 
* 
*         -GETBARG- 
*         READ NEXT EXPRESSION, WHICH MAY BE BLANK, AND 
*         ASSEMBLE GETVAR CODE IN *VARBUF* IF PRESENT.
* 
*         ON ENTRY -- *WORDPT* SET
* 
*         ON EXIT  -- X2 = NEXT CHARACTER (0 IF E-O-L)
*                     X3 = 0 IF NO ARGUMENT COMPILED
* 
*         USES     -- PRETTY MUCH EVERYTHING
* 
 
 GETBARG  EQ     *
          SX3    0           SET TO NO ARGUMENT COMPILED
          SA1    WORDPT      X1 = POINTER TO NEXT CHARACTER 
 GBA1     SA2    X1          X2 = NEXT CHARACTER
          ZR     X2,GETBARG  DONE IF E-O-L
          SX0    X2-1R       IGNORE LEADING SPACES
          NZ     X0,GBA2
          SX1    X1+1        MOVE PAST SPACE
          EQ     GBA1        AND CONTINUE 
* 
 GBA2     SA3    X2+KEYTYPE 
          SX0    X3-OPCOMMA  CHECK FOR COMMA
          NZ     X0,GBA3     COMPILE IT IF SOMETHING ELSE 
* 
          SX6    X1+1        COMMA FOUND -- BLANK EXPRESSION
          SA6    A1          UPDATE *WORDPT*
          MX3    0           FLAG NO EXPRESSION FOUND 
          EQ     GETBARG     -- EXIT
* 
 GBA3     CALL   VARDO2      GET CODE FOR NEXT VARIABLE 
          SA1    WORDPT 
          SA2    X1          SET TO NEXT CHARACTER
          SX3    1           FLAG EXPRESSION COMPILED 
          EQ     GETBARG     -- EXIT
* 
* /---   BLOCK      -CTIME-    00 000   80/10/01  03.05 
          TITLE  -CTIME- COMMAND READIN 
*         CONDENSE ROUTINE FOR -CTIME- (CODE = 180) 
*         1ST ARGS ARE INPUT PARAMETERS (UP TO 3) 
*         2ND ARG IS OUTPUT WORD TO HOLD RESULTS
*         3RD ARG IS FORMAT FOR TRANSLATION (OPTIONAL)
*                12=12 HOUR FORMAT
*                24=24 HOUR FORMAT
*** 
*         THE FIRST GETVAR CODE CONTAINS NUMBER OF
*         INPUT PARAMETERS
 
 CTIMEIN  SX6    1
          SA6    VARBUF      SET UP DUMMY FIRST ARGUMENT
          CALL   VARDO2      GET FIRST REAL ARGUMENT
 
 CTIMES   SA1    LASTKEY
          SX1    X1-KSEMIC   (KSEMIC) = SEMI-COLON
          ZR     X1,STORETC  END OF INPUT PARAMS
          CALL   VARDO2 
          SA2    VARBUF      GET NUMBER OF TAGS 
          SX2    X2-5        POSITIVE IF X2 .GT. MAX INPUT
          NG     X2,CTIMES   IS - IF MORE TAGS TO FETCH 
          EQ     ERR2MNY     MAXIMUM OF 3 TAGS FOR INPUT
 
 STORETC  SA3    VARBUF      X3 = NUMBER TAGS SO FAR
          SX6    X3-1        DO NOT COUNT DUMMY ARGS
          SA6    VARBUF+1    SAVE NO. INPUT ARGS AS 1ST ARG 
          CALL   VARDO2 
          NG     X6,ERRSTOR  NOT STOREABLE
          SA1    VARBUF+1    GET NUMBER OF INPUT TAGS 
          SX1    X1-1 
          NZ     X1,CTNEXT   MORE THEN ONE TAG
* 
          SA1    VARBUF+2    GET FIRST FLOATING POINT 
          MX6    61-XCODEL+XFBIT
          BX6    -X6*X1      GET RID OF FLOATING POINT BIT
          SA6    A1          REWRITE WORD WITHOUT F BIT 
 CTNEXT   SA1    LASTKEY
          ZR     X1,MRKLAST  IF NO FORMAT TAG EXIT
          SX1    X1-KSEMIC
          NZ     X1,ERR2MNY  ONLY SEMI COLONS 
          CALL   VARDO2 
          SA1    LASTKEY
          ZR     X1,MRKLAST  THIS IS LAST LEGAL TAG 
          EQ     ERR2MNY     TOO MANY TAGS
 
* 
          TITLE  -COLOR- COMMAND READIN 
* 
*         -COLOR- COMMAND (NUMBER 158)
* 
*         COLOR   DEFINE;(VAR),REDVAL,GREENVAL,BLUEVAL
* 
*                READS IN THE VALUES SPECIFIED FOR
*                COLOR INTENSITIES IN THE RANGE 0..1, 
*                CONVERTS THEM TO A 24-BIT INTEGER, 
*                AND STORES THE RESULT IN THE SPECIFIED 
*                VARIABLE.
* 
*         COLOR   DISPLAY;FOREGND,BACKGND 
*         COLOR   DISPLAY;FOREGND 
*         COLOR   DISPLAY;,BACKGND
* 
*                TAKES THE 24-BIT COLOR VALUE(S)
*                SPECIFIED FOR FOREGROUND AND BACKGROUND
*                COLOR(S) AND SENDS THE INFORMATION TO
*                THE TERMINAL.
* 
*         COMMAND WORD FORMAT'; 
*         20/GETVAR,20/GETVAR,11/EXSTO ADDR,9/COMMAND NUMBER
* 
*         THE FIRST GETVAR CODE IS THE COMMAND EXECUTION
*         ROUTINE NUMBER -- 
*                0 = -COLOR DEFINE- 
*                1 = -COLOR DISPLAY-
* 
* /---   BLOCK      -CTIME-    00 000   80/10/01  03.05 
*         IF THE COMMAND IS -COLOR DISPLAY-, THE SECOND 
*         GETVAR CODE IS THE FOREGROUND COLOR AND THE 
*         THIRD GETVAR CODE (FIRST IN EXTRA STORAGE) IS 
*         THE BACKGROUND COLOR.  SINCE EITHER (BUT NOT
*         BOTH) MAY BE OMITTED, AN OMITTED COLOR IS 
*         SIGNALLED BY THE GETVAR CODE 200 000B.
* 
          EJECT 
 COLORIN  BSS    0
* 
*         PROCESS FIRST TAG -- TYPE OF -COLOR- REQUEST
* 
          RJ     NXTNAM      X6 = TAG, X1 = DELIMITER CHAR
          ZR     X6,ERR2FEW  -> NOT ENOUGH TAGS 
          BX7    X1          SAVE DELIMITER 
          SX2    X1-KSEMIC   SEE IF DELIMITER = SEMICOLON 
          SA7    LASTKEY     SAVE DELIMITER 
          NZ     X2,ERRTERM  -> BAD DELIMITER CHARACTER 
          SB1    1           B1 = CONSTANT 1
          SA2    KCDEF       START OF KEYWORDS
 
 TAGCHEK  ZR     X2,ERRNAME  -> KEYWORD NOT FOUND 
          BX3    X2-X6       CHECK KEYWORD
          SA2    A2+B1       X2 = NEXT KEYWORD IN LIST
          NZ     X3,TAGCHEK  -> NOT A MATCH 
          SB1    A2-KCDEF-1  B1 = JUMP TABLE INDEX
          SX6    B1          X6 = COMMAND TYPE
          SA6    VARBUF+1 
          SX6    1           ONE ENTRY IN VARBUF
          SA6    VARBUF 
+         JP     B1+*+1 
 
+         EQ     CDEFINE     -> PROCESS DEFINE KEYWORD
+         EQ     CDISPLY     -> PROCESS DISPLAY KEYWORD 
 
 KCDEF    DATA   0LDEFINE 
          DATA   0LDISPLAY
          DATA   0           MUST END IN 0 WORD 
 
 KCOMMA   EQU    56B         COMMA CHARACTER
          EJECT 
* 
*         PROCESS DEFINE KEYWORD
* 
 CDEFINE  BSS    0
          RJ     CARGS       GET ARGUMENTS
          SA1    VARBUF      MUST BE 4 ARGUMENTS + KEYWORD
          SX1    X1-5 
          NG     X1,ERR2FEW  -> NOT ENOUGH TAGS 
          NZ     X1,ERR2MNY  -> TOO MANY TAGS 
          SA1    VARBUF+2    X1 = VAR TAG GETVAR CODE 
          NG     X1,ERRSTOR  -> MUST BE STOREABLE 
          SA1    VARBUF+3    X1 = RED TAG GETVAR CODE 
          RJ     CHKVALU     CHECK VALIDITY 
          SA1    VARBUF+4    X1 = GREEN TAG GETVAR CODE 
          RJ     CHKVALU     CHECK VALIDITY 
          SA1    VARBUF+5    X1 = BLUE TAG GETVAR CODE
          RJ     CHKVALU     CHECK VALIDITY 
          EQ     CEND        -> ALL OK; FINISH COMMAND
* 
*         PROCESS DISPLAY KEYWORD 
* 
 CDISPLY  BSS    0
          MX6    1           PRESTORE BOTH ARGS OMITTED 
          LX6    XCODEL 
          SA6    VARBUF+2 
          SA6    VARBUF+3 
          RJ     GETBARG     GET FOREGROUND ARG 
          ZR     X2,CDISP1   -> ONLY ONE ARGUMENT 
          NZ     X3,CDISP0   -> CHECK BGND IF FGND COMPILED 
          SA1    VARBUF      ELSE INCREMENT *VARBUF* OVER 
          SX6    X1+1          OMITTED FGND ARGUMENT
          SA6    VARBUF 
 CDISP0   BSS    0
          RJ     GETBARG     GET BACKGROUND ARG 
 CDISP1   BSS    0
* /---   BLOCK      -CTIME-    00 000   80/10/01  03.05 
          SA1    VARBUF      CHECK FOR .LT. 4 ARGS
          SX1    X1-4 
          PL     X1,ERR2MNY  -> TOO MANY ARGUMENTS
          SX6    3           SET TO EXACTLY 3 ARGS
          SA6    VARBUF 
          SA1    VARBUF+2    CHECK FOR BOTH ARGS OMITTED
          SA2    VARBUF+3 
          MX0    1
          LX0    XCODEL      X0 = OMITTED ARG MASK
          BX1    X0*X1       X1 .NZ. IF OMITTED 
          BX2    X0*X2       X2 .NZ. IF OMITTED 
          BX2    X1*X2       X2 .NZ. IF BOTH OMITTED
          NZ     X2,ERR2FEW  -> ERROR IF BOTH OMITTED 
 CEND     SA1    VARBUF      X1 = NUMBE OF VARBUF ENTRIES 
          EQ     VARFIN      -> BUILD COMMAND WORD
* 
*         CARGS -- GET ALL THE TAGS IN THE COMMAND. 
*         IF A TAG IS OMITTED, INSERT A GETVAR CODE 
*         OF 200 000B.
* 
 CARGS    EQ     *
 CGET     RJ     GETBARG     GET NEXT TAG 
          NZ     X3,CGET     -> NOT OMITTED, GET NEXT 
          ZR     X2,CARGS    -> EOL; EXIT 
          MX6    1
          LX6    XCODEL      X6 = OMITTED TAG CODE
          SA1    VARBUF      X1 = CURRENT ENTRIES COUNT 
          SX1    X1+1        INCREMENT COUNT
          SA6    VARBUF+X1   STORE OMITTED ARG
          BX6    X1 
          SA6    VARBUF      STORE NEW COUNT
          EQ     CGET        GET NEXT TAG 
* 
*         CHKVALU -- MAKE SURE CONSTANT IS IN 
*         RANGE 0..1. 
* 
*         ENTER'; X1 = GETVAR CODE FROM *VARBUF*
* 
 CHKVALU  EQ     *
          PL     X1,CHKVALU  -> STOREABLE; NO TEST
          MX0    1
          LX0    XCODEL      X0 = OMITTED TAG CODE
          BX2    X0*X1       X2 .NZ. IF OMITTED 
          MX0    60-XCODEAL  X0 = ADDRESS MASK
          NZ     X2,ERRTAGS  -> ERROR IN TAGS COUNT 
          BX6    -X0*X1      X6 = SHORT LIT OR ADDRESS
          BX2    X1          SAVE ORIGINAL GETVAR CODE IN X1
          AX2    XCODEAL     MOVE TYPE CODE TO LOW ORDER
          BX0    -X0*X2      X0 = TYPE CODE (0 OR 1)
          SX0    X0-1        0 = SHORT LIT, 1 = LONG LIT
          PL     X0,CHKLONG  -> CHECK LONG LIT
          PX1    X6          ELSE FLOAT SHORT LIT 
          NX1    X1 
          EQ     CHKRANGE    -> CHECK RANGE 
 CHKLONG  BSS    0
          SA1    INFO+X6     GET LONG LIT FROM *INFO* 
 CHKRANGE BSS    0
          SA2    ONEP0       X2 = 1.0 
          NG     X1,COLROOR  -> COLOR NEGATIVE
          FX2    X2-X1       X2 <= 1.0 - COLOR
          PL     X2,CHKVALU  -> COLOR OK; EXIT
 COLROOR  BSS    0           CONDENSE ERROR IF OOR
          SB1    500         B1 = CONDENSE ERROR NUMBER 
          EQ     =XERR       -> GENERATE CONDENSE ERROR 
 
 ONEP0    DATA   1.0         CONSTANT 1.0 
* 
* /---   BLOCK      ENDOV      00 000   79/01/05  02.22 
* 
 ENDOV    ENDOV 
* 
* 
* /---   BLOCK      TSLINKC    00 000   80/08/28  09.33 
 TSLINKC  SPACE  4,10 
          TITLE  -TSLINK- COMMAND READIN
**        COMMAND READIN FROM -TSLINK-
* 
*         1ST ARG IS KEYWORD
*         2ND - 4TH ARG EXTRA TAGS (ALL OPTIONAL) 
* 
*         TSLINK     LOGIN;MAINFRAME,PASSWORD 
*         TSLINK     RECOVER
*         TSLINK     COMMAND;S,X;WORDS
*         TSLINK     SEND;S,X;WORDS 
*         TSLINK     RECEIVE;S,X;MAX ALLOWED;WORDS RETURNED 
*         TSLINK     STATUS;WORD
*         TSLINK     MESSAGE;MESSAGE
*         TSLINK     CONTINUE 
*         TSLINK     STOP 
*         TSLINK     CSET;VALUE 
*         TSLINK     LOGOUT 
*         TSLINK     NOLOG
* 
 
 TSLINKC  OVRLAY
 .TSL     IFEQ   0,1
 
*         FOR NOW -TSLINK- CAN BE USED IN NORMAL LESSONS
*         ON THE SYSTEMS SPECIFIED BELOW, AND IN SYSTEM 
*         LESSONS ON ANY SYSTEM.
 
          SA1    CSYSNAM     (X1) = THIS SYSTEMS ROUTING ID 
          SA2    MNE
          BX2    X1-X2
          ZR     X2,TSOK     IF MINNE 
          SA2    PCA
          BX2    X1-X2
          ZR     X2,TSOK     IF PCA 
          SA2    PEA
          BX2    X1-X2
          ZR     X2,TSOK     IF PEA 
          SA2    PWA
          BX2    X1-X2
          ZR     X2,TSOK     IF PWA 
          SA2    S1 
          BX2    X1-X2
          ZR     X2,TSOK     IF S1
 
          CALL   SYSTEST     ELSE MUST BE SYSTEM LESSON 
 
 TSOK     BSS    0
          CALL   NXTNAM 
          BX7    X1 
          SA7    LASTKEY
 
*         IDENTIFY KEYWORD
 
          SB2    B0 
 
 TLOOP    SA2    TSTABLE+B2  FETCH TABLE ENTRY
          ZR     X2,ERRNAME   KEYWORD NOT IN TABLE
          IX3    X6-X2
          ZR     X3,FOUND    =0 IF EXACT MATCH
          SB2    B2+1        INCREMENT LOOP POINTER 
          EQ     TLOOP
* /---   BLOCK      TSLINKC    00 000   80/08/28  09.33 
 
*         FOUND SO FETCH DESCRIPTOR WORD
 
 FOUND    SA2    TSDES+B2 
          SX6    B2          KEYWORD NUMBER 
          SA6    VARBUF+1 
          SX6    1
          SA6    VARBUF      COUNT OF TAGS
          MX0    3           TAG DESCRIPTORS ARE 3 BITS 
          BX3    X0*X2       (X3) = SYSTEM LESSON FLAG
          LX2    6           PUT 1ST TAG BITS IN BITS 2-0 
          BX6    X2 
          SA6    XTEMP
          ZR     X3,FOUND.1  IF ALLOWED IN USER LESSONS 
          CALL   SYSTEST
          SA2    XTEMP       RETRIEVE DESCRIPTOR WORD 
 FOUND.1  MX0    -3 
          BX3    -X0*X2 
 
*         PROCESS DESCRIPTOR
 
 DLOOP    ZR     X3,LASTCHK  CHECK IF END OF INPUT
          SA1    LASTKEY
          ZR     X1,ERR2FEW  IF NO MORE CHARS 
          SA4    STORCO3     1R; IS ONLY LEGAL SEPERATOR
          IX1    X1-X4
          NZ     X1,ERRTERM  IF NOT ; 
          SX3    X3-1 
          NZ     X3,NREAD    (1) = READABLE 
          CALL   VARDO2 
          EQ     STORE
 
 NREAD    SX3    X3-1 
          NZ     X3,NWRITE   (2) = STOREABLE
          CALL   VARDO2 
          SA1    VARBUF      GET CURRENT NUMBER OF TAG
          SA1    VARBUF+X1   FETCH ENTRY
          NG     X1,=XERRSTOR TEST IF STOREABLE 
          EQ     STORE
 
 NWRITE   BSS    0
          CALL   NXTNAM      GET NEXT LITERAL 
          BX7    X1 
          SA7    LASTKEY
          SA2    STORCON
          IX4    X6-X2
          SB1    155         BAD STORAGE LOCATION 
          ZR     X4,NWRITEY  IS S, FORM 
          SA2    STORCO4     NOW TRY STORAGE, 
          IX4    X6-X2
* /---   BLOCK      TSLINKC    00 000   80/08/28  09.33 
          ZR     X4,NWRITEY  IS STORAGE FORM SO CONTINUE
          EQ     ERR
 
 NWRITEY  SA2    STORCO2
          IX6    X1-X2
          NZ     X6,ERR      IF NOT 2R
          SA1    LASTKEY
          ZR     X1,ERR2FEW  IF NO MORE CHARS 
          CALL   VARDO2 
 STORE    SA2    XTEMP
          LX2    3
          MX0    3
          LX0    3
          BX3    X2*X0
          BX6    X2 
          SA6    XTEMP
          EQ     DLOOP
* /---   BLOCK      TSLINKC    00 000   80/08/28  09.33 
 
 LASTCHK  SA3    LASTKEY
          NZ     X3,ERR2MNY  TOO MANY TAGS
 
          EQ     MRKLAST     MARK AS LAST FLAG
 
* /---   BLOCK      TSLINKC    00 000   80/08/28  09.33 
 STORCON  CON    1LS
 STORCO2  CON    1R,
 STORCO3  CON    1R;
 STORCO4  CON    0LSTORAGE
 XTEMP    BSSZ   1
* 
*         TO ADD A KEYWORD';
* 
*         ADD THE LITERAL STRING TO THE *KEYWORD* TABLE AND 
*         ADD THE DESCRIPTOR WORD TO THE *PROCESS WORD* 
*         TABLE.  (MATCHING THE OFFSET INTO EACH) 
*         THE END OF TABLE IS LOCATED BY THE LAST ENTRY = 0 
* 
 
*         KEYWORD TABLE 
 
 TSTABLE  DATA   0LLOGIN
          DATA   0LRECOVER
          DATA   0LCOMMAND
          DATA   0LSEND 
          DATA   0LRECEIVE
          DATA   0LSTATUS 
          DATA   0LCONTINUE 
          DATA   0LSTOP 
          DATA   0LCSET 
          DATA   0LLOGOUT 
          DATA   0LNOLOG
          DATA   0LMESSAGE
          DATA   0           END OF TABLE 
 
*         DESCRIPTOR WORD TABLE 
* 
*         THE FORMAT OF EACH WORD IS
*         EACH COMMAND MUST HAVE SEMI-COLONS FOR EACH 
*         TAG DIVISOR, EXCEPT FOR THE STORAGE, FORMAT 
*         WHICH HAS A COMMA AFTER THE S OR STORAGE
*         3/0, = NON-SYSTEM KEYWORD 
*         3/1, = SYSTEM LESSON ONLY KEYWORD 
*         THE FOLLOWING 3 BIT FIELDS DESCRIBE THE 
*         FORMAT OF THE USERS TAG 
*                0 = END OF TAGS
*                1 = READABLE USER VARIABLE  (I.E. WHERE) 
*                2 = STORABLE USER VARIABLE  (I.E. N1)
*                3 = STORAGE DEFINITION 
*                    THIS MEANS S, OR STORAGE,
 
 TSDES    VFD    3/0,3/1,3/1,3/0,48/0 
          VFD    3/0,3/0,3/0,3/0,48/0 
          VFD    3/0,3/3,3/1,3/0,48/0 
          VFD    3/0,3/3,3/1,3/0,48/0 
          VFD    3/0,3/3,3/1,3/2,48/0 
          VFD    3/0,3/2,3/0,3/0,48/0 
          VFD    3/0,3/0,3/0,3/0,48/0 
          VFD    3/0,3/0,3/0,3/0,48/0 
          VFD    3/0,3/1,3/0,3/0,48/0 
          VFD    3/0,3/0,3/0,3/0,48/0 
          VFD    3/0,3/0,3/0,3/0,48/0 
          VFD    3/0,3/2,3/0,3/0,48/0 
          VFD    60/0 
 
 
*         SYSTEM NAMES FOR WHICH -TSLINK- IS ALLOWED
 
 MNE      DATA   0LMNE
 PCA      DATA   0LPCA
 PEA      DATA   0LPEA
 PWA      DATA   0LPWA
 S1       DATA   0LA02
 .TSL     ELSE
          SB1    73          BAD COMMAND NAME 
          EQ     =XERR
 .TSL     ENDIF 
          ENDOV 
 IPCC     TITLE  -IPC- / -CHARCNV- COMMAND READ IN
**        COMMAND READIN FOR -IPC- / -CHARCNV-
* 
*         IPC    CONNECT
*         IPC    DISCONNECT 
*         IPC    SEND,MESSAGE,LENGTH,ID,ADDRESS 
*         IPC    GET,MESSAGE,LENGTH,ID,ADDRESS
*         IPC    STATUS,NUMBER,INMSG,OUTMSG 
*         IPC    RESET
* 
*         CHARCNV  PLATO,BUF1,LEN1,BUF2,LEN2,LEN3 
*         CHARCNV  ASCII,BUF1,LEN1,BUF2,LEN2,LEN3 
* 
*         LEN1 = SOURCE BUFFER LENGTH IN SOURCE CHARACTERS
*         LEN2 = MAXIMUM DESTINATION BUFFER LENGTH IN WORDS 
* /---   BLOCK      TSLINKC    00 000   80/08/28  09.33 
*         LEN3 = DESTINATION BUFFER LENGTH IN CHARACTERS
          SPACE  5,11 
 IPCC     OVRLAY
 
* /---   BLOCK      TSLINKC    00 000   80/08/28  09.33 
          CALL   SYSTEST     VERIFY A SYSTEM LESSON 
 
*         DETERMINE IPC KEYWORD 
 
          CALL   NXTNAM 
          BX7    X1 
          SA7    LASTKEY
          SB2    B0 
          SA2    IPCCA       -IPC- KEYWORD TABLE
          SA1    OVARG1 
          ZR     X1,IPCC1    IF IPC COMMAND 
          SA2    IPCCB       -CHARCNV- KEYWORD TABLE
 IPCC1    ZR     X2,ERRNAME  IF KEYWORD NOT FOUND 
          IX3    X6-X2
          ZR     X3,IPCC2    IF KEYWORD FOUND 
          SB2    B2+1 
          SA2    A2+2 
          EQ     IPCC1       CHECK NEXT ENTRY 
 
 IPCC2    SX6    1           COUNT TAGS IN VARBUF 
          SA6    VARBUF 
          SX6    B2 
          SA6    VARBUF+1    SET IPC COMMAND TYPE 
          SA2    A2+1        (X2) = COMMAND DESCRIPTOR
          MX0    -6 
          LX2    6
          BX6    X2 
          SA6    IPCCC       SAVE DESCRIPTOR WORD 
          BX6    -X0*X2 
          SA6    IPCCD       SAVE ARGUMENT COUNT
 
*         PROCESS ARGUMENTS 
 
 IPC3     SA1    IPCCD
          NZ     X1,IPC4     IF MORE ARGUMENTS
          SA1    LASTKEY     VERIFY NOT TOO MANY ARGUMENTS
          NZ     X1,ERR2MNY  IF MORE ARGUMENTS
          EQ     MRKLAST     PACK COMMAND ARGUMENTS 
 
 IPC4     SX6    X1-1        DECREMENT ARGUMENTS LEFT 
          SA6    A1 
          SA1    IPCCC
          MX0    -6 
          LX1    6
          BX6    X1 
          SA6    A1          SAVE DESCRIPTOR WORD 
          BX1    -X0*X1 
          SA2    LASTKEY
          ZR     X2,ERR2FEW  IF NO MORE ARGUMENTS 
          SX2    X2-1R, 
          NZ     X2,ERRTERM  IF NO A COMMA SEPARATOR
          ZR     X1,IPC5     IF READ-ONLY ARGUMENT OKAY 
 
*         PROCESS STOREABLE ARGUMENTS 
 
          CALL   VARDO2 
          SA1    VARBUF 
          SA1    VARBUF+X1   (X1) = LAST ARGUMENT 
          NG     X1,ERRSTOR  IF NOT STORABLE
          EQ     IPC3        PROCESS NEXT ARGUMENT
 
*         PROCESS READ-ONLY ARGUMENTS 
 
 IPC5     CALL   VARDO2 
          EQ     IPC3 
 
*         IPC KEYWORD / ARGUMENT TABLE
* 
*         6/ARGUMENT COUNT
*         6/0 - READ-ONLY, 1 - STORABLE 
 
 IPCCA    DATA   0LCONNECT
          VFD    6/0,54/0 
          DATA   0LDISCONNECT 
          VFD    6/0,54/0 
          DATA   0LSEND 
          VFD    6/4,6/1,6/0,6/0,6/0,30/0 
          DATA   0LGET
          VFD    6/4,6/1,6/1,6/1,6/1,30/0 
          DATA   0LSTATUS 
          VFD    6/3,6/1,6/1,6/1,36/0 
          DATA   0LRESET
          VFD    6/0,54/0 
          DATA   0
 
 IPCCB    DATA   0LPLATO
          VFD    6/5,6/1,6/0,6/1,6/0,6/1,24/0 
          DATA   0LASCII
          VFD    6/5,6/1,6/0,6/1,6/0,6/1,24/0 
          DATA   0
 
* /---   BLOCK      TSLINKC    00 000   80/08/28  09.33 
 IPCCC    DATA   0           DESCRIPTOR WORD
 IPCCD    DATA   0           ARGUMENT COUNT 
 
          ENDOV 
* /---   BLOCK      NSETOV     00 000   79/02/04  15.42 
          TITLE  NAMESET COMMAND READINS
* 
* 
 NSETOV   OVRLAY
* 
          SA1    OVARG1      GET OVARLAY ARGUMENT 
          SB1    X1 
          JP     B1+*+1      JUMP TO ROUTINE FOR COMMAND
* 
+         EQ     SETNAMC     0 = -SETNAME- COMMAND
+         EQ     GETNAMC     1 = -GETNAME- COMMAND
+         EQ     RENAMEC     2 = -RENAME- COMMAND 
+         EQ     ADDNAMC     3 = -ADDNAME- COMMAND
+         EQ     NAMESC      4 = -NAMES- COMMAND
+         EQ     DELRECC     5 = -DELRECS- COMMAND
+         EQ     ADDRECC     6 = -ADDRECS- COMMAND
* /---   BLOCK      SETNAME    00 000   79/02/04  15.35 
* 
*         SETNAME HAS THE FOLLOWING FORMS --
* 
*         -SETNAME <VAR>-    VAR CONTAINS FIRST WORD OF NAME
*         -SETNAME NEXTNAME- SET TO NEXT NAME IN SEQUENCE 
*         -SETNAME BACKNAME- SET TO PREVIOUS NAME IN SEQ. 
*         -SETNAME (BLANK)-  INDICATE NO NAME SELECTED
* 
 SETNAMC  CALL   NXTNAMP     GET NEXT TAG IN X6 
*    X6 = TAG, WORDPT NOT UPDATED IN CASE TAG NOT -NEXTNAME-
          SX7    1           1 = NEXTNAME TAG 
          SA1    NEXTNAME    X1 = 8LNEXTNAME
          BX1    X6-X1
          ZR     X1,SETNAM2  --- IF SO, SET TYPE CODE 
          SX7    2           2 = BACKNAME TAG 
          SA1    BACKNAME    X1 = 8LBACKNAME
          BX1    X6-X1
          ZR     X1,SETNAM2  --- IF SO, SET TYPE CODE 
          SX7    3           3 = BLANK TAG
          SA1    TAGCNT      GET NUMBER OF TAGS 
          ZR     X1,SETNAM2  --- IF NONE, SET TYPE CODE 
          CALL   VARDO1      GET ARGUMENT 
          SA1    VARBUF+1    GET FIRST GETVAR CODE
          PL     X1,SETNAM1  --- JUMP IF STOREABLE ADDRESS
          MX0    -XCODEL     MASK FOR GETVAR CODE 
          BX1    -X0*X1      MASK OFF STORABILITY FLAG
          MX6    1
          LX6    XCODEL      SHIFT TO TOP BIT OF GETVAR 
          BX1    X6+X1       INSERT TOP BIT = NOT STORABLE
* 
 SETNAM1  BX6    X1          0 = NAME SPECIFIED 
          LX6    -2*XCODEL   SHIFT TO SECOND 20 BITS
          SA2    LASTKEY
          NZ     X2,ERR2MNY   ONLY ALLOW ONE ARGUMENT 
          EQ     PUTCODE
* 
 SETNAM2  BX6    X7 
          LX6    -XCODEL     SHIFT TO TOP 20 BITS 
          EQ     PUTCODE
* 
 NEXTNAME DATA   8LNEXTNAME 
 BACKNAME DATA   8LBACKNAME 
* /---   BLOCK      GETNAME    00 000   79/02/04  15.35 
* 
* 
*         GETNAME HAS ONE OR TWO ARGUMENTS -- 
*         1ST = STARTING VARIABLE IN WHICH TO STORE NAME
*         2ND = (OPTIONAL) LOCATION TO STORE EXTRA INFO 
* 
 GETNAMC  CALL   VARDO       GET ARGUMENTS
          SA1    VARBUF      CHECK NUMBER OF TAGS 
          SX2    X1-3 
          PL     X2,ERR2MNY  --- ERROR IF TOO MANY TAGS 
          SA2    VARBUF+1    CHECK IF STORABLE
          NG     X2,ERRSTOR  --- 1ST ARG MUST BE STORABLE 
          SX2    X1-2        CHECK IF TWO ARGUMENTS 
          NG     X2,MRKLAST  --- PACK UP SINGLE ARGUMENT
          SA2    VARBUF+2    CHECK IF STORABLE
          NG     X2,ERRSTOR  --- 2ND ARG MUST BE STORABLE 
          EQ     MRKLAST     EXIT TO PACK UP TAGS 
* 
* 
* 
*         RENAME HAS ONE OR TWO ARGUMENTS --
*         1ST = STARTING VARIABLE IN WHICH TO STORE NAME
*         2ND = (OPTIONAL) LOCATION OF NEW EXTRA INFO 
* 
 RENAMEC  CALL   VARDO       OBTAIN ARGUMENTS 
          SA1    VARBUF      CHECK NUMBER OF TAGS 
          SX2    X1-3 
          NG     X2,RENAME1  OK IF .LE. 2 ARGS
          SA2    SYSFLG      (X2) = SYSTEM LESSON FLAGS 
          LX2    ZSLDSHF     POSITION SYSTEM COMMAND FLAG 
          PL     X2,ERR2MNY  --- ERROR IF NOT SYSTEM LESSON 
          SX2    X1-4        3 ARGS IS OK FOR SYSTEM LESSON 
          PL     X2,ERR2MNY  --- ERROR IF .GT. 3 ARGS 
 RENAME1  SA2    VARBUF+1    (X2) = FIRST ARG 
          NG     X2,ERRSTOR  --- 1ST ARG MUST BE STORABLE 
          EQ     MRKLAST     EXIT TO PACK UP TAGS 
* /---   BLOCK      ADDNAME    00 000   79/09/11  03.13 
* 
*         ADDNAME HAS UP TO THREE ARGUMENTS-- 
*            1ST = STARTING VARIABLE CONTAINING NAME
*            2ND = NUMBER OF RECORDS (OPTIONAL) 
*            3RD = EXTRA INFO (OPTIONAL)
* 
 ADDNAMC  RJ     VARDO       COMMA SEPARATED VARIABLES
          SA1    VARBUF      GET NUMBER OF ARGS FOUND 
          SX2    X1-4 
          NG     X2,ADDNAM1  OK IF .LE. 3 ARGS
          SA2    SYSFLG      (X2) = SYSTEM LESSON FLAGS 
          LX2    ZSLDSHF     POSITION SYSTEM COMMAND FLAG 
          PL     X2,ERR2MNY  --- ERROR IF NOT SYSTEM LESSON 
          SX2    X1-5        4 ARGS IS OK FOR SYSTEM LESSON 
          PL     X2,ERR2MNY  --- ERROR IF .GT. 4 ARGS 
 ADDNAM1  SA2    VARBUF+1    (X2) = FIRST ARG 
          NG     X2,ERRSTOR   --- 1ST ARG MUST BE STOREABLE 
          EQ     MRKLAST     FINISH PROCESSING
* 
*         -NAMES- HAS FOUR ARGUMENTS- 
* 
*            1ST = ORDINAL NUMBER OF FIRST NAME 
*                  ...OR IT CAN BE OMITTED. 
*            2ND = STARTING LOCATION OF USER BUFFER 
*            3RD = SIZE OF USER BUFFER IN WORDS 
*            4TH = VARIABLE TO RETURN COUNT 
* 
 NAMESC   RJ     VARDO       COMMA SEPARATED VARIABLES
          SA1    VARBUF      GET NUMBER OF ARGS FOUND 
          SX2    X1-3        SEE IF 1ST ARG IS TO BE OMITTED
          NZ     X2,NAMES4   --- BRIF IF NOT 3 ARG CASE 
          SX6    X1+1        RESET *VARBUF* TO A 4 ARG CASE 
          SA6    A1 
* 
          SA1    VARBUF+3    ... SHUFFLE OTHER ARGS DOWN
          SA2    A1-1 
          BX7    X1 
          BX6    X2 
          SA7    A1+1        VARBUF+4 _ VARBUF+3
          SA6    A1          VARBUF+3 _ VARBUF+2
          SA1    VARBUF+1 
          BX6    X1 
          SA6    A2          VARBUF+2 _ VARBUF+1
 
          MX6    1           NOW MARK FIRST ARGUMENT OMITTED
          LX6    XCODEL 
          SA6    VARBUF+1    STORE AS A DUMMY ARGUMENT
          SA1    VARBUF 
          EQ     NAMES2      ... NOW CHECK OTHER ARGUMENTS
* 
 NAMES4   SX2    X1-4 
          NZ     X2,ERRTAGS  --- IS NO GOOD IF NOT 3 OR 4 ARGS
 NAMES2   SA2    VARBUF+2 
          NG     X2,ERRSTOR  --- 2ND ARG MUST BE STOREABLE
          SA2    VARBUF+4 
          NG     X2,ERRSTOR  --- 4TH ARG MUST BE STOREABLE
          EQ     VARFIN      FINISH PROCESSING
* 
*         ADDRECS, DELRECS CAN HAVE 1 OR 2 ARGUMENTS--
*            1ST = NUMBER OF RECORDS TO ADD (AT END)
*         OR
*            1ST = RECORD NUMBER THAT NEW RECORDS START AT
*            2ND = NUMBER OF RECORDS
* 
 DELRECC  BSS    0
 ADDRECC  RJ     VARDO       GET COMMA SEPARATED VARIABLES
          SA1    VARBUF      GET NUMBER OF ARGS FOUND 
          SX2    X1-3 
          PL     X2,ERR2MNY 
          EQ     MRKLAST     FINISH PROCESSING
* /---   BLOCK      ENDOV      00 000   79/02/04  15.39 
* 
          ENDOV 
* /---   BLOCK      COVL3B     00 000   81/05/12  15.01 
* 
 COVL3B   OVRLAY
          SA1    OVARG1 
          SB1    X1 
          JP     B1+*+1 
* 
+         EQ     SETSYSC     0 = -SETSYS- COMMAND 
+         EQ     FILNAMC     1 = -FILENAM- COMMAND
+         EQ     NVERSC      2 = -NVERS- COMMAND
+         EQ     NETIOC      3 = -NETIO- COMMAND
+         EQ     ITOAC       4 = -ITOA- COMMAND 
+         EQ     OTOAIN      5 = -OTOA- -HTOA- COMMANDS 
+         EQ     DIOC        6 = -DREAD- -DWRITE- COMMANDS
+         EQ     DATAIOC     7 = -DATAIN- -DATAOUT- COMMANDS
+         EQ     FIOC        8 = -READF- -WRITEF- COMMANDS
+         EQ     READIN      9 = -READECS- -READTCM-
+         EQ     WREADIN     10 = -WRITECS- -WRITTCM- 
+         EQ     SBREADC     11 = -SBREAD- -READLES-
+         EQ     SBWRITC     12 = -SBWRITE- -WRITLES- 
+         EQ     SBCHANC     13 = -SBCHANG- -STCHANG- 
+         EQ     SIZEC       14 = -SIZE-
+         EQ     TEXTNIN     15 = TEXTN 
+         EQ     TRANSIN     16 = TRANSFR 
* /---   BLOCK      SETSYS     00 000   85/07/29  15.37 
          TITLE  -SETSYS- COMMAND 
* 
*         -SETSYS- HAS THE FOLLOWING FORMS -- 
* 
*         SETSYS   NEXTSYS,(BUFFER),(LTH) 
*         SETSYS   BACKSYS,(BUFFER),(LTH) 
*         SETSYS   (SYSTEM),(BUFFER),(LTH)[,RID]
* 
 SETSYSC  CALL   SYSTEST     MUST BE SYSTEM LESSON
* 
          SA1    TAGCNT 
          ZR     X1,ERR2FEW  -- ERROR EXIT
* 
          CALL   NXTNAMP     GET FIRST TAG IN X6
* X6 = TAG, B1 = NEXT *WORDPT*, X1 = TERMINATOR CHARACTER 
* 
          MX7    0           0 = NEXTSYS TAG
          SA2    NEXTSYS     X2 = 7LNEXTSYS 
          BX2    X6-X2
          ZR     X2,SETSYS2 
* 
          SX7    1           1 = BACKSYS TAG
          SA2    BACKSYS     X2 = 7LBACKSYS 
          BX2    X6-X2
          NZ     X2,SETSYS3  NOT *NEXTSYS* OR *BACKSYS* 
* 
 SETSYS2  MX6    1           BUILD SPECIAL CODE 
          LX6    XCODEL 
          BX6    X6+X7
          SX7    B1          UPDATE *WORDPT*
          SA6    VARBUF+1 
          SA7    WORDPT 
          SX6    1
          SA6    VARBUF      SHOW ONE ARGUMENT SO FAR 
          EQ     SETSYS4     CONTINUE TO SECOND TAG 
* 
 SETSYS3  CALL   VARDO1      GET SYSTEM NAME AS FIRST ARG 
          SA1    LASTKEY     GET DELIMITER
* 
 SETSYS4  ZR     X1,ERR2FEW  --- ERROR IF NO BUFFER GIVEN 
* 
          CALL   VARDO2      GET BUFFER ADDRESS 
          NZ     B1,ERRSTOR  -- ERROR IF NOT STORABLE 
          SA1    LASTKEY     CHECK IF DONE
          ZR     X1,ERR2FEW  -- MUST SPECIFY BUFFER LTH 
* 
          CALL   VARDO2      GET BUFFER LENGTH
          SA2    LASTKEY     CHECK IF MORE ARGS 
          MX7    0
          ZR     X2,SETSYS9  -- EXIT IF DONE
* 
          CALL   NXTNAM      CHECK FOR RID KEYWORD
          NZ     X1,ERR2MNY  --- ERROR IF MORE ARGS 
          SA1    RIDTAG 
          BX1    X1-X6
          SX7    1
          NZ     X1,ERRNAME  --- ERROR IF NOT -RID- 
 SETSYS9  BSS    0
          MX6    1
          LX6    XCODEL      FLAG SPECIAL ARG 
          BX6    X6+X7
          SA6    VARBUF+4 
          SX1    4           (VARFIN REQUIRES NUM OF TAGS)
          BX6    X1 
          SA6    VARBUF      ALSO SET TO 4
          EQ     VARFIN      -- EXIT
* 
* 
 NEXTSYS  DATA   7LNEXTSYS
 BACKSYS  DATA   7LBACKSYS
 RIDTAG   DATA   3LRID
* 
* 
* /---   BLOCK      FILENAM    00 000   85/07/29  15.34 
          TITLE  -FILENAM- COMMAND
* 
*         -FILENAM- HAS TWO POSSIBLE FORMS -- 
* 
*         FILENAM ACCOUNT';FILE,ONEWORD       (FORM 0)
*         FILENAM ONEWORD,ACCOUNT';FILE       (FORM 1)
* 
*         THE FIRST GETVAR CODE IS SET UP AS A FAKE ARGUMENT
*         TO INDICATE WHICH FORM IS USED. 
* 
 
 FILNAMC  BSS    0
          SA1    TAGCNT 
          ZR     X1,ERR2FEW  IF BLANK TAG 
 
*         LOOK FOR COLON TO DETERMINE WHICH FORM IS USED
 
          CALL   COLONCK     SEE IF COLON AFTER FIRST ARG 
          ZR     X6,FN10     IF FIRST SEPARATOR IS COLON
          SX6    1           SET TO FORM 1
 FN10     SA6    VARBUF+1    SET UP FIRST GETVAR CODE 
          SX6    1
          SA6    VARBUF      INITIALIZE TO 1 ARGUMENT SO FAR
 
*         COMPILE FIRST REAL ARGUMENT 
 
          CALL   VARDO2 
          SA1    LASTKEY     CHECK FOR END OF LINE
          ZR     X1,ERR2FEW  IF ONLY ONE ARGUMENT 
          CALL   COLONCK     SEE IF NEXT SEPARATOR IS COLON 
          SA1    VARBUF+1    RETRIEVE COMMAND FORM
          ZR     X1,FN15     IF FIRST SEPARATOR WAS COLON 
          ZR     X6,FN20     IF SECOND SEPARATOR WAS COLON
          EQ     ERRTERM     IF NO COLON AT ALL 
 
 FN15     ZR     X6,ERRTERM  IF BOTH SEPARATORS ARE COLONS
 
*         COMPILE SECOND ARGUMENT 
 
          CALL   VARDO2      GENERATE GETVAR CODE 
          EQ     FN30 
 FN20     CALL   PUTDO2      GENERATE PUTVAR CODE 
 
*         COMPILE THIRD ARGUMENT
 
 FN30     SA1    LASTKEY     CHECK FOR END OF LINE
          ZR     X1,ERR2FEW  IF NO THIRD ARGUMENT 
          CALL   PUTDO2      ALWAYS PUTVAR CODE FOR 3RD ARG 
 
          SA1    LASTKEY
          NZ     X1,ERR2MNY  IF MORE THAN 3 ARGUMENTS 
          SX1    4           NUMBER OF GETVAR CODES ALLOWED 
          EQ     VARFIN 
* /---   BLOCK      NVERS      00 000   85/07/29  15.34 
          TITLE  -NVERS- COMMAND
* 
*         -NVERS- COMMAND 
* 
*         NVERS  ACCOUNT';FILE,ACCOUNT';FILE
* 
*         CONVERTS SPECIFIED FILE NAME TO ITS N-VERSION FORM. 
* 
 NVERSC   BSS    0
 
          CALL   SYSTEST     SYSTEM LESSONS ONLY
 
          CALL   ACCFILE,VARBUF+1,0    GET FIRST FILE NAME
 
          SA1    LASTKEY
          ZR     X1,ERR2FEW 
          CALL   COLONCK     LOOK FOR COLON IN 2ND NAME 
          NZ     X6,NV20     IF NO COLON
 
          SX6    2
          SA6    VARBUF      2 ARGUMENTS SO FAR 
          CALL   VARDO2      VAR FOR ACCOUNT NAME RETURN
          NG     X6,ERRSTOR  IF NOT STOREABLE 
 
 NV10     CALL   VARDO2      VAR FOR FILE NAME RETURN 
          NG     X6,ERRSTOR  IF NOT STOREABLE 
          SA1    LASTKEY
          NZ     X1,ERR2MNY  IF EXTRA ARGUMENTS 
          SX1    4           4 ARGUMENTS
          EQ     VARFIN 
 
 NV20     SX6    0           FAKE UP 3RD ARGUMENT 
          SA6    VARBUF+3 
          SX6    3
          SA6    VARBUF 
          EQ     NV10 
* /---   BLOCK      NETIO      00 000   79/02/04  23.36 
          TITLE  NETWORK I/O COMMAND - NETIO
* 
*         -NETIO-  (CODE = 107) 
* 
*         NETIO  REQUEST,RESPONSE 
* 
*         REQUEST AND RESPONSE MUST BE STOREABLE VAIABLES.
* 
 NETIOC   BSS    0
 
*         ALLOW ONLY SYSTEM LESSONS WITH -NETIO- PERMISSION.
 
          SA1    SYSFLG 
          LX1    ZSLDSHF
          PL     X1,ERRORC   IF NOT A SYSTEM LESSON 
          LX1    ZNIOSHF-ZSLDSHF
          PL     X1,ERRORC   IF NO -NETIO- PERMISSION 
* 
* * *     COMPILE PARAMETERS
          CALL   VARDO
* 
* * *     CHECK NUMBER OF ARGUEMENTS, MUST BE TWO 
          SA1    VARBUF      VARIABLE COUNT 
          SX2    X1-2 
          NG     X2,ERR2FEW  JUMP IF NOT ENOUGH 
          NZ     X2,ERR2MNY  JUMP IF TOO MANY 
* 
* * *     BOTH ARGUEMENTS MUST BE STOREABLE 
          SA2    VARBUF+1    FIRST VARIABLE 
          NG     X2,ERRSTOR  JUMP IF NOT STOREABLE
          SA2    VARBUF+2    SECOND VARIABLE
          NG     X2,ERRSTOR  JUMP IF NOT STOREABLE
* 
* * *     PACK VARBUF VARIABLES  (X1=VARIABLE COUNT)
          EQ     VARFIN 
* 
* 
* /---   BLOCK      OTOAIN     00 000   77/02/18  21.40 
* 
*         -ITOA-  (CODE=220)
* 
*            1ST ENTRY=INTEGER, 
*            2ND ENTRY=ALPHA STORAGE LOCATION 
*            3RD ENTRY=RETURN ALPHA CHARACTER COUNT 
* 
 ITOAC    RJ     VARDO       ENCODE VARIABLES 
          SA1    VARBUF      X1 = NUMBER OF VARIABLES 
          SX2    X1-2 
          NZ     X2,ITOAC1   JUMP IF NOT 2 VARIABLES
          SA1    VARBUF+1 
          SA2    VARBUF+2 
          NG     X2,ERRSTOR   MUST BE ABLE TO STORE INTO
          MX0    -XCODEL
          BX1    -X0*X1 
          BX2    -X0*X2 
          LX1    60-XCODEL
          LX2    60-2*XCODEL
          BX6    X1+X2
          MX1    1
          LX1    60-2*XCODEL
          BX6    X6+X1       SET BIT TO FLAG 2 ARGS 
          EQ     PUTCODE     --- EXIT TO ADD COMMAND CODE AND STORE 
 ITOAC1   SX2    X2-1 
          NZ     X2,ERRTAGS   --- ERROR EXIT IF NOT 3 VARIABLES 
          SA2    VARBUF+2 
          NG     X2,ERRSTOR   MUST BE ABLE TO STORE INTO ALPHA STORAGE
          SA2    VARBUF+3 
          NG     X2,ERRSTOR   MUST BE ABLE TO STORE CHAR COUNT
          EQ     VARFIN      --- EXIT TO PACK UP VARIABLES
* 
* 
          TITLE  OTOA/HTOA
* 
*         -OTOA-
*         -HTOA-
* 
*         FIRST ARG IS OCTAL WORD 
*         2ND ARG GIVES FWA OF 2 WORD STOREABLE BUFFER
*            TO CONTAIN THE 20 CHAR ALPHA STRING. 
*         OPTIONAL 3RD ARGUMENT IS CHARACTER COUNT
* 
*         FORCES GETVAR CODE OF 1ST ARG TO INTEGER
*         CHECKS TO SEE THAT 2ND ARG IS STOREABLE 
* 
 OTOAIN   RJ     VARDO
          SA1    VARBUF      X1= NO. OF ARGS
          SX2    X1-2 
          ZR     X2,OKTAGS   --- IF 2 ARGS IT IS OK 
          SX2    X1-3 
          NZ     X2,ERRTAGS  --- ERROR IF NOT 2 OR 3 TAGS 
 OKTAGS   SA2    VARBUF+1 
          MX0    1
          LX0    18          2**17 BIT IS I/F FLAG
          BX6    -X0*X2      MAKE GETVAR CODE INTEGER 
          SA6    A2          PUT IT BACK FOR VARFIN 
          SA2    VARBUF+2 
          NG     X2,ERRSTOR  --- ERROR IF 2ND NOT STOREABLE 
          EQ     MRKLAST     --- EXIT AND MARK LAST CODE
* 
* 
* /---   BLOCK      DREAD      00 000   79/07/12  04.51 
          TITLE  DREAD, DWRITE
*         -DREAD-  (CODE=193) 
*         -DWRITE- (CODE=194) 
* 
*         MAY HAVE 2 OR 3 ARGUMENTS 
* 
* 
 DIOC     RJ     SYSTEST     SYSTEM LESSON CHECK
* 
 DIOC1    SX6    1           SET UP SHORT LITERAL 
          SA6    VARBUF+3 
          RJ     VARDO       DECODE VARIABLES TO *VARBUF* 
          SA1    VARBUF 
          SX2    X1-2 
          ZR     X2,DIOC2    OK IF 2 ARGUMENTS
          SX2    X1-3 
          NZ     X2,ERRTAGS   --- ERROR IF NOT 3 ARGUMENTS
* 
 DIOC2    MX0    -XCODEL
          SA1    VARBUF+1    LOAD 1ST -GETVAR- CODE 
          BX6    -X0*X1 
          LX6    60-XCODEL
          SA1    VARBUF+2    LOAD 2ND -GETVAR- CODE 
          BX1    -X0*X1 
          LX1    60-2*XCODEL
          BX6    X1+X6       COMBINE
          SA1    VARBUF+3    LOAD 3RD -GETVAR- CODE 
          BX1    -X0*X1 
          LX1    60-3*XCODEL
          BX6    X6+X1       FINISH UP XSTOR WORD 
          SA1    INX
          SA6    X1+INFO     PUT -GETVAR- CODES IN XSTOR
          SX6    X1+1 
          SA6    A1          UPDATE XSTOR POINTER 
          BX6    X1 
          LX6    60-18       POSITION XSTOR POINTER 
          EQ     PUTCODE
* /---   BLOCK      DATAIOC    00 000   81/04/27  23.28 
          TITLE  DATAIOC
* 
* 
*         CONDENSE ROUTINE FOR -DATAIN- AND -DATAOUT- 
*         1ST ARG = BLOCK NUMBER
*         2ND ARG = DATA LOCATION 
*         3RD ARG = NUMBER OF RECORDS (OPTIONAL)
* 
*         DATA LOCATION CAN BE OF FOLLOWING TYPES - 
* 
*           N1               STUDENT BANK (TYPE 0)
*           V1               STUDENT BANK (TYPE 0)
*           C,1              COMMON (TYPE 1)
*           COMMON,1         COMMON (TYPE 1)
*           S,1              STORAGE (TYPE 2) 
*           STORAGE,1        STORAGE (TYPE 2) 
*           NC1              CM VARIABLES (TYPE 3)
*           VC1              CM VARIABLES (TYPE 3)
* 
*         REFERENCES TO NC/VC VARIABLES (TYPE 3) ARE
*         CONDENSED AS N/V VARIABLES (TYPE 0).  DURING THE
*         BOUNDS CHECKS AT EXECUTION TIME THE NC/VC 
*         REFERENCES ARE DETECTED AND THE TYPE IS CHANGED.
*         THIS IS NECESSARY SINCE REFERENCES LIKE NC(N1)
*         ARE CONDENSED WITH COMPILED CODE AND CANNOT BE
*         DETECTED EASILY HERE. 
* 
* 
 DATAIOC  SA1    COMNUM      -DATAOUT- IS PUBLISH ERROR 
          SB1    =XDATOT= 
          SB2    X1 
          NE     B1,B2,DATIOC0 IF NOT -DATAOUT- 
* 
          SB1    FSDATOT     LOG PUBLISH ERROR
          RJ     =XPUBERRS
 DATIOC0  CALL   VARDO1      GET BLOCK NUMBER 
          SA1    LASTKEY     GET TERMINATOR 
          SX1    X1-1R;      INSIST ON PROPER SYNTAX
          NZ     X1,ERRTERM  ERROR IF BAD SEPARATOR 
          SX7    DIO.SV      PRESET FOR STUDENT VARIABLES 
          SA7    VARBUF+2    PRESET TYPE IN 2ND ARG 
          CALL   NXTNAMR     GET ANY SYMBOL 
          SX4    X1-1R,      CHECK FOR COMMA
          NZ     X4,DATIOC3  JUMP IF NOT C,S
          SX7    DIO.COM     PRESET FOR COMMON
          SA2    KCOM 
          BX2    X3*X2
          IX2    X2-X6
          ZR     X2,DATIOC2  IF COMMON
          SX7    DIO.STO     PRESET FOR STORAGE 
          SA2    KSTO 
          BX2    X3*X2
          IX2    X2-X6
          NZ     X2,DATIOC3  IF NOT STORAGE 
 DATIOC2  SA7    VARBUF+2    STORE TYPE AS 2ND ARG
          SX7    B1          B1 HAS BEEN SAVED TO HERE
          SA7    WORDPT 
 DATIOC3  SX6    2
          SA6    VARBUF      RESET ARGS TO 2
          CALL   VARDO2      GET DATA LOCATION
          SA2    VARBUF+2    TYPE CODE
          NZ     X2,DATIOC4  IF NOT STUDENT BANK
          NZ     B1,ERRSTOR  ERROR IF NOT STOREABLE 
 DATIOC4  SX6    1           CONSTANT 1 
          SA6    VARBUF+4    PRESET NUMBER OF RECORDS 
          SA1    LASTKEY     GET TERMINATOR 
          ZR     X1,DATIOC5  IF ONLY 2 ARGS 
          SX1    X1-1R;      INSIST ON PROPER SYNTAX
          NZ     X1,ERRTERM  ERROR IF BAD SEPARATOR 
          CALL   VARDO2      GET NUMBER OF RECORDS
          SA1    LASTKEY     GET FINAL TERMINATOR 
* /---   BLOCK      DATAIOC    00 000   81/04/27  23.28 
          NZ     X1,ERR2MNY  ERROR IF NOT E-O-L 
 DATIOC5  SX1    4           4 ARGS REQUIRED
          BX6    X1 
          SA6    VARBUF      AND GUARANTEED IN ALL CASES
          EQ     VARFIN 
* 
 KCOM     DATA   6LCOMMON 
 KSTO     DATA   7LSTORAGE
* 
* /---   BLOCK      FIOC       00 000   77/03/10  00.15 
          EJECT 
* 
*         -READF-  (CODE = 450) 
*         -WRITEF- (CODE = 451) 
* 
*         READF  FIP,BLOCK NUMBER,STORAGE ADDRESS,NO. BLOCKS
* 
*         NO. OF BLOCKS IS AN OPTIONAL PARAMETER WHICH IS 
*         ASSUMED ONE IF MISSING.  FILE INFORMATION 
*         PACKET(FIP) MUST BE A STOREABLE VARIABLE. 
* 
 FIOC     BSS    0
* 
* * *     MUST BE SYSTEM LESSON 
          CALL SYSTEST
* 
* * *     INITIALIZE NO. OF BLOCKS AND NO. OF ARGUMENTS TO 1
          SX6    1
          SA6    VARBUF+4    PUT IN FOURTH PARAMETER SLOT 
          SA6    VARBUF      NUMBER OF ARGUMENTS
* 
* * *     EVALUATE THE FIRST ARGUMENT 
          CALL   COMPILE
          NZ     B1,ERRSTOR  ERROR IF NOT STOREABLE 
* 
* * *     PUT GETVAR CODE INTO BUFFER.
          BX6    X1 
          SA6    VARBUF+1 
* 
* * *     COMPILE THE REMAINING ARGUMENTS 
 FIOC1    BSS    0
          SA1    LASTKEY     WAS THAT THE LAST ONE
          ZR     X1,FIOC2    JUMP IF NO MORE
          CALL   VARDO2      COMPILE NEXT ARGUMENT
          EQ     FIOC1
* 
* * *     CHECK FOR CORRECT NUMBER OF ARGUMENTS 
 FIOC2    BSS    0
          SA1    VARBUF      ARGUMENT COUNT 
          SX2    X1-4 
          ZR     X2,FIOC3    JUMP IF 4
          SX2    X1-3 
          NZ     X2,ERRTAGS  ERROR IF NOT 3 OR 4
* 
* * *     ONLY THREE ARGUMENTS FORCE TO FOUR
          SX1    X1+1 
* 
* * *     SET NUMBER OF VARIABLES AND GO PACK CODES 
 FIOC3    BSS    0
          BX6    X1 
          SA6    VARBUF 
          EQ     VARFIN 
* /---   BLOCK      READECS    00 000   79/03/20  20.14 
* 
          TITLE  -READECS-
*         -READECS-  (CODE=182) 
*         -READTCM-  (CODE=248) 
* 
 READIN   RJ     SYSTEST     CHECK IF SYSTEM LESSON 
 READIN1  RJ     VARDO       COMMA SEPARATED VARIABLES
          SA1    VARBUF+1 
          NG     X1,ERRSTOR   ERROR IF VARIABLE NOT STOREABLE 
          SX1    3           MUST BE 3 VARIABLES
          EQ     VARFIN      --- EXIT TO STORE CODE 
* 
* 
*         -WRITECS-  (CODE=219) 
*         -WRITTCM-  (CODE=250) 
* 
 WREADIN  RJ     SYSTST1     CHECK IF SPECIAL SYSTEM LESSON 
          EQ     READIN1
* 
* 
* 
*         -SBREAD-  (CODE=148)
*         -READLES- 
* 
 SBREADC  RJ     SYSTEST     CHECK IF SYSTEM LESSON 
 SBREAD1  RJ     VARDO       COMMA SEPARATED VARIABLES
          SA1    VARBUF+3 
          NG     X1,ERRSTOR   3RD ARG MUST BE STORABLE
          SX1    4           MUST BE 4 VARIABLES
          EQ     VARFIN      --- EXIT TO STORE CODE 
* 
*         -SBWRITE-  (CODE=149) 
*         -WRITLES- 
* 
 SBWRITC  RJ     SYSTST1     CHECK IF SPECIAL SYSTEM LESSON 
          EQ     SBREAD1
 
*         -SBCHANG- (CODE = 314)
*         -STCHANG- (CODE = 315)
 
 SBCHANC  RJ     SYSTST1     CHECK IF SPECIAL SYSTEM LESSON 
          RJ     VARDO       PROCESS COMMA-SEPARATED ARGS 
          SX1    4           THERE MUST BE 4 ARGUMENTS
          EQ     VARFIN      PACK UP GETVAR CODES AND EXIT
 
          TITLE  -SIZE- COMMAND.
**        SIZEC - SIZE COMMAND CONDENSE ROUTINE.
* 
*         COMMAND SYNTAX -
*                SIZE   <BLANK> 
*                SIZE   2 
*                SIZE   2,1.5 
*                SIZE   BOLD
 
*         CHECK FOR -BOLD- KEYWORD.  IF NOT BOLD, JUMP
*         TO STANDARD CONDENSE ROUTINE ',ONE2IN0', TO 
*         PROCESS ZERO TO TWO ARGUMENT COMMANDS.
 
 SIZEC    RJ     NXTNAMP
          SA1    BOLDNAM
          BX1    X6-X1
          NZ     X1,=XONE2IN0 IF NOT -BOLD- 
 
*         MAKE SURE THERE ARE NO MORE TAGS. 
 
          SX2    X2-EOL 
          NZ     X2,ERR2MNY  IF NOT END OF LINE 
 
*         SET BIT 58 TO INDICATE THAT THIS IS A -SIZE BOLD-.
 
          MX6    1
          LX6    58-59+60 
          EQ     PUTCODE
 
 BOLDNAM  DATA   4LBOLD 
 
* /---   BLOCK      TEXTN      00 000   83/06/13  11.57 
          TITLE  TEXTN COMMAND READIN 
* 
*         ALLOWS 4 OR 5 OR 6 OR 7 ARGUMENTS WITH LAST 
*         ARGUMENT MARKED WITH SIGN BIT SET.
*         FIRST AND SECOND ARGUMENTS MUST BE STOREABLE. 
* 
* 
 TEXTNIN  RJ     VARDO       COMMA SEPARATED VARIABLES
          SA1    VARBUF+1    FIRST GETVAR WORD
          NG     X1,ERRSTOR  MUST BE STOREABLE
          SA1    VARBUF+2    SECOND GETVAR WORD 
          NG     X1,ERRSTOR  MUST BE STOREABLE
          SA1    VARBUF      X1= NO. OF ARGS
          SX2    X1-4 
          ZR     X2,MRKLAST  --- IF 4 ARGS IT IS OK 
          SX2    X1-5 
          ZR     X2,MRKLAST  --- IF 5 ARGS IT IS OK 
          SX2    X1-6 
          ZR     X2,MRKLAST  --- IF 6 ARGS IT IS OK 
          SX2    X1-7 
          ZR     X2,MRKLAST  --- IF 7 ARGS IT IS OK 
          EQ     ERRTAGS     --- EXIT TO CONDENSE ERROR 
* 
* /---   BLOCK      TRANSFR    00 000   79/07/12  05.23 
          TITLE  -TRANSFR-
* 
* 
* 
*         -TRANSFR- COMMAND READIN
* 
 TRANSIN  SX6    2
          SA6    VARBUF      SET ARGS TO 2
          MX6    0
          SA6    VARBUF+2    CLEAR TRANSFER TYPE TO 0 
          CALL   NXTNAMR     GET FIRST SYMBOL 
          ZR     X1,SYNERR   CHECK FOR PREMATURE EOL
          SX4    X1-1R,      CHECK FOR COMMA
          NZ     X4,TRANSFR  GO GET -FROM- IF NOT C,S 
          SB3    1           SET TYPE 
          SA2    KCOM 
          BX2    X3*X2
          IX2    X2-X6
          ZR     X2,TRANSFC  COMMON 
          SB3    B3+B3
          SA2    KSTO 
          BX2    X3*X2
          IX2    X2-X6
          ZR     X2,TRANSFC  STORAGE
          SB3    B3+1 
          SA2    KROUT
          BX2    X3*X2
          IX2    X2-X6
          ZR     X2,TFCR     JUMP IF -ROUTER- 
          SB3    B3+1 
          SA2    KROUTV 
          BX2    X3*X2
          IX2    X2-X6
          NZ     X2,TRANSFR  NOT -ROUTVARS- 
* 
* /---   BLOCK      TRANSFR    00 000   79/07/12  05.07 
* 
 TFCR     SA2    ROUTER 
          NZ     X2,ERROUTR   ERROR IF THIS IS A ROUTER 
* 
 TRANSFC  SX7    B3          PICK UP FLAG 
          SA7    VARBUF+2    STORE IN SECOND ARGUMENT 
          SX7    B1          B1 HAS BEEN SAVED TO HERE
          SA7    WORDPT 
* 
* 
 TRANSFR  CALL   VARDO2      GET -FROM- VARIABLE
          SA1    LASTKEY     GET TERMINATOR 
          SX1    X1-1R;      FORCE SYNTAX 
          NZ     X1,ERRTERM   TO BE CLEAR 
          EQ     B1,B0,TRANST    OK IF STOREABLE
          SA3    VARBUF+2    GET TYPE OF TRANSFER 
          ZR     X3,ERRSTOR  ERROR IF -CM FROM- NOT A USER
*                            ARRAY ADDRESS
* 
 TRANST   CALL   NXTNAMR     SCAN FOR NEXT TERMINATOR 
          ZR     X1,SYNERR   CHECK FOR PREMATURE EOL
          SX4    X1-1R,      CHECK FOR COMMA
          NZ     X4,TRANSTO  GO GET -TO- IF NOT C,S 
          SB3    1           SET TYPE 
          SA2    KCOM 
          BX2    X3*X2
          IX2    X2-X6
          ZR     X2,TRANSTC  COMMON 
          SB3    B3+B3
          SA2    KSTO 
          BX2    X3*X2
          IX2    X2-X6
          ZR     X2,TRANSTC  STORAGE
          SB3    B3+1 
          SA2    KROUT
          BX2    X3*X2
          IX2    X2-X6
          NZ     X2,TRANSTO  NOT ROUTER 
          SA2    ROUTER 
          NZ     X2,ERROUTR   ERROR IF THIS IS A ROUTER 
* 
* /---   BLOCK      TRANSFR    00 000   79/07/12  05.08 
* 
 TRANSTC  SX7    B3          PICK UP TYPE 
          SA3    VARBUF+2 
          LX7    3           MOVE -TO- TYPE INTO PLACE
          IX7    X7+X3       ADD IT IN
          SA7    A3          RE-STORE 
          SX7    B1          B1 HAS BEEN PRESERVED
          SA7    WORDPT 
* 
 TRANSTO  RJ     VARDO2      GET -TO- ARGUMENT
          SA1    LASTKEY     GET TERMINATOR 
          SX1    X1-1R;      FORCE SYNTAX 
          NZ     X1,ERRTERM   TO BE CLEAR 
          EQ     B1,B0,TRANSL  OK IF STOREABLE
          SA3    VARBUF+2    GET TRANSFER TYPE
          AX3    3           OF -TO- ARG
          ZR     X3,ERRSTOR  ERROR IF -CM TO- ADDRESS NOT 
*                            STOREABLE
* 
 TRANSL   RJ     VARDO2      GET -LENGTH- 
          SA1    LASTKEY     CHECK FINAL TERMINATOR 
          NZ     X1,ERR2MNY 
          SA1    VARBUF+5    PICK UP LENGTH 
          BX6    X1 
          SA6    VARBUF+1    MOVE INTO SAVED SLOT 
          SX1    4           HAVE 4 ARGUMENTS (SURE)
          BX6    X1 
          SA6    VARBUF      ENSURE THAT ARG CHECK IS OK
          EQ     VARFIN      GO PACK IT ALL UP
* 
 SYNERR   SX7    B1          UPDATE CHARACTER POINTER 
          SA7    WORDPT 
          EQ     ERR2FEW
* 
 KROUT    DATA   6LROUTER 
 KROUTV   DATA   8LROUTVARS 
* 
* /---   BLOCK      ENDOV      00 000   79/02/04  23.39 
* 
          ENDOV 
* /---   BLOCK      KEYWDOV    00 000   79/11/15  20.36 
          TITLE  KEYWORD COMMAND OVERLAY
 
 KEYWDOV  OVRLAY
* 
* *       OVERLAY TO CONDENSE KEYWORD-ORIENTED COMMANDS 
* * 
* *       KEYWD MACRO 
* * 
* *       KEYWD  NUMBER,NAME,ADDRESS,FLPTFLG
* * 
* *              NUMBER  = NUMBER OF KEYWORD
* *              NAME    = NAME OF KEYWORD
* *              ADDRESS = ADDRESS OF ROUTINE TO PROCESS TAG
* *              FLPTFLG = ALPHA TO SUPPRESS F/I CONVERSION 
* 
          PURGMAC KEYWD 
 
 KEYWD    MACRO  NUMBER,NAME,ADDRESS,FLPTFLG
          LOCAL  FICONV,UNUSED
 UNUSED   SET    0
          IFC    EQ,*FLPTFLG*ALPHA* 
 FICONV   SET    1
          ELSE
 FICONV   SET    0
          ENDIF 
          DATA   L*NAME*
          VFD    1/FICONV,14/UNUSED,9/0,18/ADDRESS,18/NUMBER
          ENDM
* /---   BLOCK      COMMANDS   00 000   80/02/08  23.45 
 
          SA1    OVARG1 
          SB1    X1 
          JP     B1+*+1      JUMP TO ROUTINE FOR COMMAND
 
+         EQ     ATTF        0 = -ATTACHF-
+         EQ     DETF        1 = -DETACHF-
+         EQ     FILEF       2 = -FILEF-
+         EQ     SYSFILE     3 = -SYSFILE-
* 
* *       -ATTACHF- COMMAND 
* 
 ATTF     CALL   SYSTEST
          CALL   VARDO1      GET FIP
          NG     X1,ERRSTOR  --- ERROR IF NOT STORABLE
          CALL   KEYWORDS,ATTFTAB,0 
          EQ     MRKLAST     --- PACK UP VARBUF AND EXIT
 
 ATTFTAB  BSS    0           TABLE OF -ATTACHF- KEYWORDS
 
          KEYWD  0,FILE,FILE,ALPHA
          KEYWD  1,PACK,WORD,ALPHA
          KEYWD  2,MODE,WORD
 
          DATA   0           MARK END OF TABLE
* 
* *       -DETACHF- COMMAND 
* 
 DETF     CALL   SYSTEST
          CALL   VARDO1      GET FIP
          NG     X1,ERRSTOR  --- ERROR IF NOT STORABLE
          CALL   KEYWORDS,DETFTAB,0 
          EQ     MRKLAST     --- PACK UP VARBUF AND EXIT
 
 DETFTAB  BSS    0           TABLE OF -DETACHF- KEYWORDS
 
          KEYWD  0,FILE,FILE,ALPHA
          KEYWD  1,PACK,WORD,ALPHA
          KEYWD  2,STATION,NEXTKEYW 
          KEYWD  3,MASTER,NEXTKEYW
 
          DATA   0           MARK END OF TABLE
* 
* *       -FILEF- COMMAND (KEYWORDS MUST CORRESPOND TO
* *       THE KEYWORDS FOR -ATTACHF-) 
* 
 FILEF    CALL   SYSTEST
          CALL   VARDO1      GET FIP
          NG     X1,ERRSTOR  --- ERROR IF NOT STORABLE
          CALL   KEYWORDS,FILEFTAB,0
          EQ     MRKLAST     --- PACK UP VARBUF AND EXIT
 
 FILEFTAB BSS    0           TABLE OF -FILEF- KEYWORDS
 
          KEYWD  0,FILE,FILE,ALPHA
          KEYWD  1,PACK,WORD,ALPHA
 
          DATA   0           MARK END OF TABLE
          EJECT 
* 
* *       -SYSFILE- COMMAND 
* * 
* *       PRIMARY FUNCTIONS - 
* * 
* *              ATTACH 
* *              DETACH 
* *              CHECK EXISTENCE OF A FILE
* *              READ 
* *              WRITE
* *              CREATE 
* *              DESTROY
* *              RENAME 
* *              CHANGE FILE TYPE 
* * 
* *       EACH PRIMARY FUNCTION IS FOLLOWED BY SECONDARY
* *       KEYWORDS OR ARGUMENTS 
* 
 SYSFILE  CALL SYSTEST       ERROR IF NOT SYSTEM LESSON 
          CALL VARDO1        GET FIP
          NG     X1,ERRSTOR  --- ERROR IF NOT STORABLE
          CALL   GET1ARG     (X6) = PRIMARY KEYWORD 
          ZR     X6,ERR2FEW  --- ERROR IF NO KEYWORD
* /---   BLOCK      COMMANDS   00 000   80/02/08  23.45 
          SA1    SYSFPTAB-1  (A1) = ADDR. OF 0TH KEYWORD
          MX0    48          (X0) = MASK FOR KEYWORD NAME 
 
 SYSFIL1  SA1    A1+1        (X1) = NEXT KEYWORD TABLE ENTRY
          ZR     X1,ERRNAME  --- ERROR IF END OF TABLE
          BX2    X0*X1       (X2) = NEXT KEYWORD
          BX2    X2-X6       TEST IF SAME 
          NZ     X2,SYSFIL1  --- RELOOP IF NO MATCH 
 
          BX1    -X0*X1      (X1) = TYPE OF KEYWORD 
          SX6    A1-SYSFPTAB (X6) = PRIMARY KEYWORD NUMBER
          SA2    VARBUF      (X2) = CURRENT VARBUF POINTER
          SX7    X2+1        UPDATE VARBUF POINTER
          SA7    A2+0        STORE INCREMENTED POINTER
          SA6    VARBUF+X7   STORE KEYWORD NUMBER 
 
          NZ     X1,SYSFIL2  --- READ/WRITE ARE SPECIAL 
          SB1    SYSFSTAB    (B1) = ADDR OF SECONDARY KEYWDS
          SB2    X6+13       (B2) = KEYWORD SHIFT 
          RJ     KEYWORDS    PROCESS SECONDARY KEYWORDS 
          EQ     MRKLAST     --- PACK UP VARBUF AND EXIT
 
 
 SYSFIL2  CALL   NEXTARG     GET STARTING SECTOR NUMBER 
          CALL   NEXTARG     GET STORAGE INDEX
          SA1    LASTKEY     (X1) = LAST CHARACTER PROCESSED
          ZR     X1,SYSFIL3  --- IF END-OF-LINE REACHED 
          SX1    X1-KSEMIC   CHECK IF SEMI-COLON
          ZR     X1,SYSFIL3  IF MORE KEYWORDS ARE PRESENT 
          CALL   NEXTARG     PROCESS NUMBER OF SECTORS
          EQ     SYSFIL4
 
 SYSFIL3  CALL   OMITTED     MARK NO. OF SECTORS OMITTED
 
 SYSFIL4  CALL   GET1ARG     (X6) = NEXT KEYWORD
          ZR     X6,MRKLAST  IF NO MORE KEYWORDS
          SA1    KMSG        (X1) = 7LMESSAGE 
          IX6    X1-X6
          NZ     X6,ERRNAME  IF NOT MESSAGE KEYWORD 
          CALL   NEXTARG     GET VAR FOR ERROR MESSAGE
          SA1    LASTKEY     (X1) = LAST KEY PROCESSED
          NZ     X1,ERR2MNY  ERROR IF NOT END-OF-LINE 
 SYSFIL5  SA1    NEXTCOM     (X1) = NEXT COMMAND
          SA2    COMCONT     (X2) = CURRENT COMMAND 
          BX1    X1-X2       TEST IF CONTINUED
          NZ     X1,MRKLAST  --- FINISH UP IF ALL OK
          EQ     ERR2MNY     --- ERROR IF CONTINUED COMMAND 
* 
* *       PRIMARY -SYSFILE- KEYWORDS
* * 
* *       *SYSFIL* MACRO PARAMETERS --
* * 
* *              PRIMARY = PRIMARY KEYWORD (ATTACH, ETC.) 
* *              TYPE    = 0 IF SECONDARY KEYWORDS, 1 IF
* *                        SPECIAL HANDLING 
* 
          PURGMAC SYSFIL
          MACREF SYSFIL$
 SYSFIL   MACRO  PRIMARY,TYPE 
          MACREF SYSFIL 
          VFD    48/0L_PRIMARY,12/TYPE
          ENDM
 
 SYSFPTAB SYSFIL ATTACH,0    ATTACH FILE
* /---   BLOCK      COMMANDS   00 000   80/02/08  23.45 
          SYSFIL DETACH,0    DETACH FILE
          SYSFIL CHECK,0     CHECK EXISTENCE OF A FILE
          SYSFIL READ,1      READ FILE
          SYSFIL WRITE,1     WRITE FILE 
          SYSFIL CREATE,0    CREATE FILE
          SYSFIL DESTROY,0   DESTROY FILE 
          SYSFIL RENAME,0    RENAME FILE
          SYSFIL RETYPE,0    CHANGE FILE TYPE 
          SYSFIL FBIT,0      SET/CLEAR BACKUP BIT 
          SYSFIL RECREATE,0 
 
          DATA   0           MARK END OF TABLE
 
 
          PURGMAC SELECT
          MACREF SELECT$
 SELECT   MACRO  ATR
          MACREF SELECT 
          IRP    ATR
 ATR      SET    1
          IRP 
          ENDM
 
          PURGMAC CLEAR 
          MACREF CLEAR$ 
 CLEAR    MACRO  ATR
          MACREF CLEAR
          IRP    ATR
 ATR      SET    0
          IRP 
          ENDM
 
* 
* *       SECONDARY KEYWORD TABLE 
* * 
* *       *SYSFKEY* MACRO PARAMETERS
* * 
* *              NUMBER  = NUMBER OF KEYWORD
* *              NAME    = NAME OF KEYWORD
* *              ADDRESS = ADDRESS OF ROUTINE TO PROCESS TAG
* *              FLPTFLG = ALPHA TO SUPPRESS F/I CONVERSION 
* *              OPTS    = COMMAND OPTIONS FOR WHICH THIS 
* *                        SECONDARY KEYWORD IS AVAILABLE 
* 
 
          PURGMAC SYSFKEY 
 
 SYSFKEY  MACRO  NUMBER,NAME,ADDRESS,FLPTFLG,OPTS 
 
          LOCAL  FICONV,UNUSED
          LOCAL  FATTACH,FDETACH,FCHECK,FREAD,FWRITE
          LOCAL  FCREATE,FDEST,FRENAME,FRETYPE
          LOCAL  FFBIT
          LOCAL  FRECRE 
 
 UNUSED   SET    0
 
          IFC    EQ,*FLPTFLG*ALPHA* 
 FICONV   SET    1
          ELSE
 FICONV   SET    0
          ENDIF 
 
          CLEAR  (FATTACH,FDETACH,FCHECK,FREAD,FWRITE)
          CLEAR  (FCREATE,FDEST,FRENAME,FRETYPE)
          CLEAR  FFBIT
          CLEAR  FRECRE 
 
          IRP    OPTS 
 
 ALLIF    IFC    EQ,*OPTS*ALL*
 
          SELECT (FATTACH,FDETACH,FCHECK,FREAD,FWRITE)
          SELECT (FCREATE,FDEST,FRENAME,FRETYPE)
          SELECT FFBIT
          SELECT FRECRE 
 
 ALLIF    ELSE
 
          IFC    EQ,*OPTS*ATTACH*,1 
          SELECT FATTACH
* /---   BLOCK      COMMANDS   00 000   80/02/08  23.45 
          IFC    EQ,*OPTS*DETACH*,1 
          SELECT FDETACH
          IFC    EQ,*OPTS*CHECK*,1
          SELECT FCHECK 
* /---   BLOCK      COMMANDS   00 000   80/02/08  23.45 
          IFC    EQ,*OPTS*READ*,1 
          ERR    NOT WITH THIS FUNCTION, TURKEY.
          IFC    EQ,*OPTS*WRITE*,1
          ERR    NOT WITH THIS FUNCTION, TURKEY.
          IFC    EQ,*OPTS*CREATE*,1 
          SELECT FCREATE
          IFC    EQ,*OPTS*DESTROY*,1
          SELECT FDEST
          IFC    EQ,*OPTS*RENAME*,1 
          SELECT FRENAME
          IFC    EQ,*OPTS*RETYPE*,1 
          SELECT FRETYPE
          IFC    EQ,*OPTS*FBIT*,1 
          SELECT FFBIT
          IFC    EQ,*OPTS*RECREATE*,1 
          SELECT FRECRE 
 
 ALLIF    ENDIF 
 
          IRP 
 
          DATA   L*NAME*
          VFD    1/FICONV,12/UNUSED 
          VFD    1/FATTACH,1/FDETACH,1/FCHECK,1/FREAD 
          VFD    1/FWRITE,1/FCREATE,1/FDEST,1/FRENAME 
          VFD    1/FRETYPE
          VFD    1/FFBIT
          VFD    1/FRECRE 
          VFD    18/ADDRESS,18/NUMBER 
 
          ENDM
 
 SYSFSTAB SYSFKEY 0,FILE,FILE,ALPHA,(ALL) 
          SYSFKEY 1,PACK,WORD,ALPHA,(ALL) 
          SYSFKEY 2,DIRECTORY,WORD,ALPHA,(ALL)
          SYSFKEY 3,MODE,WORD,,(ATTACH) 
          SYSFKEY 4,STATION,NEXTKEYW,,(DETACH)
          SYSFKEY 5,MASTER,NEXTKEYW,,(DETACH) 
          SYSFKEY 6,TYPE,WORD,,(ALL)
          SYSFKEY 7,LENGTH,WORD,,(CREATE,RECREATE)
          SYSFKEY 8,NPDWRITE,NEXTKEYW,,(CREATE) 
          SYSFKEY 9,NEWNAME,FILE,ALPHA,(RENAME) 
          SYSFKEY 9,(NEW NAME),FILE,ALPHA,(RENAME)
          SYSFKEY 10,DIRSIZE,WORD,,(CREATE,RECREATE)
          SYSFKEY 10,(DIR SIZE),WORD,,(CREATE,RECREATE) 
          SYSFKEY 11,RMTSIZE,WORD,,(CREATE,RECREATE)
          SYSFKEY 11,(RMT SIZE),WORD,,(CREATE,RECREATE) 
          SYSFKEY 12,ON,NEXTKEYW,,(FBIT)
          SYSFKEY 13,OFF,NEXTKEYW,,(FBIT) 
          SYSFKEY 14,OLDPACK,WORD,ALPHA,(ALL) 
          SYSFKEY 15,MESSAGE,WORD,ALPHA,(ALL) 
          SYSFKEY 16,NOATTACH,NEXTKEYW,,(CHECK) 
          SYSFKEY 17,ACCTRES,WORD,ALPHA,(ALL) 
          SYSFKEY 18,SUBACCT,WORD,ALPHA,(CREATE,RECREATE,RENAME)
          SYSFKEY 19,ORIGINAL,WORD,,(CREATE,RECREATE,RENAME)
 
          DATA   0           MARK END OF TABLE
* /---   BLOCK      KEYWORDS   00 000   79/10/28  04.23 
          TITLE  KEYWORD PROCESSING ROUTINES
* 
* *       -KEYWORDS- SUBROUTINE 
* * 
* *       SEARCHES TABLE OF KEYWORDS AND JUMPS TO 
* *       APPROPRIATE ROUTINES FOR PROCESSING 
* * 
* *       ON ENTRY, B1 = ADDRESS OF KEYWORD TABLE 
* *                 B2 = PRIMARY KEYWORD SHIFT, 0 IF
* *                      DOES NOT APPLY 
* 
 
 KEYWORDS EQ     *
          SX6    B1 
          SX7    B2          (X7) = PRIMARY KEYWORD SHIFT 
          SA6    KEYWTAB     SAVE ADDR. OF KEYWORD TABLE
          SA7    KEYWSHF     STORE KEYWORD SHIFT
 NEXTKEYW CALL   GET1ARG     (X6) = NEXT KEYWORD
          ZR     X6,KEYWORDS --- IF ALL KEYWORDS PROCESSED
          SA1    KEYWTAB     X1 = ADDR. OF KEYWORD TABLE
          SA1    X1-2        INITIALIZE FOR KEYWORD SEARCH
 NEXTKEY2 SA1    A1+2        (X1) = NEXT KEYWORD
          ZR     X1,ERRNAME  --- ERROR IF END OF TABLE
          BX1    X1-X6       CHECK IF SAME
          NZ     X1,NEXTKEY2 --- IF NO MATCH
          SA1    A1+1        X1 = KEYWORD INFO WORD 
          SA2    KEYWSHF     (X2) = KEYWORD SHIFT 
          ZR     X2,NEXTKEY3 --- IF NOT TO CHECK
          SB2    X2 
          LX2    X1,B2       SHIFT COMMAND BIT TO SIGN
          PL     X2,ERRNAME  --- IF THIS KEYWORD ILLEGAL
 NEXTKEY3 BX6    X1          (X6) = KEYWORD INFO WORD 
          SA6    KEYWINFO    SAVE A COPY
          SX6    X6          X6 = KEYWORD NUMBER
          SA2    VARBUF      X2 = GETVAR CODE COUNTER 
          SX7    X2+1        INCREMENT COUNTER
          SX3    X7-VARBUFL  TEST IF VARBUF FULL
          PL     X3,ERR2MNY  --- ERROR IF VARBUF FULL 
          SA7    A2          STORE UPDATE COUNTER 
          SA6    VARBUF+X7   STORE KEYWORD NUMBER 
          AX1    18          SHIFT TO ADDR. FIELD 
          SB1    X1          B1 = ADDR OF PROCESSING ROUTINE
          JP     B1          --- PROCESS KEYWORD ARGUMENT 
* /---   BLOCK      KEYWORDS   00 000   80/02/08  23.45 
* 
* *       ROUTINE TO PROCESS SINGLE ARGUMENT KEYWORDS 
* 
 WORD     CALL   NEXTARG     PROCESS NEXT ARGUMENT
          CALL   CHKFLOAT    FLOATING POINT CHECK 
          EQ     NEXTKEYW    --- PROCESS NEXT KEYWORD 
* 
* *       PROCESS ACCOUNT';FILE AND <LESLIST> ARGUMENTS 
* 
 FILE     SB1    1
          SA1    WORDPT      X1 = ADDR OF NEXT CHAR 
          SX1    X1-1        BACK UP FOR LOOP 
 FILE1    SX1    X1+B1       X1 = ADDR OF NEXT CHAR 
          SA2    X1          X2 = NEXT CHAR 
          SX0    X2-1R       CHECK IF BLANK 
          ZR     X0,FILE1    SKIP BLANKS
          ZR     X2,ERR2FEW  --- ERROR IF END OF LINE 
          SX0    X2-KLT      CHECK FOR LESLIST BRACKET
          ZR     X0,FILE5    --- IF LESLIST BRACKET 
          SA3    X2+KEYTYPE 
          SX0    X3-OPCOMMA  CHECK IF SEPARATOR 
          ZR     X0,ERR2FEW  --- IF SEPARATOR REACHED 
          SX0    0           X0 = 0 = NO SPECIAL TERMINATOR 
          CALL   PSCAN       FIND END OF FIRST NAME 
          SX0    X1-KSEMIC   CHECK IF SEMI-COLON
          NZ     X0,FILE2    --- IF NOT SEMI-COLON
          SA3    B1-1        X3 = PRECEDING CHAR
          SX0    X3-KUP      CHECK IF SHIFT CODE
          NZ     X0,FILE2    --- IF NOT SHIFT CODE
          EQ     FILE3       --- IF ACCOUNT NAME PRESENT
* 
* *       ACCOUNT NAME OMITTED
* 
 FILE2    CALL   OMITTED     STORE OMITTED ARG GETVAR CODE
          EQ     FILE4       --- PROCESS FILE NAME
* 
* *       PROCESS ACCOUNT NAME
* 
 FILE3    SX6    1R          X6 = BLANK 
          SA6    A3          REPLACE SHIFT CODE WITH BLANK
*//////   TEMPORARY -- ACCOUNT NAME LEGAL ONLY IN SYSTEM LESSONS
          SA1    SYSFLG 
          LX1    ZSLDSHF
          PL     X1,ERRNAME  ERROR IF NOT SYSTEM LESSON 
*//////   END TEMPORARY 
          CALL   NEXTARG     PROCESS ACCOUNT NAME 
          CALL   CHKFLOAT    MASK OUT FLOATING POINT BIT
* 
* *       PROCESS FILE NAME 
* 
 FILE4    CALL   NEXTARG     PROCESS FILE NAME
          CALL   CHKFLOAT    MASK OUT FLOATING POINT BIT
          EQ     NEXTKEYW    --- ADVANCE TO NEXT KEYWORD
* /---   BLOCK      KEYWORDS   00 000   80/02/08  23.45 
* 
* *       PROCESS <LESLIST> REFERENCE 
* 
 FILE5    SX1    X1+B1       ADVANCE PAST LEFT BRACKET
          BX6    X1 
          SA6    WORDPT      UPDATE POINTER TO NEXT CHAR
          SX0    KGT         SCAN FOR RIGHT BRACKET 
          CALL   PSCAN
          SX0    X1-KGT      CHECK IF RIGHT BRACKET FOUND 
          NZ     X0,ERRTERM  --- IF RIGHT BRACKET NOT FOUND 
          SX6    1R 
          SA6    B1          REPLACE RIGHT BRACKET W/BLANK
          SA1    VARBUF      X1 = CURRENT VARBUF INDEX
          SX7    X1+1 
          SX2    X7-VARBUFL  CHECK IF OVERFLOWING VARBUF
          PL     X2,ERR2MNY  --- IF VARBUF FULL 
          SA7    A1          UPDATE VARBUF INDEX
          SA2    LESLCOD     X2 = LESLIST GETVAR CODE 
          BX6    X2 
          SA6    VARBUF+X7   STORE LESLIST CODE 
          CALL   NEXTARG
          EQ     NEXTKEYW    --- PROCESS NEXT KEYWORD 
 
 LESLCOD  VFD    60/LLCODE
* /---   BLOCK      KEYWORDS   00 000   80/02/08  23.45 
* 
* *       -NEXTARG- 
* * 
* *       PROCESSES NEXT VARIABLE ARGUMENT
* 
 NEXTARG  EQ     *
          SA1    WORDPT      CURRENT POSITION 
          SA1    X1 
          ZR     X1,ERR2FEW  --- IF END OF LINE REACHED 
          CALL   VARDO2 
          EQ     NEXTARG
* 
* *       -GET1ARG- 
* * 
* *       GET NEXT KEYWORD
* * 
* *       ON ENTRY, (WORDPT) = ADDR. OF NEXT CHARACTER
* *                 (LASTKEY) = PREVIOUS DELIMITER
* * 
* *       ON EXIT,  (X6) = NEXT KEYWORD, 0 IF NO MORE 
* 
 GET1ARG  EQ     *
          SA1    WORDPT      CHECK NEXT CHARACTER 
          SA1    X1          (X1) = NEXT CHARACTER
          ZR     X1,GET1ARG2 --- IF EOL, READ NEXT LINE 
          SA1    LASTKEY     (X1) = DELIMITER 
          SX6    X1-KSEMIC   CHECK FOR SEMI-COLON 
          ZR     X6,GET1ARG3 --- GO READ NEXT LINE
          EQ     ERR2MNY     --- ERROR IF NO DELIMITER
 
 GET1ARG2 SA1    NEXTCOM     (X1) = COMMAND FOR NEXT LINE 
          SA2    COMCONT     (X2) = CURRENT COMMAND 
          BX3    X1-X2       CHECK IF CONTINUED COMMAND 
          NZ     X3,GET1ARG4 --- IF NOT CONTINUED LINE
          CALL   GETLINE     READ NEXT LINE 
 
 GET1ARG3 CALL   NXTNAM      (X6) = TAG, (X1) = SEPARATOR 
          ZR     X6,ERRNAME  --- ERROR IF NONE OR TOO LONG
          BX7    X1          (X7) = SEPARATOR 
          SA7    LASTKEY     SAVE DELIMITER 
          EQ     GET1ARG     --- RETURN 
 
 GET1ARG4 MX6    0           (X6) = 0 IF NO MORE KEYWORDS 
          EQ     GET1ARG     --- RETURN 
* 
* *       CHKFLOAT MASKS OUT THE FLOATING POINT BIT SO THAT 
* *       ALPHAMERIC FIELDS WILL NOT BE CONVERTED TO
* *       INTEGER IF DEFINED IN V-TYPE VARIABLES
* 
 CHKFLOAT EQ     *
          SA1    KEYWINFO    X1 = KEYWORD INFO WORD 
          PL     X1,CHKFLOAT --- IF NOT ALPHAMERIC
          SA1    VARBUF      X1 = NO. OF GETVAR CODES 
          SB2    X1 
          SA1    A1+B2       X1 = LAST GETVAR CODE
          MX0    61-XCODEL+XFBIT
          BX6    -X0*X1      GET RID OF FLOATING POINT BIT
          SA6    A1          PUT GETVAR CODE BACK IN PLACE
          EQ     CHKFLOAT    --- RETURN 
* 
* *       STORE SPECIAL CODE FOR OMITTED ARGUMENTS
* 
 OMITTED  EQ     *
          MX6    1
          LX6    19          SET 19TH BIT = OMITTED ARGUMENT
          SA1    VARBUF      CURRENT VARBUF INDEX 
          SX7    X1+1 
* /---   BLOCK      KEYWORDS   00 000   80/02/08  23.45 
          SX2    X7-VARBUFL  SUBTRACT OFF SIZE OF VARBUF
          PL     X2,ERR2MNY  EXIT IF VARBUF BUFFER FULL 
          SA7    A1 
          SA6    VARBUF+X7   STORE DUMMY ARGUMENT 
          EQ     OMITTED
* 
* *       VARIABLES 
* 
 KEYWTAB  BSS    1           ADDRESS OF KEYWORD TABLE 
 KEYWSHF  BSS    1           PRIMARY KEYWORD NUMBER/SHIFT 
 KEYWINFO BSS    1           1/ALPHA FLAG,23/0,18/ADDR,18/NO
 KMSG     DATA   7LMESSAGE
 
          ENDOV 
* /---   BLOCK      END        00 000   76/07/21  20.45 
* 
* 
          OVTABLE 
* 
* 
          END    COVLY3$