Retro1.org codex

EXEC5 
* /---   FILE TYPE = E
* /---   BLOCK      EXEC5      00 000   78/12/15  10.55 
          IDENT  PLAT4$ 
          LCC    OVERLAY(PLATO,1,0) 
          END 
          IDENT  EXEC5
          TITLE  EXEC5       OVERLAYS FOR COMMAND EXECUTION 
* 
* 
          CST 
* 
* 
 EXEC5$   OVFILE
* 
* 
          EXT    ECSPRTY,ILOC,INAME,PROCO,ERXNAME 
          EXT    BOUNDS,WORDS,PROCESS,PROCESX,PROC,ERXMXLW
          EXT    CKPROC,RETPROC,RETPROS,RETPRO
          EXT    ERROROF,XSLICE 
          EXT    ERXROLC,ERXBADL,ERXROLV,ERXINDL,ERXINDH
          EXT    ERXPOS,ERXNOCS,ERXVAL,ERXECSB,ERXSTN 
          EXT    GET2 
          EXT    GETN 
          EXT    FODTAB,STSTUD,DST
          EXT    CHKSET 
          EXT    RCTOXY 
          EXT    LSNADDR
* 
* 
* /---   BLOCK      NOTES      00 000   77/09/13  15.45 
          TITLE  HISTORY
************************************************************
* 
*            THE ORIGINAL IDEA FOR, AND IMPLEMENTATION OF,
*         THIS SEARCH ROUTINE IS DUE TO JIM PARRY.  THE 
*         CODE WAS MODIFIED AS TO REGISTER USAGE AND
*         CALLING PROCEDURE TO CONFORM TO TUTOR EXECUTION 
*         CONVENTIONS BY RICK BLOMME, JULY 10, 1972.
* 
*            MULTIPLE SEARCH BY KIM MAST
* 
*            REVERSE SEARCH AND GENERAL CLEANUP 9/77 BY 
*         PAUL KONING.
* 
************************************************************
          TITLE  NOTES
* 
*         REGISTER USAGE IN ACTUAL SEARCH ROUTINE IS
*         A MESS.  THE PRIME REGISTER USAGE IS GIVEN
*         BELOW'; 
* 
*         X0 = OBJECT TO SEARCH FOR 
*         X1 = TEMPORARY
*         X2 = CURRENT WORD BEING CHECKED 
*         X3 = FOLLOWING WORD 
*         X4 = 10 COPIES OF COMPLEMENT OF 1ST CHARACTER 
*         X5 = 10 COPIES OF COMPLEMENT OF 2ND CHARACTER 
*         X6 = SPECIAL MASK (',SPIKES',)
*         X7 = FLAG WORD MARKING POSITIONS WHOSE FIRST
*              TWO CHARACTERS MATCH SPECIFIED OBJECT STRING 
* 
*         A0 = BASE ADDRESS OF SEARCH (WORD 1 OF STRING)
*         A2 = ADDRESS OF CURRENT WORD BEING CHECKED
*         A4 = ADDRESS OF LAST RESULT + 1 
*         A7 = ADDRESS OF WORD WHERE OBJECT WAS PLANTED 
*              TO STOP SEARCH FOR INTERRUPT OR TERMINATION
* 
*         B0 = 0
*         B1 = 1
*         B2 = 2
*         B3 = CHAR POSITION COUNTER
*         B4 = TEMPORARY
*         B5 = SHIFT COUNT (60-6*OBJECT LENGTH) 
*         B6 = ^$ SPACES LEFT IN RESULT BUFFER
*         B7 = ADDRESS TO STOP SEARCHING ON (MAY BE 
*              END + 2 OR START - 1 DEPENDING ON DIRECTION) 
* 
*         THE SEARCH ROUTINE INTERRUPTS WHEN THE TIME 
*         SLICE IS EXCEEDED.  IT DOES THIS BY PLANTING
*         THE OBJECT EVERY 70 WORDS AND CHECKING THE CLOCK
*         WHEN THE PLANTED OBJECT IS HIT.  THIS LENGTH OF 
*         70 IS DETERMINED BY SYMBOL *NWORDS* AND CAN BE
*         CHANGED TO MAKE CHECKS MORE OR LESS FREQUENT. 
* 
*         FORMAT OF THE SEARCH COMMAND';
* 
*         SEARCH  OBJ,OBJLEN,STRING,LEN,START,BUFF[,NUMBER] 
* 
*         OBJ    = OBJECT TO SEARCH FOR 
*         OBJLEN = LENGTH OF OBJECT (1^<OBJLEN^<10) 
*         STRING = STRING TO SEARCH IN (N OR NC VARS) 
*         LEN    = LENGTH OF STRING, IN CHARS 
*         START  = CHAR POSITION TO START AT (1^<START^<LEN)
*         BUFF   = BUFFER TO CONTAIN RESULTS (N, V, NC, VC) 
*         NUMBER = OPTIONAL COUNT OF NUMBER OF OCCURRENCES
*                  TO BE FOUND.  IF OMITTED, ONLY ONE IF
*                  FOUND, AND SEARCH STOPS WHEN IT IS 
*                  FOUND.  OTHERWISE, OCCURRENCES ARE 
*                  COUNTED, AND THE FIRST *NUMBER* ARE
*                  STORED.
* 
* /---   BLOCK      SEARCH DEF 00 000   79/11/01  22.57 
          TITLE  CHARACTER STRING SEARCH ROUTINE
* 
 NWORDS   EQU    70          WORDS TO SEARCH UNTIL INTERRUPT
* 
 STORE    MACRO 
          LOCAL  LB1,LB2,LB3
* 
          PL     X1,LB1      FLOAT RESULT IF NECESSARY
          PX6    X6 
          NX6    X6 
* 
***       NOTE THAT AN AUTHOR CAN HAVE HIS RETURN CELL IN 
***       AS PART OF HIS SEARCH STRING (OR ONE WORD AWAY'/) 
***       --SO MUST CHECK SO THAT DON'7T CHANGE THE END TEST
* 
LB1       SB4    A4-B6
          SB4    A7-B4       CHECK STORE ADDRESS AGAINST END TEST 
          NZ     B4,LB2      B4=0 IF RESULT ADR = END TEST
* 
          SA6    SAVWORD     STORE VALUE IN SAVED WORD
          EQ     LB3         AND CONTINUE 
* 
LB2       SA6    A4-B6       STORE VALUE IN RESULT BUFFER 
          BX6    X6          AND CONTINUE 
* 
LB3       BSS    0           FORCE TO NEXT WORD 
          ENDM
* 
 TSRCOBJ  EQU    TBINTSV     SEARCH OBJECT
 TSRCMXM  EQU    TBINTSV+1   ASSORTED JUNK, PART 1
 TSRCTC1  EQU    TBINTSV+2   TEN COPIES OF COMP. OF CHAR 1
 TSRCTC2  EQU    TBINTSV+3   TEN COPIES OF COMP. OF CHAR 2
 TSRCST   EQU    TBINTSV+4   START OF THIS PART OF SEARCH 
 TSRCINX  EQU    TBINTSV+5   NUMBER OF OCCURRENCES LEFT TO FIND 
 TSRCEND  EQU    TBINTSV+6   ASSORTED JUNK, PART 2
* 
*         SPECIFICS ON ',ASSORTED JUNK', VARIABLES';
* TSRCMXM CONTAINS';
*         1/FP FLAG          (1 MEANS STORE FLOATING) 
*         1/REPEAT FLAG      (1 MEANS NO REPEAT, 6 ARG FORM)
*         4/UNUSED
*         18/START OF RESULT AREA 
*         18/CHAR POSITION TO STOP SEARCH ON
*         18/CHAR POSITION TO START SEARCH ON 
* 
* TSRCEND CONTAINS';
*         1/DIRECTION        (1 MEANS BACKWARD SEARCH)
*         5/SHIFT COUNT/2    (30-3*OBJECT LENGTH) 
*         18/RESULT BUFFER END
*         18/STRING BASE ADDRESS
*         18/STRING END + 2 OR START - 1
*            (DEPENDING ON DIRECTION OF SEARCH) 
* 
* /---   BLOCK      SEARCH     00 000   78/07/05  01.22 
 SEARCHO  OVRLAY
          SA1    OVARG1      SEE IF INTERRUPTED 
          NZ     X1,POSTINT  IF SO, CONTINUE FROM INT.
          MX0    2*XCODEL 
          BX1    -X0*X5      MASK OUT ARGUMENTS 1 AND 2 
          AX1    XCMNDL      SHIFT OFF COMMAND CODE 
          SA2    B5+X1       X2 = 1ST EXTRA ARG WORD
          BX6    X2 
          SA3    A2+1        X3 = 2ND EXTRA ARG WORD
          BX5    X3          SET FOR NGETVAR
          BX7    X3 
          LX3    XCODEL      BRING OPTIONAL ARG. 7 TO TOP 
          SA6    SRCHSAV     STORE FIRST ARG. WORD
          SA7    SRCHSV2     AND SECOND ONE 
          NG     X3,SRCHX1   JUMP IF NO 7TH ARGUMENT
* 
* CONTINUE IF 7 ARGUMENT FORM (REPEATED SEARCH) 
* 
          NGETVAR 6          A1 = RESULT START ADDRESS
          SX6    A1 
          SA6    SRCHADR     SAVE RESULT ADDRESS
          SA2    SRCHSV2     BRING 2ND ARG WORD BACK
          BX5    X2 
          LX5    XCODEL 
* 
* GET NUMBER OF TIMES TO STORE (ARG. 7) 
* 
          NGETVAR INC        X1 = NUMBER OF TIMES TO STORE
          SA2    SRCHADR
          SA0    X2          A0 HAS STARTING ADDRESS
*          SX1    X1          USE 18 BIT ARITHMETIC 
*          NG     X1,ERXBADL  DISALLOW NEGATIVE COUNT 
*          SB1    X1+1        B1 CONTAINS LENGTH FOR BOUNDS 
          NG     X1,ERXBADL  DISALLOW NEGATIVE COUNT
*         EXECERR USES X1 
          SX6    1
          IX1    X1+X6       CHECK BOUNDS FOR STORE COUNT+1 
*          ZR     X1,ERXBADL  CHECK THAT STORE COUNT NE -1
          CALL   BOUNDS      PERFORM BOUNDS CHECK 
          SX6    B1-1        SET ADDRESS OF BUFFER END
*          SX7    X1          MOVE STORE COUNT OVER (SMALL INTEGER) 
          SX7    X1-1        MOVE STORE COUNT OVER (SMALL INTEGER)
          MX1    0           X1 = FLAG (0=REPEAT) 
          EQ     SRCHX2 
* /---   BLOCK      SEARCH     00 000   78/05/02  21.38 
* 
* 6 ARGUMENT SEARCH - GET RESULT ADDRESS
* 
 SRCHX1   NGETVAR 6          A1 = RESULT ADDRESS
          SX6    A1          COPY TO X6 
          SA0    A1          AND TO A0
          SX7    1           NUMBER OF SEARCHES TO DO 
          MX1    1           SET FLAG FOR NO REPEAT 
          LX1    -1          MOVE INTO PROPER PLACE 
 SRCHX2   SA7    TSRCINX     STORE REPEAT COUNT 
          MX0    -18
          BX6    -X0*X6      AVOID EXTENDED SIGNS 
          LX6    36 
          SA6    TSRCEND     STORE AWAY 
          SX6    A0          GET COUNTER ADDRESS (7ARG ONLY)
          BX6    -X0*X6      WIPE OUT SIGN EXTENSION
          LX6    36 
          BX6    X1+X6       MOVE IN REPEAT FLAG
          SA5    A5          RESTORE COMMAND WORD 
          SA6    TSRCMXM     AND STORE
* /---   BLOCK      SEARCH     00 000   78/05/02  21.38 
* 
* GET SEARCH OBJECT (ARG 1) 
* 
          NGETVAR 1          X1 = OBJECT
          BX6    X1 
          SA6    TSRCOBJ     STORE OBJECT 
          MX0    6           MASK FOR FIRST CHARACTER 
          BX6    X6*X0       X......... 
          BX2    X6          X......... 
          LX2    6           .........X 
          BX2    X2+X6       X........X 
          LX2    6           ........XX 
          BX6    X6+X2       X.......XX 
          LX2    12          ......XX.. 
          BX6    X6+X2       X.....XXXX 
          BX2    -X6         C;;;;;CCCC 
          LX2    30          ;CCCCC;;;; 
          BX6    -X6*X2      GOT 10 COPIES OF CHAR 1 NOW
          SA6    TSRCTC1     STORE THAT 
          LX1    6           REPEAT THIS FOR 2ND CHAR 
          BX6    X1*X0       X......... 
          BX2    X6          X......... 
          LX2    6           .........X 
          BX2    X2+X6       X........X 
          LX2    6           ........XX 
          BX6    X6+X2       X.......XX 
          LX2    12          ......XX.. 
          BX6    X6+X2       X.....XXXX 
          BX2    -X6         C;;;;;CCCC 
          LX2    30          ;CCCCC;;;; 
          BX6    -X6*X2      GOT 10 COPIES OF CHAR 2
          SA6    TSRCTC2     STORE THAT TOO 
* 
* GET ARGUMENT 2 (OBJECT LENGTH)
* 
          SA5    A5          GET COMMAND WORD BACK
          LX5    XCODEL 
          NGETVAR INC        LENGTH IN X1 
          SA2    SRCHSAV     BRING UP 1ST EXTRA ARG WORD
          BX5    X2          FOR NGETVAR
          SX6    X1          LENGTH TO X6, 18 BIT ARITHMETIC
          NG     X6,ERXBADL  ERROR IF NEGATIVE
          ZR     X6,NOSRCH   DON'7T SEARCH FOR NOTHING
          SX2    X6-11
          PL     X2,ERXBADL  ERROR IF GREATER THAN 10 
          SA6    SRCHOBL     SAVE OBJECT LENGTH 
          SA1    TSRCEND     BRING UP INCOMPLETE TSRCEND
          LX6    2           MULTIPLY LENGTH BY 4 
          SX2    X6-30       4*LENGTH-30
          LX6    -2          NOW X6 = LENGTH AGAIN
          IX6    X6-X2       X6 = 30-(LENGTH*3) 
          MX0    -5          MASK FOR SHIFT COUNT 
          BX6    -X0*X6 
          LX6    54          MOVE INTO PLACE
          BX6    X1+X6       MERGE IN NEW DATA
          SA6    A1          STORE RESULT 
* /---   BLOCK      SEARCH     00 000   78/05/02  21.39 
* 
* GET BASE ADDRESS OF SEARCH (ARG 3)
* 
          NGETVAR INC        BASE ADDRESS TO A1 
          SX6    A1 
          SA6    TSRCST      STORE FOR A WHILE
          MX0    -18
          BX6    -X0*X6      REDUCE TO 18 BITS
          LX6    18          MOVE INTO PLACE
          SA1    TSRCEND
          BX6    X1+X6       MERGE WITH OLDER DATA
          SA6    A1          AND STORE BACK 
          SA1    SRCHSAV     GET 1ST ARG WORD AGAIN 
          BX5    X1 
          LX5    XCODEL 
* 
* GET LENGTH IN CHARACTERS (ARG. 4) 
* 
          NGETVAR INC        X1 = NUMBER OF CHAR
          ZR     X1,NOSRCH   DON'7T SEARCH THROUGH NOTHING
          SA3    SRCHSAV     GET EXTRA ARG WORD BACK
          SX6    X1          MOVE LENGTH, 18 BIT ARITHMETIC 
          PL     X6,SRCHX3   BRANCH IF FORWARD SEARCH 
          BX6    -X6         GET ABSOLUTE VALUE 
          SA1    TSRCEND
          MX0    1           FLAG BIT FOR REVERSE SEARCH
          BX7    X1+X0       MERGE
          SA7    A1          AND STORE THE RESULT 
 SRCHX3   SA6    SRCHLEN     SAVE LENGTH IN CHARS 
          SA1    TSRCST 
          SA0    X1 
          BX1    X6          FOR *WORDS*
          CALL   WORDS
          BX5    X3 
          LX5    2*XCODEL    BRING UP ARGUMENT 5
* /---   BLOCK      SEARCH     00 000   78/05/02  21.39 
* 
* GET STARTING OFFSET (ARGUMENT 5)
* 
          NGETVAR INC        OFFSET TO X1 
          SB3    X1-1        MAKE 1-BASE INTO 0-BASE OFFSET 
          NG     B3,ERXPOS   ERROR IF OFFSET TOO SMALL
          SA1    SRCHLEN     READ SEARCH LENGTH IN CHARS
          SA2    SRCHOBL     AND OBJECT LENGTH
          SB2    X1          COPY LENGTH
          LE     B2,B3,SERX  ERROR IF OFFSET > MAX
          IX2    X1-X2       MAX POSSIBLE CHAR POSITION -1
          NG     X2,NOSRCH   --- IF NO SEARCH POSSIBLE
          SB1    X2          TO B1
          SX3    B3          X3 = CHAR POS. TO START ON 
          SA1    TENTH       BRING UP 1/10
          SA4    TSRCEND     GET DIRECTION FLAG 
          PL     X4,SRCHX4   BRANCH IF FORWARD SEARCH 
* 
* SET UP DATA FOR BACKWARD SEARCH 
*         X2 = ENDING CHAR POSITION (0-BASED) 
*         X3 = INITIAL CHAR POSITION (0-BASED)
*         X6 = STARTING WORD OFFSET (SET LATER) 
*         X7 = WORD OFFSET FOR END TEST (END+2 OR END-1)
* 
          SX7    -1          SEARCH END ADDRESS (RELATIVE)
          MX2    0           LAST CHAR POSITION -1
          LE     B3,B1,SRCHX5  --- IF OFFSET SMALL ENOUGH 
          SX3    B1          CORRECT OFFSET 
          EQ     SRCHX5      CONTINUE IN COMMON CODE
* 
* SAME FOR FORWARD SEARCH 
* 
 SRCHX4   GT     B3,B1,NOSRCH  --- IF NO SEARCH POSSIBLE
*         (X2 ALREADY SET)
          PX7    X2          FLOAT ENDING CHAR POSITION 
          FX7    X1*X7       COMPUTE WORD ENDING OFFSET 
          SX7    X7+2        SEARCH END ADDRESS (RELATIVE)
* /---   BLOCK      SETUP END  00 000   77/09/13  00.00 
* 
* NOW PACK UP EVERYTHING INTO TBINTSV BUFFER
* 
 SRCHX5   SX2    X2+1        MAKE CHAR POSITIONS 1-BASED
          LX2    18          SHIFT END POSITION OVER
          PX6    X3          FLOAT STARTING CHAR POSITION 
          SX3    X3+1        ADJUST THIS ONE TOO
          BX2    X2+X3       PACK UP FOR TSRCMXM
          FX6    X1*X6       COMPUTE WORD OFFSET
          SX6    X6          TOSS EXPONENT
          SA3    TSRCST      READ UP BASE ADDRESS 
          IX6    X6+X3       MAKE STARTING ADDRESS ABSOLUTE 
          IX7    X7+X3       LIKEWISE FOR ENDING ADDRESS
          SA6    A3          STORE STARTING ADDRESS 
          SA3    TSRCEND     GET END ADDRES ETC. WORD 
          MX0    -18
          BX7    -X0*X7      CLEAR SIGN EXTEND
          BX7    X7+X3       MERGE WITH ENDING ADDRESS
          SA7    A3          AND STORE BACK 
          SA1    TSRCMXM     GET FIRST ASSORTED THINGS WORD 
          BX6    X1+X2       MERGE IN CHARACTER BOUNDS
          SA2    SRCHSV2     READ UP SECOND ARG. WORD 
          LX2    XFBIT       SEE IF ARG. 6 WAS FLOATING 
          MX0    1
          BX2    X0*X2       ISOLATE FLOATING ARG. FLAG 
          BX6    X6+X2       MERGE WITH TSRCMXM 
          SA6    A1          STORE EVERYTHING BACK
* 
* /---   BLOCK      POSTINT    00 000   78/01/07  19.22 
* 
* ENTER HERE AFTER SETUP OR UPON RETURN FROM INTERRUPT. 
* TUTOR'7S B REGISTERS ARE SAVED AND ALL REGISTERS ARE
* SET UP FOR THE MAIN SEARCH LOOP.
* 
 POSTINT  SX6    B5 
          SX7    B7 
          SA6    SAVEB5 
          SA7    SAVEB7 
* 
* NOW SET UP REGISTERS FOR SEARCH 
* 
          SA1    TSRCINX     GET NUMBER OF TIMES LEFT 
          SA2    TSRCEND     SEARCH ENDING ADDRESS
          SB6    X1          NUMBER LEFT INTO B6
          SB7    X2          ENDING ADDRESS INTO B7 
          AX2    18          MOVE UP BASE ADDRESS OF SEARCH 
          SA0    X2          INTO A0
          AX2    18          MOVE UP BUFFER END ADDRESS 
          SA4    X2          INTO A4 (...)
          AX2    18          MOVE UP SHIFT COUNT/2
          LX2    1           NOW TRUE SHIFT COUNT 
          SA1    TSRCTC1     TEN COPIES OF COMP. OF CHAR 1
          SA3    TSRCOBJ     AND SEARCH OBJECT
          BX4    X1          CHAR 1 TO X4 
          BX0    X3          OBJECT TO X0 
          SA1    TSRCTC2     LIKEWISE FOR CHAR 2
          BX5    X1          INTO THE PROPER REGISTER 
          NG     X2,BINIT    BRANCH IF REVERSE
          SB5    X2          SET UP SHIFT COUNT IN B5 
* 
* ENTER HERE AFTER OK TIME CHECK (INTERRUPT NOT PERFORMED)
* 
 NLOOP    SB1    1           B1 = 1 (STANDARD INCREMENT)
          SA1    TSRCST      GET STARTING ADDRESS 
* 
          SB4    X1+NWORDS
          SA2    X1-1        A2 = STARTING ADDRESS -1 
          SB2    B1+B1       B2 = 2 (FOR COMBINING BITS)
          LT     B4,B7,SETEND   JUMP IF NEED INTERRUPT TEST 
          SB4    B7          B4 = END TEST = LAST SEARCH
*                            ADDRESS +2 
 SETEND   SX6    B4-B1       RESTART IN WORD PRECEDING END TEST 
          SA6    A1          STORE BACK FOR NEXT TIME 
* 
* STORE WORD AT END TO GUARANTEE EXIT 
* 
          SA1    B4 
          BX6    X1 
          SA6    SAVWORD
          BX7    X0          X7 HAS OBJECT
          SA7    B4          STORE AT END 
* 
*  NOTE - - A7 HAS END TEST ADDRESS, (MUST BE SAVED FOR END TEST) 
* 
          SA1    SPIKES      READ UP MASK WITH EVERY 6TH BIT ON 
          BX6    X1          X6 = SPIKE MASK
* 
****************************************************
************ REPEATED SEARCH LOOP ******************
****************************************************
* 
 NSRCH    SX1    B5-54       EXAMINE SHIFT COUNT
          ZR     X1,SINGLE   JUMP IF SINGLE CHAR LOOKUP 
* /---   BLOCK      F-SEARCHLP 00 000   79/10/31  12.14 
******************************************
**********   SEARCH LOOP     *************
******************************************
* 
 NXTWORD  SA2    A2+B1       X2 = NEXT WORD TO SEARCH 
****
*   TRAP 10/31/79 FRYE
          SB4    A2-B7       SEE IF WE WENT PAST END CHECK
          SA3    B1-B4       AND BLOW AWAY IF SO
* 
****
          BX1    X2-X4       MAKE 6 1-S EVERYWHERE THE 1ST CHARACTER WAS
          LX3    X1,B1       SHIFT A COPY 1 BIT 
          BX1    X1*X3       COMBINE EVEN AND ODD BITS
          LX3    X1,B2       SHIFT A COPY OF COMBO 2 BITS 
          BX3    X1*X3       COMBINE AGAIN
          LX1    X3,B2       SHIFT THIS COMBO 2 BITS
          BX7    X1*X3       COMBINE ONCE AGAIN 
          BX7    X6*X7       CLEAR THE JUNK WITH SPIKES 
* 
*         X7 HAS THE TOP BIT OF EACH CHAR THAT MATCHED THE
*         1ST CHAR OF THE STRING SET
* 
          ZR     X7,NXTWORD  LOOP IF NO MATCHES 
* 
* SPECIAL CHECK FOR CHAR IN POSITION 10 
* 
          BX1    X7 
          LX1    54          MOVE FLAG TEN TO SIGN BIT OF X1
          PL     X1,CHAR2ND  JUMP OVER IF NOT 
* 
* IF YES THEN SEE IF NEXT WORD HAS 2ND CHAR AT TOP
* 
          SA3    A2+B1       X3 = FOLLOWING WORD
          BX1    -X5-X3      GET 6 ZEROS TO TOP IF MATCH
          AX1    54          SHIFT OFF THE REST OF THE JUNK 
          ZR     X1,INORDER  JUMP IF MATCH (SKIP INTERMEDIATE TEST) 
          MX1    54          ELSE WIPE OUT TENTH CHARACTER FLAG 
          BX7    X1*X7
          ZR     X7,NXTWORD  SEE IF THERE WERE ANY OTHER THAN NO. 10
* 
* SEE IF 2ND CHARACTER IS ALSO THERE
* 
 CHAR2ND  BX1    X2-X5       MAKE 6 1-S EVERYWHERE THE 2ND CHARACTER WAS
          LX3    X1,B1       SHIFT A COPY 1 BIT 
          BX1    X1*X3       COMBINE EVEN AND ODD BITS
          LX3    X1,B2       SHIFT A COPY OF COMBO 2 BITS 
          BX3    X1*X3       COMBINE AGAIN
          LX1    X3,B2       SHIFT THIS COMBO 2 BITS
          BX3    X1*X3       COMBINE ONCE AGAIN 
          LX3    6           MOVE REMAINING BITS FROM CHAR 2
          BX7    X3*X7
          ZR     X7,NXTWORD  IF NOT IN SEQUENCE GO TO NEXT WORD 
* /---   BLOCK      F-IN ORDER 00 000   77/09/04  08.36 
**********************************************************
***** FIRST 2 CHARS ARE PRESENT AND IN ORDER *************
**********************************************************
          SA3    A2+B1       X3 = FOLLOWING WORD
* 
* IF IN CHAR POSITION 0, NO SHIFTING NECESSARY
* 
 INORDER  SB3    B0          PRESET CHAR POSITION COUNTER 
          BX1    X2          SET COMPARE WORD (X1)
          NG     X7,COMPARE  JUMP IF CHAR POSITION 0
* 
* LOOP TO DETERMINE OTHER 2 CHARACTER MATCHES 
* 
 OCCLOOP  SB3    B3+B1       B3 = CHAR POSITION (0-9) 
          LX7    6           SHIFT FLAG WORD
          PL     X7,OCCLOOP  LOOP IF SIGN BIT OFF 
* 
* WHEN FLAG COMES INTO SIGN BIT CREATE COMPARE WORD 
* 
          SB4    B3+B3
          SB4    B4+B3
          SB4    B4+B4       B4 = MASK LENGTH (B3*6)
* 
          SB4    B4-B1       SUBTRACT INITIAL MASK LENGTH 
          MX1    1           INITIAL MASK 
          AX1    X1,B4       FORM MASK IN X1, B4 BITS 
          BX2    -X1*X2      CLEAR UNEEDED CHARS FROM WORD
          BX1    X1*X3       AND UNEEDED CHARS FROM WORD +1 
          BX1    X1+X2       PUT THEM TOGETHER
          SB4    B4+1        RESET B4 
          LX1    X1,B4       SHIFT TO PROPER POSITION 
* 
* NOW COMPARE WITH OBJECT 
* 
 COMPARE  LX7    1
          AX7    1           CLEAR SIGN BIT (OCCLOOP END TEST)
          BX1    X1-X0       COMPARE WITH OBJECT
          AX1    X1,B5       ONLY AFTER SHIFTING OFF JUNK 
          ZR     X1,FOUNDIT  IF PERFECT MATCH 
          ZR     X7,NXTWORD  IF NO MORE TO TEST, GO TO NEXT WORD
          EQ     OCCLOOP     OTHERWISE LOOP 
* /---   BLOCK      F-FOUNDOBJ 00 000   77/09/04  08.42 
********************************************************* 
*************** FOUND FULL STRING MATCH ***************** 
********************************************************* 
* 
* CALCULATE CHARACTER LENGTH FROM BASE ADDRESS
* 
 FOUNDIT  SB4    A0          A0 HAS BASE ADDRESS
          SX1    A2-B4       X1 = WORD COUNT
          SB4    X1 
          SB4    B4+X1       MULTIPLY BY 2 TO B4
          LX1    3           MULTIPLY BY 8 TO  X1 
          SB4    X1+B4       B4 = WORD COUNT * 10 
          SB4    B4+B3
          SB4    B4+B1       B4 = CHAR LENGTH FROM BASE 
* 
* TEST TO MAKE SURE IT IS GREATER THAN OFFSET 
* 
          SA1    TSRCMXM     RESTORE CHECK WORD 
          SB2    X1 
          AX1    18 
          LT     B4,B2,RESRCH1  SEARCH MORE IF NOT
* 
* TEST TO SEE IF GREATER THAN MAXIMUM CHAR LENGTH 
* 
          SB2    X1          B2 HAS MAX CHAR COUNT
          SX6    -B1         X6 = SET FOR NOT FOUND 
          GT     B4,B2,NOTFND  IF NOT FOUND, GO AND EXIT
* 
* TEST TO SEE IF PLANTED INTERRUPT TEST (OR WORD BEFORE)
* 
          SX6    B4          X6 = CHARACTER POSITION OF FOUND MATCH 
          SB2    A7-B1       SO WILL TEST FOR WORD BEFORE 
          SB2    A2-B2       SUBTRACT FROM CURRENT ADDRESS
          GE     B2,B0,TIMETST
* /---   BLOCK      F-STO/SNGL 00 000   77/09/04  08.39 
* 
 OKFIND   SB6    B6-B1       DECREMENT COUNTER
          NG     B6,RESRCH   IF ONLY COUNT SEARCH 
* 
* 
* 
          STORE 
          NZ     B6,RESRCH
* 
* 
* 
          SA1    A1          RESTORE FLAG WORD
          LX1    1
          NG     X1,EXIT
* 
* GET READY TO SEARCH AGAIN 
* 
 RESRCH   SA1    SPIKES      BRING UP SPIKED WORD 
          BX6    X1 
 RESRCH1  SB2    B1+B1       RESET B2 
          ZR     X7,NSRCH 
          SX1    B5-54
          NZ     X1,OCCLOOP  RETURN TO LOOP IF MULTIPLE CHAR SEARCH 
          EQ     SINGLP      OTHERWISE GOTO SINGLE LOOP 
* 
* 
**********************************************************
************ SINGLE CHARACTER SEARCH *********************
**********************************************************
* 
 SINGLE   SA2    A2+B1       X2 = NEXT WORD TO BE CHECKED 
          BX1    X2-X4       MAKE 6 1-S EVERYWHERE THE CHARACTER WAS
          LX3    X1,B1       SHIFT A COPY 1 BIT 
          BX1    X1*X3       COMBINE EVEN AND ODD BITS
          LX3    X1,B2       SHIFT A COPY OF COMBO 2 BITS 
          BX3    X1*X3       COMBINE AGAIN
          LX1    X3,B2       SHIFT THIS COMBO 2 BITS
          BX7    X1*X3       COMBINE ONCE AGAIN 
          BX7    X6*X7       CLEAR THE JUNK WITH SPIKES 
* 
*         NOW HAVE A 1 IN TOP BIT OF ANY CHAR POSITION WHICH
*         MATCHED FIRST CHARACTER OF STRING 
* 
          ZR     X7,SINGLE   LOOP IF NO MATCHES 
          SB3    B0          PRESET CHAR POSITION COUNT 
          BX1    X7          SO CAN TEST X1 INSTEAD OF X7 
          LX7    1
          AX7    1           GET RID OF SIGN BIT
          NG     X1,FOUNDIT  IF FOUND IN 1ST CHAR POSITION
* 
 SINGLP   SB3    B3+B1       INCREMENT CHAR POSITION COUNT
          LX7    6           SHIFT FLAG REGISTER
          PL     X7,SINGLP   LOOP IF NO SIGN BIT NOT ON 
          MX1    1
          BX7    -X1*X7      GET RID OF SIGN BIT (FOR LOOP END TEST)
          EQ     FOUNDIT     SEEK AND STORE RESULT
* 
* 
* /---   BLOCK      B-NO INTER 00 000   77/09/14  05.42 
          TITLE  REVERSE SEARCH LOOP
* 
* ENTER HERE AFTER INTERRUPT OR SETUP 
* 
 BINIT    SX1    76B         MASK FOR SHIFT COUNT 
          BX2    X1*X2       CLEAR OUT JUNK BITS
          SB5    X2          MOVE SHIFT COUNT TO B5 
* 
* ENTER HERE AFTER OK TIME CHECK (INTERRUPT NOT PERFORMED)
* 
 BNLOOP   SB1    1           B1 = 1 (STANDARD INCREMENT)
          SA1    TSRCST      GET STARTING ADDRESS 
* 
          SB4    X1-NWORDS
          SA2    X1+1        A2 = STARTING ADDRESS +1 
          SB2    B1+B1       B2 = 2 (FOR COMBINING BITS)
          GT     B4,B7,BSETEND   JUMP IF NEED INTERRUPT TEST
          SB4    B7          B4 = END TEST = LAST SEARCH
*                            ADDRESS - 1
 BSETEND  SX6    B4          TO RESTART AT PLANTED WORD 
          SA6    A1          STORE RESTART ADDRESS
* 
* STORE WORD AT END TO GUARANTEE EXIT 
* 
          SA1    B4 
          BX6    X1 
          SA6    SAVWORD
          BX7    X0          X7 HAS OBJECT
          SA7    B4          STORE AT END 
* 
*  NOTE - - A7 HAS END TEST ADDRESS, (MUST BE SAVED FOR END TEST) 
* 
          SA1    SPIKES      READ UP MASK WITH EVERY 6TH BIT ON 
          BX6    X1          X6 = SPIKE MASK
* 
****************************************************
************ REPEATED SEARCH LOOP ******************
***************************************************** 
* 
 BNSRCH   SX1    B5-54       EXAMINE SHIFT COUNT
          ZR     X1,BSINGLE  JUMP IF SINGLE CHAR LOOKUP 
* /---   BLOCK      B-SEARCHLP 00 000   77/09/04  08.42 
******************************************
**********   SEARCH LOOP     *************
******************************************
* 
 BNXTWRD  SA2    A2-B1       X2 = NEXT WORD TO SEARCH 
          BX1    X2-X4       MAKE 6 1-S EVERYWHERE THE 1ST CHARACTER WAS
          LX3    X1,B1       SHIFT A COPY 1 BIT 
          BX1    X1*X3       COMBINE EVEN AND ODD BITS
          LX3    X1,B2       SHIFT A COPY OF COMBO 2 BITS 
          BX3    X1*X3       COMBINE AGAIN
          LX1    X3,B2       SHIFT THIS COMBO 2 BITS
          BX7    X1*X3       COMBINE ONCE AGAIN 
          BX7    X6*X7       CLEAR THE JUNK WITH SPIKES 
* 
*         X7 HAS THE TOP BIT OF EACH CHAR THAT MATCHED THE
*         1ST CHAR OF THE STRING SET
* 
          ZR     X7,BNXTWRD  LOOP IF NO MATCHES 
* 
* SPECIAL CHECK FOR CHAR IN POSITION 10 
* 
          BX1    X7 
          LX1    54          MOVE FLAG TEN TO SIGN BIT OF X1
          PL     X1,BCHR2ND  JUMP OVER IF NOT 
* 
* IF YES THEN SEE IF NEXT WORD HAS 2ND CHAR AT TOP
* 
          SA3    A2+B1       X3 = FOLLOWING WORD
          BX1    -X5-X3      GET 6 ZEROS TO TOP IF MATCH
          AX1    54          SHIFT OFF THE REST OF THE JUNK 
          ZR     X1,BINORDR  JUMP IF MATCH (SKIP INTERMEDIATE TEST) 
          MX1    54          ELSE WIPE OUT TENTH CHARACTER FLAG 
          BX7    X1*X7
          ZR     X7,BNXTWRD  SEE IF THERE WERE ANY OTHER THAN NO. 10
* 
* SEE IF 2ND CHARACTER IS ALSO THERE
* 
 BCHR2ND  BX1    X2-X5       MAKE 6 1-S EVERYWHERE THE 2ND CHARACTER WAS
          LX3    X1,B1       SHIFT A COPY 1 BIT 
          BX1    X1*X3       COMBINE EVEN AND ODD BITS
          LX3    X1,B2       SHIFT A COPY OF COMBO 2 BITS 
          BX3    X1*X3       COMBINE AGAIN
          LX1    X3,B2       SHIFT THIS COMBO 2 BITS
          BX3    X1*X3       COMBINE ONCE AGAIN 
          LX3    6           MOVE REMAINING BITS FROM CHAR 2
          BX7    X3*X7
          ZR     X7,BNXTWRD  IF NOT IN SEQUENCE GO TO NEXT WORD 
* /---   BLOCK      B-IN ORDER 00 000   78/01/12  00.59 
**********************************************************
***** FIRST 2 CHARS ARE PRESENT AND IN ORDER *************
**********************************************************
          SA3    A2+B1       X3 = FOLLOWING WORD
* 
 BINORDR  SB3    10          PRESET CHAR POSITION COUNTER 
* 
* LOOP TO FIND 2 CHARACTER MATCHES FROM THE END BACKWARDS 
* 
 BOCLOOP  SB3    B3-B1       B3 = CHAR POSITION (0-9) 
          LX7    -6          SHIFT FLAG WORD
          PL     X7,BOCLOOP  LOOP IF SIGN BIT OFF 
          ZR     B3,B1ST     JUMP IF IN 1ST CHAR POSITION 
* 
* WHEN FLAG COMES INTO SIGN BIT CREATE COMPARE WORD 
* 
          SB4    B3+B3
          SB4    B4+B3
          SB4    B4+B4       B4 = MASK LENGTH (B3*6)
* 
          SB4    B4-B1       SUBTRACT INITIAL MASK LENGTH 
          MX1    1           INITIAL MASK 
          AX1    X1,B4       FORM MASK IN X1, B4 BITS 
          BX3    X1*X3       CLEAR UNNEEDED BITS FROM WORD 2
          BX1    -X1*X2      AND FROM WORD 1
          BX1    X1+X3       PUT THEM TOGETHER
          SB4    B4+1        RESET B4 
          LX1    X1,B4       SHIFT TO PROPER POSITION 
* 
* NOW COMPARE WITH OBJECT 
* 
 BCOMPAR  LX7    1
          AX7    1           CLEAR SIGN BIT (BOCLOOP END TEST)
          BX1    X1-X0       COMPARE WITH OBJECT
          AX1    X1,B5       ONLY AFTER SHIFTING OFF JUNK 
          ZR     X1,BFOUND   IF PERFECT MATCH 
          ZR     X7,BNXTWRD  IF NO MORE TO TEST, GO TO PRECEDING WORD 
          EQ     BOCLOOP     OTHERWISE LOOP 
* 
 B1ST     BX1    X2          GET COMPARISON WORD
          EQ     BCOMPAR     NOW DO COMPARE 
* /---   BLOCK      B-FOUNDOBJ 00 000   77/09/12  12.10 
********************************************************* 
*************** FOUND FULL STRING MATCH ***************** 
********************************************************* 
* 
* CALCULATE CHARACTER LENGTH FROM BASE ADDRESS
* 
 BFOUND   SB4    A0          A0 HAS BASE ADDRESS
          SX1    A2-B4       X1 = WORD COUNT
          SB4    X1 
          SB4    B4+X1       MULTIPLY BY 2 TO B4
          LX1    3           MULTIPLY BY 8 TO  X1 
          SB4    X1+B4       B4 = WORD COUNT * 10 
          SB4    B4+B3
          SB4    B4+B1       B4 = CHAR LENGTH FROM BASE 
* 
* TEST TO MAKE SURE IT IS LESS THAN OFFSET
* 
          SA1    TSRCMXM     RESTORE CHECK WORD 
          SB2    X1 
          AX1    18 
          GT     B4,B2,BRSRCH1  IF TOO FAR, SEARCH MORE 
* 
* TEST TO SEE IF LESS THAN LOWEST VALUE 
* 
          SB2    X1          B2 HAS MAX CHAR COUNT
          SX6    -B1         X6 = SET FOR NOT FOUND 
          LT     B4,B2,NOTFND  EXIT IF TOO SMALL
* 
* TEST TO SEE IF PLANTED INTERRUPT TEST 
* DON'7T NEED TO CHECK PRECEDING WORD LIKE FORWARD... 
* 
          SX6    B4          X6 = CHARACTER POSITION OF FOUND MATCH 
          SB2    A7 
          SB2    A2-B2       SUBTRACT FROM CURRENT ADDRESS
          EQ     B2,B0,TIMETST
* /---   BLOCK      B-STO/SNGL 00 000   77/09/12  12.09 
* 
 BOKFIND  SB6    B6-B1       DECREMENT COUNTER
          NG     B6,BRESRCH  IF ONLY COUNT SEARCH 
* 
* 
* 
          STORE 
          NZ     B6,BRESRCH 
* 
* 
* 
          SA1    A1          RESTORE FLAG WORD
          LX1    1
          NG     X1,EXIT
* 
* GET READY TO SEARCH AGAIN 
* 
 BRESRCH  SA1    SPIKES      BRING UP SPIKED WORD 
          BX6    X1 
 BRSRCH1  SB2    B1+B1       RESET B2 
          ZR     X7,BNSRCH
          SX1    B5-54
          NZ     X1,BOCLOOP  RETURN TO LOOP IF MULTIPLE CHAR SEARCH 
          EQ     BSINGLP     OTHERWISE GOTO SINGLE LOOP 
* 
* 
**********************************************************
************ SINGLE CHARACTER SEARCH *********************
**********************************************************
* 
 BSINGLE  SA2    A2-B1       X2 = PREVIOUS WORD BEING CHECKED 
          BX1    X2-X4       MAKE 6 1-S EVERYWHERE THE CHARACTER WAS
          LX3    X1,B1       SHIFT A COPY 1 BIT 
          BX1    X1*X3       COMBINE EVEN AND ODD BITS
          LX3    X1,B2       SHIFT A COPY OF COMBO 2 BITS 
          BX3    X1*X3       COMBINE AGAIN
          LX1    X3,B2       SHIFT THIS COMBO 2 BITS
          BX7    X1*X3       COMBINE ONCE AGAIN 
          BX7    X6*X7       CLEAR THE JUNK WITH SPIKES 
* 
*         NOW HAVE A 1 IN TOP BIT OF ANY CHAR POSITION WHICH
*         MATCHED FIRST CHARACTER OF STRING 
* 
          ZR     X7,BSINGLE  LOOP IF NO MATCHES 
          SB3    10          PRESET CHAR POSITION COUNT 
 BSINGLP  SB3    B3-B1       DECREMENT CHAR POSITION COUNT
          LX7    -6          SHIFT FLAG REGISTER
          PL     X7,BSINGLP  LOOP IF NO SIGN BIT NOT ON 
          MX1    1
          BX7    -X1*X7      GET RID OF SIGN BIT (FOR LOOP END TEST)
          EQ     BFOUND      SEEK AND STORE RESULT
* 
* 
* /---   BLOCK      FINISH/TIM 00 000   80/04/22  01.21 
* 
* NOT FOUND 
* 
 NOTFND   SB6    B6-B1       DECREMENT COUNTER
          NG     B6,CNTCALC  IF COUNT ONLY WAS CALCULATED 
          STORE 
          SA1    A1          RESTORE FLAG WORD
          LX1    1
          NG     X1,EXIT
 CNTCALC  SB6    B6+B1       SET COUNT BACK AGAIN 
          SA1    A1          RESTORE  FLAG WORD 
          AX1    36          X2 = INITIAL RESULT ADDRESS
* 
          SB2    X1 
          SB3    A4-B6
          SX6    B3-B2
* 
          PL     X1,STORCNT  IF NOT FLOATING, STORE AS INT
          PX6    X6 
          NX6    X6          PACK AND NORMALIZE 
 STORCNT  SA6    X1          STORE COUNT
* 
* CLEAN UP AND EXIT 
* 
 EXIT     SA2    A7 
          IX2    X2-X0
          NZ     X2,NOREST
          SA1    SAVWORD
          BX6    X1 
          SA6    A7 
 NOREST   SA1    SAVEB5      AND B REGISTERS
          SA2    SAVEB7 
          SB5    X1 
          SB7    X2 
          EQ     PROCESX     -- AND EXIT
* 
* COME HERE AFTER HITTING THE PLANTED OBJECT TO SEE 
* IF TIME SLICE IS OVER AND SEARCH SHOULD BE INTERRUPTED
* 
 TIMETST  SA1    A7          FETCH WORD USED FOR END TEST 
          BX1    X0-X1       COMPARE WITH OBJECT
          NZ     X1,NOREST2  DONT RESTORE IF NOT EQUAL
          SA1    SAVWORD
          BX6    X1 
          SA6    A7          RESTORE WORD DESTROYED BY END TEST 
* 
 NOREST2  SA1    XSLCLOK     GET RUNNING CPU CLOCK
          SA2    MAXCLOK     GET END OF TIME-SLICE
          IX2    X1-X2
          SA1    TSRCEND     GET DIRECTION INDICATION 
          PL     X2,AUTOBRK  INTERRUPT IF TOO MUCH TIME 
          PL     X1,NLOOP    CONTINUE FORWARD SEARCH
          EQ     BNLOOP      ... OR BACKWARD SEARCH 
* /---   BLOCK      INTERRUPT  00 000   78/05/17  20.51 
* 
* PACK UP ALL VITAL REGISTERS TO SAVE DURING INTERRUPT
* 
 AUTOBRK  SX6    B6          NEED TO SAVE STORE INDEX 
          SA6    TSRCINX     SO DO IT 
* 
* RESTORE B REGISTERS 
* 
          SA1    SAVEB5 
          SA2    SAVEB7 
          SB5    X1 
          SB7    X2 
* 
* 
* PERFORM INTERRUPT 
* 
          RETURN             DO THE INTERRUPT 
* 
* OUT OF LINE ROUTINES, LITERALS AND STORAGE LOCATIONS
* 
 SPIKES   VFD    60/40404040404040404040B 
 SRCHSAV  BSS    1           STORES FIRST ARGUMENT WORD 
 SRCHSV2  BSS    1           STORES SECOND ARGUMENT WORD
 SRCHLEN  BSS    1           LENGTH OF SEARCH IN CHARS
 SRCHOBL  BSS    1           LENGTH OF SEARCH OBJECT
 SAVEB5   BSS    1           SAVES B5 
 SAVEB7   BSS    1           SAVES B7 
 SAVWORD  BSS    1           CONTAINS WORD USED FOR END TEST
 SRCHADR  BSS    1           RESULT BUFFER ADDRESS
* 
* EXEC ERROR FOR OFFSET TOO LARGE 
* 
 SERX     SX2    B3+1        SET UP FOR EXEC ERROR ROUTINE
          EXECERR 101 
* 
* EXIT IF NO SEARCH 
* 
 NOSRCH   MX6    -1 
          SA1    TSRCMXM     GET WORD CONTAINING RESULT ADDR
          BX2    X1 
          LX2    1           GET MULTIPLE SEARCH BIT TO TOP 
          AX1    36          BRING ADDRESS DOWN 
          PL     X1,NOSRCH2  BRANCH IF STORING INTEGERS 
          PX6    X6 
          NX6    X6          FLOAT THE -1 
 NOSRCH2  NG     X2,NOSRCH3  BRANCH IF SINGLE SEARCH
          MX7    0
          SA7    X1          SET COUNTER TO 0 
          SX1    A7+1        UPDATE STORAGE ADDRESS 
          SA2    TSRCINX     CHECK IF COUNT ONLY DESIRED
          ZR     X2,PROCESX  EXIT IF SO 
 NOSRCH3  SA6    X1          STORE -1 FOR NOT FOUND 
          EQ      PROCESX    AND EXIT 
* 
* 
          ENDOV 
* /---   BLOCK      ABORT      00 000   80/07/16  01.35 
          TITLE  -ABORT- COMMAND
* 
*         -ABORT- COMMAND 
*         ABORT VARIOUS SYSTEM FUNCTIONS
* 
* 
 ABORTOV  OVRLAY
          PL     X5,ABORTR   SEE IF ABORT COMMON
* 
* 
*         ABORT RETURN OF COMMON TO DISK
* 
          SA1    TBCOMLS     GET COMMON LESSON NUMBER 
          SX0    X1 
          ZR     X0,ABRTER1  EXIT IF NO COMMON
          LX1    1
          NG     X1,ERXROLC  EXIT IF READ-ONLY COMMON 
          SX1    X0          GET *LESNUM* 
          CALL   LSNADDR
          SX1    1
          IX0    X0+X1       ADVANCE TO LESSON NAME WORD
          SA1    CABORT      GET *ABORT* CODE WORD
          WX1    X0         (-WXX- 1 WD WRITE, MAY CHG *A6*)
* 
* /---   BLOCK      ABORT      00 000   79/04/07  01.15 
 ABORTR   LX5    1           SEE IF ABORT RECORD
          PL     X5,ABORTN
          MX6    6           MASK TO CHECK TOP CHARACTER
          SA1    TTYPE       USER TYPE
          SA2    TYPETAB+UT.STUD
          BX2    X2-X1
          BX2    X2*X6       CHECK ONLY FIRST CHARACTER 
          NZ     X2,ABORTN   --- IGNORE IF NOT STUDENT
          SA2    KABORT      X2 = 6LSABORT
          BX6    X2 
          SA6    A1          SET RECORDS TO -SABORT-
          EQ     ABORTN1     NOW SET CHECKPOINT OFF FLAG
* 
*            'NOW USER PART OF RECORDS WILL NOT BE UPDATED
*         ON DISK, BUT LAST DATE, CPU USE, ETC. WILL. 
* 
 ABORTN   LX5    1           SEE IF ABORT AUTO-CHECK-POINT
          PL     X5,ABORTL
          SA1    TTYPE       USER TYPE
          SA2    TYPETAB+UT.STUD
          BX2    X2-X1
          NZ     X2,ABORTL   --- IGNORE IF NOT STUDENT
          SA2    KNOCKPT     X2 = 7LSNOCKPT 
          BX6    X2 
          SA6    A1          SET RECORDS TO -SNOCKPT- 
* 
 ABORTN1  SA1    TRECBIT     GET WORD HOLDING CHECKPT FLAG
          MX6    1
          LX6    60-CCHKSHF  POSITION CHECKPOINT BIT
          BX6    -X6*X1      CLEAR BIT (TURN CHECKPOINT OFF)
          MX1    1
          LX1    60-DCHKSHF  POSITION BIT FOR DEFAULT 
          BX6    -X1*X6      CLEAR CHECKPT DEFAULT
          SA6    A1 
          CALL   CHKSET      SET OVERALL CHECKPT STATUS 
* 
 ABORTL   LX5    1           SEE IF ABORT LESLIST 
          PL     X5,ABORTZ
          SA1    TBLLIST     GET LESLIST LESSON NUMBER
          SX0    X1 
          ZR     X0,ABRTER3  EXIT IF NO LESLIST 
          SX1    X0          GET *LESNUM* 
          CALL   LSNADDR
          SX1    1
          IX0    X0+X1       ADVANCE TO LESSON NAME WORD
          SA1    CABORT      GET *ABORT* CODE WORD
          WX1    X0         (-WXX- 1 WD WRITE, MAY CHG *A6*)
* 
 ABORTZ   EQ     PROC 
* 
* 
 ABRTER1  EXECERR 53         *NO COMMON*
* 
 ABRTER3  EXECERR 55         *NO LESLIST* 
* 
* 
 CABORT   VFD    60/9L**ABORT** 
* 
* 
          ENDOV 
* /---   BLOCK      CHECKPT    00 000   80/03/11  03.01 
          TITLE  -CHECKPT- COMMAND
* 
* 
*         -CHECKPT- COMMAND 
*         TURN STUDENT RECORD CHECKPOINTING ON OR OFF 
* 
*         AFTER EXECUTION OF -CHECKPT- COMMAND, 
* 
*                ZRETURN = -1 = IT WORKED 
*                        =  0 = WRONG USER TYPE 
* 
* 
 CKPTOV   OVRLAY
          SX6    0
          SA6    TRETURN     PRESET *ZRETURN* FOR FAILURE 
          SA1    TTYPE       GET USER TYPE
          SA2    TYPETAB+UT.STUD
          BX2    X1-X2
          ZR     X2,CKPT0    --- OK IF STUDENT
          SA2    TYPETAB+UT.INST
          BX2    X1-X2
          NZ     X2,PROC     --- IGNORE IF NOT INSTRUCTOR 
 CKPT0    NGETVAR 
          MX6    1
          LX6    60-CCHKSHF  POSITION CHECKPOINT BIT
          SA2    TRECBIT     WORD HOLDING CHECKPOINT FLAG 
          NZ     X1,CKPTON   --- JUMP IF -CHECKPT ON- 
* 
          BX6    -X6*X2      CLEAR BIT (CHECKPOINT OFF) 
          EQ     CKPT1
* 
 CKPTON   BX6    X6+X2       SET BIT (CHECKPOINT ON)
* 
 CKPT1    CALL   INROUTE
          PL     X1,CKPT2    IF NOT EXECUTING ROUTER
          BX1    X6 
          LX1    CCHKSHF     SHIFT CURRENT STATUS TO SIGN 
          MX0    1
          BX1    X0*X1       X1 = CURRENT CHECKPT STATUS
          LX0    60-DCHKSHF  SHIFT BIT TO DEFAULT STATUS
          BX6    -X0*X6      CLEAR DEFAULT STATUS 
          LX1    60-DCHKSHF  SHIFT CURRENT STATUS TO DEFAULT
          BX6    X1+X6       RESET DEFAULT STATUS 
 CKPT2    SA6    A2          UPDATE *TRECBIT* 
          CALL   CHKSET      SET OVERALL CHECKPT STATUS 
          SX6    -1 
          SA6    TRETURN     SET *ZRETURN* TO ALL OK
          EQ     PROC 
* 
          ENDOV 
* /---   BLOCK      STOLOAD    00 000   76/08/17  16.40 
          TITLE  -STOLOAD- COMMAND
* 
* 
*         -STOLOAD- COMMAND 
*         SETS AUTOMATIC LOADING OF -STORAGE- 
* 
* 
 STOLOV   OVRLAY
          SA1    OVARG1 
          NZ     X1,COMLOD   JUMP IF -COMLOAD- COMMAND
* 
          SA1    TBXSTOR     SEE IF ANY -STORAGE- 
          ZR     X1,SCLONO
          CALL   READLES,LHEADER,1
          SX6    2
          IX6    X0+X6       BIAS TO STORAGE
          SA6    LLECSAD
          SA1    INHIBS 
          MX6    1           CLEAR -UNLOAD- BIT 
          LX6    60-UNLOSHF 
          BX6    -X6*X1 
          SA6    A1 
          LX1    UNLOSHF     SEE IF INHIBIT -UNLOAD-
          NG     X1,STOLO1
          SA1    TSTOSET
          ZR     X1,STOLO1   JUMP IF NO STORAGE AUTO-LOAD 
          SA2    TBXSTOR     STORAGE LESSON NUMBER
          SX3    2           BIAS FOR STORAGE HEADER
          CALL   LESSADD
          RJ     ULOADER     DO FIRST UNLOAD
          SA1    TSTOSET+1
          ZR     X1,STOLO1
          RJ     ULOADER     DO SECOND UNLOAD 
          SA1    TSTOSET+2
          ZR     X1,STOLO1
          RJ     ULOADER     DO THIRD UNLOAD
* 
 STOLO1   MX6    0
          SA6    TSTOSET     CLEAR CURRENT SELECTIONS 
          SA6    TSTOSET+1
          SA6    TSTOSET+2
          SX6    TSTOSET
          SA6    LBUFF
          CALL   LOADSET
          MX6    1
          SA1    INHIBS      CLEAR -INHIBIT LOAD- BIT 
          LX6    60-LOADSHF 
          BX6    -X6*X1 
          SA6    A1 
          EQ     PROCESS
* 
* 
* /---   BLOCK      COMLOAD    00 000   77/07/21  20.50 
          TITLE  -COMLOAD- COMMAND
* 
* 
*         -COMLOAD- COMMAND 
*         SETS AUTOMATIC LOADING OF -COMMON-
* 
* 
 COMLOD   SA1    TBCOMLS     SEE IF ANY -COMMON-
          SX1    X1 
          ZR     X1,SCLONO
          CALL   READLES,LHEADER,1
          SX6    COMHEAD
          IX6    X0+X6       BIAS TO COMMON 
          SA6    LLECSAD
          SA1    INHIBS 
          MX6    1           CLEAR -UNLOAD- BIT 
          LX6    60-UNLOSHF 
          BX6    -X6*X1 
          SA6    A1 
          LX1    UNLOSHF     SEE IF INHIBIT -UNLOAD-
          NG     X1,COMLO1
          SA1    TCOMSET
          ZR     X1,COMLO1   JUMP IF NO COMMON AUTO-LOAD
          SA3    TBCOMLS
          SX2    X3          PICK OFF LESSON NUMBER 
          LX3    1
          NG     X3,COMLO1   JUMP IF READ-ONLY COMMON 
          SX3    COMHEAD
          CALL   LESSADD     GET ADDRESS OF COMMON LESSON 
          RJ     ULOADER     DO FIRST UNLOAD
          SA1    TCOMSET+1
          ZR     X1,COMLO1
          RJ     ULOADER     DO SECOND UNLOAD 
          SA1    TCOMSET+2
          ZR     X1,COMLO1
          RJ     ULOADER     DO THIRD UNLOAD
* 
 COMLO1   MX6    0
          SA6    TCOMSET     CLEAR CURRENT SELECTIONS 
          SA6    TCOMSET+1
          SA6    TCOMSET+2
          SX6    TCOMSET
          SA6    LBUFF
          CALL   LOADSET
          MX6    1
          SA1    INHIBS      CLEAR -INHIBIT LOAD- BIT 
          LX6    60-LOADSHF 
          BX6    -X6*X1 
          SA6    A1 
          EQ     PROCESS
* 
* 
 
 SCLONO   MX0    XCODEL      COMES HERE IF NO COMMON/STORAGE
          BX6    X0*X5       MASK OFF NUMBER OF ARGUMENTS 
          ZR     X6,PROCESS  OKAY IF BLANK TAG
          EQ     ERXNOCS
* 
* /---   BLOCK      LOADSET    00 000   79/02/09  13.56 
* 
          TITLE  -LOADSET-
* 
* 
*         -LOADSET- 
*         EXECUTION OF -STOLOAD- AND -COMLOAD- COMMANDS 
* 
* 
 LOADSET  EQ     *
          MX0    XCODEL 
          BX6    X0*X5       MASK OFF NUMBER OF ARGUMENTS 
          ZR     X6,LOADSET 
          LX6    XCODEL 
          SA6    NLOADS 
          MX0    -12
          AX5    XCMNDL 
          BX6    -X0*X5      MASK OFF XSTOR ADDRESS 
          SX6    X6+B5
          SA6    GVADD       SAVE ABSOLUTE ADDRESS
* 
 LOLOOP   SA1    GVADD
          SA1    X1          LOAD WORD OF -GETVAR- CODES
          BX5    X1 
          NGETVAR 
          SX6    A1          SAVE CM ADDRESS FOR LOADING
          SA6    VBUFF
          SX1    NCVRBUF
          IX6    X6-X1       CANNOT LOAD INTO STUDENT BANK
          NG     X6,LDERR1   OR ROUTER VARIABLES
          SA1    GVADD
          SA1    X1 
          LX1    XCODEL      POSITION NEXT -GETVAR- CODE
          BX5    X1 
          NGETVAR            GET ECS ADDRESS FOR LOADING
          SX6    X1-1        EXECERR USES X1
          NG     X6,ERXINDL  INDEX ERROR ON LOWER BOUND 
          SA6    VBUFF+1
          SA1    GVADD
          SX7    X1+1        ADVANCE POINTER
          SA7    A1 
          SA1    X1          LOAD WORD OF -GETVAR- CODES
          LX1    2*XCODEL 
          BX5    X1 
          NGETVAR            GET LENGTH TO LOAD/UNLOAD
          ZR     X1,LDSKIP   IF LENGTH 0, IGNORE
          NG     X1,ERXBADL  EXECERR USES X1
* 
          SA2    VBUFF       LOAD CM ADDRESS FOR LOADING
          SA0    X2 
          CALL   BOUNDS      CM BOUNDS CHECK
          SX6    X1 
          SA1    LHEADER
          SX1    X1          LENGTH OF -STORAGE-
          SA2    VBUFF+1     STARTING ECS ADDRESS OF LOAD 
          IX0    X2+X6
          IX0    X1-X0       DO ECS BOUNDS CHECK
          NG     X0,ERXECSB1 EXCEEDING BOUNDS 
* /---   BLOCK      LOADSET    00 000   77/08/07  21.26 
* 
          BX0    X2 
          LX2    18          POSITION ECS ADDRESS 
          SB1    X6 
          LX6    18+18       POSITION LENGTH
          BX6    X2+X6
          SA1    VBUFF
          SA0    X1 
          BX6    X1+X6       ATTACH CM ADDRESS
          SA1    INHIBS 
          LX1    LOADSHF     SEE IF -INHIBIT- LOAD
          NG     X1,LOLP1 
          SA1    LLECSAD
          IX0    X0+X1       COMPUTE ECS ADDRESS
+         RE     B1          DO THE LOAD
          RJ     ECSPRTY
* 
 LOLP1    SA1    NLOADS 
          SX7    X1-1        NUMBER OF SETS TO DO 
          SA7    A1 
          SA1    LBUFF       *TSTOSET* / *TCOMSET* POINTER
          SA6    X1 
          SX6    X1+1 
          SA6    A1          UPDATE POINTER 
          NG     X7,LOADSET 
          ZR     X7,LOADSET 
          EQ     LOLOOP 
* 
 LDSKIP   SA1    NLOADS      IF LENGTH=0, SKIP IT 
          SX7    X1-1 
          SA7    A1          RESET NLOADS 
          SB1    X7 
          LE     B1,LOADSET 
          EQ     LOLOOP 
* 
* 
 LDERR1   EXECERR 67         *NOT NC OR VC VARIABLES* 
* 
 ERXECSB1 BX3    X1          LTH OF ECS COM/STO 
          BX1    X2          START ADDRESS
          SX1    X1+1 
          BX2    X6          TOTAL LTH REQUESTED
          EQ     ERXECSB
* 
* /---   BLOCK      LOADSET    00 000   80/02/22  23.37 
 LOADER   EQ     *
          SA0    X1          PICK OFF CM ADDRESS
          AX1    18 
          SX2    X1          PICK OFF ECS BIAS
          AX1    18 
          SB1    X1          PICK OFF LENGTH TO LOAD
          IX0    X2+X7
+         RE     B1 
          RJ     ECSPRTY
          EQ     LOADER 
* 
* 
 ULOADER  EQ     *
          SA0    X1          PICK OFF CM ADDRESS
          AX1    18 
          SX2    X1          PICK OFF ECS BIAS
          AX1    18 
          SB1    X1          PICK OFF LENGTH TO UNLOAD
          IX0    X2+X7
+         WE     B1 
          RJ     ECSPRTY
          EQ     ULOADER
* 
 LBUFF    EQU    VARBUF 
 LLECSAD  EQU    LBUFF+1
 LHEADER  EQU    LLECSAD+1
 NLOADS   EQU    LHEADER+1
 GVADD    EQU    NLOADS+1 
 VBUFF    EQU    GVADD+1
* 
* 
          ENDOV 
* /---   BLOCK      TRANSFER   00 000   78/05/17  20.51 
          TITLE  TIMING COMMANDS
* 
* 
 TIMOV    OVRLAY
* 
* *       ENSURE THAT THERE IS ENOUGH SPACE IN THE ACTION 
* *       REQUEST BUFFER--AS OUTPUT OVERFLOW IS FATAL 
* 
          EXT    RETRNZ 
 
          SA1    AOUTLOC     CHECK WHETHER THERE IS 
          SX1    X1-AOUTLTH+8  ROOM FOR TWO TIMING REQUESTS 
          PL     X1,RETRNZ   RE-START THIS COMMAND NEXT TIME
* 
* *       IT SHOULD NO LONGER BE POSSIBLE TO GET AN OUTPUT
* *       BUFFER OVERFLOW FROM -TIME- COMMANDS.  A NUMBER OF
* *       USERS LOOPING ON -TIME- COMMANDS CAN INTEFERE WITH
* *       THE ORDERLY PROCESSING OF ACTION BUFFER REQUESTS
* *       BY FILLING UP THE BUFFER (THERE WILL BE 4 WORDS LEFT) 
* *              CORRECTION BY B. RADER /DMA  3/2/77
* 
 
          SA1    OVARG1 
          SB1    X1 
          JP     B1+*+1 
* 
+         EQ     TIMEX
+         EQ     TIMELX 
+         EQ     TIMERX 
* 
* 
* /---   BLOCK      TIME       00 000   81/06/24  21.45 
* 
*         -TIME-
*         INITIATES TIMING FOR SPECIFIED NUMBER OF SECONDS. 
* 
 TIMEX    NG     X5,TIMEOFF  TURN OFF TIMING IN BLANK TAG 
          FGETVAR            GET TIMING VALUE 
          NG     X1,TIMEOFF  TURN OFF TIMING IF NEGATIVE TAG
          SA2    TK1000      CONVERT TO MILLISECONDS
          FX7    X1*X2
          UX7    X7,B1       CONVERT TO INTEGER 
          LX7    X7,B1
          SX2    750         CONVERT SHORTER THAN 3/4 SEC.
          IX2    X7-X2       TO 3/4 SECONDS 
+         PL     X2,*+1 
          SX7    750
+         SA3    AOUTLOC     THEN PUT IN TIMING REQUEST 
          SX6    X3+4        TAKES FOUR WORDS 
          SX2    X3-AOUTLTH  OVERFLOW CHECK 
          PL     X2,ERROROF 
          SA6    A3          UPDATE NUMBER OF OUTPUT WORDS
          SX6    RQTIMNG     PUT IN TIMING REQUEST CODE 
          SA6    X3+ACTOUT
          SA7    A6+1        PUT IN TIME
          SX6    TK.TUP      KEY = PTIMEUP
          SA6    A7+1        PUT IN KEY 
          SX6    TRT.TIM     -TIME- COMMAND REQUEST 
          SA6    A6+1        PUT IN REQUEST TYPE
* 
          SA2    TIMING      TURN ON TIMING FLAG
          MX6    1
          BX2    X2+X6
          LX6    TMEDONE-59  CLEAR -TIME- UNPROCESSED FLAG
          BX6    -X6*X2 
          SA6    A2 
          EQ     PROCESS
* 
 TIMEOFF  SA2    TIMING      SEE IF TIMING IN PROGRESS
          PL     X2,PROCESS  EXIT IF NOT
          MX6    1           TURN OFF TIMING FLAG 
          BX2    -X6*X2 
          LX6    TMEDONE-59  CLEAR -TIME- UNPROCESSED BIT 
          BX6    -X6*X2 
          SA6    A2 
* 
          SA3    AOUTLOC     PUT IN CLEAR TIMING REQUEST
          SX6    X3+2        TAKES TWO WORDS
          SX2    X3-AOUTLTH  OVERFLOW CHECK 
          PL     X2,ERROROF 
          SA6    A3          UPDATE NUMBER OF OUTPUT WORDS
          SX6    RQTIMCL
          SA6    X3+ACTOUT
          SX6    TRT.TIM     CLEAR -TIME- REQUEST 
          SA6    A6+1 
          EQ     PROCESS
* /---   BLOCK      TIMEL      00 000   81/06/24  21.46 
          TITLE  -TIMEL-
* 
*         -TIMEL- COMMAND 
* 
*         SPECIFIES UNIT OF LESSON TO GO TO AFTER 
*         SPECIFIED NUMBER OF SECONDS.
* 
* 
 TIMELX   NG     X5,TMLOFF   TURN OFF TIMEL'/ 
          MX0    -XCODEL
          LX5    XCODEL      POSITION UNIT NUMBER 
          BX6    -X0*X5 
          SA6    ILOC        SAVE UNIT NUMBER 
* 
          FGETVAR            GET NUMBER OF SECONDS
          NG     X1,TMLOFF   TURN OFF IF NEGATIVE 
          SA2    TK1000      CHANGE SECONDS TO MILLISECONDS 
          FX1    X2*X1
          UX1    X1,B1       UNPACK TO INTEGER
          LX6    X1,B1
          SX2    750         3/4 SECOND 
          IX1    X6-X2       CONVERT TIMES LESS THAN .75 SEC
+         PL     X1,*+1 
          SX6    750            TO .75 SECONDS
+         SA6    ILOC+1      SAVE TIME AMOUNT 
* 
          SA1    ILOC 
          CALL   UEXIST      CHECK IF UNIT EXISTS 
          ZR     X6,TMLOFF   IF DONT, TURN TIMEL OFF
          SA2    TIMING      IF EXISTS, SAVE UNIT NUMBER
          MX6    -12         TURN OFF OLD UNIT NUMBER 
          BX2    X2*X6
          BX2    X2+X1       .OR. IN NEW UNIT NUMBER
          MX6    1           CLEAR -TIMEL- UNPROCESSED BIT
          LX6    TMLDONE-59 
          BX6    -X6*X2 
          SA6    A2 
* 
* SET UP TIMING REQUEST FOR  [ILOC+1] MILLISECONDS, 
          SA3    AOUTLOC
          SX6    X3+4        TAKES FOUR WORDS 
          SX2    X3-AOUTLTH  OVERFLOW CHECK 
          PL     X2,ERROROF 
          SA6    A3          UPDATE NUMBER OF OUTPUT WORDS
          SX6    RQTIMNG     PUT IN TIMING REQUEST CODE 
          SA6    X3+ACTOUT
          SA1    ILOC+1      GET TIME AMOUNT
          BX6    X1 
          SA6    A6+1        PUT IN TIME
          SX6    TK.LUP      KEY = PLONGUP
          SA6    A6+1        PUT IN KEY 
          SX6    TRT.TML     -TIMEL- COMMAND REQUEST
          SA6    A6+1 
          EQ     PROCESS
* 
* 
 TMLOFF   SA3    AOUTLOC     PUT IN CLEAR TIMING REQUEST
          SX6    X3+2        TAKES TWO WORDS
          SX2    X3-AOUTLTH  OVERFLOW CHECK 
          PL     X2,ERROROF 
          SA6    A3          UPDATE NUMBER OF OUTPUT WORDS
          SX6    RQTIMCL
          SA6    X3+ACTOUT
          SX6    TRT.TML     CLEAR -TIMEL- REQUEST
          SA6    A6+1 
* 
* CLEAR -TIMEL- UNIT NUMBER FROM *TIMING* 
          SA2    TIMING 
          MX6    -12         BOTTOM 12 BITS 
          BX2    X6*X2
          MX6    1           CLEAR -TIMEL- UNPROCESSED FLAG 
          LX6    TMLDONE-59 
          BX6    -X6*X2 
          SA6    A2 
          EQ     PROCESS
* /---   BLOCK      TIMER      00 000   81/06/24  21.47 
          TITLE  -TIMER-
* 
*         -TIMER- COMMAND 
* 
*         SPECIFIES UNIT OF ROUTER TO BRANCH TO AFTER 
*         SPECIFIED NUMBER OF SECONDS.
* 
* 
 TIMERX   CALL   INROUTE
          PL     X1,PROC     IF NOT IN ROUTER LESSON
          NG     X5,TMROFF   TURN OFF TIMER'/ 
          MX0    -XCODEL
          LX5    XCODEL      POSITION UNIT NUMBER 
          BX6    -X0*X5 
          SA6    ILOC        SAVE UNIT NUMBER 
* 
          FGETVAR            GET NUMBER OF SECONDS
          NG     X1,TMROFF   TURN OFF IF NEGATIVE 
          SA2    TK1000      CHANGE SECONDS TO MILLISECONDS 
          FX1    X2*X1
          UX1    X1,B1       UNPACK TO INTEGER
          LX6    X1,B1
          SA2    TK1MIN      1 MINUTES (IN MILLISECONDS)
          IX1    X6-X2       CONVERT TIMES LESS THAN 1 MIN
+         PL     X1,*+1 
          BX6    X2             TO 1 MIN
+         SA6    ILOC+1      SAVE TIME AMOUNT 
* 
          SA1    ILOC 
          CALL   UEXIST      CHECK IF UNIT EXISTS 
          ZR     X6,TMROFF   IF DONT, TURN TIMER OFF
          SA2    TIMING      IF EXISTS, SAVE UNIT NUMBER
          MX6    -12         TURN OFF OLD UNIT NUMBER 
          LX1    12          -TIMER- UNIT NEXT TO BOTTOM 12 
          LX6    12          MOVE MASK UP TOO 
          BX2    X2*X6
          BX2    X2+X1       .OR. IN NEW UNIT NUMBER
          MX6    1           CLEAR -TIMER- UNPROCESSED FLAG 
          LX6    TMRDONE-59 
          BX6    -X6*X2 
          SA6    A2 
* 
* SET UP TIMING REQUEST FOR  [ILOC+1] MILLISECONDS, 
          SA3    AOUTLOC
          SX6    X3+4        TAKES FOUR WORDS 
          SX2    X3-AOUTLTH  OVERFLOW CHECK 
          PL     X2,ERROROF 
          SA6    A3          UPDATE NUMBER OF OUTPUT WORDS
          SX6    RQTIMNG     PUT IN TIMING REQUEST CODE 
          SA6    X3+ACTOUT
          SA1    ILOC+1      GET TIME AMOUNT
          BX6    X1 
          SA6    A6+1        PUT IN TIME
          SX6    TK.RUP      KEY = PROUTUP
          SA6    A6+1        PUT IN KEY 
          SX6    TRT.TMR     -TIMER- COMMAND REQUEST
          SA6    A6+1 
          EQ     PROCESS
* 
* /---   BLOCK      TIMERX     00 000   81/06/24  21.47 
* 
 TMROFF   SA3    AOUTLOC     PUT IN CLEAR TIMING REQUEST
          SX6    X3+2        TAKES TWO WORDS
          SX2    X3-AOUTLTH  OVERFLOW CHECK 
          PL     X2,ERROROF 
          SA6    A3          UPDATE NUMBER OF OUTPUT WORDS
          SX6    RQTIMCL
          SA6    X3+ACTOUT
          SX6    TRT.TMR     CLEAR -TIMER- REQUEST
          SA6    A6+1 
* 
* CLEAR -TIMER- UNIT NUMBER FROM *TIMING* 
          SA2    TIMING 
          MX6    -12         NEXT TO BOTTOM 12 BITS 
          LX6    12 
          BX2    X6*X2
          MX6    1           CLEAR -TIMER- UNPROCESSED FLAG 
          LX6    TMRDONE-59 
          BX6    -X6*X2 
          SA6    A2 
          EQ     PROCESS
* 
 TK1000   DATA   1000.0 
 TK1MIN   DATA   60000       EQUALS 1 MINUTE (IN MSEC)
* 
* 
          ENDOV 
* /---   BLOCK      READECS    00 000   78/07/05  01.23 
          TITLE  -READECS/WRITECS-
* 
* 
*         -READECS/WRITECS- COMMANDS
* 
*         READS OR WRITES ECS RELATIVE TO PLATO 
* 
*         ON ENTRY, 
* 
*         OVARG1 = 0   FOR -READECS-
*                  1   FOR -WRITECS-
* 
 READECS  OVRLAY
          NGETVAR            A1 = VARIABLE STORAGE ADDRESS
          SX6    A1 
          SA6    RVADDR      SAVE STARTING VARIABLE ADDRESS 
          SA5    A5          RETRIEVE ORIGINAL COMMAND WORD 
          LX5    XCODEL 
          NGETVAR            X1 = ECS ADDRESS 
          BX6    X1 
          SA6    RABSA       SAVE ABSOLUTE ADDRESS
          SA5    A5          RETRIEVE ORIGINAL COMMAND WORD 
          MX0    2*XCODEL 
          BX5    -X0*X5 
          AX5    XCMNDL 
          SA1    B5+X5       GET ADDITIONAL INFO WORD 
          BX5    X1          MOVE TO REQUIRED X5
          NGETVAR            X1 = TRANSFER LENGTH 
          ZR     X1,PROCESS  IGNORE ZERO LENGTH 
          SA2    RVADDR 
          SA0    X2          A0 = STARTING ADDRESS
          CALL   BOUNDS      CHECK WITHIN BOUNDS
          SA4    RABSA       GET ECS ADDRESS
          NG     X4,RERXVAL 
          MX0    -24
          BX0    X0*X4       CHECK FOR REASONABLE ECS ADDR
          NZ     X0,RERXVAL 
          IX5    X1+X4       (X5) = LWA+1 OF ECS TRANSFER 
          SX3    1
          IX5    X5-X3       (X5) = LWA OF ECS TRANSFER 
          SA3    NLENGTH     (X3) = ECS LWA OF PLATO
          IX3    X3-X5       SEE IF BEYOND TUTOR ECS
          NG     X3,RERXVAL 
          BX0    X4 
          SB1    X1          PICK UP LENGTH TO READ 
          SA1    OVARG1 
          NZ     X1,WRTECS   JUMP IF -WRITECS-
+         RE     B1 
          RJ     ECSPRTY
          EQ     PROCESS
* 
 RERXVAL  BX1    X4 
          EQ     ERXVAL 
* 
 WRTECS   WE     B1 
          RJ     ECSPRTY
          EQ     PROCESS
* 
 RVADDR   BSS    1           ADDRESS OF STARTING VARIABLE 
 RABSA    BSS    1           ECS ADDRESS
* 
* 
          ENDOV 
* /---   BLOCK      SBREAD     00 000   77/11/11  05.43 
          TITLE  -SBREAD/SBWRITE- 
* 
*         -SBREAD-  (CODE=148)
*         -SBWRITE-  (CODE=149) 
* 
*   -SBREAD- READS SPECIFIED WORDS FROM STUDENT BANK
*   -SBWRITE- WRITES SPECIFIED WORDS TO STUDENT BANK
* 
*     BOTH COMMANDS HAVE FOLLOWING FORMAT'; 
* 
*         FOUR ARGUMENTS';
*            ARG1 = STATION WHOSE BANK IS TO BE READ (WRITTEN)
*            ARG2 = OFFSET INTO STUDENT BANK
*            ARG3 = STARTING VAR TO READ INTO (WRITE FROM)
*            ARG4 = NUMBER OF WORDS TO READ (WRITE) 
* 
*         RETURNS SYSTEM VARIABLE ERROR = 
*               -1  IF SUCCESSFUL READ/WRITE
*                0  IF NO SUCH STUDENT BANK 
* 
*         ON ENTRY, 
* 
*         OVARG1 = 0   FOR -SBREAD- 
*                  1   FOR -SBWRITE-
* 
 SBREAD   OVRLAY
          MX7    2*XCODEL 
          MX6    0
          SA6    SOWNFLG     MARK NOT OWN STATION 
* 
*  GET AND STORE EXTRA STORAGE WORD 
          BX1    -X7*X5      MASK OUT VARIABLE CODES
          AX1    XCMNDL      SHIFT OFF COMMAND CODE 
          SA1    B5+X1       X1 = EXTRA STORAGE WORD
          BX6    X1 
          SA6    SAVE1       STORE EXTRA STORAGE WORD 
* /---   BLOCK      SBREAD     00 000   81/03/10  01.42 
* 
*  PROCESS ARG1 
          NGETVAR            X1 = STATION 
* 
*         CHECK FOR STATION OUT OF RANGE
*         NEED TO LEAVE ORIGINAL ARGUMENT IN X1 AS
*         EXECERR STUFF EXPECTS IT TO BE THERE
          MX0    42 
          BX2    X0*X1       CATCH NEGATIVES AND > 18 BITS
          NZ     X2,ERXSTN   --- STATION OUT OF RANGE 
          BX2    -X0*X1      USE ONLY 18 BITS 
          SX3    NUMSTAT     TOTAL STATIONS DEFINED 
          IX3    X2-X3
          PL     X3,ERXSTN   --- STATION OUT OF RANGE 
*         CHECK FOR OWN STATION 
          SA3    STATION
          IX3    X2-X3
          NZ     X3,SBRX10   JUMP IF NOT OWN STATION
          MX6    -1 
          SA6    SOWNFLG     MARK OWN STATION 
          EQ     SBRX15 
* 
 SBRX10   SX0    BANKADD-STSTART
          SA1    NSYSBNK     ADDRESS OF STATION BANKS 
          IX0    X0+X1
          SA1    NSYSLTH     LENGTH OF STATION BANKS
          IX1    X1*X2       X1 = OFFSET INTO STATION BANKS 
          IX0    X0+X1       X0 = ADDRESS OF STATION BANK 
          RX1    X0          (-RXX- 1 WD READ, MAY CHG *A1*)
          CALL   BANKLOC     COMPUTE ADDRESS OF BANK
          BX6    X0 
          SA6    SBADD       SAVE ADDRESS OF STUDENT BANK 
* 
*  PROCESS ARG2 
 SBRX15   SA5    A5          RESET COMMAND WORD 
          LX5    XCODEL 
          NGETVAR            X1 = OFFSET
          SX6    X1 
          NG     X6,ERXVAL   --- OFFSET OUT OF RANGE
          SA6    STOFFS 
* 
*  PROCESS ARG4 
          SA1    SAVE1       EXTRA STORAGE WORD 
          BX5    X1 
          LX5    XCODEL 
          NGETVAR            X1 = LENGTH TO READ
          SX6    X1          18 BITS ONLY 
          SA6    STLTH
* 
*  PROCESS ARG3 
          SA1    SAVE1       EXTRA STORAGE WORD 
          BX5    X1 
          NGETVAR            A1 = STARTING ADDRESS
* 
*         CHECK IF OWN STUDENT BANK 
          SA2    SOWNFLG
          ZR     X2,SBRX20   JUMP IF NOT OWN BANK 
          SA2    ATEMPEC
          BX0    X2          ADDRESS OF ECS SCRATCH BUFFER
          SA0    SBSTART
+         WE     SBMAX       COPY BANK TO TEMP ECS BUFFER 
          RJ     ECSPRTY
          BX6    X2          SET ADDRESS OF BANK
          SA6    SBADD
* 
*  PERFORM CHECK FOR VARIABLE OUT OF RANGE
 SBRX20   SA0    A1          FOR BOUNDS CHECKER 
          SA1    STLTH
          CALL   BOUNDS      --- EXITS IF OUT OF RANGE
          SB1    X1          RESTORE LENGTH TO READ/WRITE 
* /---   BLOCK      SBREAD     00 000   81/03/10  01.49 
* 
*  CHECK FOR STUDENT BANK OUT OF RANGE
          SA2    STOFFS      RESTORE OFFSET INTO BANK 
          SX1    X2+B1       ADD OFFSET AND LENGTH
          SX1    X1-TBLTH-1  SUBTRACT LENGTH OF STUDENT BANK
          PL     X1,SERXOOR  --- ERROR IF OUT OF RANGE
* 
*  ERROR CHECKS ON STUDENT BANK ADDRESS 
          SA1    SBADD       RESTORE SB RELATIVE ADDRESS
          SX6    0           SET ERROR FLAG FOR NO SB 
          ZR     X1,SBRX3 
          NG     X1,SBRX3 
          SX6    -1          SET ERROR FLAG FOR SUCCESS 
* 
*  READ/WRITE OF STUDENT BANK 
          IX0    X1+X2       ADD OFFSET TO SB ADDRESS 
          SA2    OVARG1      GET READ/WRITE FLAG
          NZ     X2,SBRX2    JUMP IF TO WRITE 
          RE     B1 
          RJ     ECSPRTY
          EQ     SBRX3       JUMP TO EXIT 
 SBRX2    WE     B1 
          RJ     ECSPRTY
          SA2    SOWNFLG     CHECK IF WROTE OWN STUDENT BANK
          ZR     X2,SBRX3    IF NOT OWN BANK
 
*         UPDATE CM COPY OF OWN STUDENT BANK
 
          SA2    STOFFS      (X2) = OFFSET INTO STUDENT BANK
          SA0    SBSTART+X2 
          RE     B1          UPDATE CM COPY 
          RJ     ECSPRTY
* 
 SBRX3    SA6    TERROR      STORE ERROR FLAG 
          EQ     PROCESS     +++ EXIT TO CONTINUE PROCESSING
* 
 SERXOOR  SA1    STOFFS      OFFSET INTO STUDENT BANK 
          SX2    B1          LENGTH 
          SX3    TBLTH       LENGTH OF STUDENT BANK 
          EXECERR 117        SBREAD OUT OF RANGE
* 
* 
 SOWNFLG  BSS    1           FLAG FOR OWN STUDENT BANK
 SAVE1    BSS    1           STORAGE FOR EXTRA STORAGE WORD 
 SBADD    BSS    1           STORAGE FOR RELATIVE SB ADDRESS
 STOFFS   BSS    1           STORAGE FOR OFFSET 
 STLTH    BSS    1           STORAGE FOR LENGTH 
* 
* 
          ENDOV 
* /---   BLOCK      SBCHANG    00 000   80/08/28  09.33 
          TITLE  -SBCHANG- / -STCHANG-
 
**        SBCHANG - CHANGE A WORD IN A STUDENT BANK 
* 
*         STCHANG - CHANGE A WORD IN A STATION BANK 
* 
*         SBCHANG  STATION,OFFSET,SOURCE,OPERATION
* 
*         OPERATION - '7AND'7, '7OR'7, OR '7SET'7 
 
 
 SBCHNG   OVRLAY
          CALL   MXTEST,-1,XR.THR  GUARD AGAINST REQ OVRFLOW
          NG     X6,=XRETRNZ  TRY AGAIN NEXT TIMESLICE
 
*         GET STATION NUMBER
 
          NGETVAR 
          NG     X1,ERXSTN   IF STATION ILLEGAL 
          SX2    NUMSTAT
          IX2    X1-X2
          PL     X2,ERXSTN   IF STATION ILLEGAL 
          SA2    OVARG1      SET EXECUTOR REQUEST CODE
          SA2    SBCC+X2
          LX1    42 
          BX6    X1+X2
          SA6    MASRQ       SAVE STATION NUMBER
 
*         FETCH OFFSET
 
          LX5    XCODEL 
          NGETVAR 
          NG     X1,ERXVAL   IF OFFSET OUT OF RANGE 
          SA2    OVARG1 
          SA2    SBCA+X2
          IX2    X1-X2
          PL     X2,ERXVAL   IF OFFSET OUT OF RANGE 
          SX6    X1 
          SA6    MASRQ+2     SAVE OFFSET
 
*         FETCH VALUE TO SET
 
          SA5    A5          RESTORE COMMAND WORD 
          MX6    2*XCODEL 
          BX1    -X6*X5      (X1) = EXTRA STORAGE POINTER 
          AX1    XCMNDL 
          SA1    X1+B5       (X1) = EXTRA STORAGE WORD
          BX5    X1 
          NGETVAR 
          BX6    X1 
          SA6    MASRQ+3     SAVE VALUE TO USE
 
*         FETCH OPERATION TO PERFORM
 
          LX5    XCODEL 
          NGETVAR 
          SA2    SBCB        SEARCH FOR OPERATION 
          MX0    42 
 SBC1     BX6    X2*X0
          BX6    X6-X1
          ZR     X6,SBC2     IF OPERATION FOUND 
          SA2    A2+1 
          NZ     X2,SBC1     IF MORE ENTRIES IN TABLE 
          EQ     ERXVAL      UNKNOWN OPERATION
 
 SBC2     SX6    X2 
          SA6    MASRQ+1     SAVE OPERATION 
* /---   BLOCK      SBCHANG    00 000   81/03/10  02.00 
 
*         CHECK EXECUTOR FOR STATION
 
          SA3    MASRQ
          AX3    42 
          CALL   GETEXID,X3 
          ZR     X1,SBC3     IF ON THIS EXECUTOR
          CALL   SETEXID
          CALL   MXREQ       POST EXECUTOR REQUEST
          SX6    -1          (X6) = SUCCESSFUL
          EQ     SBC6 
 
*         HANDLE REQUEST FOR THIS EXECUTOR
 
 SBC3     SA4    STATION
          BX6    X3-X4
          ZR     X6,SBC4     IF FOR THIS STATION
          SA1    NSYSBNK     COMPUTE ADDRESS OF /STATION/ 
          SX2    PSYSLTH
          IX2    X2*X3
          IX0    X1+X2
          SA0    SBCE 
          RE     PSYSLTH     READ STATION BANK
          RJ     ECSPRTY
          SA1    OVARG1 
          SA2    SBCA+X1
          SB2    X2          (B2) = LENGTH OF BANK
          NZ     X1,SBC5     IF -STCHANG- 
          SA1    A0+BANKADD-STSTART 
          BX6    X1 
          SA6    SBBNKA      SAVE *BANKADD* IMAGE 
          CALL   BANKLOC
          SX6    0           (X6) = NO STUDENT BANK 
          NG     X0,SBC6     IF NO STUDENT BANK 
          ZR     X0,SBC6
          SA0    SBCE 
          RE     SBMAX
          RJ     ECSPRTY
          SA4    A0+STATION-SBSTART (X4) = STATION NUMBER 
          EQ     SBC5        PERFORM OPERATION
 
 SBC4     SA1    OVARG1 
          SA1    SBCD+X1
          SA0    X1          (A0) = BASE ADDRESS OF TABLE 
          MX0    0           (X0) = MARK THIS STATION 
 SBC5     CALL   MXCST       UPDATE STATION/STUDENT BANK
          SX6    -1          (X6) = NO ERRORS 
          ZR     X0,SBC6     IF FOR THIS STATION
          SA1    OVARG1 
          NZ     X1,SBC5.1   IF -STCHANG- 
 
*         WRITE CHANGED WORDS TO ECS
 
          WE     B2 
          RJ     ECSPRTY
          EQ     SBC6 
* /---   BLOCK      SBCHANG    00 000   81/03/10  01.55 
 
*         DO NOT WRITE OUT READ-ONLY PART OF STATION BANK 
 
 SBC5.1   SX2    PSYSRLN
          IX0    X0+X2
          SA0    A0+PSYSRLN 
          SB2    B2-PSYSRLN 
          WE     B2 
          RJ     ECSPRTY
 SBC6     SA6    TERROR      SET ERROR FLAG 
          EQ     PROCESS
 
 
 SBBNKA   BSSZ   1           HOLD TARGET *BANKADD* IMAGE
 
 SBCA     BSS    0
          CON    SBMAX       LENGTH OF STUDENT BANK 
          CON    PSYSLTH     LENGTH OF STATION BANK 
 
 SBCB     BSS    0
          VFD    42/0LSET,18/0
          VFD    42/0LOR,18/1 
          VFD    42/0LAND,18/2
          VFD    42/0LXOR,18/3
          VFD    42/0LTALK,18/4 
          DATA   0
 
 SBCC     BSS    0
          CON    XR.WRTSB 
          CON    XR.WRTST 
 
 SBCD     BSS    0
          CON    SBSTART
          CON    STSTART
 
 .1       MAX    SBMAX,PSYSLTH
 SBCE     OVDATA .1          TEMPORARY BUFFER 
 
 
          ENDOV 
* /---   BLOCK      USERLOC    00 000   79/10/04  03.56 
 
          TITLE  -USERLOC- (CODE = 150) 
 
*         USERLOC NAME,GROUP
* 
*         LOCATES USER *NAME* IN GROUP *GROUP*
* 
*         *NAME* MUST BE STOREABLE AND TWO WORDS LONG.
* 
*         AFTER EXECUTION, *ERROR* IS SET TO
* 
*                -1 IF THE USER IS NOT SIGNED ON, OR
*                THE STATION WHERE THE USER IS SIGNED ON
* 
*         *ZRETURN* IS NOT SET BY THIS COMMAND. 
 
 USERLOC  OVRLAY
 
          SA5    A5          (X5) = COMMAND WORD
          LX5    XCODEL      POSITION GETVAR FOR GROUP NAME 
          NGETVAR            (X1) = GROUP NAME
          ZR     X1,NOFIND   IF NO GROUP NAME 
          MX6    48 
          BX6    X6*X1       BOTTOM 48 BITS ONLY
          SA6    ULGROUP     SAVE GROUP NAME
 
          SA5    A5          (X5) = COMMAND WORD
          NGETVAR            (A1) = ADDR OF USER NAME 
          SX6    A1          (X6) = ADDR OF USER NAME 
          SA6    TEMP        SAVE OVER CALL TO *WORDS*
          SA0    A1          (A0) = ADDR OF USER NAME 
          SX1    18          (X1) = LENGTH OF NAME
          CALL   WORDS       CHECK BOUNDS ON USER NAME
          SA1    TEMP        (X1) = ADDR OF USER NAME 
          SA1    X1          (X1) = FIRST WORD OF USER NAME 
          BX6    X1 
          ZR     X1,NOFIND   EXIT IF NO NAME
          SA6    ULNAME      SAVE FIRST WORD OF NAME
          SA1    A1+1        (X1) = SECOND WORD OF USER NAME
          MX6    48          ONLY WANT 8 CHARACTERS OF IT 
          BX6    X6*X1       (X6) = CHARS 11 - 18 OF NAME 
          SA6    A6+1        SAVE SECOND WORD OF NAME 
 
          MX7    -1 
          SA7    JJSTORE     MARK *INFO* BUFFER OVERWRITTEN 
 
          SB1    1           (B1) = 1 
          SB2    0           (B2) = STARTING STATION NUMBER 
          SB4    NUMSTAT-1   (B4) = MAX POSSIBLE STATION NO 
 
*         SEARCH GROUP NAME BUFFER FOR SAME GROUP.
 
 ULOC1    SB3    B2+INFOLTH-1  (B3) = LAST STATION THIS PASS
          LE     B3,B4,ULOC2  IF IN RANGE 
          SB3    B4          ADJUST IF NOT IN RANGE 
 ULOC2    SB4    B3-B2
          SB4    B4+B1       (B4) = NO. OF STATIONS TO CHECK
          SA1    AGROUP      (X1) = ECS ADDR OF GROUP BUFFER
          SX0    B2          (X0) = FIRST STATION TO CHECK
* /---   BLOCK      USERLOC    00 000   79/10/04  03.56 
          IX0    X0+X1       (X0) = ADDR OF FIRST GROUP NAME
          SA0    INFO 
          RE     B4          READ GROUP NAMES TO INFO BUFFER
          RJ     ECSPRTY
          SA1    ULGROUP     (X1) = NAME OF GROUP 
          SA2    INFO-1      (A2) = BIAS TO INFO BUFFER 
          MX0    48 
* 
 ULOC10   SA2    A2+1        (X2) = NEXT GROUP NAME 
          BX2    X0*X2       MASK OUT TALK OPTIONS
          BX3    X1-X2       CHECK IF CORRECT GROUP 
          NZ     X3,ULOC40   IF NOT CORRECT GROUP 
* /---   BLOCK      USERLOC    00 000   79/10/04  03.56 
 
*         GROUP NAME MATCHED -- SEE IF NAME MATCHES.
 
          SX6    B2          SAVE CURRENT STATION NUMBER
          SX7    B3          SAVE ENDING STATION NUMBER 
          SA6    SAVE.B2
          SA7    SAVE.B3
          SX6    A2          SAVE ADDRESS OF GROUP NAME 
          SA6    SAVE.A2
 
          CALL   READSBK,UNAME,SAVE.B2,(TNAME-SBSTART),2
          PL     X6,ULOC30   IF NO STUDENT BANK 
          SA1    ULNAME 
          SA2    UNAME
          BX1    X1-X2       CHECK IF NAMES MATCH 
          NZ     X1,ULOC30   IF NAMES DIFFERENT 
          NG     X1,ULOC30   TREAT -0 AS NO MATCH 
          SA1    ULNAME+1 
          SA2    UNAME+1
          BX1    X1-X2
          MX0    48 
          BX1    X0*X1
          NZ     X1,ULOC30  IF NAMES DIFFERENT
 
*         IF MATCH, FETCH STATION NUMBER AND JUMP TO EXIT.
 
          SA1    SAVE.B2
          SX6    X1+         (X6) = STATION NUMBER
          EQ     ULEXIT 
 
*         IF NOT THE ONE WE WANT, RESTORE REGISTERS AND 
*         PROCEED TO NEXT STATION.
 
 ULOC30   SA2    SAVE.B2
          SA3    SAVE.B3
          SB2    X2          RESTORE CURRENT STATION NUMBER 
          SB3    X3          RESTORE LAST STATION NUMBER
          SA2    SAVE.A2
          SA2    X2          RESTORE ADDRESS OF GROUP NAME
 
          SB1    1           (B1) = 1 AGAIN 
          MX0    48          (X0) = MASK FOR GROUP NAME 
          SA1    ULGROUP     (X1) = GROUP NAME
 
*         END OF LOOPS. 
 
 ULOC40   SB2    B2+1         INCREMENT STATION NUMBER
          LE     B2,B3,ULOC10  RELOOP IF NOT YET DONE 
          SB4    NUMSTAT-1   (B4) = MAX POSSIBLE STATION NO 
          LE     B2,B4,ULOC1
 
*         USER IS NOT SIGNED ON -- RETURN *ERROR* = -1. 
 
 NOFIND   SX6    -1 
 
*         SET ERROR AND EXIT TO NEXT COMMAND
 
 ULEXIT   SA6    TERROR 
          EQ     PROCESS
 
 ULNAME   OVDATA 2           NAME OF USER TO SEARCH FOR 
 UNAME    OVDATA 2           NAME READ FROM STUDENT BANK
 ULGROUP  OVDATA             NAME OF GROUP TO SEARCH FOR
 
 SAVE.B2  OVDATA             CURRENT STATION
 SAVE.B3  OVDATA             LAST STATION FOR THIS PASS 
* /---   BLOCK      USERLOC    00 000   79/10/04  03.56 
 SAVE.A2  OVDATA             ADDRESS OF CURRENT GROUP NAME
 
 TEMP     OVDATA             SCRATCH
 
          ENDOV 
* /---   BLOCK      READTCM    00 000   78/07/05  01.24 
          TITLE      -READTCM-   READ TUTOR CENTRAL MEMORY
* 
*         -READTCM-  -WRITTCM-
*         READS OR WRITES CENTRAL INSIDE PLATO*S FL 
* 
* 
*         ON ENTRY, 
*         OVARG1 = 0 IF READ, 1 IF WRITE
* 
 READTCM  OVRLAY
          NGETVAR 
          SX6    A1 
          SA6    READTC1
          SA5    A5 
          LX5    XCODEL 
          NGETVAR 
          SX6    X1 
          SA6    READTC2
          SA5    A5 
          MX0    2*XCODEL 
          BX5    -X0*X5 
          AX5    XCMNDL 
          SA1    B5+X5
          BX5    X1 
          NGETVAR            X1 = LENGTH
          SA2    READTC1     X2 = TO ADDRESS (READ) 
          SA3    READTC2     X3 = FROM ADDRESS (READ) 
          SA0    X2 
          CALL   BOUNDS      SEE IF IT WILL FIT 
          SA4    CMFL 
          LX4    30 
          SB2    X4 
          SB1    X3 
          NG     B1,RERXTCM  ERROR IF NEGATIVE ADDRESS
          SB1    X1+B1
          GT     B1,B2,ERXBADL   ERR IF MORE THAN FL
          SA4    ATEMPEC
          BX0    X4 
          SB1    X1 
          SA4    OVARG1      SEE IF READ OR WRITE 
          NZ     X4,WRTTCM   JUMP IF -WRITE-
          SA0    X3 
          WE     B1 
          RJ     ECSPRTY
          SA0    X2 
          RE     B1 
          RJ     ECSPRTY
          EQ     PROC 
* 
 RERXTCM  SX1    B1 
          EQ     ERXVAL 
* 
 WRTTCM   SA0    X2          FROM ADDRESS 
          WE     B1 
          RJ     ECSPRTY
          SA0    X3          TO ADDRESS 
          RE     B1 
          RJ     ECSPRTY
          EQ     PROC 
* 
 READTC1  BSS    1
 READTC2  BSS    1
* 
* 
          ENDOV 
* /---   BLOCK      HIDDEN     00 000   78/02/16  00.32 
          TITLE  -HIDDEN- COMMAND 
* 
*         -HIDDEN- COMMAND
* 
* 
* THIS COMMAND WILL DISPLAY TEXT ON THE SCREEN IN THE 
* ',HIDDEN', FORMAT. CHARACTERS CHANGED LISTED BELOW
*        !^O = ZERO (O00)             SUB ACCESS O
*        '6 = BLANK (O55)            SHIFT 6
*        '" = SUBSCRIPT (O66)        SHIFT MULTIPLY 
*        '# = SUPERSCRIPT (O67)      SHIFT DIVIDE 
*        ^'W = SHIFT (O70)            ACCESS SHIFT W
*        ^'X = CARRIAGE RETURN (O71)  ACCESS SHIFT X
*        ^'A = BACKSPACE (O74)        ACCESS SHIFT A
*        ^,@^'A = FONT (O75)             ACCESS 'F
*        '#@'" = ACCESS (O76)           ACCESS 'O 
 
*         - NOTE -
*         A VARIATION OF THIS ROUTINE AND A COPY OF ITS 
*         TABLE IS USED INTERNAL TO THE -PACK- COMMAND FOR
*         EMBEDDED -HIDDEN- COMMANDS.  SEE PACKOV / EXEC8.
* 
* 
 HIDDEN   OVRLAY
          SA1    MOUTLOC     SEE IF MOUT BUFFER PRETTY FULL 
          SX1    X1-MOUTLTH+70   SEE IF A SHORT ONE WILL FIT
          NG     X1,HIDEX    IF ROOM
          SA5    A5+1        BACK UP COMMAND POINTER
          EQ     XSLICE      END THIS TIME SLICE
* 
 HIDEX    MX0    1
          BX5    -X0*X5 
          NGETVAR            GET FIRST ARGUMENT 
          SX6    A1          SAVE ADDRESS 
          SA6    HIDADD 
          BX6    X1 
          SA6    HIDLIT      SAVE INCASE OF LITERAL 
          SA5    A5          RESTORE COMMAND
          LX5    XCODEL 
          NGETVAR            GET CHARACTER COUNT
          ZR     X1,PROCESS 
          NG     X1,ERXBADL 
*                            EXECERR USES X1
* CHECK TO SEE IF MAXIMUM EXPANSION WILL FIT IN MOUT BUFFER 
 
*         INSURE THAT (X1) IS IN LOW 18 BITS. 
 
          SX0    X1 
          IX0    X0-X1
          NZ     X0,ERXBADL  IF NOT IN LOW 18 BITS
 
          SX0    X1-1        CONVERT TO WORDS 
          SA2    SIXTEN      TO GET [(N-1)/10]*6
          PX0    X0 
          FX0    X0*X2       X0=(N-1)*(6/10) AND SOME GARBAGE EXPONENT
          SX0    X0+1        X0 = LENGTH (IN WORDS) 
          SA2    MOUTLOC
          IX6    X2+X0       OPPPS
          SX3    X6-MOUTLTH+1 
          PL     X3,PROCESS    JUST SKIP IF NOT ENOUGH ROOM 
*ABOVE ABORTS OUTPUT IF IT DON'7T FIT 
          SX2    X1-11       SEE IF ONE WORD(LITERAL STUFF) 
          PL     X2,HIDCHKR  OTHERWISE CHECK IF IN BOUNDS 
          SA0    HIDLIT 
          EQ     HIDEDO 
* 
 HIDCHKR  SA2    HIDADD 
          SA0    X2 
          CALL   WORDS       BOUNDS CHECK 
* 
* /---   BLOCK      HIDDEN     00 000   78/01/07  19.24 
* COMING HERE 
* A0 = ADDRESS OF FIRST WORD
* X1 = NUMBER OF CHARACTERS TO DISPLAY
* 
* REGISTER USAGE';
* A0    NUMBER OF CHARACTERS IN MOUT WORD 
* A5    RESERVED FOR PLATO USE
* A6    POINT TO OUTPUT WORD
* 
* X0    77B     SINGLE CHARACTER MASK 
* X1    INPUT WORD
* X2 = CHARACTER(S) TO PUT IN OUTPUT WORD 
* X3 = NUMBER OF CHARACTERS IN X2 
* X4 = TEMP REGISTER
* X6    OUTPUT WORD 
* X7 = NEW MOUTLOC
* 
* B1    UNIVERSAL INCREMENT REGISTER
* B2    CHARACTER LOOKING AT IN INPUT WORD
* B3    NUMBER OF CHARACTERS LEFT TO DO 
* B5,B7 RESERVED FOR PLATO USE
* 
 HIDEDO   BSS    0
          BX6    X1 
          SA6    HIDCHR      SAVE FOR XYFIX 
          SA2    MOUTLOC     FIRST WORD IS A HEADER 
          SA3    X2+MOUT
          SX7    X2+1        SAVE MOUTLOC + HEADER
          BX6    X3 
          SA6    A3          SET UP OUTPUT STORING
          SB3    X1          NUMBER OF CHARACTERS 
          SA1    A0          GET FIRST WORD 
          SA0    B0          POSITION OF CHAR BEFORE MOUTPLAC 
          MX6    0           ZERO OUTPUT WORD 
          SB1    1           UNIVERSAL INCREMENT REGISTER 
          SB2    B0          STARTING CHARACTER 
          MX0    54          ONE CHARACTER MASK 
          BX0    -X0         LESS TYPING
          SX3    B1          NUMBER OF CHARACTERS IN OUTPUT 
 HIDGO    LX1    6           GET NEXT CHARACTER 
          BX2    X1*X0
          ZR     X2,HIDNUL   IF ZERO, MUST CHANGE 
          SX4    X2-55B      IF LESS THAN SPACE, CHAR OK
          MI     X4,HIDOK 
          ZR     X4,HIDSPC   JUMP IF SPACE
          SX4    X4-11B      CHECK FOR SUB
          MI     X4,HIDOK 
          SA4    X4+HIDTAB
          BX3    X4*X0       CHARACTER COUNT IN X3
          BX2    -X0*X4      GET RID OF CHAR COUNT
          EQ     HIDOK1 
* 
 HIDNUL   SA2    HIDNULC
          SX3    3           SUB ACCESS O 
          EQ     HIDOK1 
* 
 HIDSPC   SA2    HIDSPCC
          SX3    2           SHIFT 6
          EQ     HIDOK1 
* 
 HIDOK1   LX2    6
 HIDOK    BX4    X2*X0       GET CHAR TO MERGE
          LX6    6
          BX6    X6+X4
          SA0    A0+B1
          SX4    A0-10
          NZ     X4,HIDCNT   IF WORD NOT FULL 
          SA6    A6+B1       STORE MOUT WORD
          SX7    X7+B1       UPDATE MOUTLOC 
          MX6    0
          SA0    B0 
 HIDCNT   SX3    X3-1 
          ZR     X3,HIDGO1   IF DONE WITH THIS MOVE 
          LX2    6
          EQ     HIDOK       PUT IN NEXT CHAR 
 HIDGO1   SX3    B1 
          SB3    B3-B1
          ZR     B3,HIDONE   CHECK IF DONE
          SB2    B2+B1
          SX4    B2-10
          NZ     X4,HIDGO    GET NEXT CHARACTER 
          SA1    A1+B1
          SB2    B0 
          EQ     HIDGO
* 
* /---   BLOCK      HIDDEN     00 000   78/03/07  17.00 
* 
 HIDONE   SX4    A0 
          ZR     X4,HIDON1
          BX4    -X4         POSITION LAST WORK CORRECTLY 
          SX4    X4+10       10-X4
          LX4    1           *2 
          SB2    X4          *2 
          LX4    1           *4 
          SB2    B2+X4       *6 
          LX6    X6,B2
          SX7    X7+B1       UPDATE MOUTLOC 
          SA6    A6+B1       STORE IN MOUT
* 
 HIDON1   SA1    MOUTLOC     GET ORIGINAL MOUTLOC 
          SA7    A1          STORE NEW COUNT
          IX5    X7-X1       GET NUMBER OF WORDS
          SX3    X5-1        REMOVE HEADER WORD COUNT 
          LX2    X3,B1       *2 
          LX3    3           *8 
          IX2    X2+X3       *10
          LX2    24          SHIFT INTO PLACE IN HEADER 
          LX5    12          SHIFT HEADER ADVANCE INTO PLACE
          SX4    WRSCODE     GET WRITE CODE 
          BX5    X5+X4
          BX7    X2+X5       PUT ALL PARTS TOGETHER 
          SA7    X1+MOUT     AND OUTPUT HEADER
          SA1    HIDCHR 
          CALL   XYFIX
          EQ     PROCO
* 
 SIXTEN   CON    17174631463146314631B
* 
 HIDLIT   BSS    1
 HIDADD   BSS    1
 HIDCHR   BSS    1
* 
*         -- WARNING -- 
*         A COPY OF THE FOLLOWING SUBTITUTION CHARS AND 
*         TABLE IS USED IN PACKOV / EXEC8 TO ALLOW -HIDDEN- 
*         TO BE EMBEDDED IN THE -PACK/C-,-SAY/C- COMMANDS.
*         IF YOU CHANGE THIS HERE, BE SURE TO CHANGE IT 
*         THERE ALSO. 
* 
 HIDNULC  DATA   66761700000000000000B                 !^O
 HIDSPCC  DATA   70410000000000000000B                 '6 
* 
 HIDTAB   DATA   70640000000000000002B    66B          '" 
          DATA   70600000000000000002B    67B          '# 
          DATA   76702700000000000003B    70B          ^'W
          DATA   76703000000000000003B    71B          ^'X
          DATA   72000000000000000001B    72B=&lt; 
          DATA   73000000000000000001B    73B=> 
          DATA   76700100000000000003B    74B          ^'A
*          DATA   76567476700100000006B    75B          ^,@^'A
          DATA   76700600000000000003B    75B          ^'F
*          DATA   70607470640000000005B    76B          '#@'" 
          DATA   76701700000000000003B    76B          ^'O
          DATA   77000000000000000001B    77B=; 
* 
* 
          ENDOV 
* /---   BLOCK      SEND       00 000   80/03/22  05.48 
          TITLE  -SEND- COMMAND EXECUTION OVERLAY 
* 
*         -SEND- COMMAND (CODE = 274) 
* 
*         SENDS OUTPUT TO ANOTHER TERMINAL
* 
* 
*         SEND    STATION,WHERE,BUFFER,LENGTH 
*         SEND    STATION,BEEP
*         SEND    STATION,ERASE 
* 
*         SEND    STATION,ON,WHERE,BUFFER,LENGTH
*         SEND    STATION,OFF,WHERE,BUFFER,LENGTH 
*         SEND    STATION,ALL,WHERE,BUFFER,LENGTH 
* 
*         SEND    STATION,ON,BEEP 
*         SEND    STATION,OFF,BEEP
*         SEND    STATION,ALL,BEEP
* 
*         SEND    STATION,ON,ERASE
*         SEND    STATION,OFF,ERASE 
*         SEND    STATION,ALL,ERASE 
* 
* 
*         AFTER EXECUTION,
* 
*                (TERROR) = -1 = IT DID NOT WORK
*                            0 = IT WORKED
*                            N = OUTPUT SENT TO N STATIONS
* 
*                (TRETURN) = -1 = IT WORKED 
*                             0 = BAD STATION NUMBER
*                             1 = NOT SIGNED ON 
*                             2 = (UNUSED)
*                             3 = NON-BEEP-ABLE TERMINAL
* 
* 
* /---   BLOCK      SEND       00 000   80/03/22  05.48 
 
 SENDXV   OVRLAY
 
          FINISH             ILLEGAL IN -FINISH- UNIT 
 
          SX6    0           PRESET FOR NO ERROR
          SA6    TERROR 
          SA6    SSTATS      NO. OF STATIONS SENT TO
          SA6    NSTATN      PRESET FOR 1 STATION 
          SA6    SSTATUS     NO SAVLES/INTRCLR YET
          SX6    -1 
          SA6    TRETURN     *ZRETURN* PRESET TO OK 
 
* 
*         GET STATION NUMBER TO SEND TO (-1 = ALL STATIONS) 
* 
 
          NGETVAR            (X1) = STATION NUMBER
          NG     X1,SENDALL  -1 = ALL STATIONS
          BX6    X1 
          SA6    SSTATN      SAVE STATION NUMBER
          SA6    LSTATN      LAST STATION = FIRST STATION 
          SX0    HRDSTAT     CHECK FOR PSEUDO-STATIONS
          IX0    X1-X0
          PL     X0,SENDERR0 --- ERROR IF FOR RUNNERS 
          SX0    LSTUD       CHECK FOR CONSOLE
          IX0    X1-X0
          ZR     X0,SENDERR0 --- ERROR IF FOR CONSOLE 
 SENDX0   SA2    STATION
          IX0    X1-X2       CHECK FOR THIS STATION 
          NZ     X0,SENDX1   --- OK IF FOR OTHER STATION
          EQ     SENDERR0    --- ERROR IF OWN STATION 
 
 SENDALL  SX6    1
          SA6    SSTATN      START AT STATION 1 
          SX6    HRDSTAT-1
          SA6    LSTATN      LAST STATION NUMBER
          SX6    X6-1 
          SA6    NSTATN      NUMBER OF STATIONS - 1 
* /---   BLOCK      SEND       00 000   80/03/22  05.48 
 
* 
*         FIND OUT WHAT TYPE OF -SEND- (-1 = TEXT,
*         0 = BEEP, 1 = ERASE) AND WHETHER ACTIVE OR
*         INACTIVE STATIONS SHOULD RECEIVE THE
*         OUTPUT (-1 = ACTIVE, 0 = BOTH, 1 = INACTIVE)
* 
 
 SENDX1   SA5    A5          RESTORE COMMAND WORD 
          AX5    XCODEL      SHIFT 2ND GETVAR CODE DOWN 
          MX0    -5 
          BX6    -X0*X5      (X6) = ACTIVE/INACTIVE/BOTH
          AX5    5
          BX7    -X0*X5      (X7) = TEXT/BEEP/ERASE INFO
          SX6    X6-1        -1=ACTIVE, 0=BOTH, 1=INACTIVE
          SX7    X7-1        -1=TEXT, 0=BEEP, 1=ERASE 
          SA6    SWHO        STORE DESIRED STATION STATUS 
          SA7    STYPE       STORE OUTPUT TYPE
          PL     X7,SENDGO   --- IF NOT TEXT
* /---   BLOCK      SEND       00 000   80/03/22  05.48 
 
* 
*         FETCH EXTRA STORAGE WORD
* 
 
          SA5    A5          RESTORE COMMAND WORD 
          MX0    -11
          AX5    9           POSITION INDEX IN XSTOR
          BX5    -X0*X5 
          SA1    X5+B5       LOAD XSTOR WORD
          BX6    X1 
          SA6    STEMP       SAVE FOR LATER GETVAR CALLS
          BX5    X6 
 
* 
*         GET SCREEN POSITION 
* 
 
          NGETVAR            DECODE SECOND VARIABLE 
          CALL   RCTOXY      CONVERT TO FINE GRID 
          MX0    -9 
          BX6    -X0*X6      LIMIT X TO 9 BITS
          BX7    -X0*X7      LIMIT Y TO 9 BITS
          LX6    9
          BX6    X6+X7       MERGE X AND Y
          SA6    SAT         SAVE SCREEN POSITION 
 
* 
*         GET ADDRESS OF TEXT BUFFER
* 
 
          SA1    STEMP       (X1) = EXTRA STORAGE WORD
          BX5    X1 
          LX5    XCODEL      POSITION SECOND GETVAR CODE
          NGETVAR            DECODE THIRD VARIABLE
          SX6    A1 
          SA6    SBUFFER     SAVE BUFFER ADDRESS
 
* 
*         GET LENGTH OF TEXT IN CHARACTERS
* 
 
          SA1    STEMP       (X1) = EXTRA STORAGE WORD
          BX5    X1 
          LX5    2*XCODEL    POSITION THIRD GETVAR CODE 
          NGETVAR            DECODE FOURTH VARIABLE 
          SX1    X1 
          ZR     X1,PROCESS  --- IF NOTHING TO SEND 
          BX6    X1 
          SA6    SCHARS 
 
* 
*         CHECK BOUNDS ON TEXT
* 
 
          SA2    SBUFFER     BUFFER ADDRESS 
          SA0    X2 
          CALL   WORDS       CHECK BUFFER BOUNDS
* /---   BLOCK      SENDGO     00 000   80/03/22  05.49 
 
* 
*         PREPARE FOR MAIN -SEND- LOOP
* 
 
 SENDGO   CALL   EFORMAT     DUMP OWN OUTPUT
          CALL   SAVLES      UNLOAD COMMON, STORAGE, ETC. 
          SX6    -1 
          SA6    SSTATUS     MARK SAVLES/INTRCLR IN EFFECT
 
* 
*         LOOP THROUGH STATIONS SENDING THE OUTPUT TO 
*         THE SPECIFIED STATIONS
* 
 
 SENDLOOP SA1    SSTATN      (X1) = NO. OF NEXT STATION 
          SA2    STATION     CHECK FOR OWN STATION
          IX2    X1-X2
          ZR     X2,SENDL99  --- SKIP OWN STATION 
 
*         SKIP STATIONS IN TEKTRONIX MODE.
 
          CALL   READTBK,STEMP,SSTATN,(STFLAG1-STSTART) 
          SA1    STEMP       (X1) = *STFLAG1* FOR RECEIVER
          LX1    60-TEKBIT
          NG     X1,SENDL99  SKIP IF IN TEKTRONIX MODE
 
* 
*         CALL *READSBK* TO SEE IF STATION IS ACTIVE
*         OR NOT -- (X6) = -1 IF ACTIVE, 0 IF INACTIVE
* 
*         SET UP REGISTERS FOR OTHER CHECKS 
* 
 
          CALL   READSBK,STEMP,SSTATN,0,0 
          SA6    SACTIVE     -1 = ACTIVE, 0 = INACTIVE
          SA1    NSTATN      (X1) > 0 IF MULTI-STATION
          SA2    STYPE       (X2) = TYPE OF OUTPUT
          SA3    SWHO        (X3) = ACTIVE/BOTH/INACTIVE
* /---   BLOCK      SENDGO     00 000   80/03/22  05.49 
 
* 
*         CHECK IF ACTIVE/INACTIVE STATUS OF STATION
*         MATCHES THE DESIRED STATUS
* 
 
          ZR     X3,SNDCIU1  --- SKIP CHECK IF BOTH DESIRED 
          MX0    1
          BX3    X0*X3
          AX3    58          -1 = ACTIVE, 0 = INACTIVE
          BX4    X3-X6       CHECK IF CORRECT STATUS
          ZR     X4,SNDCIU1  --- IF STATUS MATCHES
          NZ     X1,SENDL99  --- IF MULTI-STATION -SEND-
          EQ     SENDERR1    --- ERROR IF INCORRECT STATUS
 
* 
*         IF INACTIVE STATION, ONLY SEND MESSAGE IF ON CIU
* 
 SNDCIU1  NG     X6,SENDL1   NO NEED TO CHECK IF ACTIVE 
          SA3    SSTATN      NEXT STATION 
          SX4    C0SITE      CHECK RANGE OF 1ST CIU SITES 
          LX4    5           1ST CIU STATION
          IX0    X3-X4
          NG     X0,SNDCIU2  NOT THIS CIU 
          SX4    NC0SITE
          LX4    5
          IX0    X0-X4
          NG     X0,SENDL1   IF IN RANGE, CONTINUE
 SNDCIU2  SX4    C1SITE      CHECK RANGE OF 2ND CIU SITES 
          LX4    5
          IX0    X3-X4
          NG     X0,SENDL99  NOT ON CIU, SKIP THIS STATION
          SX4    NC1SITE
          LX4    5
          IX0    X0-X4
          NG     X0,SENDL1   IF IN RANGE, CONTINUE
          EQ     SENDL99     NOT ON CIU, SKIP THIS STATION
 
* 
*         ONLY ACTIVE BEEP-ABLE STATIONS CAN BE BEEPED
* 
 
 SENDL1   NZ     X2,SENDL20  --- IF NOT BEEP OPTION 
          NG     X6,SENDL2   --- IF STATION IS ACTIVE 
          NZ     X1,SENDL99  --- IF MULTI-STATION -SEND-
          EQ     SENDERR3    --- ERROR IF NOT BEEP-ABLE 
 
* 
*         COMPUTE ADDRESS OF STATION BANK 
* 
 
 SENDL2   SA3    SSTATN      (X3) = STATION NUMBER
          SX4    PSYSLTH     (X4) = STATION BANK LENGTH 
          IX3    X3*X4       COMPUTE OFFSET FROM BANK 0 
          SA4    NSYSBNK     GET ABSOLUTE ADDRESS OF BANK 0 
          IX3    X3+X4       COMPUTE REAL ADDRESS OF BANK 
 
* 
*         CHECK FOR ATTEMPT TO BEEP UN-BEEP-ABLE TERMINAL 
* 
 
          SX0    STFLAG1-STSTART
          IX0    X0+X3       (X3) = REAL ADDR OF *STFLAG1*
          SA0    STEMP
          RE     1           READ *STFLAG1* TO *STEMP*
          RJ     ECSPRTY
          SA3    A0          (X3) = *STFLAG1* 
          AX3    4
          MX0    -4 
          BX3    -X0*X3      (X3) = TERMINAL TYPE 
          SA3    X3+PPTINFO  (X3) = TERMINAL ATTRIBUTES 
          LX3    1           SHIFT TO BEEP-ABILITY FLAG 
          NG     X3,SENDL20  --- IF BEEP-ABLE 
          NZ     X1,SENDL99  --- IF MULTI-STATION SEND
          EQ     SENDERR3    --- UN-BEEP-ABILITY ERROR
* /---   BLOCK      SENDGO     00 000   80/08/11  02.55 
 
* 
*         SWITCH OUTPUT TO OTHER STATION AND SEND IT
* 
 
 SENDL20  MX1    60          -0 
          OUTCODE SWTCODE 
 
          SA1    STYPE       (X1) = TYPE OF OUTPUT
          ZR     X1,SBEEP    --- IF BEEP OPTION 
          PL     X1,SERASE   --- IF ERASE OPTION
 
          SX1    1
          OUTCODE WEFCODE    SET TO MODE -REWRITE-
 
          SA1    SAT         (X1) = SCREEN POSITION 
          SA2    SACTIVE     (X2) = NEG. IF ACTIVE
          NG     X2,SENDL25  --- IF STATION IS ACTIVE 
          OUTCODE WFMCODE    SET MARGINS IF INACTIVE
          EQ     SENDL27
 SENDL25  OUTCODE WFCODE     LEAVE MARGINS ALONE IF ACTIVE
 
 SENDL27  SA1    SBUFFER     ADDRESS OF BUFFER
          SB1    X1 
          SB2    SCHARS      CHARACTER COUNT
          CALL   AWTOUT      WRITE IN STANDARD FONT 
          EQ     SENDL30
 
 SBEEP    SA1    BEEPCOD
          OUTCODE S19CODE    PUT IN MOUT BUFFER 
          EQ     SENDL30
 
 SERASE   CALL   ERSOUT,0    FSERASE--DONT CHANGE SBANK 
*                            WE/COLOR DATA
 
* 
*         DUMP OUTPUT 
* 
 
 SENDL30  MX1    -1 
          OUTCODE SWTCODE 
          SA1    SSTATN 
          BX6    X1 
          SA6    FORCSTN     FORCE DUMPING OF MOUT BUFFER 
          CALL   EFORMAT
* /---   BLOCK      SENDGO     00 000   80/04/22  01.22 
 
* 
*         INCREMENT STATS IF MULTI-STATION -SEND- 
* 
 
          SA1    NSTATN 
          ZR     X1,SENDL40  --- IF NOT MULTI-STATION 
          SA1    SSTATS 
          SX6    X1+1 
          SA6    A1 
 
* 
*         IF END OF TIME-SLICE, TAKE A SHORT BREAK
* 
*         UPON RETURN FROM TUTIMING, THE LESSON/COMMON/ 
*         STATION INTERLOCKS ARE RESTORED 
* 
*         MUST KEEP CLEARING COMMON INTERLOCK TO AVOID
*         DEADLOCK BETWEEN YOUR OWN EXECUTOR HAVING A 
*         COMMON INTERLOCKED WHEN ASKING TO INTERLOCK 
*         ANOTHER STATION BANK, WITH THE OTHER PERSON 
*         SIMULTANEOUSLY (ON A DIFFERENT EXECUTOR) TRYING 
*         TO INTERLOCK YOUR OWN COMMON
* 
 
 SENDL40  SA1    XSLCLOK     GET RUNNING CPU CLOCK
          SA2    MAXCLOK     GET END OF TIME-SLICE
          IX2    X1-X2
          NG     X2,SENDL99 
          SA1    KEY
          BX6    X1 
          SA6    TOKEY       SAVE *KEY* 
          TUTIM  250,,,STOPCHK
          SA1    TOKEY
          BX6    X1 
          SA6    KEY         RESTORE *KEY*
          CALL   RESTLES     ENSURE *NC* VARS VALID 
          CALL   SAVLES      RE-SAVE *NC* VARIABLES 
 
* 
*         EXIT IF DONE, ELSE ADVANCE TO NEXT STATION
* 
 
 SENDL99  SA1    SSTATN      (X1) = CURRENT STATION 
          SX6    X1+1        (X6) = NEXT STATION
          SA2    LSTATN      (X2) = LAST STATION
          IX2    X2-X6       CHECK IF DONE
          NG     X2,SENDFIN  --- IF FINISHED
          SA6    A1          STORE NEXT STATION 
          EQ     SENDLOOP 
* /---   BLOCK      SENDEND    00 000   80/03/22  05.49 
 
* 
*         -SEND- COMMAND EXITS
* 
 
 SENDFIN  SA1    NSTATN      (X1) = NO. OF STATIONS 
          ZR     X1,SENDEXIT --- IF NOT MULTI-STATION 
          SA1    SSTATS      (X1) = STATIONS SENT TO
          BX6    X1 
          SA6    TERROR      RETURN IN *TERROR* 
 
 SENDEXIT SA1    SSTATUS     CHECK FOR SAVLES/INTRCLR 
          PL     X1,PROCO    --- IF NOT IN EFFECT 
          CALL   RESTLES     RESTORE COMMON, STORAGE, ETC.
          EQ     PROCO
 
* 
*         SET RETURNS FOR ERRORS
* 
 
 SENDERR0 MX6    0           0 = BAD STATION NUMBER 
          MX7    -1 
          EQ     SENDERR
 
 SENDERR1 SX6    1           1 = NOT SIGNED ON (OR OFF) 
          SX7    -1 
          EQ     SENDERR
 
 SENDERR3 SX6    3           3 = NOT BEEP-ABLE
          SX7    -1 
 
 SENDERR  SA6    TRETURN     SET *ZRETURN*
          SA7    TERROR      SET *ERROR*
          EQ     SENDEXIT 
 
* 
*         DATA DEFINITIONS
* 
 
 SSTATN   EQU    TBINTSV     CURRENT STATION NUMBER 
 LSTATN   EQU    SSTATN+1    LAST STATION NUMBER
 NSTATN   EQU    LSTATN+1    NUMBER OF STATIONS - 1 
 SSTATS   EQU    NSTATN+1    NUMBER OF STATIONS SENT TO 
 
 SAT      EQU    SSTATS+1    SCREEN LOCATION
 SBUFFER  EQU    SAT+1       ADDRESS OF TEXT BUFFER 
 SCHARS   EQU    SBUFFER+1   LENGTH OF TEXT (CHARS) 
 
 STYPE    EQU    SCHARS+1    -1=NORMAL, 0=SEND, 1=ERASE 
 SWHO     EQU    STYPE+1     -1=ON, 0=BOTH, 1=OFF 
 
 SACTIVE  EQU    SWHO+1      NEG. IF ACTIVE, POS. IF NOT
 SSTATUS  EQU    SACTIVE+1   -1 IF THINGS TO RESTORE
 
          ERRPL  SSTATUS-TBINTSV-TINTSVL
 
 BEEPCOD  VFD    42/0,3/3B,8/0,7/173B 
 
 STEMP    OVDATA             SCRATCH
 
          ENDOV 
* /---   BLOCK      BEEP       00 000   80/02/08  23.37 
          TITLE  -BEEP- 
* 
 BEEPOV   OVRLAY
          SA1    STFLAG1
          AX1    4
          MX0    -4 
          BX1    -X0*X1      MASK OFF TERMINAL TYPE CODE
          SA1    X1+PPTINFO  GET TERMINAL DESCRIPTION WORD
          LX1    1           CHECK IF BEEP-ABLE 
          PL     X1,PROCESS 
          SA1    BEEPCOD
          OUTCODE S19CODE    OUTPUT BEEP REQUEST
          EQ     PROCESS
* 
 BEEPCOD  VFD    42/0,3/3B,8/0,7/173B 
* 
          ENDOV 
* /---   BLOCK      ACCESS     00 000   80/04/30  18.55 
          TITLE  -ACCESS- AND -SYSACC- COMMAND EXECUTION. 
 ACCESS   SPACE  5,11 
***       ACCESS - EXECUTION ROUTINE FOR -ACCESS- COMMAND.
* 
*         ACCESS LESSON,RETURNVARIABLE
*         ACCESS FILE,RETURNVARIABLE
*         ACCESS ACCOUNT';FILE,BLOCK,RETURNVARIABLE 
* 
*         OVARG1 = 0 FOR -ACCESS- 
*         OVARG1 = 1 FOR -SYSACC- 
* 
*         ENTRY  (A5)     = ADDRESS OF COMMAND WORD 
*                (OVARG1) = COMMAND TYPE
* 
*         EXIT - (TRETURN) = ZRETURN
*                STUDENT BANK HAS USERS ACCESS BITS 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                A - 0, 1, 2, 3, 4, 6, 7. 
*                B - 1, 2, 3. 
* 
*                CAN NOT CHANGE B4,B5,B6,B7.
* 
*         MACROS - NGETVAR. 
* 
*         CALLS  SAVLES, GETCODX, GETACN, SYSACC
*                GETACC, PUTACC, ACTFILE, RETPROC.
* 
* 
* 
*          SUMMARY OF STATE TABLE 
*         ------------------------
*         S1)    SEARCH FOR SYSTEM
*         S2)    SEARCH FOR GROUP 
*         S3)    SEARCH FOR ACCOUNT 
*         S4)    SEARCH FOR NAME  (NAME/GROUP/SYSTEM) 
*         S5)    SEARCH FOR TYPE  (TYPE/GROUP/SYSTEM) 
*         S6)    SEARCH FOR OTHER (OTHER/GROUP/SYSTEM)
*         S7)    SEARCH FOR TYPE  (TYPE/ACCOUNT/SYSTEM) 
*         S8)    SEARCH FOR OTHER (OTHER/ACCOUNT/SYSTEM)
*         S9)    SEARCH FOR ACCOUNT = OTHER 
*         S10)   SEARCH FOR TYPE  (TYPE/OTHER/SYSTEM) 
*         S11)   SEARCH FOR OTHER (OTHER/OTHER/SYSTEM)
* 
* 
* /---   BLOCK      ACCESS     00 000   81/01/12  21.50 
          EJECT 
***       FLOW-CHART OF THE ALGORITHM USED TO DECIDE ACCESS 
* 
*          START (ACHECK) 
*            V
*         ------    ----------      ---------     ----------
*         I    I NO I ACH13  I NO   I BIT 0 I YES I RETURN I
*         I S1 I--->I RID=A1 I----->I SET   I---->I O/O/L  I
*         ------    ----------      ---------     ----------
*            I YES      V YES           NO  V          V
*            I      ----------      ----------    --------
*            I<-----I SET TO I      I RETURN I    I      I
*            I      I LOCAL  I      I ZEROS  I--->I EXIT I
*            I      ----------      ----------    --------
*            V
*         ------     ------     ------     ------ 
*         I    I YES I    I NO  I    I NO  I    I 
*         I S2 I---->I S4 I---->I S5 I---->I S6 I 
*         ------     ------     ------     ------ 
*           I NO       I YES      I YES  YES I  I NO
*           I          V          V          V  I 
*           I          -----------------------  I 
*           I          I RETURN USERS ACCESS I  I 
*           I          I        (ACH11)      I  I 
*           I          -----------------------  I 
*           I           A           A        A  I 
*           I <---------I-----------I--------I--I 
*           V           I YES       I YES    I
*         ------     ------     ------       I
*         I    I YES I    I NO  I    I       I
*         I S3 I---->I S7 I---->I S8 I       I
*         ------     ------     ------       I
*        NO I                  NO I          I
*           I <--------------------          I
*           I                                I
*           I           ----------------------
*           V           I YES       I YES 
*         ------     -------     -------
*         I    I YES I     I NO  I     I NO 
*         I S9 I---->I S10 I---->I S11 I---I
*         ------     -------     -------   I
*           I NO                           I
*           I <-----------------------------
*           V 
*         -------------     ----------
*         I STATION   I YES I RETURN I
*         I =0 (ACH8) I---> I   -0   I
*         ------------     ---------- 
*          NO I               I 
*             V               I 
*         ------------        I 
*         I RETURN 0 I        I 
*         ------------        I 
* /---   BLOCK      ACCESS     00 000   81/01/12  21.50 
*             I               I 
*             I <-------------- 
*             V 
*           EXIT (ACHECK) 
          EJECT 
* /---   BLOCK      ACCESS     00 000   81/01/13  00.25 
 ACCESX   OVRLAY
 
 ACW8     EQU    TBINTSV     NUMBER OF WORDS TO RETURN
 ACW14    EQU    TBINTSV+1   GETVAR CODE OF WORDS RETURNED
 ACW15    EQU    TBINTSV+2   GETVAR CODE OF RETURNED ACCESS 
 
*         CHECK FOR AVAILABLE JUDGE BUFFERS - USED TO SAVE
*         INFO OVER INTERRUPT IN *GETACC* SUBOVERLAY. 
 
          INTLOK X,I.JUDG,W 
          SA1    AJBSTAT     (X1) = EM FWA OF JBUFF STATS 
          BX0    X1 
          SA0    JBUFCNT
+         RE     4
          RJ     ECSPRTY
          SA2    A0          NUMBER JUDGE BUFFERS IN USE
          SX1    =XJBANKS-1  CHECK FOR 2 LEFT 
          IX2    X2-X1
          NG     X2,ACC0     IF AVAILABLE 
          SA1    JMAXCNT+1   INCREMENT OVERFLOW COUNT 
          SX6    1
          IX6    X1+X6
          SA6    A1 
+         WE     4
          RJ     ECSPRTY
          INTCLR X,I.JUDG 
          SA5    A5+1        BACK UP COMMAND POINTER
          EQ     =XXSLICE    END TIME-SLICE 
 
 
*         SAVE COMMON 
 
 ACC0     BSS    0
          INTCLR X,I.JUDG 
          CALL   SAVLES      SAVE COMMON  PROBABLY NOT NEED 
 
*         CHECK FOR -SYSACC- COMMAND FORM 
 
          SA1    OVARG1 
          NZ     X1,SYSACC   1 FOR SYSACC 
 
*         STORE A ZERO AS THE NAME AS A FLAG TO GETACC
*         TO USE CURRENT PERSON EXECUTING INFO
 
          BX6    X6-X6
          SA6    ACP2 
 
          SX7    1
          SA7    ACP8        MAXIMUM WORDS TO RETURN TO USER
          SA7    ACW8 
 
*         MOVE GETVAR CODES INTO *VARBUF* 
 
          SX6    5
          CALL   GETCODX     5 ARGUMENTS TOTAL
 
*         CHECK IF 3 TAG COMMAND FORM 
 
          SA1    VARBUF      GET FIRST GETVAR CODE; TOP BIT 
          PL     X1,ACC4     SET IF LESSON/FILE KEYWORD 
 
*         TWO TAG -ACCESS- COMMAND
*         THE TOP TWO BITS OF THE *GETVAR* CODE ARE SET TO
*         1 = KEYWORD -FILE-      2 = KEYWORD -LESSON-
 
          LX1    XCODEL 
          SX6    X1-2        (X5) = 0 IF KEYWORD -FILE- 
          SA1    VARBUF+3    GET 4TH ARGUMENT (RETURN)
          BX7    X1 
          SA7    ACW15       STORE RETURN LOCATION
          ZR     X6,ACC2     IF KEYWORD LESSON
 
*         IF A *FILE* KEYWORD IS BEING PROCESSED, FETCH 
*         THE ACTUAL FILE NAME AND FILE NODE LESSON NUMBER
 
          AFTJMP ACC3,X,ACC1  BRANCH ON ACTIVE FILE TYPE
 
          SA1    TDSPARM     (X1) = NAMESET/DATASET INFO
          EQ     ACC1.1 
 
 ACC1     SA1    TAFINF2     (X1) = TUTOR-TYPE FILE INFO
 
 ACC1.1   BX7    X1          SAVE OVER *ACTFILE* CALL 
          CALL   ACTFILE,ACP9  GET ACCOUNT/FILE NAMES 
          SX1    X7          (X1) = LESSON NUMBER 
 
*         KEYWORD FILE
 
* /---   BLOCK      ACCESS     00 000   81/01/13  00.25 
          RJ     GETACN      READ ACCESS LESSON FROM HEADER 
          EQ     ACC5 
* /---   BLOCK      ACCESS     00 000   81/01/13  00.25 
 
*         KEYWORD LESSON
*         GET NAME OF ACCESS LIST ASSOCIATED
*         WITH THIS LESSON FROM LESSON DIRECTORY
 
 ACC2     SA1    TBLESSN     GET CURRENT LESSON NAME
          SA2    ILESUN      LESSON NUMBER
          AX2    18          SHIFT FOR LESSON NUMBER
          BX6    X1 
          SA6    ACP10       STORE LESSON NAME
          SX1    X2          (X1) = LESSON NUMBER 
          RJ     GETACN      READ ACCESS LESSON FROM HEADER 
          EQ     ACC5 
 
 ACC3     SX6    1           NO FILE ATTACHED 
          SA6    TRETURN
          EQ     CKPROC      EXIT 
* /---   BLOCK      ACCESS     00 000   81/01/18  20.04 
 
*         LESSON AND BLOCK NAME SPECIFIED 
 
 ACC4     CALL   FILEBLK,VARBUF,ACP9
 
          SA1    VARBUF+3    GET 4TH ARGUMENT 
          BX6    X1 
          SA6    ACW15
 ACC5     BX6    X6-X6
          SA6    ACP1        RETURN USER BITS ONLY
          SA1    KEY
          BX6    X1 
          SA6    TOKEY
          SA1    XSSTATS     *** TEMP STATS 
          SX6    1           ***
          IX6    X1+X6       ***
          SA6    A1          ***
          X      GETACC,B0   SEARCH ACCESS LIST BY NAME 
          RJ     PUTACC      STORE USERS ACCESS 
          EQ     CKPROC      EXIT 
* /---   BLOCK      SYSACC     00 000   80/04/30  19.06 
 SYSACC   SPACE  5,11 
***       SYSACC - BEGIN -SYSACC- COMMAND PROCESSING. 
* 
*         IF INFO IS PASSED SET UP *ACP* BUFFER ELSE SET
*         *ACP2* = 0 (NAME) AS FLAG FOR GETACC TO SUPPLY
*         THE CURRENTLY EXECUTING USERS INFO, I.E. NAME.
* 
*         SYSACC ACCOUNT';FILE,BLOCK,BUFFER,RETURN,MAXL,RETURNL 
* 
*         ACCOUNT     ACCOUNT OF FILE WITH ACCESS BLOCK 
*         FILE        NAME OF FILE WITH ACCESS BLOCK
*         BLOCK       NAME OF ACCESS BLOCK
*         BUFFER      USER SUPPLIED BUFFER TO READ
*                            NAME (2 WORDS) 
*                            GROUP
*                            ACCOUNT
*                            USER TYPE
*                            SYSTEM 
*         RETURN      VARIABLE TO RETURN BITS IN
*         RETURNL     NUMBER OF BITS RETURNED 
*         MAXL        MAXIMUM LENGTH TO RETURN
* 
*         EXIT - (TRETURN) = ZRETURN
*                (TERROR) = TYPE OF ACCESS BLOCK
 
 SYSACC   SX6    7           GET 7 ARGUMENTS
          CALL   GETCODX     UNPACK ARGUMENTS TO VARBUF 
 
          CALL   FILEBLK,VARBUF,ACP9
 
          MX6    0
          SA6    SRCHTYP     SET SEARCH TYPE / NAME SEARCH
 
*         GET VALUES FROM PASSED-OFF USER BUFFER
 
          SA1    VARBUF+3    GET BUFFER LOCATION
          BX5    X1 
          NGETVAR 
          BX6    X1 
          SA6    ACP2        STORE NAME 
 
          ZR     X1,SYSAC1   IF USE THIS USERS INFO 
          SA0    A1 
          SX1    6
          CALL   BOUNDS      AT LEAST 6 WORDS TO READ FROM
 
          SA1    A0+1        INCREMENT POINTER INTO BUFFER
          BX6    X1 
          SA6    ACP3        STORE SECOND PART OF NAME
 
          SA1    A1+1        GET GROUP
          BX6    X1 
          SA6    ACP4        STORE GROUP
          NZ     X6,SYSAC0   IF GROUP=0, MAY BE LESSON SRCH 
          SA2    ACP2        GET FIRST WORD OF NAME/LESSON
          NG     X2,SYSAC0   IF CAPITALIZED, 'OTHER OR 'USER
          SX6    1
          SA6    SRCHTYP     SET SEARCH TYPE / LESSON SEARCH
 
 SYSAC0   SA1    A1+1        GET ACCOUNT
          BX6    X1 
          SA6    ACP5        STORE ACCOUNT NAME 
 
          SA1    A1+1        GET USER TYPE
          BX6    X1 
          SA6    ACP6        STORE TYPE 
 
          SA1    A1+1        GET SYSTEM 
          MX0    18 
          BX1    X1*X0
 SYSAC1   SX6    1
 
*         THE RIGHTMOST 18 BITS OF ACP1 ARE 1 IF -SYSACC- 
 
          BX6    X1+X6
* /---   BLOCK      SYSACC     00 000   80/04/30  19.06 
          SA6    ACP1        STORE SYSTEM 
* /---   BLOCK      SYSACC     00 000   81/01/18  20.06 
 
*         STORE REST OF TAGS FROM COMMAND 
 
          SA1    VARBUF+4    FWA TO RETURN BITS IN
          BX6    X1 
          SA6    ACW15
 
          SA1    VARBUF+5    MAXIMUM LENGTH TO RETURN 
          BX5    X1 
          NGETVAR 
          BX6    X1 
          SA6    ACP8 
          SA6    ACW8 
 
          SA1    VARBUF+6    GETVAR TO STORE LENGTH RETURNED
          BX6    X1 
          SA6    ACW14       WORDS RETURNED 
          SA1    KEY
          BX6    X1 
          SA6    TOKEY
          SA1    XSSTATS+1   *** TEMP STATS 
          SX6    1           ***
          IX6    X1+X6       ***
          SA6    A1          ***
          SA1    SRCHTYP     X1 = SEARCH TYPE (0/1) 
          X      GETACC,X1   SEARCH ACCESS LIST 
 
*         SET ERROR TO CONTAIN BLOCK TYPE, GETACC STORES IT 
*         IN *ACP1* IN THE LEFTMOST 6 BITS. 
 
          SA1    ACP1        GET TYPE OF ACCESS BLOCK 
          MX2    6           ITS IN THE TOP 6 BITS
          BX6    X2*X1
          LX6    6
          SA6    TERROR      SET *ERROR* IN STUDENT BANK
          RJ     PUTACC      RETURN USERS BITS
          EQ     CKPROC      EXIT 
 
 SRCHTYP  BSSZ   1           SEARCH TYPE (TEMP HOLDING CELL)
* /---   BLOCK      GETACN     00 000   80/04/30  18.02 
 GETACN   SPACE  5,11 
**        GETACN - GET USERS ACCESS LIST NAME.
* 
*         THIS ROUTINES READS A LESSON HEADER 
*         DECIDES THE TYPE OF THE LESSON HEADER 
*         AND RETURNS THE NAME OF THE ASSOCIATED
*         ACCESS LESSON AND BLOCK NAME. 
* 
*         ENTRY  - (X1) = LESSON NUMBER 
* 
*         EXIT   - ACCESS LIST NAME IN *ACACCT*, *ACFILE*, *ACBLOCK*
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 1. 
* 
*         CALLS  READLES. 
* 
*         CALLED BY ACCESX. 
 
 GETACN   PS                 READ LESSON HEADER FOR NAMES 
          SX6    0           ALWAYS ZERO ACCOUNT NAME FOR NOW 
          SA6    ACP9 
          CALL   READLES,LHBUFF,LPRMLTH 
          SA1    A0          CHECK LESON TYPE 
          MX2    12 
          BX1    X2*X1
          LX1    12          (X1) = LESSON TYPE 
          ZR     X1,GETA1    IF LESSON
          SX1    X1-9 
          ZR     X1,GETA2    IF DATASET FILE NODE 
          SX1    X1-10+9
          ZR     X1,GETA3    IF TUTOR FILENODE
          SA2    -1          ABORT
 
*         PROCESS LESSON
 
 GETA1    RE     LESHEAD
          RJ     ECSPRTY
          SA1    A0+LACCLN   SAVE ACCESS FILE / BLOCK NAME
          SA2    A0+LACCBN
          EQ     GETA4
 
*         PROCESS DATASET FILE NODE 
 
 GETA2    SA0    DSH
          SX1    DSHEAD 
          IX0    X0+X1
          RE     FPRMLTH
          RJ     ECSPRTY
          SA1    ACCLNW 
          SA2    ACCBNW 
          EQ     GETA4
 
*         PROCESS TUTOR FILE NODE 
 
 GETA3    SX1    TUTHEAD+4+O.ACCLN
          IX0    X0+X1       BIAS PAST HEADER 
          RX1    X0 
          SX2    O.ACCBN-O.ACCLN
          IX0    X0+X2
          RX2    X0 
 
 GETA4    ZR     X2,GETA5 
          BX6    X2 
          SA6    ACP11
          ZR     X1,GETACN
          BX6    X1 
          SA6    ACP10
          EQ     GETACN 
 
 GETA5    BX6    X6-X6       ZERO X6
          SA6    ACP10
          SA6    ACP11
          EQ     GETACN 
* /---   BLOCK      PUTACC     00 000   80/05/01  14.16 
 PUTACC   SPACE  5,11 
**        PUTACC - RETURN ACCESS BITS TO USER.
* 
*         ENTRY - EXIT FROM GETACC OVERLAY
 
 PUTACC   PS
          SA1    TOKEY       RESTORE *KEY*
          BX6    X1 
          SA6    KEY
 
*         RESTORE NC VARS BEFORE WRITTING IN NEW VALUES 
 
          CALL   RESTLES
          SB1    1           B1=1 
          SA1    TRETURN
          PL     X1,PUTACC   ERROR / NO CHANGE STUDENT VARS 
          SA1    ACP1        CHECK FOR MORE THAN ONE WORD 
          AX1    18+18
          SX1    X1 
          NG     X1,PAC4     IF NO WORDS TO RETURN
          ZR     X1,PAC4
          SX1    X1-1 
          NZ     X1,PAC1     IF MORE THAN ONE WORD TO STORE 
          SA2    ACP2        GET ACCESS WORD
          BX6    X2          (X6) = VALUE TO STORE
          SA1    ACW15       (X1) = GETVAR CODE 
          BX5    X1 
          NPUTVAR 
          EQ     PAC3 
 
 PAC1     SA1    ACW15       (X1) = GETVAR CODE TO STORE
          BX5    X1 
          NGETVAR 
          SA0    A1 
          SA1    ACP1 
          AX1    18+18
          SX1    X1 
          CALL   BOUNDS      MAKE SURE LEGAL ADDRESS
          SB2    A0          (B2) = FWA TO STORE
          SA1    ACP2 
 PAC2     BX6    X1 
          SA6    B2 
          SB2    B2+1 
          SA1    A1+1 
          LT     B2,B1,PAC2  IF MORE TO STORE 
 PAC3     SA1    ACP1 
          SX1    X1 
          ZR     X1,PUTACC   IF NON-SYSTEM VERSION
 
*         RETURN NUMBER OF WORDS RETURNED 
 
          SA1    ACP1 
          AX1    18+18
          SX1    X1 
          SA2    ACW14
          BX6    X1 
          BX5    X2 
          NPUTVAR            RETURNED WORD COUNT
          EQ     PUTACC      EXIT 
 
 PAC4     SX6    0           ERROR = 0 = NO ACCESS BITS 
          SA6    TRETURN
          EQ     PUTACC 
 
          ENDOV 
* /---   BLOCK      GETACC     00 000   80/05/01  10.30 
 GETACC   TITLE  SEARCH ACCESS LIST.
 GETACC   SPACE  5,11 
**        GETACC - GET ACCESS ACCESS BITS FOR USER. 
* 
*         SEARCH ACCESS LIST. 
* 
*         TBINTSV IS SAVED DURING EXECUTION 
* 
*         ENTRY - (ACP1) = 18/SYSTEM NAME,
*                          24/0,
*                          18/1 IF SYSTEM SEARCH
*                 (ACP2) = USERS NAME OR LESSON ACCOUNT 
*                 (ACP3) = USERS NAME OR LESSON NAME
*                 (ACP4) = USERS GROUP
*                 (ACP5) = USERS ACCOUNT
*                 (ACP6) = USERS TYPE 
*                 (ACP7) = 0
*                 (ACP8) = NUMBER OF WORDS TO RETURN
*                 (ACP9) = ACCOUNT OF ACCESS LIST 
*                 (ACP10)= FILE OF ACCESS LIST
*                 (ACP11)= BLOCK OF ACCESS LIST 
*                 (OVARG1) =  0 IF SEARCH BY NAME 
*                             1 IF SEARCH BY LESSON 
* 
*         EXIT  - (ACP1) = 6/ACCESS LIST TYPE 
*                          18/NUMBER OF WORDS RETURNED
*                          18/
*                          18/1 IF SYSTEM SEARCH
*                 (ACP2) = ACCESS BIT FOR (ACP8) WORDS
*                 (ZRETURN) = -2 - NO ERRORS, OWNER FOUND 
*                             -1 - NO ERRORS
*                              0 - NO ACCESS BITS 
*                              1 - ACCESS LESSON NOT FOUND
*                              2 - ACCESS BLOCK NOT FOUND 
*                              3 - SYSTEM (SUBFILE) ERROR 
* 
* /---   BLOCK      GETACC     00 000   80/05/01  14.23 
 
 GETACC   OVRLAY
          CALL   GJBUF
          NG     X6,=XNJBMSG   IF NO BUFFER AVAILABLE 
          SA1    TJDBUF1     SAVE JUDGE BUFFER NUMBER 
          MX0    -18
          BX1    X0*X1
          BX6    X1+X6
          SA6    A1 
          CALL   GBA         GET JUDGE BUFFER ADDRESS 
          SA0    TBINTSV
          WE     TINTSVL
          RJ     ECSPRTY
          SA1    TIOECS      SAVE SUBFILE BUFFER
          BX6    X1 
          SA6    A0 
          SA1    OVRETRN     SAVE OVERLAY RETURN INFO 
          BX6    X1 
          SA6    A0+1 
          CALL   SSTACK,A0+2
          SX1    TINTSVL
          IX0    X0+X1
          WE     TINTSVL
          RJ     ECSPRTY
 
*         MOVE PARAMETER BLOCK TO *TBINTSV* 
 
          SA0    ACP1 
          SA1    ATEMPEC
          BX0    X1 
          WE     TINTSVL
          RJ     ECSPRTY
          SA0    ACW1 
          RE     TINTSVL
          RJ     ECSPRTY
          SA1    OVARG1 
          MX7    -1 
          BX6    X1 
          SA7    ACW12       SHOW NO ACCESS BLOCK 
          SA6    ACW16
          CALL   IOSAV       SAVE / CLEAR SUBFILE BUFFER
          BX6    X6-X6
          SA6    TIOECS 
          SA1    ACFILE 
          ZR     X1,AERR1    IF NO ACCESS LESSON
          TUTIM  1
          SX6    11          SET ACCESS LIST TYPE 
          LX6    48 
          SA6    ACTYPE 
* /---   BLOCK      GETACC     00 000   80/05/01  14.23 
 
*         GET USER INFO AND STORE IN *ACW* BUFFER 
 
          SA1    ACW16
          ZR     X1,GETN     IF SEARCH BY NAME
 
*         CHECK IF LESSON NAME SPECIFIED
 
          SA1    ACW3 
          NZ     X1,GET8     IF LESSON SPECIFIED
          SA2    TBLESAC
          SA3    A2+1 
          BX6    X2 
          BX7    X3 
          SA6    ACW2 
          SA6    ACW6        SET ACCOUNT / OTHER SEARCH 
          SA2    OTHER
          SA7    A1 
          BX6    X2 
          SA6    A6+1 
          EQ     GET8 
 
*         CHECK IF NAME SPECIFIED 
 
 GETN     SA1    ACW2 
          NZ     X1,GET0
          SA1    TNAME       GET USERS NAME 
          SA2    TNAME1 
          MX3    48 
          BX6    X1 
          BX7    X3*X2       MASK OUT DISK BLOCK NUMBER 
          SA6    ACW2        STORE FIRST PART OF NAME 
          SA7    ACW3        STORE SECOND PART
          SA2    AGROUP      ECS ADDRESS OF GROUP BUFFER
          SA1    STATION     ADD BIAS OF THIS STATION 
          IX0    X2+X1
          RX1    X0 
          BX6    X1*X3       THROW AWAY DISK BLOCK NUMBER 
          SA6    ACW4        SAVE GROUP NAME
          SA1    TACCNAM     PICK UP ACCOUNT NAME OF USER 
          BX6    X1 
          SA6    ACW5        STORE ACCOUNT NAME 
          SA1    TTYPE       GET USER TYPE
          BX6    X1 
          SA6    ACW6        STORE USER TYPE
          SA1    =XHOMERID   GET SYSTEM NAME
          SA2    ACW1        TO SAVE SYSTEM FLAG
          BX6    X1+X2
          SA6    A2          STORE SYSTEM NAME
* /---   BLOCK      GETACC     00 000   80/05/01  14.21 
 
*         SET USER TYPE TO PSEUDO TYPE STORED ON DISK 
 
 GET0     SA1    ACW6        GET USER TYPE ALREADY STORED 
          AX1    56 
          SB2    X1 
          NG     B2,GET3     IF INVALID TYPE
          SB3    B2-4 
          GT     B3,GET3     IF INVALID TYPE
          JP     GET1+B2
 
 GET1     EQ     GET2        AUTHOR 
+         EQ     GET3        ERROR TYPE DOES NOT EXIST
+         EQ     GET4        INSTRUCTOR 
+         EQ     GET5        MULTIPLE 
+         EQ     GET6        STUDENT
 
 GET2     SA2    AUTHOR      PSEUDO TYPE AUTHOR 
          BX3    X3-X3
          EQ     GET7 
 
 GET3     BX2    X2-X2       INVALID TYPE OF USER 
          BX3    X3-X3
          EQ     GET7 
 
 GET4     SA2    INSTRUC     PSEUDO TYPE INSTRUCTOR 
          SA3    INSTRU1
          EQ     GET7 
 
 GET5     SA2    MULTIP      PSEUDO MULTIPLE
          SA3    MULTIP1
          EQ     GET7 
 
 GET6     SA2    STUDENT     PSEUDO STUDENT 
          BX3    X3-X3
 
 GET7     BX6    X2          STORE THE RESULTS
          BX7    X3 
          SA6    ACW6 
          SA7    ACW7 
* /---   BLOCK      GETACC     00 000   81/03/22  01.12 
 
*         CHECK TO SEE IF ACCESS BLOCK BEING LOADED 
 
 GET8     INTLOK X,I.SIGN,W  INTERLOCK
          CALL   IOSRCH,ACACCT,ACLIOT 
          NG     X6,GET10    JUMP IF NOT
 
*          WAIT FOR I/O TO COMPLETE OR FOR STORAGE
 
 GET9     INTCLR X,I.SIGN 
          CALL   IOREL       RELEASE BUFFER IF ASSIGNED 
          TUTIM  250
          EQ     GET8 
 
*         CHECK IF LIST ALREADY IN ECS
 
 GET10    CALL   FINDLES,ACACCT,ACW12 
          SA2    ACW12
          PL     X2,GET13 
 
*         RESERVE I/O BUFFER. 
 
          CALL   IORES,ACACCT,ACLIOT
          PL     X6,GET9     JUMP IF NONE AVAILABLE 
 
*         PREPARE TO READ DIRECTORY 
 
          SA1    ACACCT      GET ACCOUNT NAME 
          BX6    X1 
          SA6    ACCNTF 
          SA1    ACFILE      GET FILE NAME
          BX6    X1 
          SA6    LESSONF
          SA1    ACBLOCK     GET BLOCK NAME 
          BX6    X1 
          SA6    BLOCKF 
          SA1    ACW1        CHECK COMMAND TYPE 
          SX1    X1          CLEAR SYSTEM NAME
          MX6    -1          (X6) = ANY FILE TYPE 
          NZ     X1,GET11    IF SYSTEM VERSION
          BX6    X6-X6       (X6) = TUTOR FILE ONLY 
 GET11    SA6    FILETF 
          SX6    1           1 = READ DIRECTORY ONLY
          SA6    IOCODEF
          SX6    10          ACCESS BLOCK 
          SA6    BLKTF       ACCESS BLOCK TYPE
          INTCLR X,I.SIGN 
 
*         READ LESSON DIRECTORY 
 
          CALLX  SUBFILE
          SA1    NERROR      GET ERROR RETURN 
          NZ     X1,AERR0    IF ERROR OCCURRED
 
*         CHECK NUMBER OF BLOCKS IN SUB-FILE
 
          SA1    LTHF        (X1) = EM LENGTH OF ACCESS LIST
          ZR     X1,AERR3S   --- IF GARBAGENOUS 
          NG     X1,AERR3S   --- DITTO
          SX2    8000+1      MAXIMUM SIZE IS 8000 WORDS 
          IX2    X1-X2       CHECK THAT SIZE .LE. 8000 WORDS
          PL     X2,AERR3S   --- IF ACCESS LIST TOO LARGE 
          SA2    DSKLTHF     (X2) = DISK LTH OF ACCESS LIST 
          IX2    X1-X2       COMPARE EM AND DISK LENGTHS
          NZ     X2,AERR3S   --- ERROR IF LENGTHS DIFFERENT 
 
*         GET FULL ACCOUNT NAME RETURNED BY SUBFILE 
 
          SA1    ACCNTF 
          BX6    X1 
          SA6    ACACCT 
* /---   BLOCK      GETACC     00 000   80/07/08  02.41 
 
*         CALCULATE SIZE OF ECS BUFFER NEEDED 
 
          INTLOK X,I.SIGN,W 
          SA1    SFNSETF     (X1) = NAMESET / TUTOR FLAG
          NG     X1,GET11.1  --- IF ACCESS LIST IN NAMESET
          SA1    NBLKF
          SX6    BLKLTH      COMPUTE LENGTH OF BUFFER NEEDED
          IX6    X1*X6
          EQ     GET11.2
 
 GET11.1  SA1    LTHF        (X1) = LENGTH OF ACCESS LIST 
          SX6    X1+
 
*         WORKS WITH 64 WORD SUBFILE REQUESTS 
*         ALLOCATE ECS BUFFER 
 
 GET11.2  CALL   XSTOR,ACACCT,X6  GET EM BUFFER 
          SA1    LESNUM 
          NG     X1,GET9     JUMP IF NO ECS AVALIABLE 
 
 GET12    BX6    X1 
          SA6    ACW12       SAVE LESSON NUMBER 
* /---   BLOCK      GETACC     00 000   82/10/28  16.24 
 
*         SET UP TO READ FROM DISK
 
          SA1    LESLOC      GET ECS ADDRESS OF BUFFER
          SX2    ACCHEAD
          IX6    X1+X2       BIAS PAST HEADER 
          SA6    ECSF        SET ECS ADDRESS FOR DISK READ
          SX6    2
          SA6    IOCODEF     READ - DIRECTORY AVAILABLE 
 
*         SET BUFFER STATUS TO I/O PENDING
 
          CALL   IOLESSN,ACW12,4000B
          INTCLR X,I.ADDL    RELEASE LESNAM INTERLOCK 
          INTCLR X,I.SIGN 
 
*         CHANGE FROM 320 WORD TO 64 WORD REQUEST 
 
          SA1    SFNSETF     (X1) = NAMESET / TUTOR FLAG
          NG     X1,GET12.1  --- IF ACCESS LIST IN NAMESET
          SX6    5
          SA1    NBLKF
          IX6    X6*X1
          SA6    A1 
 
*         READ ACCESS LIST INTO ECS 
 
 GET12.1  CALLX  SUBFILE
 
*         UNLOCK ECS BUFFER 
 
          INTLOK X,I.SIGN,W  INTERLOCK SIGNIN PROCESS 
          CALL   IOLESSN,ACW12,-4000B 
*          INTCLR X,I.SIGN
          CALL   IOREL
 
*         CHECK SUBFILE RETURN
 
          SA1    NERROR 
          NZ     X1,AERR0    IF ERROR OCCURRED
 
*         SIGN USER INTO LIST 
 
* GET13    INTLOK X,I.SIGN,W
 GET13    SA1    ACW12       GET LESSON NUMBER
          CALL   ALTLES,1 
          INTCLR X,I.SIGN 
 
 
*         READ IN DISK DIRECTORY FROM ECS INTO
*         A CM BUFFER 
 
          SA1    ACW12       GET LESSON NUMBER
          CALL   READLES,B0,B0
          SX1    ACCHEAD
          IX0    X0+X1
          SA0    DWD1 
          RE     DWORDS+1    GET DIRECTORY AND LOCAL SYSTEM 
          RJ     ECSPRTY
          BX7    X0 
          SA7    ECSDIR      STORE LOCATION OF ECS DIRECTORY
* /---   BLOCK      GETACC     00 000   80/05/01  12.12 
 
*         INITIALIZE STATE TABLES 
*         SET WORDS / ENTRY AND WORDS / ENTRY OF NEXT TABLE 
 
          SA1    DWD3        SET WORDS / SYSTEM 
          LX1    29 
          MX0    -2 
          BX6    -X0*X1 
          SA6    S1+SWPE     SET WORDS / SYSTEM 
          LX1    2
          BX6    -X0*X1 
          SA6    S2+SWPE     WORDS PER GROUP
          SA6    S3+SWPE     WORDS PER ACCOUNT
          SA6    S9+SWPE     WORDS PER ACCOUNT
          SA6    S1+SNWE     WORD PER ENTRY OF NEXT TABLE 
          MX0    -4          SET WORDS / NAME 
          LX1    4
          BX6    -X0*X1 
          SA6    S2+SNWE     WORDS PER GROUP
          SA6    S3+SNWE     WORDS PER NEXT ACCOUNT 
          SA6    S9+SNWE     WORDS PER NEXT ACCOUNT 
          SA6    S4+SWPE     NAME 
          SA6    S5+SWPE     TYPE 
          SA6    S6+SWPE     OTHER
          SA6    S7+SWPE     TYPE 
          SA6    S8+SWPE     OTHER
          SA6    S10+SWPE    TYPE 
          SA6    S11+SWPE    TYPE 
          MX0    -3 
          LX1    3
          BX6    -X0*X1 
          SA6    S12+SWPE    WORDS / LESSON 
          SA6    S13+SWPE 
          SA6    S14+SWPE 
* /---   BLOCK      GETACC     00 000   80/05/01  12.22 
 
*         SET FWA AND LWA OF NEXT TABLE 
 
          SX1    DWORDS      GET BIAS 
          IX6    X7+X1
          SA6    S1+SFWA     STORE FWA OF SYSTEMS 
          SA1    DWD1 
          MX0    -13
          LX1    6+13 
          BX6    -X0*X1 
          IX6    X7+X6
          SA6    S12+SLWA    SET LWA OF LESSONS 
          SA6    S13+SLWA 
          SA6    S14+SLWA 
          LX1    13 
          BX6    -X0*X1 
          SX6    X6-1 
          IX6    X7+X6
          SA6    S1+SLWA     SET LWA OF SYSTEMS 
          SA6    S2+SFWA     SET FWA OF GROUPS / ACCOUNTS 
          SA6    S3+SFWA
          SA6    S9+SFWA
          BX2    X6 
          LX1    13 
          BX6    -X0*X1      SET FWA OF NAMES 
          SX6    X6-1 
          IX6    X7+X6
          SA6    S4+SFWA
          SA6    S5+SFWA
          SA6    S6+SFWA
          SA6    S7+SFWA
          SA6    S8+SFWA
          SA6    S10+SFWA 
          SA6    S11+SFWA 
          SA6    S2+SLWA     SET LWA OF GROUPS
          SA6    S3+SLWA
          SA6    S9+SLWA
          BX3    X6 
          IX6    X6-X2
          SA6    S1+SNWA     SET LWA OF NEXT TABLE
          LX1    13 
          BX6    -X0*X1      SET LWA OF NAMES 
          SX6    X6-1 
          IX6    X7+X6
          SA6    S4+SLWA
          SA6    S5+SLWA
          SA6    S6+SLWA
          SA6    S7+SLWA
          SA6    S8+SLWA
          SA6    S10+SLWA 
          SA6    S11+SLWA 
          SA6    S12+SFWA    SET FWA OF LESSONS 
          SA6    S13+SFWA 
          SA6    S14+SFWA 
          IX6    X6-X3
          SA6    S2+SNWA     SET LWA OF NEXT TABLE
          SA6    S3+SNWA
          SA6    S9+SNWA
 
*         INITIALIZE FIRST STATE
 
          SA1    ACW16
          NZ     X1,GET14    IF SEARCH BY LESSON
          SA1    DWD2        GET NUMBER OF SYSTEMS
          LX1    13 
          MX0    -13
          SX6    1
          SA6    ACHB        SET LOWER LIMIT
          BX6    -X0*X1 
          SX6    X6-1 
          SA6    A6+1        SET LIMIT FOR FIRST SEARCH 
* /---   BLOCK      GETACC     00 000   80/05/01  12.22 
          SX6    S1          (X6) = FIRST STATE 
          EQ     GET15
 
 GET14    BX6    X6-X6       SET LOWER LIMIT FOR SEARCH 
          MX0    -13
          SA1    DWD2 
          SA6    ACHB 
          LX1    2*13+12+13 
          BX6    -X0*X1      (X6) = NUMBER OF LESSONS 
          SA6    A6+1 
          SX6    S12
 GET15    SA6    ACHA        SET FIRST STATE
          RJ     ACHECK      GET ACCESS CHECK 
* /---   BLOCK      GETACC     00 000   80/07/08  00.39 
 
*         SETUP ZRETURN AND DETACH ECS BUFFER AND RETURN
* 
*         THIS CODE ASSUMES THAT YOU HAVE AN ECS COPY 
*         OF THE LIST ALREADY ATTACHED BY YOU, YOU CAN
*         NOT CALL THIS ROUTINE IF YOU DO NOT HAVE ONE. 
 
 AEXIT    SA1    ACW1        SET ACCESS BLOCK TYPE
          SA2    DWD1 
          SA3    ACW8        SET NUMBER OF WORDS
          MX6    6
          BX2    X6*X2       (X2) = ACCESS LIST TYPE
          MX6    6+18 
          BX1    -X6*X1 
          LX3    18+18
          BX6    X2+X1
          BX6    X3+X6
          SA6    ACP1        SET RETURN VALUE 
          MX6    -1          FOR ZRETURN
          SA1    ACW1 
          AX1    18 
          SX1    X1 
          IX6    X6-X1
          EQ     AERR4       EXIT PROCESSING
 
* /---   BLOCK      GETACC     00 000   80/07/08  02.37 
 AERR0    SX1    X1+2 
          ZR     X1,AERR2    IF BLOCK NOT FOUND 
          NG     X1,AERR3    IF OTHER ERROR 
 AERR1    SX6    1           1 = ACCESS LESSON NOT FOUND
          EQ     AERR4
 
 AERR2    SX6    2           2 = ACCESS BLOCK NOT FOUND 
          EQ     AERR4
 
 AERR3S   SX6    5           (X6) = TERMINATE I/O REQUEST 
          SA6    IOCODEF
          CALLX  SUBFILE     TERMINATE NAMESET I/O
 AERR3    SX6    3           3 = SYSTEM ERROR 
 
 AERR4    SA6    TRETURN
 
*         RELEASE I/O BUFFER
 
          CALL   IOREL
 
*         DECREMENT COUNT 
 
          SA1    ACW12
          NG     X1,AERR5    IF NOT LOCATED 
          INTLOK X,I.SIGN,W 
          SA1    ACW12
          CALL   ALTLES,-1
          INTCLR X,I.SIGN 
 
*         RESTORE TBINTSV, OVERLAY STACK
*         RELEASE JUDGE BUFFER
 
 AERR5    CALL   GBA         (X0) = BUFFER ADDRESS
          SA0    TBINTSV
          SX1    TINTSVL
          IX0    X0+X1
          RE     TINTSVL
          RJ     ECSPRTY
          SA1    A0          RESTORE SUBFILE BUFFER 
          BX6    X1 
          SA6    TIOECS 
          SA1    A0+1        RESTORE OVERLAY RETURN INFO
          BX6    X1 
          SA6    OVRETRN
          CALL   RSTACK,A0+2
          SX1    TINTSVL     RESTORE *TBINTSV*
          IX0    X0-X1
          RE     TINTSVL
          RJ     ECSPRTY
          CALL   IORST
          SA1    TJDBUF1
          MX6    42          CLEAR ACCESS BUFFER NUMBER 
          BX6    X6*X1
          SA6    A1 
          SX1    X1 
          NG     X1,"CRASH" 
          ZR     X1,"CRASH" 
          CALL   RJBUF
 AERR6    RETURN
* /---   BLOCK      ACHECK     00 000   80/04/30  19.42 
 ACHECK   SPACE  5,11 
**        ACHECK - CHECK USERS ACCESS 
* 
*         PROCESS STATE TABLES TO LOCATE USERS ACCESS BITS. 
* 
*         ENTRY  (ACHA) = CURRENT STATE 
*                (ACHB) = BIAS INTO TABLE 
*                 AND STATE TABLES ARE SET UP 
* 
* /---   BLOCK      ACHECK     00 000   80/04/30  19.42 
 
*         TEST TO SEE IF ANY SYSTEMS IN LIST
*         (X0) CONTAINS ECS FWA OF DIRECTORY
 
 ACHECK   PS                 ACCESS CHECKING
          SB1    1           B1=1 
 
*         PROCESS NEXT STATE
 
 ACH1     SA4    ACHA        (X4) = ADDRESS OF CURRENT STATE
          SA1    X4+SITM
          SA1    X1          (X1) = ITEM TO SEARCH FOR
          SA2    A1+B1       (X2) = SECOND WORD OF ITEM 
          SA3    X4+SFWA     (X5) = FWA OF TABLE
          BX5    X3 
          SA3    X4+SWPE
          SB2    X3          (B2) = WORDS / ENTRY 
          SA3    ACHB        (X3) = BIAS INTO TABLE 
          IX5    X5+X3
          SA3    A3+B1       (X3) = NUMBER OF ENTRIES 
          SA4    X4+SMSK
          BX6    X4          (X6) = FIRST WORD OF MASK
          SA4    A4+B1
          BX7    X4          (X7) = SECOND HALF OF MSK
          RJ     EBCHOP      PERFORM BINARY CHOP
          SA4    ACHA 
          PL     X0,ACH3     IF ENTRY FOUND 
          SA4    X4+SNFS     GET NOT FOUND STATE
          NG     X4,ACH2     IF NEXT STATE DEFINED
          SB3    X4 
          JP     B3 
 
 ACH2     BX6    -X4         SET NEXT STATE 
          SA6    ACHA 
          EQ     ACH1        PROCESS NEXT STATE 
 
*         PROCESS ITEM FOUND
 
 ACH3     SA1    X4+SFWA     (X1) = FWA OF TABLE
          SA2    X4+SLWA     (X2) = LWA OF TABLE
          SX3    B2          (X3) = WORDS / ENTRY 
          IX2    X2-X3
          SB3    B2+B2
          RE     B3          READ NEXT TWO ENTRIES
          RJ     ECSPRTY
          SA1    A0 
          MX5    -12
          BX7    -X5*X1 
          SA7    ACHB        SET BIAS INTO TABLE
          IX1    X0-X2
          ZR     X1,ACH4     IF LAST ENTRY IN TABLE 
          SA1    A0+B2
          BX1    -X5*X1      LWA OF BIAS
          EQ     ACH5 
 
 ACH4     SA1    X4+SNWA     LWA OF NEXT TABLE
 ACH5     IX6    X1-X7
          SA3    X4+SNWE     (X3) = WORDS/ENTRY OF NEXT TAB 
          PX6                IX6    X6/X3 
          PX3 
          NX6 
          NX3 
          FX6    X6/X3
          UX6    X6,B3
          LX6    B3 
          SA6    A7+B1       SET NUMBER OF ENTRIES
* /---   BLOCK      ACHECK     00 000   80/04/30  19.42 
          SX1    X4-S1       CHECK LIMITS SHOULD BE SAVED 
          NZ     X1,ACH6     IF NOT AT HIGHEST LEVEL
          SA7    ACHC        SAVE LIMITS
          SA6    A7+B1
 ACH6     SA4    X4+SFS      GET FOUND STATE
          NG     X4,ACH7     IF STATE DEFINED 
          SB3    X4 
          JP     B3          PROCESS STATE
 
 ACH7     BX6    -X4
          SA6    ACHA 
          EQ     ACH1        PROCESS NEXT STATE 
* /---   BLOCK      ACHECK     00 000   80/04/30  19.45 
 
*         NOT FOUND ROUTINE 
 
 ACH8     SA1    ACW1        SET SYSTEM ERROR 
          SX6    -4 
          MX2    -18
          LX6    18 
          LX2    18 
          BX1    X2*X1
          BX6    -X2*X6 
          BX6    X1+X6
          SA6    A1 
          EQ     ACHECK 
 
*         SYSTEM NOT FOUND
 
 ACH10    SA1    AZERBUF     RETURN ACCESS OF ZERO
          SB2    377777B     RETURN USER SPECIFIED WORD CNT 
          BX0    X1 
 
*         FOUND 
 
 ACH11    RJ     DIRCHK 
          SA0    ACP2 
          SX1    B1 
          IX0    X0+X1       BIAS PAST NAME / ACCOUNT 
          SB2    B2-B1
          SA2    ACW16
          ZR     X2,ACH11.1  IF SEARCH BY NAME
          IX0    X0+X1
          SB2    B2-B1
 ACH11.1  SA2    ACW1        CHECK COMMAND TYPE 
          SX2    X2 
          NZ     X2,ACH12    IF SYSTEM VERSION
          IX0    X0+X1       BIAS PAST SYSTEM BITS
          SB2    B2-B1
 ACH12    SX6    B2 
          SA1    ACW8        ACW8 = MIN(ACW8,X6)
          IX3    X1-X6
          AX3    59 
          BX1    X3*X1
          BX6    -X3*X6 
          BX6    X1+X6
          SA6    A1 
          SB2    X6 
          LE     B2,ACHECK   IF NO WORDS TO RETURN
          RE     B2 
          RJ     ECSPRTY
          ZR     X2,ACHECK   IF NON-SYSTEM VERSION
          SA1    A0          MASK OUT ACCESS BITS 
          MX6    -12
          BX6    -X6*X1 
          SA6    A1 
          EQ     ACHECK 
 
*         SET TO LOCAL SYSTEM 
 
 ACH13    SA1    ACW1        (X1) = PASSED SYSTEM NAME
          MX4    18 
          BX1    X4*X1       GET SYSTEM FROM LEFT 18 BITS 
          SA4    =XHOMERID
          BX1    X4-X1
          ZR     X1,ACH15    PROCESS AS LOCAL SYSTEM
          SA1    DWD1        GET FIRST WORD 
          LX1    59-0        RIGHTMOST BIT IS FLAG
          PL     X1,ACH10    IF OTHER/OTHER/LOCAL OFF 
 
*         CLEAR NAME / GROUP / ACCOUNT / TYPE 
*         CAUSE A SEARCH FOR LOCAL / OTHER / OTHER
 
* /---   BLOCK      ACHECK     00 000   80/04/30  19.45 
          BX6    X6-X6
          SA6    ACW2 
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          SA6    A6+B1
          EQ     ACH15
 
*         RESET LIMITS, GO ONTO NEXT STATE
 
 ACH14    SA1    ACHC        FETCH SAVED LIMITS 
          SA2    A1+B1
          BX6    X1 
          BX7    X2 
          SA6    ACHB        SET AS NEW LIMITS
          SA7    A6+B1
          AX4    30          GET NEXT STATE 
          BX6    X4 
          SA6    ACHA 
          EQ     ACH1 
 
 ACH15    SX0    DWORDS      DIRECTORY LENGTH 
          SA1    ECSDIR      LOCATION OF DIRECTORY IN ECS 
          IX0    X0+X1
          SA4    ACHA 
          EQ     ACH3        PROCESS AS FOUND SYSTEM
* /---   BLOCK      DIRCHK     00 000   80/04/30  19.46 
 DIRCHK   SPACE  5,11 
**        DIRCHK - CHECK TO SEE IF THIS USER IS OWNER 
* 
*         DECIDES IF NAME IS DIRECTOR AND IF SO SETS A FLAG 
*         IN ACW1 
* 
*         (ACW1) = 18/SYSTEM,6/0,18/FLAG IF DIR,18/SYS FLAG 
* 
*         ENTRY  (B1) = 1 
* 
*         USES   A - 1, 2, 6
*                X - 1, 2, 6
 
 DIRCHK   PS                 CHECK FOR DIRECTOR 
          SA1    DWD5        CHECK FIRST PART OF NAME 
          SA2    ACW2 
          BX2    X2-X1
          NZ     X2,DIRCHK
 
          SA1    A1+B1       CHECK SECOND PART OF NAME
          SA2    A2+B1
          BX2    X2-X1
          NZ     X2,DIRCHK
 
          SA1    A1+B1       CHECK GROUP
          SA2    A2+B1
          BX2    X2-X1
          NZ     X2,DIRCHK
 
*         NAME/GROUP MATCH, CHECK SYSTEMS 
 
          SA2    DWD11
          NZ     X2,DIR1     IF ACCESS LIST DEFINES A SYSTEM
          SA2    HOMERID     USE THIS SYSTEMS ID
 DIR1     SA1    ACW1 
          MX6    18 
          BX6    X1*X6
          BX6    X6-X2
          NZ     X6,DIRCHK   IF SYSTEMS TO DO NOT MATCH 
 
*         SET THIS USER AS A DIRECTOR 
 
          SX2    B1 
          LX2    18 
          BX6    X1+X2
          SA6    A1 
          EQ     DIRCHK      EXIT 
* /---   BLOCK      STATE      00 000   79/09/04  17.31 
 STATE    SPACE  5,11 
**        STATE - STATE TABLES TO DEFINE NEXT SEARCH. 
* 
*         THESE CONSTANTS DEFINE WHAT IS TO BE SEARCHED 
*         FOR AND WHERE TO GO APON COMPLETION OF THE SEACH
*         THE RESULTS OF THE SEARCH DETERMINE WHERE TO GO 
*         RESUME PROCESSING.  IF THE STORED CONSTANT IS 
*         NEGITIVE THEN THE LOCATION IS THE ADDRESS OF THE
*         NEXT STATE TABLE.  THE NON-TERMINAL STATES CONTAIN
*         INFORMATION ABOUT THE NEXT PHYSICAL TABLE, THIS 
*         IS TO ALLOW CALCULATING LENGTH OF THE NEXT TABLE
*         TO SEARCH 
 
 SWPE     EQU    0           WORDS /ENTRY 
 SFWA     EQU    1           ECS FWA OF TABLE 
 SLWA     EQU    2           LENGTH OF TABLE
 SNWA     EQU    3           LENGTH OF NEXT TABLE 
 SNWE     EQU    4           WORDS / ENTRY OF NEXT TABLE
 SITM     EQU    5           ADDRESS OF ITEM TO SEARCH
 SMSK     EQU    6           MASK TO USE
*                            SECOND WORD OF MASK
 SFS      EQU    8
 SNFS     EQU    9           NEXT STATE IF NOT FOUND
 
*         SEARCH FOR SYSTEM 
 
 S1       CON    0           WORDS / ENTRY
          CON    0           ECS FWA
          CON    0           LWA + 1 OF THIS TABLE
          CON    0           LENGTH OF NEXT TABLE 
          CON    0           WORDS / ENTRY OF NEXT TABLE
          CON    ACW1        SYSTEM NAME
          VFD    18/-0,42/0  MASK FOR FIRST WORD
          VFD    60/0        MASK FOR SECOND WORD 
          CON    -S2         NEXT STATE IF FOUND
          CON    ACH13       SET TO LOCAL SYSTEM
 
 S2       CON    0           SEARCH TABLE FOR GROUP 
          CON    0
          CON    0
          CON    0
          CON    0
          CON    ACW4        GROUP NAME 
          VFD    1/0,47/-0,12/0 
          VFD    60/0 
          CON    -S4
          CON    -S3
 
 S3       CON    0           SEARCH TABLE FOR ACCOUNTS
          CON    0
          CON    0
          CON    0
          CON    0
          CON    ACW5        ACCOUNT NAME 
          VFD    1/0,47/-0,12/0 
          VFD    60/0 
          CON    -S7
          CON    -S9
 
* /---   BLOCK      STATE      00 000   80/05/01  11.03 
 S4       CON    0           SEARCH FOR NAMES 
          CON    0
          CON    0
          CON    0
          CON    0
          CON    ACW2        SEARCH FOR NAME
          VFD    60/-0
          VFD    48/-0,12/0 
          CON    ACH11
          CON    -S5
 
 S5       CON    0           SEARCH FOR USER TYPE FOR GROUP 
          CON    0
          CON    0
          CON    0
          CON    0
          CON    ACW6        USERS TYPE 
          VFD    60/-0
          VFD    48/-0,12/0 
          CON    ACH11
          CON    -S6
 
 S6       CON    0           SEARCH TABLE FOR OTHER (GROUP) 
          CON    0
          CON    0
          CON    0
          CON    0
          CON    OTHER2      SEARCH FOR OTHER/GROUP 
          VFD    60/-0
          VFD    48/-0,12/0 
          CON    ACH11
          VFD    30/S3,30/ACH14 
 
 S7       CON    0           SEARCH FOR TYPE OF ACCOUNT 
          CON    0
          CON    0
          CON    0
          CON    0
          CON    ACW6        USER TYPE
          VFD    60/-0
          VFD    48/-0,12/0 
          CON    ACH11
          CON    -S8
 
 S8       CON    0           SEARCH FOR OTHER OF ACCOUNT
          CON    0
          CON    0
          CON    0
          CON    0
          CON    OTHER2      OTHER
          VFD    60/-0
          VFD    48/-0,12/0 
          CON    ACH11
          VFD    30/S9,30/ACH14 
 
 S9       CON    0           SEARCH FOR OTHER / OTHER 
          CON    0
          CON    0
          CON    0
          CON    0
          CON    OTHER       OTHER
          VFD    1/0,47/-0,12/0 
          VFD    60/0 
          CON    -S10 
          CON    ACH8 
 
 S10      CON    0           SEARCH FOR TYPE OF ACCOUNT 
          CON    0
          CON    0
          CON    0
          CON    0
          CON    ACW6        USER TYPE
          VFD    60/-0
          VFD    48/-0,12/0 
          CON    ACH11
          CON    -S11 
 
 S11      CON    0           SEARCH FOR OTHER OF ACCOUNT
          CON    0
          CON    0
          CON    0
* /---   BLOCK      STATE      00 000   80/05/01  11.03 
          CON    0
          CON    OTHER2      OTHER
          VFD    60/-0
          VFD    48/-0,12/0 
          CON    ACH11
          CON    ACH8 
* /---   BLOCK      STATE      00 000   80/05/01  11.12 
 
*         SEARCH BY LESSON
 
 S12      CON    0           SEARCH FOR ACCOUNT/LESSON
          CON    0
          CON    0
          CON    0
          CON    0
          CON    ACW2        LESSON NAME
          VFD    42/-0,18/0 
          VFD    60/-0
          CON    ACH11
          CON    -S13 
 
 S13      CON    0           SEARCH FOR ACCOUNT/OTHER 
          CON    0
          CON    0
          CON    0
          CON    0
          CON    ACW6        ACCOUNT / OTHER
          VFD    42/-0,18/0 
          VFD    60/-0
          CON    ACH11
          CON    -S14 
 
 S14      CON    0           SEARCH FOR OTHER/OTHER 
          CON    0
          CON    0
          CON    0
          CON    0
          CON    AOTHER      LESSON OTHER 
          VFD    42/-0,18/0 
          VFD    60/-0
          CON    ACH11
          CON    ACH8 
* /---   BLOCK      EBCHOP     00 000   79/08/10  10.02 
 EBCHOP   SPACE  5,11 
**        EBCHOP - ECS BINARY CHOP. 
* 
*         PERFORMS A BINARY CHOP IN ECS OF A LIST.
*         ALLOWS PASSING THE LENGTH OF A RECORD.  THE 
*         SEARCH ALLOWS UP TO A TWO WORD OBJECT TO
*         LOCATE.  IT ALSO REQUIRES A TWO WORD MASK.
*         IT RETURNS THE ADDRESS OF THE OBJECT IN ECS IN
*         X0, A0 CONTAINS THE ADDRESS OF THE CELL IN CM 
*         WHICH HAS A COPY OF THE LOCATED OBJECT FROM ECS.
* 
*         ENTRY (B1) = 1
*               (B2) = WORDS PER RECORD 
* 
*               (X1) = FIRST WORD OF OBJECT TO LOACTE 
*               (X2) = SECOND WORD OF OBJECT TO LOCATE
*               (X3) = NUMBER OF LOGICAL RECORDS TO SEARCH
*               (X5) = FWA TO SEARCH FROM 
*               (X6) = FIRST WORD OF MASK 
*               (X7) = SECOND WORD OF MASK
* 
*         EXIT  (X0) = ADDRESS OF LOCATION OF OBJECT IN ECS 
*                    = -1 IF NOT LOCATED
*               (A0) = ADDRESS OF COPY OF OBJECT IN CM
* 
*         USES  A - 0, 1, 2, 4, 6, 7. 
*               B - 1, 2, 3.
*               X - 0, 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLED BY ACHECK. 
* 
*         USAGE X0 = ECS ADDRESS TO TRANSFER FROM 
*               X1 = OBJECT TO LOCATE 
*               X2 = LOGICAL RECORD NUMBER
*               X3 = MIDDLE POINTER 
*               X4 = MASK 
*               X5 = FWA-1 TO SEARCH FROM 
*               X6 = BOTTOM POINTER 
*               X7 = TOP POINTER
* 
*               B1 = 1
*               B2 = WORDS PER RECORD (1,2) 
* 
*         TEMPORARY CM CELLS
*               (OBJECT)  = FIRST WORD TO SEARCH FOR
*               (OBJECT2) = SECORD WORD TO SEARCH FOR 
*               (MASK)    = MASK FOR FIRST WORD TO LOCATE 
*               (MASK2)   = MASK FOR SECOND WORD TO LOCATE
*               (CMLOC)   = HOLD ECS TRANSFERD RECORD 
*               (CMLOC2)  = SECOND WORD OF ECS TRANSFER 
          EJECT 
* /---   BLOCK      EBCHOP     00 000   79/08/10  10.02 
 EX0      SX0    -1          (X0) = NOT FOUND 
 
 EBCHOP   PS                 ECS BINARY CHOP
 
*         SET UP CM CELLS 
 
          BX1    X1*X6
          BX2    X2*X7
          SA6    MASK        STORE MASK USE TO COMPARE
          SA7    MASK2
          BX4    X6          (X4) = MASK
          BX6    X1          (X1) = OBJECT
          BX7    X2 
          SA6    OBJECT      STORE OBJECT 
          SA7    OBJECT2
 
*         INITIALIZE LOOP PARAMETERS
 
          SX6    B0          STARTING RECORD NUMBER (0) 
          SA0    CMLOC
          SX7    X3-1        (X7) = NUMBER OF RECORDS - 1 
 
*         MAIN LOOP FOR CHOP
 
 EX1      IX2    X7-X6
          NG     X2,EX0     ENDLOOP; OBJECT NOT FOUND 
 
*         CALCULATE NEXT GUESS   X3 =  INT((X6+X7)/2) 
 
          IX3    X6+X7
          AX3    1           DIVIDE BY 2
 
*         COMPUTE NEXT ECS ADDRESS  X0=B2*X3+X5 
 
          SX0    B2 
          IX0    X3*X0
          IX0    X0+X5       STARTING ECS ADDRESS 
 
*         READ RECORD FROM ECS
 
          RE     B2 
          RJ     ECSPRTY
          SA2    A0 
          BX2    X2*X4       MASK OFF WORD FROM CM
* 
          NG     X2,EX4      IF TABLE NEGATIVE
          NG     X1,EX3      IF OBJECT NEGATIVE 
 EX2      IX4    X2-X1
          PL     X4,EX5      IF  OBJECT &lt; ECS RECORD
 EX3      SX6    X3+B1       RAISE BOTTOM POINTER 
          EQ     EX14 
 
 EX4      NG     X1,EX2      IF BOTH NEGATIVE 
          EQ     EX6
 
 EX5      ZR     X4,EX7      IF ECS RECORD = OBJECT 
 EX6      SX7    X3-1        LOWER TOP POINTER
          EQ     EX14 
 
 EX7      SA4    MASK2       FIRST WORDS MATCH
          SA2    A0+B1       SECOND WORD OF ECS RECORD
          BX2    X2*X4
          SA1    OBJECT2     FETCH SECOND WORD OF OBJECT
 
          NG     X2,EX10     IF TABLE NEGATIVE
          NG     X1,EX9      IF OBJECT NEGATIVE 
 EX8      IX4    X2-X1
          PL     X4,EX11      IF  OBJECT2 > ECS2
 EX9      SX6    X3+B1       RAISE BOTTOM 
          EQ     EX14 
 
* /---   BLOCK      EBCHOP     00 000   79/08/10  10.02 
 EX10     NG     X1,EX8      IF BOTH NEGATIVE 
          EQ     EX12 
 
 EX11     ZR     X4,EX13     IF ECS2 = OBJECT2
 EX12     SX7    X3-1        LOWER TOP
          EQ     EX14 
 
 EX13     EQ     EBCHOP      FOUND OBJECT, EXIT 
 
 EX14     SA1    OBJECT      RESTORE OBJECT 
          SA4    MASK        RESTORE MASK 
          EQ     EX1
          EJECT 
* /---   BLOCK      GBA        00 000   80/04/30  17.18 
 GBA      SPACE  5,11 
**        GBA - GET JUDGE BUFFER ADDRESS
* 
*         ENTRY - (TJDBUF1) = JUDGE BUFFER NUMBER 
* 
*         EXIT  - (X0) = ADDRESS OF JUDGE BUFFER
*                 (X1) = JUDGE BUFFER NUMBER
 
 
 GBA      PS
          SA1    TJDBUF1
          SX1    X1 
          NG     X1,"CRASH" 
          ZR     X1,"CRASH" 
          SX0    JBXSAVE     (X0) = LENGTH OF EACH BUFFER 
          SX2    X1-1 
          IX0    X2*X0
          SA2    XJBANKS
          IX0    X2+X0
          EQ     GBA
* /---   BLOCK      STORAGE    00 000   80/05/01  11.08 
 
*         EQU-ED TO LOCATIONS IN USERS STUDENT BANK 
 
 ACW1     EQU    TBINTSV     42/SYSTEM NAME 
                             18/ZERO IF USER BITS ONLY
 ACW2     EQU    TBINTSV+1   NAME TO LOOK UP
 ACW3     EQU    TBINTSV+2   NAME CONTINUED 
 ACW4     EQU    TBINTSV+3   GROUP
 ACW5     EQU    TBINTSV+4   ACCOUNT
 ACW6     EQU    TBINTSV+5   USER TYPE / OTHER ACCOUNT
 ACW7     EQU    TBINTSV+6   SECOND WORD OF USER TYPE 
 ACW8     EQU    TBINTSV+7   NUMBER OF WORDS TO RETURN
 ACACCT   EQU    TBINTSV+8   ACCOUNT NAME 
 ACFILE   EQU    TBINTSV+9   FILE NAME
 ACBLOCK  EQU    TBINTSV+10  BLOCK NAME 
 ACTYPE   EQU    TBINTSV+11  BLOCK TYPE (11)
 
 ACW12    EQU    TBINTSV+12  NUMBER OF ACCESS LESSON
 ACW14    EQU    TBINTSV+13  GETVAR OF COUNT OF RETURN WORDS
 ACW15    EQU    TBINTSV+14  FWA TO RETURN ACCESS IN
 ACW16    EQU    TBINTSV+15  SEARCH TYPE
 
*         DUMMY USER TYPES (ORDER DEPENDENT)
 
 AOTHER   VFD    60/0 
 OTHER    VFD    6/0,54/0L'OTHER
          VFD    60/0 
 OTHER2   VFD    12/0,48/0L'OTHER 
          VFD    60/0 
 AUTHOR   VFD    6/0,54/0L'AUTHORS
          VFD    60/0 
 INSTRUC  VFD    6/0,54/0L'INSTRUCT 
 INSTRU1  VFD    60/0LORS 
 STUDENT  VFD    6/0,54/0L'STUDENTS 
          VFD    60/0 
 MULTIP   VFD    6/0,54/0L'MULTIPLE 
 MULTIP1  VFD    60/0LS 
 
*         DISK DIRECTORY DEFINES AND TEMPORARY INFO CELLS 
 
 DWORDS   EQU    10 
 DWD0     OVDATA 1
 DWD1     OVDATA 1
 DWD2     OVDATA 1
 DWD3     OVDATA 1
 DWD4     OVDATA 1
 DWD5     OVDATA 1
 DWD6     OVDATA 1
 DWD7     OVDATA 1
 DWD8     OVDATA 1
 DWD9     OVDATA 1
 DWD10    OVDATA 1
 DWD11    OVDATA 4
 ECSDIR   OVDATA 1
 
 CMLOC    OVDATA 10B         FIRST WORD OF OBJECT (2 WORDS) 
 MASK     OVDATA 1           MASK FOR OBJECT
 MASK2    OVDATA 7
 OBJECT   OVDATA 1           OBJECT TO LOCATE 
 OBJECT2  OVDATA 7
 
*         TEMP CELLS FOR STATE TABLES 
 
 ACHA     OVDATA 1           INITIAL STATE
 ACHB     OVDATA 2           LOWER/UPPER BOUND (2 WORDS)
 ACHC     OVDATA 2           LOWER/UPPER BOUND (2 WORDS)
 
          ENDOV 
* /---   BLOCK      REPLACE DF 00 000   78/02/11  22.50 
          TITLE  -REPLACE- COMMAND EXECUTION
 
 COMPROV  OVRLAY
 
 
***       -REPLACE- COMMAND 
* 
*         FORMAT--
*         REPLACE IN,LTH,OUT,LTH,TABLE,LTH,CHARS,MODE 
* 
*         IN     INPUT BUFFER, *LTH* WORDS
*         OUT    OUTPUT BUFFER, *LTH* WORDS 
*         TABLE  REPLACEMENT TABLE, *LTH* WORDS 
*                LTH MUST BE ODD; LAST WORD IS SET
*                TO ZERO.  TABLE CONTAINS PAIRS-- 
*                60/0LOLDNAME,54/0LNEWNAME,6/NEWLTH 
*         CHARS  ON RETURN, SET TO CHAR COUNT IN OUTPUT 
*         MODE   -1 FOR EXPRESSION
*                 0 FOR WRITE 
*                +N FOR WRITE PRECEDED BY *N* EXPRESSIONS 
* 
*         ON EXIT-- 
*         CHARS  NUMBER OF CHARACTERS IN OUTPUT BUFFER
*                (REST OF LAST WORD IS ZERO, FOLLOWING
*                WORDS LEFT ALONE)
*         ZRETURN = 0 IF NO CHANGE
*                 =-1 IF SOMETHING CHANGED
* 
          SPACE  3
**        REGISTER USAGE
* 
*         A0     CHANGE FLAG
*         X0     CHARACTER MASK 
* 
*         A1     INPUT POINTER
*         X1     INPUT WORD 
*         B1     INPUT CHARACTER COUNT
* 
*         X2     INPUT CHARACTER ASSEMBLY 
*         B2     CHARACTER ASSEMBLY CODE
* 
*         X3     SCRATCH
*         B3     SCRATCH
* 
*         X4     NAME ASSEMBLY
*         B4     NAME ASSEMBLY COUNTER
* 
*         X5     MODE 
*         B5     FONT FLAG
* 
*         B6     SCRATCH
*         X6     TEMPORARY
* 
*         A7     OUTPUT POINTER 
*         X7     OUTPUT WORD ASSEMBLY 
*         B7     OUTPUT CHARACTER COUNT 
* 
          SPACE  3
 XW1      EQU    TBINTSV
 XW2      EQU    TBINTSV+1
 TABLTH   EQU    TBINTSV+2
 ACOUNT   EQU    TBINTSV+3
 RMODE    EQU    TBINTSV+4
 AOUT     EQU    TBINTSV+5
 AIN      EQU    TBINTSV+6
 INLTH    EQU    TBINTSV+7
 OUTLTH   EQU    TBINTSV+8
 ATABLE   EQU    TBINTSV+9
 BREGS    EQU    TBINTSV+10 
* /---   BLOCK      MACROS     00 000   78/02/10  11.32 
 GETCHAR  MACRO  REG         GET 6 BITS, RIGHT JUSTIFIED
          LOCAL  AA,BB
          NZ     B1,AA
          SA1    A1+1 
          SB1    10 
 AA       LX1    6
          B_REG  -X0*X1 
          SB1    B1-1 
          SX3    REG-FONT 
          NZ     X3,BB
          SB5    B5-1 
          SB5    -B5         FLIP FONT FLAG 
 BB       BSS    0
          ENDM
 
 PUTCHAR  MACRO  REG         PUT 6 BITS, RIGHT JUSTIFIED
          LOCAL  AA 
          NZ     B7,AA
          SA7    A7+1 
          SB7    10 
          SX7    0
 AA       LX7    6
          BX7    X7+REG 
          SB7    B7-1 
          ENDM
 
* /---   BLOCK      MACROS     00 000   78/02/10  08.35 
GETCODE   MACRO  REG,BREG    GET CHARACTER RIGHT JUSTIFIED
          LOCAL  AA,BB
          GETCHAR REG 
          S_BREG 1
          BX6    X2 
          EQ     BB 
 AA       L_REG  6
          S_BREG BREG+1 
          GETCHAR X6
          B_REG  REG+X6 
 BB       SX3    X6-KUP 
          ZR     X3,AA
          SX3    X6-ACCESS
          ZR     X3,AA
          ENDM
 
 PUTCODE  MACRO  REG,BREG    PUT CHARACTER RIGHT JUSTIFIED
          LJUST  REG,BREG 
          PUTSTR REG,BREG 
          ENDM
 
 PUTSTR   MACRO  REG,BREG    PUT STRING LEFT JUSTIFIED
          LOCAL  AA,BB
 AA       ZR     BREG,BB
          S_BREG BREG-1 
          L_REG  6
          BX6    -X0*REG
          PUTCHAR X6
          EQ     AA 
 BB       BSS    0
          ENDM
 
 LJUST    MACRO  REG,BREG    LEFT JUSTIFY STRING
          SB6    BREG+BREG
          SB6    B6+B6
          SB6    BREG-B6
          SB6    B6+B6
          SB6    B6+60
          L_REG  B6 
          ENDM
* /---   BLOCK      REPLACE    00 000   78/02/11  00.50 
          MX0    2*XCODEL 
          BX1    -X0*X5 
          AX1    XCMNDL      GET LINK TO EXTRA STORAGE
          SA1    X1+B5
          SA2    A1+1 
          BX6    X1 
          BX7    X2 
          SA6    XW1
          SA7    XW2         SAVE EXTRA STORAGE WORDS 
          BX5    X2 
          NGETVAR            GET ARGUMENT 6 (TABLE LTH) 
          BX6    X1 
          SA6    TABLTH 
          LX6    59 
          PL     X6,=XERXVAL MUST BE ODD
          SA1    XW2
          LX1    XCODEL 
          BX5    X1 
          NGETVAR            GET ARG. 7 (CHAR COUNT RETURN) 
          SX6    A1 
          SA6    ACOUNT      SAVE ADDRESS 
          SA1    XW2
          LX1    2*XCODEL 
          BX5    X1 
          NGETVAR            GET ARG. 8 (MODE)
          BX6    X1 
          SA6    RMODE
          SA1    XW1
          BX5    X1 
          NGETVAR            GET ARG. 3 (OUT ADDRESS) 
          SX6    A1 
          SA6    AOUT        SAVE ADDRESS 
          SA1    XW1
          LX1    XCODEL 
          BX5    X1 
          NGETVAR            GET ARG. 4 (OUT LENGTH)
          BX6    X1 
          SA6    OUTLTH 
          SA1    XW1
          LX1    2*XCODEL 
          BX5    X1 
          NGETVAR            GET ARG. 5 (TABLE ADDRESS) 
          SX6    A1 
          SA6    ATABLE      SAVE ADDRESS 
          SA5    A5          RESTORE COMMAND WORD 
          NGETVAR            GET ARG. 1 (IN ADDRESS)
          SX6    A1 
          SA6    AIN         SAVE ADDRESS 
          SA5    A5 
          LX5    XCODEL 
          NGETVAR            GET ARG. 2 (IN LENGTH) 
          BX6    X1 
          SA6    INLTH
* /---   BLOCK      REPLACE    00 000   78/02/11  01.14 
          SA1    INLTH
          SA2    AIN
          SA0    X2          SET UP FOR *BOUNDS*
          CALL   BOUNDS 
          MX0    -6 
          SA1    B1-1        PICK UP LAST WORD
          BX6    X0*X1       GUARANTEE AN EOL 
          SA6    A1          STORE IT BACK
          SA1    OUTLTH 
          SA2    AOUT 
          SA3    INLTH
          IX3    X3-X1       CHECK OUTLTH>INLTH 
          PL     X3,=XERXBADL  IF NOT 
          SA0    X2 
          CALL   BOUNDS 
          SA1    TABLTH 
          SA2    ATABLE 
          SA0    X2 
          CALL   BOUNDS 
          MX6    0
          SA6    B1-1        CLEAR LAST WORD OF TABLE 
          MX0    -18
          SX6    B5 
          BX6    -X0*X6      18 BIT LIMIT 
          SX1    B7 
          BX1    -X0*X1 
          LX6    18 
          BX6    X1+X6       MERGE
          SA6    BREGS       PRESERVE B5, B7
          SA1    RMODE
          BX5    X1          SET MODE 
          SB5    B0          CLEAR FONT 
          SA1    AOUT 
          SA1    X1-1        GET WORD PRECEDING OUT BUFFER
          BX7    X1 
          SA7    A1          INIT OUTPUT POINTER
          SA1    AIN
          SA1    X1-1        INIT INPUT POINTER 
          SA0    B0 
          SB1    B0 
          MX7    0           CLEAR OUTPUT ASSEMBLY
          SB7    10          INIT CHAR COUNTERS, CHANGE FLAG
          MX0    -6          INIT MASK
          ZR     X5,WLOOP 
          EQ     NLOOP
* /---   BLOCK      REPLACE    00 000   78/02/11  01.49 
 NLP0     PUTCODE X2,B2 
 NLOOP    GETCODE X2,B2 
 NLP0.5   ZR     X2,EOL 
          BX3    -X0*X2 
          SX3    X3-1RZ-1 
          PL     X3,NLP2
          BX4    X2          ASSEMBLE NAME IN X4
          SB4    B2 
 NLP1     GETCODE X2,B2 
          ZR     X2,NLP1.2
          BX3    -X0*X2 
          SX3    X3-1RZ-1    CHECK LETTER 
          NG     X3,NLP1.1
          SX3    X2-2R'6      SPECIAL CASE
          ZR     X3,NLP1.1
          SX3    X2-1R.      ANOTHER ONE
          ZR     X3,NLP1.1
          SX3    X2-1R9-1    DIGITS ONLY BY THEMSELVES
          PL     X3,NLP1.2
 NLP1.1   SB4    B4+B2
          SB6    B4-10-1
          PL     B6,NLP1.5
          SB6    B2+B2
          SB6    B2+B6
          SB6    B6+B6
          LX4    B6 
          BX4    X4+X2
          EQ     NLP1 
 NLP1.2   LJUST  X4,B4
          SA3    ATABLE      FETCH TABLE ADDRESS
          SA3    X3-2        INIT SEARCH POINTER
 NLP1.3   SA3    A3+2 
          ZR     X3,NLP1.4   END TEST 
          BX3    X3-X4
          NZ     X3,NLP1.3   (NOTE -0 IS NOT POSSIBLE)
          SA3    A3+1        GET NEW ENTRY
          BX4    X0*X3       REMOVE LENGTH
          BX3    -X0*X3 
          SB4    X3          SET LENGTH 
          SA0    -1          SET CHANGE FLAG
 NLP1.4   PUTSTR X4,B4
          EQ     NLP0.5 
 NLP1.5   SB4    B4-B2
          EQ     NLP1.4 
 
 NLP2     SX3    X2-2R',
          ZR     X3,NLP2.1
          SX3    X2-2R'7
          NZ     X3,NLP3
 NLP2.1   BX4    X2          SAVE QUOTE 
 NLP2.2   PUTCODE X2,B2 
          GETCODE X2,B2 
          ZR     X2,EOL 
          BX3    X2-X4       SEE IF MATCHING QUOTE
          NZ     X3,NLP2.2   IF NOT 
          EQ     NLP0 
* /---   BLOCK      REPLACE    00 000   78/02/11  01.31 
 
 NLP3     SX3    X2-1R, 
          ZR     X3,NLP3.1
          SX3    X2-1R; 
          ZR     X3,NLP3.1
          SX3    X2-2R^,
          NZ     X3,NLP4
          SB5    0           CLEAR FONT FLAG
 NLP3.1   NG     X5,NLP0     IF NOT IN WRITEC MODE
          ZR     X5,NLP0
          SX5    X5-1        DECREMENT COUNT OF DELIMS LEFT 
          ZR     X5,WLP0     IF SWITCHING TO WRITE MODE 
          EQ     NLP0 
 
 NLP4     SX3    X2-2R^1      CHECK FOR CLOSE EMBED 
          NZ     X3,NLP0
          NZ     X5,NLP0     IF NOT IN WRITE MODE 
          NZ     B5,NLP0     IF FONTED
*         EQ     WLP0        FALL THROUGH INTO -WRITE- LOOP 
          SPACE  3,10 
 WLP0     PUTCODE X2,B2 
 WLOOP    GETCODE X2,B2 
          ZR     X2,EOL 
          SX3    X2-2R^,
          NZ     X3,WLP2
          SB5    0           CLEAR FONT 
          EQ     WLP0 
 
 WLP2     SX3    X2-2R^0      CHECK FOR OPEN EMBED
          NZ     X3,WLP0
          EQ     NLP0        TO PROCESSING LOOP 
          SPACE  3,10 
 EOL      SB6    B7+B7
          SB6    B6+B7
          SB6    B6+B6
          LX7    B6          LEFT JUSTIFY LAST WORD 
          SA7    A7+1        STORE IT 
          SX1    10 
          SA2    AOUT 
          SX7    A7 
          IX7    X7-X2       COMPUTE WORD COUNT 
          IX7    X7*X1       COMPUTE CHAR COUNT 
          SX1    B7-10
          IX7    X7-X1       FINAL CHAR COUNT 
          SA1    ACOUNT      FETCH COUNTER ADDRESS
          SA7    X1 
          SX6    A0 
          SA6    TRETURN     SET *ZRETURN*
          SA1    BREGS
          SB7    X1 
          AX1    18 
          SB5    X1          RESTORE B REGISTERS
          EQ     PROCESS
 
          ENDOV 
* /---   BLOCK      END        00 000   80/01/25  01.20 
* 
* 
          OVTABLE 
* 
* 
          END    EXEC5$