Retro1.org codex

EXEC6

[00008] EXEC6 OVERLAYS FOR COMMAND EXECUTION
[00030] -OUTPUT- COMMAND
[00216] -OUTPUTL- COMMAND
[00339] -OUTPUTT- OUTPUT TEXT FORMAT DATA
[00398] -ANSDAT- OUTPUT STUDENTS ANSWER
[00553] -AREAOUT- OUTPUT -AREA- COMMAND DATA
[00652] -HELPOUT- OUTPUT -HELP- KEY DATA
[00756] -TERMOUT- OUTPUT -TERM- DATA
[00836] PARAMETERS FOR READL,READA,READD
[00846] READL
[00975] READA
[01100] -SYSDATA- COMMAND
[01307] -DATAON- COMMAND
[01428] -DATAOFF- COMMAND
[01456] READD
[01551] -SETDAT- SET DATA RESERVED WORDS
[01662] -INIDOV- INITIALIZE FOR DATA COLLECTION
[01990] -FINDOV- TERMINATE DATA COLLECTION
[02214] -DATOOV- OUTPUT TO DATA FILE
[02504] -DATOOV- SET TO NEXT DATA FILE
[02588] -DATOOV- WAIT FOR DATA FILE AVAILABLE
[02704] -BACKOUT-
[02937] SHOWE
[02999] SHOWO
[03048] SHOWH
[03097] -TALKREQ- DOCUMENTATION
[03098] TALKREQ - TALK/MONITOR INITIATION/TERMINATION.
[03188] -TALKREQ- TALK/MONITOR FUNCTIONS
[03259] -TALKREQ- COMMAND, KEYWORD ROUTINES
[03682] -TALKREQ- *CANCEL* FUNCTION
[03683] TRQBYE - COMMON TERMINATION FUNCTION.
[03786] -TALKREQ- SUBROUTINES
[03791] RDSTAT - READ TALK/MONITOR STATUS FOR STATION.
[03838] WRTSTAT - WRITE STATUS WORD FOR STATION.
[03884] ZEROSTAT - ZERO STATUS WORD FOR SPECIFIED STATION.
[03911] GETARG - GET ARGUMENT FROM COMMAND WORD.
[03926] -TALKREQ- EXITS AND STORAGE
[03992] FASTKOV – KEY COLLECTION (PIO TO STORAGE)
[04313] -HASH- COMMAND EXECUTION.
[04314] HASHOV - EXECUTE -HASH- COMMAND.
[04401] PURDY - IRREVERSIBLE ENCIPHERING.
[04402] PURDYOV - APPLY A ONE-WAY HASHING ALGORITHM.
[04501] PURDY - EVALUATE PURDY-S IRREVERSIBLE ENCIPHERING
[04615] Z= - OPDEFS TO SET B-REGISTER.
[04684] CALLL - CALL LOCAL ROUTINE WITH PARAMETERS.
[04712] ZEROL - ZERO A CM BUFFER (LOCAL TO *EXEC6*)
[04742] LOAD - LOAD EACH WORD OF A CM BUFFER.
[04797] MPSET - COPY ONE M-P NUMBER INTO ANOTHER.
[04860] KOMP - COMPARE TWO M-P NUMBERS.
[05053] EXPP - COMPUTE Y = X**K MOD PRIME. X AND Y ARE
[05124] MULTP - COMPUTE RS = R*S MOD PRIME. RS, R, AND S
[05161] ADDP - COMPUTE RPS = R+S MOD PRIME. RPS, R, AND S
[05199] MOD2Q - COMPUTE R = W MOD PRIME, FOR 2Q-BIT W.
[05279] MODQ1 - COMPUTE Y = S MOD PRIME, FOR (Q+1)-BIT S.
[05343] MODQ - COMPUTE Y = X MOD PRIME FOR Q-BIT X.
[05377] MPMLT - UNSIGNED, MULTI-PRECISION INTEGER
[05504] MPML - UNSIGNED, MULTI-PRECISION INTEGER
[05607] MPADD - UNSIGNED, NP-PRECISION INTEGER ADDITION.
[05668] MPSUB - UNSIGNED, N-PRECISION INTEGER SUBTRACTION,
Source Code

EXEC6 
* /---   FILE TYPE = E
* /---   BLOCK      EXEC6      00 000   81/08/26  21.47 
          IDENT  PLAT5$ 
          LCC    OVERLAY(PLATO,1,0) 
          END 
          IDENT  EXEC6
          TITLE  EXEC6       OVERLAYS FOR COMMAND EXECUTION 
* 
* 
          CST 
* 
* 
 EXEC6$   OVFILE
* 
* 
          EXT    ECSPRTY,DOVRET,PROC,RETRNX,RETPRO
          EXT    BOUNDS,PROCESS,ANSDAT
          EXT    AREAOUT,HELPOUT,TERMOUT,ERRDATO,ERXDATO
          EXT    OUTDATT
          EXT    NKLIST,NKLEND,RLLOOP,RALOOP,SDSETX 
          EXT    SDCHKX,RSLOOP
          EXT    ERXBADL,ERXVAL,ERXBOFF,ERXEODF 
          EXT    ERXBFT      ERROR EXIT, -EXEC2-
          EXT    DATAOUT,DATAO,DATAOA,DARG1,DARG2 
          EXT    FINISH 
* 
* 
* /---   BLOCK      OUTPUT     00 000   74/03/13  23.42 
          TITLE  -OUTPUT- COMMAND 
* 
* 
*         -OUTPUT- COMMAND
*         OUTPUTS AUTHOR GENERATED STUDENT DATA 
* 
*         FIRST WORD -
*         IST   6 BITS =  NUMBER OF ENTRIES 
*         NEXT  6      =  LENGTH OF ENTRY TYPE TABLE
*         NEXT 18      =  ELAPSED TIME
*         NEXT 18      =  UNUSED
*         NEXT  6      =  TOTAL NUMBER OF WORDS 
*         NEXT  6      =  DATA TYPE CODE
* 
*         NEXT 2 WORDS =  STUDENTS NAME 
*         NEXT WORD    =  LESSON NAME 
*         NEXT WORD    =  AREA NAME 
*         NEXT N WORDS =  DATA TYPE TABLE 
*         NEXT N WORDS =  AUTHOR GENERATED DATA 
* 
* 
 OUTOV    OVRLAY
          LX5    18          POSITION NUMBER OF ENTRIES 
          SX6    X5 
          SA6    NENT 
          SA6    NENTX
          LX5    18          POSITION BIAS TO TABLE 
          SX7    X5+B5
          SA7    NTAB 
          MX6    0
          SA6    INDX        INITIALIZE INDEX IN TABLE
          SA6    INDX1
          SA6    ILTH        INITIALIZE TOTAL WORD COUNT
          SA6    INFO+5 
          SX6    60 
          SA6    SHFT1       INITIALIZE SHIFT COUNT 
* 
 OD100    SA1    NENTX       NUMBER OF ENTRIES TO PROCESS 
          SX6    X1-1 
          NG     X6,OD900 
          SA6    A1 
          MX0    -1 
          SA1    INDX 
          SX6    X1+1        ADVANCE INDEX
          SA6    A1 
          BX5    -X0*X1      MASK OFF ODD/EVEN BIT
          AX1    1
          SB1    X1          WORD COUNT 
          SA2    NTAB 
          SA1    X2+B1       LOAD PROPER WORD OF TABLE
          NZ     X5,OD120 
          AX1    30          EXTEND SIGN
          EQ     OD140
* 
 OD120    LX1    30 
          AX1    30          EXTEND UPPER BIT OF ENTRY
* /---   BLOCK      OUTPUT     00 000   74/03/13  23.34 
* 
 OD140    NG     X1,OD500    JUMP IF -EMBEDDED- VARIABLE
          MX0    -9 
          BX2    -X0*X1      MASK OFF BIAS TO TEXT
          SA0    X2+B5       CM ADDRESS OF TEXT 
          AX1    9
          SB1    X1          PICK UP NUMBER OF WORDS
          SA1    ILTH 
          SX6    X1+B1       INCREMENT TOTAL WORD COUNT 
          SA6    A1 
          SA2    ATEMPEC     ADDRESS OF ECS BUFFER
          IX0    X1+X2
+         WE     B1          TRANSFER TEXT TO ECS 
          RJ     ECSPRTY
          SX7    B1          6/TYPE (0=ALPHA), 6/LENGTH 
          RJ     PUTTAB      PUT NEXT ENTRY INTO TABLE
          EQ     OD100
* 
 OD500    BX5    X1          SET UP FOR -GETVAR- CALL 
          LX5    60-XCODEL
          MX0    -6          MASK FOR TYPE CODE 
          AX1    XCODEL 
          BX7    -X0*X1      MASK OFF TYPE CODE 
          SB3    X7-3        SAVE FOR FLOATING POINT CHECK
          LX7    6
          SX7    X7+1        6/TYPE, 6/LENGTH 
          RJ     PUTTAB      MAKE ENTRY IN TABLE
          ZR     B3,OD520    JUMP IF FLOATING POINT 
          NGETVAR 
          EQ     OD540
* 
 OD520    FGETVAR 
* 
 OD540    BX6    X1          STORE FOR ECS TRANSFER 
          SA6    ITEMP
          SA1    ILTH 
          SX6    X1+1        INCREMENT TOTAL WORD COUNT 
          SA6    A1 
          SA2    ATEMPEC     ADDRESS OF ECS BUFFER
          IX0    X1+X2
          SA0    ITEMP       TRANSFER WORD TO ECS 
+         WE     1
          RJ     ECSPRTY
          EQ     OD100       PROCESS NEXT ENTRY 
* /---   BLOCK      OUTPUT     00 000   74/03/13  23.35 
* 
 OD900    SA1    ILTH        NUMBER OF WORDS OF TEXT
          SA2    INDX1
          SA3    SHFT1       SEE IF LAST TABLE WORD EMPTY 
          SX3    X3-60
          ZR     X3,OD910    JUMP IF LAST WORD EMPTY
          SX2    X2+1 
* 
 OD910    SA0    X2+INFO+5   CM ADDRESS OF TEXT 
          SB1    X1 
          SA3    ATEMPEC     ECS ADDRESS OF TEXT
          BX0    X3 
+         RE     B1          BRING TEXT INTO *INFO* 
          RJ     ECSPRTY
          IX6    X1+X2       COMPUTE TOTAL LENGTH OF DATA 
          SX6    X6+5        ADD FOR HEADER AND NAME
          SB2    X6          SET UP FOR CALL
          LX6    6
          SX6    X6+AUTHD    ATTACH DATA TYPE CODE
          SA1    NENT 
          LX1    60-6        POSITION NUMBER OF ENTRIES 
          BX6    X1+X6
          LX2    60-6-6      POSITION LENGTH OF TABLE 
          BX6    X2+X6
          MX0    -18
          SA1    SYSCLOK     LOAD RUNNING CLOCK 
          SA2    TIMEARK
          IX1    X1-X2       ELAPSED TIME AT ENTRY
          AX1    7           KEEP TO ABOUT 1/10 SECOND
          BX1    -X0*X1 
          LX1    60-6-6-18
          BX6    X1+X6
          SA6    INFO        STORE HEADER WORD
          SA1    TNAME
          BX6    X1          FIRST WORD OF STUDENT NAME 
          SA6    INFO+1 
          MX0    48 
          SA1    TNAME1 
          BX6    X0*X1       SECOND WORD OF STUDENT NAME
          SA6    INFO+2 
          CALL   FSQUISH,TBLESAC
          BX6    X1 
          SA6    INFO+3 
          SA1    TBAREA      AREA NAME
          BX6    X1 
          SA6    INFO+4 
          EQ     DOVRET 
* 
* /---   BLOCK      OUTPUT     00 000   74/03/13  23.35 
* 
* 
 PUTTAB   EQ     *           ENTRY / EXIT 
          SA2    INDX1       CURRENT WORD IN NEW TABLE
          SA1    SHFT1
          SX6    X1-12       COMPUTE SHIFT COUNT
          PL     X6,PT1 
          SX6    60-12       RE-INITIALIZE SHIFT COUNT
          SA6    A1 
          SX6    X2+1        ADVANCE WORD COUNT 
          SA6    A2 
          LX7    60-12       POSITION FIRST BYTE
          SA7    X6+INFO+5
          EQ     PUTTAB 
* 
 PT1      SB1    X6          PICK UP SHIFT COUNT
          SA6    A1 
          LX7    X7,B1
          SA1    X2+INFO+5   LOAD CURRENT WORD
          BX7    X1+X7
          SA7    A1          STORE WITH NEW ENTRY 
          EQ     PUTTAB 
* 
* 
 NENT     EQU    INFO+DATAMAX+5 
 NENTX    EQU    NENT+1 
 NTAB     EQU    NENTX+1
 INDX     EQU    NTAB+1 
 INDX1    EQU    INDX+1 
 SHFT1    EQU    INDX1+1
 ILTH     EQU    SHFT1+1
* 
* 
          ENDOV 
* /---   BLOCK      OUTPUTL    00 000   78/07/05  01.26 
          TITLE  -OUTPUTL- COMMAND
* 
* 
*         -OUTPUTL- COMMAND 
*         OUTPUTS AUTHOR GENERATED DATA WITH LABEL
* 
*         FIRST WORD -
*         IST  18 BITS =  ELAPSED TIME
*         NEXT 30      =  UNUSED
*         NEXT  6      =  TOTAL NUMBER OF WORDS 
*         NEXT  6      =  DATA TYPE CODE
* 
*         NEXT 2 WORDS =  STUDENTS NAME 
*         NEXT WORD    =  LESSON NAME 
*         NEXT WORD    =  AREA NAME 
*         NEXT WORD    =  DATA LABEL
*         NEXT N WORDS =  AUTHOR GENERATED DATA 
* 
* 
 OUTLOV   OVRLAY
          NG     X5,OUTDLX
          NGETVAR            GET OUTPUT LABEL 
          CALL   LJUST,(1R ),0
          BX6    X1 
          SA6    INFO+5 
          SA5    A5          RESTORE X5 
          LX5    XCODEL 
          NGETVAR            GET STARTING ADDRESS 
          SX6    A1 
          SA6    OLWK 
          SA5    A5          RESTORE X5 
          AX5    XCMNDL 
          MX2    2*XCODEL+XCMNDL
          BX5    -X2*X5      MASK OFF XSTOR POINTER 
          SA2    X5+B5
          BX5    X2          -GETVAR- CODE TO X5 FOR CALL 
          NGETVAR            GET NUMBER OF WORDS TO OUTPUT
          NG     X1,ERXBADL  NO NEGATIVE OR ZERO LENGTH 
          ZR     X1,ERXBADL  EXECERR USES X1 FOR ERXBADL
          SB2    X1-21
          PL     B2,ERXBADL  ERROR IF TOO MUCH DATA 
* /---   BLOCK      OUTPUTL    00 000   74/03/13  23.46 
* 
          SA2    OLWK        LOAD STARTING ADDRESS
          SA0    X2 
          CALL   BOUNDS 
          SB1    X1          RESTORE LENGTH 
          SB2    B1+6        SAVE TOTAL LENGTH FOR LATER
          SA1    ATEMPEC
          BX0    X1 
+         WE     B1          TRANSFER TO *INFO* VIA ECS 
          RJ     ECSPRTY
          SA0    INFO+6 
+         RE     B1 
          RJ     ECSPRTY
          MX0    -18
          SA1    SYSCLOK     LOAD CURRENT CLOCK 
          SA2    TIMEARK
          IX1    X1-X2       COMPUTE ELAPSED TIME 
          AX1    7
          BX1    -X0*X1      KEEP TO 1/10 SECOND
          LX1    60-18
          SX6    B2          PICK UP TOTAL LENGTH 
          LX6    6
          SX6    X6+AUTHDL   LENGTH AND CODE
          BX6    X1+X6
          SA6    INFO        STORE HEADER WORD
          SA1    TNAME
          BX6    X1          STORE FIRST WORD OF NAME 
          SA6    INFO+1 
          MX0    -12
          SA1    TNAME1 
          BX6    X0*X1       STORE SECOND WORD OF NAME
          SA6    INFO+2 
          CALL   FSQUISH,TBLESAC
          BX6    X1 
          SA6    INFO+3 
          SA1    TBAREA      AREA NAME
          BX6    X1 
          SA6    INFO+4 
          EQ     DOVRET 
* 
* /---   BLOCK      OUTPUTL    00 000   78/07/05  01.26 
* 
*         -OUTPUTL- COMMAND 
*         TWO ARGUMENT -OUTPUTL-   MINIMUM HEADER INFO
* 
* 
 OUTDLX   MX6    1
          BX5    -X6*X5      CLEAR FLAG BIT 
          NGETVAR 
          SX6    A1          SAVE ADDRESS 
          SA6    OLWK 
          SA5    A5          GET NEXT -GETVAR- CODE 
          LX5    XCODEL 
          NGETVAR            GET NUMBER OF WORDS TO OUTPUT
          NG     X1,ERXBADL  NO NEGATIVE OR ZERO LENGTH 
          ZR     X1,ERXBADL  EXECERR USES X1 FOR ERXBADL
          SB2    X1-21
          PL     B2,ERXBADL  ERROR IF TOO MUCH DATA 
          SA2    OLWK        LOAD STARTING ADDRESS
          SA0    X2 
          CALL   BOUNDS 
          SB1    X1          RESTORE LENGTH 
          SB2    B1+1        SAVE TOTAL LENGTH FOR LATER
          SA1    ATEMPEC
          BX0    X1 
+         WE     B1          TRANSFER TO *INFO* VIA ECS 
          RJ     ECSPRTY
          SA0    INFO+1 
+         RE     B1 
          RJ     ECSPRTY
          SX6    B2          PICK UP LENGTH OF RECORD 
          LX6    6
          SX6    X6+AUTHDX   ATTACH DATA TYPE CODE
          SA6    INFO 
          EQ     DOVRET 
* 
* 
 OLWK     BSS    1
* 
          ENDOV 
* /---   BLOCK      OUTPUTT    00 000   78/07/05  01.27 
          TITLE  -OUTPUTT-   OUTPUT TEXT FORMAT DATA
* 
* 
*         -OUTPUTT- 
*         OUTPUTS AUTHOR GENERATED TEXT 
* 
*         FIRST WORD -
*         IST  48 BITS =  UNUSED
*         NEXT  6      =  TOTAL NUMBER OF WORDS 
*         NEXT  6      =  DATA TYPE CODE
* 
*         NEXT 'N WORDS =  TEXT TO BE PUT INTO DATAFILE 
* 
* 
 OUTTOV   OVRLAY
* 
          NGETVAR            GET ADDRESS OF CHARACTER STRING
          SX6    A1 
          SA6    VARBUF      SAVE FOR LATER 
* 
          SA5    A5          RE-FETCH COMMAND WORD
          LX5    XCODEL 
          NGETVAR            GET SECOND ARGUMENT
* 
          NG     X1,ERXBADL  BAD LTH, EXECERR USES X1 
          ZR     X1,PROCESS  JUST EXIT IF LENGTH UNSUITABLE 
          SX6    X1-DATAMAX+1-1   1 WORD FOR HEADER 
          PL     X6,DERXBAD  LIMIT OF *DATAMAX* WORDS 
* 
          SA2    VARBUF      RE-FETCH STARTING ADDRESS
* 
          SA0    X2          PREPARE FOR BOUNDS TEST
          RJ     BOUNDS      SEE IF ALL WITHIN BOUNDS 
* 
* 
          SB1    X1          LTH OF BUFFER
          SX1    X1+1        LENGTH OF RECORD 
          SB2    X1          SAVE FOR DATAOUT 
* 
          LX1    6           POSITION LENGTH OF RECORD
          SX6    X1+DOUTT    ATTACH DATA TYPE CODE
          SA6    INFO        STORE HEADER WORD
* 
          SA1    ATEMPEC
          BX0    X1          ADDRESS OF SCRATCH ECS 
+         WE     B1 
          RJ     ECSPRTY
          SA0    INFO+1      MOVE BUFFER SPECIFIED TO *INFO*
+         RE     B1 
          RJ     ECSPRTY
* 
* 
          EQ     DOVRET 
* 
 DERXBAD  SX2    DATAMAX-1   POSSIBLY OFF BY ONE
          EXECERR 98         VALUE TOO HIGH 
* 
          ENDOV 
* /---   BLOCK      ANSDAT     00 000   76/04/26  04.55 
          TITLE  -ANSDAT-    OUTPUT STUDENTS ANSWER 
* 
* 
*         -ANSDAT-
*         OUTPUTS STUDENT ANSWER AND RELATED INFORMATION
* 
*         FIRST WORD -
*         1ST  18 BITS =  ELAPSED TIME SINCE SIGN-ON
*         NEXT  6      =  JUDGEMENT TYPE
*         NEXT  9      =  ARROW NUMBER
*         NEXT 15      =  ANSWER DUMP CAUSE BITS
*         NEXT  6      =  TOTAL NUMBER OF WORDS 
*         NEXT  6      =  DATA TYPE CODE
* 
*         NEXT 2 WORDS =  STUDENTS NAME 
*         NEXT WORD    =  LESSON NAME 
*         NEXT WORD    =  AREA NAME 
*         NEXT WORD    =  UNIT NAME 
*         NEXT N WORDS =  STUDENTS ANSWER 
* 
* 
 ANSDOV   OVRLAY
          SA1    TBITS       SEE IF -ERASEU- BIT SET
          LX1    ERSUBIT
          NG     X1,ANSDAT   EXIT IF PROCESSING -ERASEU-
          MX6    -1          MARK *INFO* BUFFER USED
          SA6    JJSTORE
          SA1    TJUDGED     LOAD JUDGMENT
          NG     X1,DANS1    JUMP IF -OK- 
          ZR     X1,DANS2    JUMP IF RECOGNIZED -NO-
          CALL   AREAINC,1,27 
          MX7    1
          LX7    DSUNO       POSITION BIT FOR UNRECOGINZED
          SA1    TBLDATA+1
          BX7    X1+X7       MERGE WITH REST OF DUMP BITS 
          MX1    1
          LX1    DSNO        POSITION BIT FOR -NO-
          BX7    X1+X7
          SA7    A1 
          EQ     ANSXX
* 
 DANS1    CALL   AREAINC,1,9
          SA1    TBLDATA+1
          MX7    1
          LX7    DSOK        SET BIT FOR -OK- 
          BX7    X1+X7
          SA7    A1 
          MX7    -9 
          BX7    -X7*X1      MASK OFF NUMBER OF TRIES 
          SX7    X7-1 
          NZ     X7,ANSXX    JUMP IF NOT FIRST TRY
          CALL   AREAINC,1,18 
          EQ     ANSXX
* /---   BLOCK      ANSDAT     00 000   74/12/31  18.47 
* 
 DANS2    CALL   AREAINC,1,0
          SA1    TBLDATA+1
          MX7    1
          LX7    DSNO        SET BIT FOR -NO- 
          BX7    X1+X7
          SA7    A1 
* 
 ANSXX    SA1    TBLDATA     SELECTED DATA OPTION BITS
          SB1    X1          SEE IF COLLECTING DATA 
          SA2    TBTDATA
          NG     X2,ANSDAT   EXIT IF -SYSDATA- USAGE
          BX1    X1+X2       ATTACH LESSON-SELECTED BITS
          SA2    TBLDATA+1
          MX0    -9 
          BX6    -X0*X2      CLEAR OUT ALL BUT TRY COUNTER
          SA6    A2 
          ZR     B1,ANSDAT   EXIT IF NOT COLLECTING DATA
          BX6    X1*X2       SEE IF SHOULD DUMP ANSWER
          AX6    18 
          ZR     X6,ANSDAT
          MX0    15          ALLOW 15 BITS ONLY 
          LX2    1
          BX6    X0*X2       MASK OFF DUMP CAUSE BITS 
          SA6    ADWK1
          SA1    LESUN       LOAD UNIT NUMBER 
          SX6    X1 
          SA6    ADWK        CONVERT NUMBER TO NAME 
          CALL   HOLUNIT,ADWK,ADWK
          MX0    -18
          SA1    SYSCLOK     LOAD CURRENT CLOCK 
          SA2    TIMEARK
          IX1    X1-X2       COMPUTE ELAPSED TIME 
          AX1    7           KEEP TO ABOUT 1/10 SECOND
          BX1    -X0*X1 
          LX1    60-18       POSITION ELAPSED TIME
          MX0    -6 
          SA2    TJUDGED     LOAD ANSWER JUDGMENT 
          SX6    X2+2        1=OK  2=NO  3=UNREC NO 
          BX2    -X0*X6 
          LX2    60-18-6
          BX6    X1+X2       BEGIN FORMING HEADER WORD
* /---   BLOCK      ANSDAT     00 000   76/05/17  22.12 
* 
          MX0    -9 
          SA1    AREADAT
          BX1    -X0*X1      MASK OFF ARROW COUNT 
          LX1    60-18-6-9
          BX6    X6+X1       MERGE WITH HEADER WORD 
          SA1    LONG        NUMBER OF 6 BIT CODES
          SX1    X1+9 
          PX1    X1          PACK CHARACTER COUNT 
          SA2    ADK1 
          FX1    X1*X2       COMPUTE NUMBER OF WORDS
          SB1    X1 
          SX1    X1+6        INCREMENT FOR ADDITIONAL INFO
          SB2    X1          SAVE TOTAL COUNT FOR CALL
          LX1    6           POSITON WORD COUNT 
          BX6    X6+X1
          SA1    ADWK1       LOAD DUMP-CAUSE BITS 
          LX1    6+6+15 
          BX6    X1+X6
          SX1    STANS       CODE FOR STUDENT ANSWER
          BX6    X6+X1
          SA6    INFO        STORE COMPLETED HEADER 
          SA1    TNAME       FIRST WORD OF STUDENTS NAME
          BX6    X1 
          SA6    INFO+1 
          MX0    48 
          SA1    TNAME1      SECOND WORD OF STUDENTS NAME 
          BX6    X0*X1
          SA6    INFO+2 
          CALL   FSQUISH,TBLESAC
          BX6    X1 
          SA6    INFO+3 
          SA1    TBAREA      AREA NAME
          BX6    X1 
          SA6    INFO+4 
          SA1    ADWK        LOAD UNIT NAME 
          BX6    X1 
          SA6    INFO+5 
          SA1    TBINPUT     ADDRESS OF STUDENTS ANSWER 
          SA0    X1 
          SA1    ATEMPEC     ADDRESS OF ECS SCRATCH BUFFER
          BX0    X1 
+         WE     B1          MOVE STUDENTS ANSWER 
          RJ     ECSPRTY
          SA0    INFO+6 
+         RE     B1 
          RJ     ECSPRTY
          EQ     ADVEXIT
* 
 ADK1     DATA   17170631463146314632B    (1/10)*2**-48 
 ADWK     BSS    1
 ADWK1    BSS    1
* 
 ADVEXIT  RETURN
* 
* 
          ENDOV 
* /---   BLOCK      AREAOUT    00 000   74/12/31  18.47 
          TITLE  -AREAOUT-   OUTPUT -AREA- COMMAND DATA 
* 
* 
*         -AREAOUT- 
*         OUTPUTS DATA ASSOCIATED WITH -AREA- COMMAND 
* 
*         FIRST WORD -
*         IST  18 BITS =  CURRENT TIME
*         NEXT 30      =  UNUSED
*         NEXT  6      =  TOTAL NUMBER OF WORDS 
*         NEXT  6      =  DATA TYPE CODE
* 
*         NEXT 2 WORDS =  STUDENTS NAME 
*         NEXT WORD    =  LESSON NAME 
*         NEXT WORD    =  AREA NAME 
*         NEXT 3 WORDS =  AREA DATA 
* 
* 
 AREAOV   OVRLAY
          SA1    TBLDATA     SEE IF COLLECTING DATA 
          SX2    X1 
          ZR     X2,AREAOUT 
          SA2    TBTDATA     ATTACH LESSON-SELECTED BITS
          NG     X2,AREAOUT  EXIT IF -SYSDATA-
          BX1    X1+X2
          LX1    60-DSAREA   SEE IF SHOULD DUMP -AREA-
          PL     X1,AREAOUT 
          SA1    TBAREA      SEE IF ANY -AREA- COMMAND
          ZR     X1,AREAOUT 
          BX6    X1          STORE -AREA- NAME
          SA6    INFO+4 
          MX0    -18
          SA1    SYSCLOK     LOAD CURRENT CLOCK 
          SA2    TIMEARK
          IX2    X1-X2       COMPUTE ELAPSED TIME 
          AX2    7           KEEP TO ABOUT 1/10 SECOND
          BX2    -X0*X2 
          LX2    60-18       POSITION ELAPSED TIME
* /---   BLOCK      AREAOUT    00 000   77/11/05  07.47 
* 
          MX0    18 
          SA1    AREADAT+1   GET TIME OF ENTRY TO AREA
          BX1    X0*X1
          IX1    X2-X1       CURRENT TIME - ENTRY TIME
          SA3    AREADAT+2   GET PREVIOUS ELAPSED TIME
          BX6    X0*X3
          IX6    X1+X6       ADD ON RECENT ELAPSED TIME 
          BX6    X0*X6
          BX3    -X0*X3      CLEAR OUT OLD ELAPSED TIME 
          BX6    X3+X6
          SA6    A3 
          SX6    1000B+DAREA LENGTH AND CODE
          BX6    X6+X2
          SA6    INFO        STORE HEADER WORD
          SA1    TNAME
          BX6    X1          FIRST WORD OF STUDENTS NAME
          SA6    INFO+1 
          MX0    48 
          SA1    TNAME1      SECOND WORD OF NAME
          BX6    X0*X1
          SA6    INFO+2 
          CALL   FSQUISH,TBLESAC
          BX6    X1 
          SA6    INFO+3 
          SA1    AREADAT     AREA DATA WORD 
          BX6    X1 
          SA6    INFO+5 
          SA1    AREADAT+1   SECOND AREA DATA WORD
          BX6    X1 
          SA6    INFO+6 
          SA1    AREADAT+2   THIRD AREA DATA WORD 
          BX6    X1 
          SA6    INFO+7 
          LX1    18          CHECK IF LAST AREA WAS COMPLETE
          MX0    1
          LX0    60-18-1     POSITION AREA CONTINUED BIT
          BX6    X0+X6       SET CONTINUATION BIT 
          SA6    A1          WRITE TO INFO BUFFER 
          PL     X1,AOVEND
          MX6    0
          SA6    TBAREA      CLEAR OUT AREA NAME
          SA6    AREADAT
          MX0    -18
          SA1    AREADAT+2   SAVE -DATAON- TIME 
          BX6    -X0*X1      IN LOWER 18 BITS 
          SA6    AREADAT+2
          SA1    SYSCLOK     LOAD RUNNING CLOCK 
          SA2    TIMEARK
          IX1    X1-X2       ELAPSED TIME AT ENTRY
          AX1    7           KEEP TO ABOUT 1/10 SECOND
          BX6    -X0*X1 
          LX6    60-18
          SA6    AREADAT+1   INITIALIZE DATA FOR THIS AREA
* 
 AOVEND   RETURN
* 
* 
          ENDOV 
* /---   BLOCK      HELPOUT    00 000   74/12/31  18.49 
          TITLE  -HELPOUT-   OUTPUT -HELP- KEY DATA 
* 
* 
*         -HELPOUT- 
*         OUTPUTS HELP-TYPE KEY DATA
* 
*         ON ENTRY - *OVARG1* =  0 IF HELP NOT FOUND
*                               -1 IF HELP WAS FOUND
*                          X5 = UNIT NUMBER 
* 
*         FIRST WORD -
*         IST  18 BITS =  CURRENT TIME
*         NEXT 30      =  UNUSED
*         NEXT  6      =  TOTAL NUMBER OF WORDS 
*         NEXT  6      =  DATA TYPE CODE
* 
*         NEXT 2 WORDS =  STUDENTS NAME 
*         NEXT WORD    =  LESSON NAME 
*         NEXT WORD    =  AREA NAME 
*         NEXT WORD    =  CURRENT UNIT NAME 
*         NEXT WORD    =  HELP UNIT NAME  (OR 0)
*         NEXT WORD    =  HELP KEY NAME 
* 
* 
 HELPOV   OVRLAY
          BX6    X5          SAVE X5  (UNIT NUMBER) 
          SA6    HELPSAV
          SA1    OVARG1 
          NG     X1,HLPA     JUMP IF -HELP- WAS FOUND 
          CALL   AREAINC,0,9
          SA1    TBLDATA
          SX2    X1          SEE IF COLLECTING DATA 
          ZR     X2,HELPOUT 
          SA2    TBTDATA
          NG     X2,HELPOUT  EXIT IF -SYSDATA-
          BX1    X1+X2       ATTACH LESSON-SELECTED BITS
          LX1    60-DSHELPN  SEE IF COLLECTING -HELP- DATA
          PL     X1,HELPOUT 
          MX6    0           SET FOR -HELP- NOT FOUND 
          SA6    INFO+6 
          EQ     HLPB 
* 
 HLPA     CALL   AREAINC,0,18 
          SA1    TBLDATA
          SX2    X1          SEE IF COLLECTING DATA 
          ZR     X2,HELPOUT 
          SA2    TBTDATA     ATTACH LESSON-SELECTED BITS
          NG     X2,HELPOUT  EXIT IF -SYSDATA-
          BX1    X1+X2
          LX1    60-DSHELP
          PL     X1,HELPOUT  SEE IF COLLECTING -HELP- DATA
          SA1    ILESUN 
          BX5    X1          BE SURE LESSON POINTERS SET
          CALL   SETLESN
          CALL   HOLUNIT,HELPSAV,INFO+6 
* /---   BLOCK      HELPOUT    00 000   76/05/17  22.12 
* 
 HLPB     SA1    KEY         CONVERT KEY NUMBER TO NAME 
          SA2    HK1         *NOSUCH* 
          BX6    X1+X2       MAKE UP NAME IN CASE NO FIND 
          SA6    NKLEND 
          MX0    -18         MASK FOR KEY NUMBER
          SA2    NKLIST-1 
* 
 HKLP     SA2    A2+1        LOAD NEXT KEY NAME/NUMBER
          BX3    -X0*X2 
          BX3    X1-X3       SEE IF NUMBERS MATCH 
          NZ     X3,HKLP
          BX6    X0*X2       MASK OFF KEY NAME
          SA6    INFO+7 
          SA1    SYSCLOK     LOAD CURRENT CLOCK 
          SA2    TIMEARK
          IX1    X1-X2       COMPUTE ELAPSED TIME 
          AX1    7
          BX1    -X0*X1      KEEP TO 1/10 SECOND
          LX1    60-18
          SX6    1000B+HELPD
          BX6    X1+X6       FORM HEADER WORD 
          SA6    INFO 
          SA1    TNAME
          BX6    X1          FIRST WORD OF STUDENT NAME 
          SA6    INFO+1 
          MX0    -12
          SA1    TNAME1 
          BX6    X0*X1       SECOND WORD OF STUDENT NAME
          SA6    INFO+2 
          CALL   FSQUISH,TBLESAC
          BX6    X1          STORE LESSON NAME
          SA6    INFO+3 
          SA1    TBAREA 
          BX6    X1          STORE AREA NAME
          SA6    INFO+4 
          SA1    TUNAME 
          BX6    X1          STORE CURRENT UNIT NAME
          SA6    INFO+5 
          EQ     HOEXIT 
* 
 HK1      DATA   6LNOSUCH 
* 
 HOEXIT   RETURN
* 
* 
          ENDOV 
* /---   BLOCK      TERMOUT    00 000   76/05/29  00.23 
          TITLE  -TERMOUT-   OUTPUT -TERM- DATA 
* 
* 
*         -TERMOUT- 
*         OUTPUTS TERM REQUEST INFO 
* 
*         ON ENTRY - *OVARG1* =  0 IF TERM NOT FOUND
*                               -1 IF TERM WAS FOUND
* 
*         FIRST WORD -
*         IST  18 BITS =  CURRENT TIME
*         NEXT 30      =  UNUSED
*         NEXT  6      =  TOTAL NUMBER OF WORDS 
*         NEXT  6      =  DATA TYPE CODE
* 
*         NEXT 2 WORDS =  STUDENTS NAME 
*         NEXT WORD    =  LESSON NAME 
*         NEXT WORD    =  AREA NAME 
*         NEXT WORD    =  TERM DATA 
* 
* 
 TERMOV   OVRLAY
          SA1    OVARG1 
          ZR     X1,TRMOUT0  JUMP IF TERM NOT FOUND 
          CALL   AREAINC,0,36 
          SA1    TBLDATA     SEE IF COLLECTING DATA 
          SX2    X1 
          ZR     X2,TERMOUT 
          SA2    TBTDATA     ATTACH LESSON-SELECTED BITS
          NG     X2,TERMOUT  EXIT IF -SYSDATA-
          BX1    X1+X2
          LX1    60-DSTERM
          PL     X1,TERMOUT  SEE IF TERM DUMP SPECIFIED 
          MX7    0           FLAG FOR TERM FOUND
          EQ     TRMOUT1
* 
 TRMOUT0  CALL   AREAINC,0,27 
          SA1    TBLDATA     SEE IF COLLECTING DATA 
          SX2    X1 
          ZR     X2,TERMOUT 
          SA2    TBTDATA     ATTACH LESSON-SELECTED BITS
          NG     X2,TERMOUT  EXIT IF -SYSDATA-
          BX1    X1+X2
          LX1    60-DSTERMN 
          PL     X1,TERMOUT  SEE IF TERM DUMP SPECIFIED 
          SX7    1
* 
 TRMOUT1  MX0    -18
          SA1    SYSCLOK     LOAD CURRENT CLOCK 
          SA2    TIMEARK
          IX1    X1-X2       COMPUTE ELAPSED TIME 
          AX1    7
          BX1    -X0*X1      KEEP TO 1/10 SECOND
          LX1    60-18
          SX6    600B+TERMD  LENGTH AND CODE
          BX6    X1+X6
          SA6    INFO        STORE HEADER WORD
          SA1    TNAME
          BX6    X1          STORE FIRST WORD OF NAME 
          SA6    INFO+1 
          MX0    -12
          SA1    TNAME1 
          BX6    X0*X1       STORE SECOND WORD OF NAME
          SA6    INFO+2 
          CALL   FSQUISH,TBLESAC
          BX6    X1 
          SA6    INFO+3 
          SA1    TBAREA      AREA NAME
          BX6    X1 
          SA6    INFO+4 
* 
          SA1    TTERM       TERM NAME
          BX6    X1+X7       STORE TERM NAME AND BIT
          SA6    INFO+5 
          RETURN
* 
          ENDOV 
* 
* 
* /---   BLOCK      PARAMETERS 00 000   77/07/14  03.38 
          TITLE  PARAMETERS FOR READL,READA,READD 
* 
*   THE FOLLOWING BUFFER IS USED BY READL, READA, READD 
*   OVERLAYS TO ASSEMBLE THE STUDENT DATA PACKAGE TO BE 
*   WRITTEN TO ECS. 
* 
 IIBUFF   EQU    INFO+DATAMAX+1 
* 
* 
* /---   BLOCK      READL      00 000   78/12/23  00.34 
          TITLE  READL
* 
*         -READL- COMMAND 
* 
*         READ NEXT -OUTPUTL- DATA RECORD 
* 
*         ON EXIT-- 
*           *TRETURN* = -1  IF OK 
*                        0  IF END-OF-FILE ENCOUNTERED
*           (*TERROR* = REVERSE OF ABOVE) 
* 
* 
 READLOV  OVRLAY
          MX0    -6 
          SA1    INFO        LOAD HEADER WORD 
          ZR     X1,RLEOF    JUMP IF END-OF-FILE
          BX2    -X0*X1 
          SX6    X2-AUTHDL   CHECK FOR -OUTPUTL-
          ZR     X6,RLLPA 
          SX6    X2-AUTHDX
          ZR     X6,RDOLX    JUMP IF TWO-ARG -OUTPUTL-
          EQ     RLLOOP 
* 
 RLLPA    MX6    18 
          BX6    X6*X1       MASK OFF TIME
          LX6    18+7 
          SA6    IIBUFF+5 
          AX1    6           POSITION LENGTH OF RECORD
          BX1    -X0*X1 
          SX6    X1+1        LENGTH OF RE-FORMATTED RECORD
          SA6    IIBUFF 
          SA1    INFO+2      SECOND WORD OF STUDENT NAME
          BX6    X1 
          SA6    IIBUFF+2 
          SA1    INFO+1      FIRST WORD OF STUDENT NAME 
* 
 RLLP0    BX6    X1 
          SA6    IIBUFF+1 
          SA1    INFO+3 
          BX6    X1          LESSON NAME
          SA6    IIBUFF+3 
          SA1    INFO+4 
          BX6    X1          AREA NAME
          SA6    IIBUFF+4 
          SA1    INFO+5 
          BX6    X1          OUTPUT LABEL 
          SA6    IIBUFF+6 
          SA1    IIBUFF      LENGTH OF RECORD 
          SB3    X1          SAVE TOTAL LENGTH OF RECORD
          SB1    X1-7        LENGTH OF AUTHOR DATA
          SA2    ATEMPEC
          BX0    X2 
          SA0    IIBUFF      REFORM RECORD IN TEMP ECS
          WE     7
          RJ     ECSPRTY
          SA0    INFO+6 
          SX3    7           ADVANCE ECS ADDRESS
          IX0    X0+X3
          WE     B1          WRITE OUT AUTHOR DATA
          RJ     ECSPRTY
* 
 RLLPB    SA1    TBDFINF+1
          SB2    X1          PICK OFF ADDRESS OF BUFFER 
          AX1    18 
          SB1    X1          PICK OFF LENGTH OF BUFFER
          BX0    X2          ECS SCRATCH BUFFER 
          SA0    B2 
          RE     B1          MOVE DATA TO AUTHOR BUFFER 
          RJ     ECSPRTY
          GE     B3,B1,RLLP1
          SA0    B2+B3
          SB3    B1-B3
          SX1    A0          SAVE *A0*
          ZERO   X1,B3       CLEAR OUT REST OF BUFFER 
* /---   BLOCK      RLLP1      00 000   78/12/23  00.36 
* 
 RLLP1    MX6    -1          -1 = OK
          MX7    0
          SA6    TRETURN
          SA7    TERROR 
          EQ     PROCESS     --- RETURN 
* 
 RDOLX    AX1    6           POSITION LENGTH OF RECORD
          BX1    -X0*X1 
          SB1    X1-1        LENGTH OF AUTHOR DATA
          SX6    B1+7        LENGTH OF REFORMATED RECORD
          SA6    IIBUFF 
          SB3    X6 
          MX6    0           CLEAR OUT NAME, LESSON ETC 
          SA6    IIBUFF+1 
          SA6    IIBUFF+2 
          SA6    IIBUFF+3 
          SA6    IIBUFF+4 
          SA6    IIBUFF+5 
          SA6    IIBUFF+6 
          SA2    ATEMPEC
          BX0    X2 
          SA0    IIBUFF      REFORM RECORD IN ECS 
          WE     7
          RJ     ECSPRTY
          SX3    7
          IX0    X0+X3
          SA0    INFO+1 
          WE     B1          WRITE OUT AUTHOR DATA
          RJ     ECSPRTY
          EQ     RLLPB
* 
* 
 RLEOF    SA1    TBDFINF+1   LOAD BUFFER ADDRESS/LENGTH 
          SA0    X1          PICK OFF ADDRESS 
          AX1    18 
          SB1    X1          PICK OFF LENGTH
          SX1    A0          SAVE *A0*
          ZERO   X1,B1       ZERO REST OF BUFFER
          SA1    TBDFINF
          SX1    X1          RELEASE DATA-READ BUFFER 
          CALL   ALTLES,-1
          MX6    0
          SA6    TBDFINF     CLEAR OUT INFO WORDS 
          SA6    TBDFINF+1
          MX6    0           0 = END-OF-FILE ENCOUNTERED
          MX7    -1 
          SA6    TRETURN
          SA7    TERROR 
          EQ     PROCESS     --- RETURN 
* 
* 
          ENDOV 
* /---   BLOCK      READA      00 000   75/11/27  20.27 
          TITLE  READA
* 
*         -READA- COMMAND 
* 
*         READ NEXT -AREA- DATA RECORD
* 
*         ON EXIT-- 
*           *TRETURN* = -1  IF OK 
*                        0  IF END-OF-FILE ENCOUNTERED
*           (*TERROR* = REVERSE OF ABOVE) 
* 
* 
 READAOV  OVRLAY
          MX0    -6 
          SA1    INFO        LOAD HEADER WORD 
          ZR     X1,RAEOF    JUMP IF END-OF-FILE
          BX2    -X0*X1 
          SX2    X2-DAREA    CHECK FOR -AREA- DATA
          NZ     X2,RALOOP
          SA1    INFO+2      SECOND WORD OF STUDENT NAME
          BX6    X1 
          SA6    IIBUFF+1 
          SA1    INFO+1      FIRST WORD OF STUDENT NAME 
* /---   BLOCK      RALP0      00 000   78/12/23  00.37 
* 
 RALP0    BX6    X1 
          SA6    IIBUFF 
          SA1    INFO+3      LESSON NAME
          BX6    X1 
          SA6    IIBUFF+2 
          SA1    INFO+4      AREA NAME
          BX6    X1 
          SA6    IIBUFF+3 
          MX6    18 
          SA1    INFO+7      ELAPSED TIME 
          BX6    X6*X1
          LX6    18+7        REPOSITION FOR MSEC TIME 
          SA6    IIBUFF+4 
          BX6    X1 
          LX6    19          POSITION CONTINUATION BIT
          AX6    59 
          MX0    -1          -1 IF A CONTINUATION 
          BX6    X6*X0
          SA6    IIBUFF+15
          LX1    18          POSITION -COMPLETE- BIT
          AX1    59 
*          MX6    -1
          BX6    X1*X0       -1 = COMPLETE, 0 = INCOMPLETE
          SA6    IIBUFF+14
          MX0    -9 
          SA1    INFO+5 
          BX6    -X0*X1      NUMBER OF ARROWS ENCOUNTERED 
          SA6    IIBUFF+5 
          AX1    9
          BX6    -X0*X1      NUMBER OF UNSUCESSFUL -HELPS-
          SA6    IIBUFF+11
          AX1    9
          BX6    -X0*X1      NUMBER OF SUCESSFUL -HELPS-
          SA6    IIBUFF+10
          AX1    9
          BX6    -X0*X1      NUMBER OF UNSUCESSFUL -TERMS-
          SA6    IIBUFF+13
          AX1    9
          BX6    -X0*X1      NUMBER OF SUCESSFUL -TERMS-
          SA6    IIBUFF+12
          SA1    INFO+6 
          BX6    -X0*X1      NUMBER OF -NO- JUDGEMENTS
          SA6    IIBUFF+8 
          AX1    9
          BX6    -X0*X1      NUMBER OF -OK- JUDGEMENTS
          SA6    IIBUFF+6 
          AX1    9
          BX6    -X0*X1      NUMBER -OK- ON FIRST TRY 
          SA6    IIBUFF+7 
          AX1    9
          BX6    -X0*X1      NUMBER OF UNRECOGNIZED -NO-
          SA6    IIBUFF+9 
* 
          SA1    TBDFINF+1
          SB2    X1          PICK OFF ADDRESS OF BUFFER 
          AX1    18 
          SB1    X1          PICK OFF LENGTH OF BUFFER
          SB3    16          **** LENGTH OF DATA **** 
          GE     B3,B1,RALP1
          SA0    B3+IIBUFF
          SB3    B1-B3
          SX1    A0          SAVE *A0*
          ZERO   X1,B3       CLEAR OUT REST OF BUFFER 
* /---   BLOCK      RALP1      00 000   78/12/23  00.39 
* 
 RALP1    SA1    ATEMPEC
          BX0    X1          ECS SCRATCH BUFFER 
          SA0    IIBUFF 
          WE     B1          MOVE DATA TO ECS SCRATCH 
          RJ     ECSPRTY
          SA0    B2 
          RE     B1          MOVE DATA TO AUTHOR BUFFER 
          RJ     ECSPRTY
          MX6    -1          -1 = OK
          MX7    0
          SA6    TRETURN
          SA7    TERROR 
          EQ     PROCESS     --- RETURN 
* 
 RAEOF    SA1    TBDFINF+1   LOAD BUFFER ADDRESS/LENGTH 
          SA0    X1          PICK OFF ADDRESS 
          AX1    18 
          SB1    X1          PICK OFF LENGTH
          SX1    A0          SAVE *A0*
          ZERO   X1,B1       ZERO REST OF BUFFER
          SA1    TBDFINF
          SX1    X1          RELEASE DATA-READ BUFFER 
          CALL   ALTLES,-1
          MX6    0
          SA6    TBDFINF     CLEAR OUT INFO WORDS 
          SA6    TBDFINF+1
          MX6    0           0 = END-OF-FILE ENCOUNTERED
          MX7    -1 
          SA6    TRETURN
          SA7    TERROR 
          EQ     PROCESS     --- RETURN 
* 
* 
          ENDOV 
* /---   BLOCK      SYSDATA    00 000   75/08/25  00.51 
          TITLE  -SYSDATA- COMMAND
* 
* 
* 
*         -SYSDATA- COMMAND 
*         PERFORMS VARIOUS SYSTEM FUNCTIONS FOR HANDLING
*         OF STUDENT DATA FILES 
* 
* 
 SDATOV   OVRLAY
          MX6    -1          MARK *INFO* BUFFER USED
          SA6    JJSTORE
          NGETVAR            GET OPTION CODE
          SB1    X1 
          JP     B1+*+1 
* 
+         EQ     SDAT10      -SETFILE-
+         EQ     SDAT20      -REWIND- 
+         EQ     SDAT30      -CHECKPT-
* 
* 
* 
*         SYSDATA    SETFILE,FILE NAME
*         ACTIVATES DATA FOR THIS STUDENT WITH ONLY -OUTPUT-
*         AND -OUTPUTL- COMMAND DATA SELECTED 
* 
* 
 SDAT10   SX6    3
          CALL   GETCODX     UNPACK 3 ARGUMENTS TO VARBUF 
          CALL   ACCFILE,VARBUF+1,TBINTSV,0 
          SA1    TBINTSV+1   LOAD FILE NAME 
          ZR     X1,SDAT90   EXIT IF FILE NAME ZERO 
* 
          SA1    TBLDATA
          SX0    X1          CHECK IF DATA ALREADY ON 
          NZ     X0,SDAT90
          MX0    1           SET UP -SYSDATA- BIT 
          MX6    1
          LX6    DSOUTP      SET UP BIT FOR -OUTPUT- COMMAND
          BX6    X0+X6       ATTACH -SYSDATA- BIT 
          SA6    TBTDATA
          MX6    0           CLEAR -AREA- COMMAND INFO
          SA6    TBAREA 
          SA6    AREADAT
          SA6    AREADAT+1
          SA6    AREADAT+2
          EQ     SDSETX      GO TO ACTIVATE DATA COLLECTION 
* 
* /---   BLOCK      SYSDATA    00 000   77/10/20  01.38 
* 
* 
*         SYSDATA   REWIND
*         REWINDS AND CHECKPOINTS DATA-FILE SPECIFIED BY
*         STUDENT BANK VARIABLE *TBLDATA* 
* 
* 
 SDAT20   SA1    TBLDATA     GET DATA BUFFER LESSON NUMBER
          SX1    X1 
          ZR     X1,SDAT90   EXIT IF NO DATA FILE 
          CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
          CALL   DATDATE     GET HOLLERITH DATE AND TIME
          SA1    ITEMP
          BX6    X1          SAVE COMPRESSED DATE / TIME
          SA6    SDWK 
          INTLOK X,I.DAT,W   INTERLOCK
          SA1    TBLDATA     GET BUFFER LESSON NUMBER 
          SX1    X1 
          CALL   READLES,IBUFF,(LPRMLTH+DPRMLTH)
          SX1    LPRMLTH
          IX5    X0+X1       ECS ADDRESS OF DATA BUFFER 
          SA1    IINF+DATSTAT    LOAD BUFFER STATUS WORD
          BX0    X1 
          LX0    DINITSH     CHECK IF FILE BEING INITIALIZED
          NG     X0,SDAT96
          BX0    X1 
          LX0    DWRITSH     CHECK IF FILE BEING WRITTEN
          NG     X0,SDAT96
          BX0    X1 
          LX0    DERRSH      CHECK IF ERROR HAS OCCURRED
          NG     X0,SDAT97
          MX0    1
          LX0    -DFULLSH    SET UP MASK FOR FILE FULL BIT
          BX6    -X0*X1      CLEAR FILE FULL BIT
          SA6    A1 
          SX6    1           RE-SET CURRENT BLOCK NUMBER
          SA6    IINF+DATBLOK 
          SX6    0           RE-SET CURRENT WORD NUMBER 
          SA6    IINF+DATWORD 
          BX0    X5          ECS ADDRESS OF INFO
          SA0    IINF 
+         WE     DPRMLTH     UPDATE BUFFER INFO WORDS 
          RJ     ECSPRTY
* /---   BLOCK      SYSDATA    00 000   78/12/23  00.45 
* 
          SX3    DDIRECT     X3 = BIAS TO DIRECTORY AREA
          IX0    X5+X3       ECS ADDRESS OF DIRECTORY AREA
          SA0    BBUFF
+         RE     BLKLTH      READ IN DIRECTORY BLOCK
          RJ     ECSPRTY
          SA1    BBUFF+2     LOAD NUMBER OF BLOCKS IN FILE
          SB1    X1-1        SUBTRACT 1 FOR DIRECTORY BLOCK 
          ZERO   BBUFF+64+128+1,B1   ZERO OUT BLOCK NAMES 
          SA1    SDWK        LOAD COMPRESSED DATE / TIME
          BX6    X1 
          SA6    A0          SET DATE FIRST BLOCK STARTED 
          SA0    BBUFF+64+1  ADDRESS OF BLOCK INFO WORDS + 1
          SB2    0           B2=POINTER 
          SB3    1           B3=INCREMENT 
          MX0    -9 
          LX0    9
 SDAT22   SA1    A0+B2
          BX6    X0*X1       CLEAR THE WORD COUNT 
          SA6    A1 
          SB2    B2+B3
          LT     B2,B1,SDAT22 
* 
          SA1    BBUFF+3     FLAG / LAST BLOCK USED 
          SX2    1           X2 = NEW LAST BLOCK
          MX6    -18
          BX6    X6*X1       ONLY LAST 18 BITS ARE BLOCK
          BX6    X6+X2       PUT IN NEW BLOCK NUMBER (1)
          SA6    A1 
* 
 SDAT25   SA0    BBUFF
          IX0    X5+X3       ECS ADDRESS OF DIRECTORY AREA
+         WE     BLKLTH      RE-WRITE DIRECTORY 
          RJ     ECSPRTY
          ZERO   BBUFF,BLKLTH    ZERO *BBUFF* BUFFER
          SX1    DBLK1       BIAS TO CURRENT DATA BLOCK 
          IX0    X5+X1
+         WE     BLKLTH      ZERO CURRENT DATA BLOCK
          RJ     ECSPRTY
          EQ     SDAT35 
* /---   BLOCK      SYSDATA    00 000   81/08/19  03.59 
* 
* 
*         SYSDATA   CHECKPT 
*         CHECKPOINTS DATA FILE INDICATED BY *TBLDATA*
* 
* 
 SDAT30   CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
* 
 SDAT35   INTLOK X,I.DAT,W   INTERLOCK
          SA1    TBLDATA
          SX1    X1          DATA BUFFER LESSON NUMBER
          ZR     X1,SDAT95
          CALL   READLES,IBUFF,(LPRMLTH+DPRMLTH)
          SA1    IINF+DATSTAT   LOAD BUFFER STATUS WORD 
          BX0    X1 
          LX0    DINITSH     CHECK IF FILE BEING INITIALIZED
          NG     X0,SDAT96
          BX0    X1 
          LX0    DWRITSH     CHECK IF FILE BEING WRITTEN
          NG     X0,SDAT96
          BX0    X1 
          LX0    DFULLSH     CHECK IF FILE FULL 
          NG     X0,SDAT98
          LX1    DERRSH      CHECK IF ERROR HAS OCCURRED
          NG     X1,SDAT97
          EQ     SDCHKX      GO TO CHECKPOINT DATA FILE 
* 
* 
* 
* 
 SDAT90   MX6    -1          MARK ERROR OCCURRED
          SA6    TERROR 
          INTCLR X,I.DAT     RELEASE INTERLOCK
          EQ     PROC 
* 
 SDAT95   MX6    -1          MARK ERROR OCCURRED
          SA6    TERROR 
          EQ     SDATX
* 
 SDAT96   SX6    -2          -2 = DATA FILE ACTIVE
          SA6    TERROR 
          EQ     SDATX
* 
 SDAT97   SX6    -3          -3 = DISK ERROR HAS OCCURRED 
          SA6    TERROR 
          EQ     SDATX
* 
 SDAT98   SX6    -4          -4 = DATA FILE FULL
          SA6    TERROR 
          EQ     SDATX
* 
 SDAT99   MX6    0           MARK NO ERROR
          SA6    TERROR 
* 
 SDATX    INTCLR X,I.DAT     RELEASE INTERLOCK
          EQ     RETPRO 
* 
* 
 IBUFF    EQU    INFO 
 IINF     EQU    INFO+LPRMLTH 
 BBUFF    EQU    IINF+DPRMLTH 
* 
 SDWK     BSS    1
* 
 DBUFNAM  BSS    1           DATA BUFFER NAME 
          DATA   10LDATA
+         VFD    12/3,48/0
* 
* 
          ENDOV 
* 
* 
* /---   BLOCK      DATAON     00 000   79/08/18  18.46 
          TITLE  -DATAON- COMMAND 
* 
* 
*         -DATAON- COMMAND
*         TURN ON STUDENT DATA OR SELECTED DATA TYPES 
* 
*         FIRST WORD -
*         IST  30 BITS =  BCD TIME OF SIGN-ON 
*         NEXT 18      =  UNUSED
*         NEXT  6      =  TOTAL NUMBER OF WORDS 
*         NEXT  6      =  DATA TYPE CODE
* 
*         NEXT 2 WORDS =  STUDENTS NAME 
*         NEXT WORD    =  LESSON NAME 
*         NEXT WORD    =  BCD DATE
* 
* 
 DATONOV  OVRLAY
*          ENTRY  DATAONX 
* 
 DATAONX  MX6    -1          MARK *INFO* BUFFER USED
          SA6    JJSTORE
          MX0    60-18-1
          LX0    59          POSITION MASK FOR OPTION BITS
          NG     X5,DATAOFX  JUMP IF -DATAOFF- COMMAND
          BX6    X0*X5
          MX0    1
          SA1    TBTDATA     LOAD CURRENT OPTION BITS 
          BX1    -X0*X1      CLEAR -SYSDATA- BIT
          BX6    X1+X6
          SA6    A1 
          SA1    TBLDATA
          SX2    X1          SEE IF DATA ALREADY -ON- 
          NZ     X2,=XPROC
          SA1    TBDFILE     SEE IF ANY DATA FILE 
          ZR     X1,=XPROC
          FINISH DON10       CHECK IF IN -FINISH- UNIT
          EQ     DON15
* 
 DON10    MX6    0           KILL ANY OUTPUT FOR -FINISH- 
          SA6    MOUTLOC
* 
* 
 DON15    SA1    KEY
          BX6    X1 
          SA6    TOKEY       SAVE ORIGINAL KEY
* 
          CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
* 
          CALLX  INITDAT,TBDFACC,TBDFILE       INITIALIZE 
          SA1    TBLDATA
          SX1    X1          CHECK IF DATA INITIALIZED
          NZ     X1,DON20 
          TUTIM  250         PAUSE FOR A WHILE
* /---   BLOCK      DATAON     00 000   77/07/05  20.58 
* 
 DON20    CALL   RESTLES     RESTORE LESSON, COMMON, ETC. 
* 
          CALL   INROUTE
          PL     X1,DON30    IF NOT IN ROUTER LESSON
          MX6    0           CLEAR OUT -AREA- DATA IF ROUTER
          SA6    TBAREA 
          SA6    AREADAT
          SA6    AREADAT+1
          SA6    AREADAT+2
* 
 DON30    SA1    TBLDATA
          SX2    X1          SEE IF DATA COLLECTION -ON-
          ZR     X2,DON90 
* 
          SA2    TBTDATA     MERGE LESSON-SELECTED BITS 
          SA3    TBTDATA+1   OPTIONS LESSON MAY TURN ON 
          BX6    -X3*X2 
          SA6    A2 
          BX1    X1+X6
          BX0    X1 
          LX1    60-DSDATON  SEE IF -DATAON- SELECTED 
          PL     X1,DON90 
          LX0    60-DSNODON  BIT SET IF NO OUTPUT 
          NG     X0,DON90 
* 
          CALL   S=TDATE,ITEMP
          MX0    30 
          SA1    ITEMP       LOAD CLOCK  (BCD)
          LX1    6
          BX1    X0*X1       SAVE HOURS AND MINUTES 
          SX6    500B+DSIGNI
          BX6    X1+X6       STORE HEADER WORD
          SA6    INFO 
          SA1    TNAME
          BX6    X1          FIRST 10 CHARS OF NAME 
          SA6    INFO+1 
          MX0    -12
          SA1    TNAME1      LAST 8 CHARS OF NAME 
          BX6    X0*X1
          SA6    INFO+2 
          CALL   FSQUISH,TBLESAC
          BX6    X1 
          SA6    INFO+3 
          SA1    ITEMP+1     LOAD BCD DATE
          BX6    X1 
          SA6    INFO+4 
          CALLX  DATAOUT,INFO,5 
* 
 DON90    SA1    SYSCLOK
          SA2    TIMEARK     TIME OF ENTRY TO LESSON
          IX6    X1-X2       ELAPSED TIME AT -DATAON- 
          AX6    7           KEEP TO ABOUT 1/10 SEC 
          MX0    -18
          SA2    AREADAT+2
          BX2    X0*X2       CLEAR PREVIOUS ENTRY TIME
          BX6    -X0*X6      LIMIT TIME TO 18 BITS
          BX6    X6+X2       ADD IN REST OF DATA WORD 
          SA6    A2          STORE LESSON ENTRY TIME
          SA1    TOKEY
          BX6    X1 
          SA6    KEY         RESTORE ORIGINAL KEY 
          EQ     =XCKPROC    TO PROCESS AFTER TIME CHECK
* 
* 
* /---   BLOCK      DATAOFF    00 000   79/08/18  18.46 
          TITLE  -DATAOFF- COMMAND
* 
* 
*         -DATAOFF- COMMAND 
*         TURN OFF STUDENT DATA OR SELECTED DATA TYPES
* 
* 
 DATAOFX  BX6    X0*X5       MASK OFF OPTION BITS 
          ZR     X6,DATAOF1  JUMP IF BLANK TAG
          SA1    TBTDATA
          BX6    -X6*X1      CLEAR APPROPRIATE BITS 
          SA6    A1 
          EQ     =XPROC 
* 
 DATAOF1  FINISH             CHECK FOR -FINISH- UNIT
          CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
          CALLX  FINDAT 
          CALLX  DATAFIN     TERMINATE DATA COLLECTION
          MX6    0           CLEAR DATA OPTION BITS 
          SA6    TBTDATA
          SX6    NEXT 
          SA6    KEY         SWALLOW ANY KEY
          CALL   RESTLES     RESTORE LESSON, COMMON, ETC. 
          EQ     RETRNX      PAUSE FOR A WHILE
          ENDOV 
* 
* 
* /---   BLOCK      READD      00 000   76/02/13  16.19 
          TITLE  READD
* 
*         -READD   SIGNOFF- 
* 
*         READ NEXT -SIGNOFF- DATA RECORD 
* 
*         ON EXIT-- 
*           *TRETURN* = -1  IF OK 
*                        0  IF END-OF-FILE ENCOUNTERED
*           (*TERROR* = REVERSE OF ABOVE) 
* 
* 
 READDOV  OVRLAY
          MX0    -6 
          SA1    INFO        LOAD HEADER WORD 
          ZR     X1,RDEOF    JUMP IF END-OF-FILE
          BX2    -X0*X1 
          SX2    X2-DSIGNF   CHECK FOR -SIGNOFF- DATA 
          NZ     X2,RSLOOP
* 
          SA1    INFO+1      FIRST WORD OF STUDENT NAME 
          BX6    X1 
          SA6    IIBUFF 
          SA1    INFO+2      SECOND WORD OF STUDENT NAME
          BX6    X1 
          SA6    IIBUFF+1 
          SA1    INFO+3      LESSON NAME
          BX6    X1 
          SA6    IIBUFF+2 
* 
          SA1    INFO+4      DATE 
          BX6    X1 
          SA6    IIBUFF+5 
          MX0    30 
          SA1    INFO        TIME 
          BX6    X0*X1
          SA6    IIBUFF+6 
* 
          SA1    INFO+5 
          BX6    -X0*X1      PICK OFF ELAPSED TIME (MIN)
          SA6    IIBUFF+3 
          MX6    -1          IF NOT COMPLETE
          NG     X1,RDD01    SEE IF COMPLETED THIS TIME 
          BX6    X0*X1
          LX6    30 
 RDD01    SA6    IIBUFF+4    STORE COMPLETION TIME
* /---   BLOCK      RDD01      00 000   78/12/23  00.47 
* 
          SA1    TBDFINF+1
          SB2    X1          PICK OFF ADDRESS OF BUFFER 
          AX1    18 
          SB1    X1          PICK OFF LENGTH OF BUFFER
          SB3    7           **** LENGTH OF DATA **** 
          GE     B3,B1,RDD03
          SA0    B3+IIBUFF
          SB3    B1-B3
          SX1    A0          SAVE *A0*
          ZERO   X1,B3       CLEAR OUT REST OF BUFFER 
* 
 RDD03    SA1    ATEMPEC
          BX0    X1          ECS SCRATCH BUFFER 
          SA0    IIBUFF 
          WE     B1          MOVE DATA TO ECS SCRATCH 
          RJ     ECSPRTY
          SA0    B2 
          RE     B1          MOVE DATA TO AUTHOR BUFFER 
          RJ     ECSPRTY
          MX6    -1          -1 = OK
          MX7    0
          SA6    TRETURN
          SA7    TERROR 
          EQ     PROCESS     --- RETURN 
* 
 RDEOF    SA1    TBDFINF+1   LOAD BUFFER ADDRESS/LENGTH 
          SA0    X1          PICK OFF ADDRESS 
          AX1    18 
          SB1    X1          PICK OFF LENGTH
          SX1    A0          SAVE *A0*
          ZERO   X1,B1       ZERO REST OF BUFFER
          SA1    TBDFINF
          SX1    X1          RELEASE DATA-READ BUFFER 
          CALL   ALTLES,-1
          MX6    0
          SA6    TBDFINF     CLEAR OUT INFO WORDS 
          SA6    TBDFINF+1
          MX6    0           0 = END-OF-FILE ENCOUNTERED
          MX7    -1 
          SA6    TRETURN
          SA7    TERROR 
          EQ     PROCESS     --- RETURN 
* 
* 
          ENDOV 
* /---   BLOCK      SETDAT     00 000   76/07/05  21.05 
* 
          TITLE  -SETDAT-   SET DATA RESERVED WORDS 
* 
* 
 SETROV   OVRLAY
          LX5    XCODEL      GET CODE FOR RESERVED WORD 
          SX6    X5 
          SA6    SRTEMP      SAVE INDEX 
          NGETVAR            GET VALUE OF EXPRESSION
          SA3    SRTEMP 
          SB1    X3+1 
+         JP     *+B1        GO TO APPROPRIATE SUBROUTINE 
+         EQ     SR001       AARROWS
+         EQ     SR002       AOK
+         EQ     SR003       AOKIST 
+         EQ     SR004       ASNO 
+         EQ     SR005       AUNO 
+         EQ     SR006       AHELP
+         EQ     SR007       AHELPN 
+         EQ     SR008       ATERM
+         EQ     SR009       ATERMN 
+         EQ     SR010       AAREA
+         EQ     SR011       ATIME
* 
* /---   BLOCK      SETDAT     00 000   77/05/30  03.55 
* 
 SR001    SB1    B0          WORD POSITION FOR *AARROWS*
          SB2    B0          SHIFT COUNT
          EQ     SAREA
* 
 SR002    SB1    1           WORD POSITION FOR *AOK*
          SB2    9           SHIFT COUNT
          EQ     SAREA
* 
 SR003    SB1    1           WORD POSITION FOR *AOKIST* 
          SB2    18          SHIFT COUNT
          EQ     SAREA
* 
 SR004    SB1    1           WORD POSITION FOR *ASNO* 
          SB2    B0          SHIFT COUNT
          EQ     SAREA
* 
 SR005    SB1    1           WORD POSITION FOR *AUNO* 
          SB2    27          SHIFT COUNT
          EQ     SAREA
* 
 SR006    SB1    B0          WORD POSITION FOR *AHELP*
          SB2    18          SHIFT COUNT
          EQ     SAREA
* 
 SR007    SB1    B0          WORD POSITION FOR *AHELPN* 
          SB2    9           SHIFT COUNT
          EQ     SAREA
* 
 SR008    SB1    B0          WORD POSITION FOR *ATERM*
          SB2    36          SHIFT COUNT
          EQ     SAREA
* 
 SR009    SB1    B0          WORD POSITION FOR *ATERMN* 
          SB2    27          SHIFT COUNT
          EQ     SAREA
* 
* 
*                            EXECERR USES X1
 SAREA    NG     X1,ERXVAL   NEGATIVE NOT ALLOWED 
          SA2    AREADAT+B1  READ APPROPRIATE DATA WORD 
          SB1    60 
          SB3    B1-B2
          LX2    X2,B3       GET RIGHT FIELD LOWER
          MX0    -9 
          BX2    X0*X2       CLEAR OUT CURRENT VALUE
          BX1    -X0*X1      LIMIT NEW VALUE TO 9 BITS
          BX6    X1+X2       MERGE WITH AREA WORD 
          LX6    X6,B2       SHIFT BACK 
          SA6    A2          REWRITE AREA WORD
          EQ     PROCESS
* 
* /---   BLOCK      SETDAT     00 000   77/05/30  03.55 
* 
 SR010    CALL   LJUST,(1R ),0   GET NEW AREA NAME
          BX6    X1 
          SA6    TBAREA      STORE AS NEW AREA NAME 
          EQ     PROCESS
* 
*                            EXECERR USES X1
 SR011    NG     X1,ERXVAL   NEGATIVE NOT ALLOWED 
          SA2    SYSCLOK     GET CURRENT TIME 
          SA3    TIMEARK     TIME OF SIGNON 
          IX2    X2-X3       CURRENT ELAPSED TIME 
          IX3    X2-X1       SUBTRACT NEW FROM CURRENT
          NG     X3,SR011A   IF TOO LONG SET TO ENTRY 
 SR011B   AX3    7           KEEP TIME TO ABOUT 1/10 SEC
          MX0    18 
          SA2    AREADAT+1   GET ENTRY TIME TO AREA 
          BX2    -X0*X2      CLEAR OUT ENTRY TIME 
          LX3    -18         SHIFT TIME TO TOP 18 BITS
          BX3    X0*X3       LIMIT TO 18 BITS 
          BX6    X2+X3       MERGE IN NEW ENTRY TIME
          SA6    A2 
          SA2    AREADAT+2   GET PREVIOUS ELAPSED TIME
          BX6    -X0*X2      CLEAR IT OUT 
          SA6    A2 
          EQ     PROCESS
* 
 SR011A   MX3    0           AREA STARTED AT SIGNON TIME
          EQ     SR011B 
* 
* 
 SRTEMP   BSS    1
* 
          ENDOV 
* /---   BLOCK      INITDAT    00 000   79/07/15  21.52 
          TITLE  -INIDOV-    INITIALIZE FOR DATA COLLECTION 
* 
* 
          EXT    DATAFIN,DBUFNAM,IDWK 
* 
* 
          PURGMAC DISKI 
          MACREF DISKI$ 
 DISKI    MACRO  ADD,UNIT,BLOCK,ECS,N 
          LOCAL  AA,XX
          MACREF DISKI
          IFC    EQ,*N**,1
          SX3    K1 
          IFC    NE,*N**,1
          SX3    N
          CALL   DISKXJ,ADD,UNIT,BLOCK,K1,ECS,X3
          NZ     X6,XX
 AA       TUTIM  -1,,IOKEY
          CALL   POSTXJ,XX,AA,XX
 XX       BSS    0
          ENDM
* 
* 
          PURGMAC DISKO 
          MACREF DISKO$ 
 DISKO    MACRO  ADD,UNIT,BLOCK,ECS,N 
          LOCAL  AA,XX
          MACREF DISKO
          CALL   DISKXJ,ADD,UNIT,BLOCK,K2,ECS,K1
          NZ     X6,XX
 AA       TUTIM  -1,,IOKEY
          CALL   POSTXJ,XX,AA,XX
 XX       BSS    0
          ENDM
* 
* 
*         ENTRY - TBINTSV+1 = *EQ* TO RETURN TO CALLING ROUTINE 
*                 TBINTSV+2 = DATA FILE ACCOUNT NAME
*                 TBINTSV+3 = DATA FILE NAME
* 
* 
 INIDOV   OVRLAY (TBINTSV+15) 
          EQ     ID120
* 
 ID110    INTCLR X,I.DAT     RELEASE INTERLOCK
          TUTIM  250         PAUSE FOR A WHILE
* 
*         CHECK IF ECS DATA BUFFER ALREADY SET UP 
* 
 ID120    SA1    TBINTSV+2   GET DATA FILE ACCOUNT NAME 
          SA2    TBINTSV+3   GET FILE NAME
          BX6    X1 
          BX7    X2 
          SA6    DBUFNAM     SET UP DATA ACCOUNT NAME 
          SA7    DBUFNAM+1   AND FILE NAME
          INTLOK X,I.DAT,W   INTERLOCK
          CALL   FINDLES,DBUFNAM,LESNUM 
          SA1    LESNUM 
          NG     X1,ID200    JUMP IF NO BUFFER EXISTS YET 
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SA1    INF+DATSTAT      LOAD DATA FILE STATUS WORD
          LX1    DINITSH     POSITION FILE INITIALIZING BIT 
          NG     X1,ID110    EXIT IF FILE BEING INITIALIZED 
          SA1    LESNUM 
          SA2    TBLDATA
          BX6    X1+X2       SET DATA BUFFER LESSON NUMBER
          SA6    A2 
          CALL   ALTLES,1    SIGN INTO DATA BUFFER
          EQ     ID900
* 
* /---   BLOCK      INITDAT    00 000   78/06/24  21.16 
* 
* 
*         CHECK THAT FILE EXISTS AND IS OF CORRECT TYPE 
* 
 ID200    SA1    TBINTSV+3   LOAD DATA FILE NAME
          CALL   FINDFN 
          NG     X7,ID900    EXIT IF FILE DOES NOT EXIST
          SA7    IDWK        SAVE DISK UNIT NUMBER
          SA1    X7+FITS
          IX0    X1+X6       ECS ADDRESS OF FILE INFO WORD
          SA0    IDWK+1 
+         RE     1           READ FILE INFO WORD
          RJ     ECSPRTY
          MX0    -6          MASK FOR FILE TYPE CODE
          SA1    A0          LOAD FILE INFO WORD
          AX1    30 
          BX1    -X0*X1      MASK OFF FILE TYPE CODE
          SX1    X1-4        CHECK FOR TYPE 4 = DATA FILE 
          NZ     X1,ID900    EXIT IF NOT A DATA FILE
          SA6    ITEMP       SAVE FILE INDEX
          CALL   FILMARK,IDWK,ITEMP     MARK FILE ALTERED 
* 
*         CREATE ECS DATA BUFFER
* 
          CALL   XSTOR,DBUFNAM,DBUFLTH
          SA1    LESNUM 
          NG     X1,ID110    JUMP IF INSUFFICIENT ECS 
          SA2    TBLDATA
          BX6    X1+X2       ATTACH DATA BUFFER LESSON NUM
          SA6    A2 
          CALL   ALTLES,1    SIGN INTO DATA BUFFER
          CALL   IOLESSN,TBLDATA,4000B
          INTCLR X,I.ADDL    RELEASE LESNAM INTERLOCK 
* 
* /---   BLOCK      INITDAT    00 000   78/06/24  21.39 
* 
*         INITIALIZE DATA BUFFER PARAMETERS 
* 
          SA1    TBLDATA     DATA BUFFER LESSON NUMBER
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH     BIAS PAST HEADER RECORD
          IX0    X0+X1       ECS ADDRESS OF DATA BUFFER 
          MX6    1           SET UP FILE INITIALIZING BIT 
          LX6    60-DINITSH 
          MX1    -18         CLEAR THE OLD STATION NUMBER 
          BX6    X6*X1
          SA1    STATION     INSERT CURRENT STATION NUMBER
          BX6    X6+X1
          SA6    INF+DATSTAT      SET DATA FILE STATUS WORD 
          SA1    TBINTSV+2   ACCOUNT NAME 
          SA2    TBINTSV+3   FILE NAME
          BX6    X1 
          BX7    X2 
          SA6    INF+DFACCT 
          SA7    INF+DFILNAM
          SA1    IDWK 
          BX6    X1          SET DATA FILE DISK UNIT NUMBER 
          SA6    INF+DDISKU 
          SA1    IDWK+1 
          BX6    X1          SET DATA FILE INFO WORD
          SA6    INF+DFINF
          SA0    INF
+         WE     DPRMLTH     INITIALIZE ECS DATA PARAMETERS 
          RJ     ECSPRTY
* 
*         READ DATA FILE DIRECTORY TO ECS DIRECTORY AREA
* 
          SX1    DDIRECT     BIAS TO FILE DIRECTORY AREA
          IX6    X0+X1
          SA6    DECSLOC     ECS ADDRESS OF DIRECTORY AREA
          INTCLR X,I.DAT
          DISKI  (INF+DFINF),(INF+DDISKU),K0,DECSLOC
          NZ     X6,ID750    EXIT IF DISK ERROR 
* 
*         CHECK THAT FILE DIRECTORY IS INTACT 
* 
          INTLOK X,I.DAT,W   INTERLOCK
          SA1    TBLDATA     RESTORE DATA BUFFER PARAMETERS 
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH
          IX5    X0+X1       ECS ADDRESS OF DATA BUFFER 
          SX1    DDIRECT     BIAS TO FILE DIRECTORY AREA
          IX0    X1+X5
          SA0    INFO        READ FILE DIRECTORY TO *INFO*
+         RE     BLKLTH 
          RJ     ECSPRTY
* 
* /---   BLOCK      INITDAT    00 000   78/06/24  21.40 
* 
          SA1    INFO        LOAD FILE NAME 
          SA2    INF+DFILNAM
          BX1    X1-X2       CHECK THAT FILE NAME IS CORRECT
          NZ     X1,ID750 
          SA1    INFO+1      LOAD FILE TYPE 
          SA2    KDATAD 
          BX1    X1-X2       CHECK THAT FILE TYPE IS CORRECT
          NZ     X1,ID750 
* 
          SA2    INF+DFINF   LOAD FILE INFO WORD
          MX0    -6 
          AX2    24          POSITION NUMBER OF DISK SPACES 
          BX2    -X0*X2 
          SX0    DSBLKS      NUMBER OF BLOCKS PER PART
          IX6    X0*X2       COMPUTE NUMBER BLOCKS IN FILE
          SA6    DBLKLIM     (X6=BLOCK COUNT--USED LATER) 
          SX7    X6-1        SET MAXIMUM BLOCK NUMBER 
          SA7    INF+DATBLIM
* 
          SA1    INFO+3      FLAG / LAST BLOCK USED 
          SX2    X1          X2 = LAST BLOCK
          IX3    X6-X2
          NG     X2,ID750    --- EXIT IF UNREASONABLE BLOCK 
          NG     X3,ID750    --- EXIT IF UNREASONABLE BLOCK 
          ZR     X3,ID225    X3(WORD)=0 IF FILE FULL
          SA3    INFO+64+X2  APPROPRIATE INFO WORD
          MX0    -9 
          AX3    9
          BX3    -X0*X3      X3 = LAST WORD 
 ID225    BSS    0
          NZ     X2,ID250 
          SX2    1           DO NOT ALLOW BLOCK 0 
 ID250    IX0    X6-X2
          NG     X0,ID750    --- EXIT IF UNREASONABLE BLOCK 
          SB1    B0          B1 = 0 = FILE NOT FULL 
          NZ     X0,ID300    JUMP IF FILE NOT FULL
          MX6    1
          LX6    60-DFULLSH       SET UP FILE FULL BIT
          SA1    INF+DATSTAT      LOAD DATA FILE STATUS WORD
          BX6    X1+X6
          SA6    A1          SET BIT TO MARK FILE FULL
          SB1    -1          B1 = -1 = FILE FULL
* /---   BLOCK      INITDAT    00 000   78/12/18  21.45 
* 
 ID300    BX6    X2          SET CURRENT BLOCK NUMBER 
          SA6    INF+DATBLOK
          SA6    DBLOKN 
          NG     X3,ID750    --- EXIT IF UNREASONABLE WORD
          SX0    BLKLTH 
          IX0    X3-X0
          PL     X0,ID750    --- EXIT IF UNREASONABLE WORD
          BX6    X3          SET CURRENT WORD POINTER 
          SA6    INF+DATWORD
          NZ     B1,ID800    EXIT IF FILE FULL
          ZR     X3,ID400    JUMP IF CURRENT BLOCK EMPTY
* 
*         LOAD CURRENT DATA BLOCK TO CURRENT BLOCK AREA 
* 
          BX0    X5          ECS ADDRESS OF DATA PARAMETERS 
          SA0    INF
+         WE     DPRMLTH     UPDATE PARAMETERS
          RJ     ECSPRTY
          SX1    DBLK1       BIAS TO CURRENT BLOCK AREA 
          IX6    X1+X5
          SA6    DECSLOC     SET ECS ADDRESS OF BLOCK 
          INTCLR X,I.DAT
          DISKI  (INF+DFINF),(INF+DDISKU),DBLOKN,DECSLOC
          NZ     X6,ID750    JUMP IF DISK ERROR 
* 
*         CORRECT POSSIBLE DAMAGE TO CURRENT WORD POINTER 
* 
          INTLOK X,I.DAT,W   INTERLOCK
          SA1    TBLDATA
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH
          IX5    X0+X1       ECS ADDRESS OF DATA PARAMETERS 
          SX1    DBLK1
          IX0    X1+X5       ADDRESS OF CURRENT BLOCK 
          SA0    INFO 
+         RE     1           READ FIRST WORD OF DATA BLOCK
          RJ     ECSPRTY
          SA1    A0          LOAD FIRST WORD OF DATA BLOCK
          NZ     X1,ID800    JUMP IF DATA ACTUALLY PRESENT
          MX6    0
          SA6    INF+DATWORD      RE-SET WORD POINTER 
          ZERO   INFO,BLKLTH   READ BOCK OF ZEROS TO CM 
          SX1    DBLK1       BIAS TO CURRENT DATA BLOCK 
          IX0    X1+X5
+         WE     BLKLTH      ZERO OUT CURRENT BLOCK AREA
          RJ     ECSPRTY
          EQ     ID800
* /---   BLOCK      INITDAT    00 000   77/10/20  01.04 
* 
*         PUT DATE BLOCK STARTED IN DIRECTORY IF 1ST BLOCK
* 
 ID400    SA1    DBLOKN      CHECK IF ON FIRST BLOCK
          SX1    X1-1 
          NZ     X1,ID800 
          BX6    X5          SAVE ECS ADDRESS OF BUFFER 
          SA6    DECSLOC
* 
          CALL   DATDATE     GET HOLLERITH DATE / TIME
* 
          SA1    DECSLOC     GET ECS ADDRESS OF BUFFER
          BX5    X1          BACK TO X5 
          SX1    DDIRECT+64+128  X1 = BIAS TO BLOCK NAMES 
          SA2    DBLOKN 
          IX1    X1+X2       ADD BIAS TO CURRENT BLOCK
          IX0    X1+X5
          SA0    ITEMP       CURRENT HOLLERITH DATE 
+         WE     1           WRITE OUT DATE BLOCK STARTED 
          RJ     ECSPRTY
          EQ     ID800
* /---   BLOCK      INITDAT    00 000   78/06/24  23.02 
* 
*         FINAL PROCESSING
*         CLEAR INITIAL BIT AND SET ERROR BIT IF NECCESSARY 
* 
 ID750    MX6    1           SET UP BIT FOR ERROR CONDITION 
          LX6    60-DERRSH
          SA6    DERRFLG     SET ERROR FLAG 
          INTLOK X,I.DAT,W   INTERLOCK
          SA1    TBLDATA
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH
          IX5    X0+X1       BIAS TO DATA PARAMETER AREA
          EQ     ID810
* 
 ID800    MX6    0           MARK NO ERROR OCCURRED 
          SA6    DERRFLG
* 
 ID810    MX6    1           SET UP MASK FOR INITIAL BIT
          LX6    60-DINITSH 
          SA1    INF+DATSTAT      LOAD STATUS WORD
          BX6    -X6*X1      CLEAR INITIAL BIT
          SA2    DERRFLG
          BX6    X2+X6       ATTACH ANY ERROR BIT 
          SA6    A1 
          BX0    X5          ECS ADDRESS OF DATA BUFFER INFO
          SA0    INF
+         WE     DPRMLTH     UPDATE BUFFER INFO WORDS 
          RJ     ECSPRTY
          CALL   IOLESSN,TBLDATA,-4000B 
* 
 ID900    INTCLR X,I.DAT     RELEASE INTERLOCK
          EQ     TBINTSV+1   EXIT 
* 
* 
 DECSLOC  BSS    1
 DWORD    BSS    1
 DBLOKN   BSS    1
 DBLKLIM  BSS    1
 DERRFLG  BSS    1
 ISYSF    BSS    1
* 
 DATINF   BSS    LPRMLTH+DPRMLTH
 INF      EQU    DATINF+LPRMLTH 
* 
 DSLTH    EQU    1+DATAMAX+DRJLTH 
* 
 K0       DATA   0
 K1       DATA   1
 K2       DATA   2
 KDATAD   DATA   10LDATA     D
* 
* 
          ENDOV 
* /---   BLOCK      DATAFIN    00 000   81/08/20  02.38 
          TITLE  -FINDOV-    TERMINATE DATA COLLECTION
          SPACE  4
 FINDOV   OVRLAY (TBINTSV+15) 
          INTLOK X,I.SIGN,W  KEEP EM MANAGER AT BAY...
          INTLOK X,I.DAT,W   INTERLOCK
          SA1    TBLDATA
          SX1    X1 
          CALL   ALTLES,-1   SIGN OUT OF DATA FILE
          SA1    NSTUDS      NUMBER OF STUDENTS USING FILE
          ZR     X1,DF200    JUMP IF FILE NO LONGER IN USE
* 
 DF100    MX0    -18
          SA1    TBLDATA     CLEAR OUT BUFFER LESSON NUMBER 
          BX6    X0*X1
          SA6    A1 
          INTCLR X,I.DAT     RELEASE INTERLOCK
          INTCLR X,I.SIGN    RELEASE INTERLOCK
          EQ     DATAFIN     EXIT 
* 
 DF110    SA1    TBLDATA     DATA BUFFER LESSON NUMBER
          CALL   DELETE      DELETE DATA BUFFER 
          EQ     DF100
* 
 DF200    SA1    TBLDATA     DATA BUFFER LESSON NUMBER
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH     LENGTH OF HEADER 
          IX5    X0+X1       ADDRESS OF DATA BUFFER 
          SA1    INF+DATSTAT      BUFFER STATUS WORD
          BX2    X1 
          LX2    DERRSH      CHECK IF ERROR HAS OCCURRED
          NG     X2,DF110 
          BX2    X1 
          LX2    DFULLSH     CHECK IF DATA FILE FULL
          NG     X2,DF110 
          MX6    1           SET UP FILE WRITE BIT
          LX6    60-DWRITSH 
          BX6    X1+X6       ATTACH TO STATUS WORD
          MX1    -18         CLEAR THE OLD STATION NUMBER 
          BX6    X6*X1
          SA1    STATION     INSERT CURRENT STATION NUMBER
          BX6    X6+X1
          SA6    INF+DATSTAT    STORE FILE BUSY AND STATION 
* 
* /---   BLOCK      DATAFIN    00 000   81/08/20  02.38 
* 
*         MOVE CURRENT DATA BLOCK TO DISK BUFFER AREA 
* 
          SX1    DBLK1       BIAS TO CURRENT BLOCK AREA 
          IX0    X1+X5
          SA0    INFO        TEMPORARY CM BUFFER
+         RE     BLKLTH      READ CURRENT DATA BLOCK
          RJ     ECSPRTY
          SX1    DBLK2       BIAS TO DISK BUFFER AREA 
          IX0    X1+X5
+         WE     BLKLTH      MOVE DATA TO DISK BUFFER AREA
          RJ     ECSPRTY
          BX6    X5          SAVE ECS ADDRESS OF DATA BUFFER
          SA6    DECSLOC
* 
*         GET FILE INFO WORD
* 
          SA1    INF+DFILNAM      LOAD DATA FILE NAME 
          CALL   FINDFN      GET POINTERS TO FILE INFO
          NG     X7,DF110 
          SA7    INF+DDISKU  SAVE DISK UNIT NUMBER
          SA1    X7+FITS
          IX0    X1+X6       ECS ADDRESS OF FILE INFO WORD
          SA0    INF+DFINF
+         RE     1           READ FILE INFO WORD
          RJ     ECSPRTY
          MX0    -6 
          SA1    A0          LOAD FILE INFO WORD
          AX1    24 
          BX1    -X0*X1      MASK OFF NUMBER OF DISK SPACES 
          SX2    DSBLKS 
          IX2    X1*X2       COMPUTE NUMBER OF BLOCKS 
          SA1    INF+DATBLOK      LOAD CURRENT BLOCK NUMBER 
          IX2    X1-X2
          PL     X2,DF110    EXIT IF BLOCK NUMBER TOO BIG 
+         NZ     X1,*+1 
          SX1    1           DO NOT ALLOW BLOCK 0 
+         BX6    X1          SET CURRENT BLOCK NUMBER 
          SA6    DBLOKN 
* 
* /---   BLOCK      DATAFIN    00 000   77/10/20  01.09 
* 
*         UPDATE BLOCK AND WORD COUNTS IN FILE DIRECTORY
* 
          SA1    DECSLOC     ECS ADDRESS OF FILE
          BX5    X1          BACK TO X5 
          SX1    DDIRECT+3   BIAS TO FLAG / LAST BLOCK USED 
          IX0    X5+X1
          SA0    ITEMP
+         RE     1
          RJ     ECSPRTY
          SA1    A0          FLAG / LAST BLOCK USED 
          SA2    DBLOKN      X2 = CURRENT LAST BLOCK
          MX6    -18
          BX6    X6*X1       ONLY LAST 18 BITS ARE BLOCK
          BX6    X6+X2       PUT IN NEW BLOCK NUMBER
          SA6    A0 
+         WE     1           UPDATE FLAG / LAST BLOCK USED
          RJ     ECSPRTY
          SX1    DDIRECT+64+X2  BIAS TO BLOCK INFO WORD 
          IX0    X5+X1
+         RE     1           READ PROPER BLOCK INFO WORD
          RJ     ECSPRTY
          SA1    A0 
          MX6    -9 
          LX6    9
          BX6    X6*X1       CLEAR OLD WORD COUNT 
          SA1    INF+DATWORD CURRENT LAST WORD
          LX1    9
          BX6    X6+X1
          SA6    A0 
+         WE     1           UPDATE BLOCK INFO WORD 
          RJ     ECSPRTY
* 
* /---   BLOCK      DATAFIN    00 000   78/06/24  21.50 
* 
*         RETURN CURRENT DATA BLOCK TO DISK 
* 
 DF500    SA1    TBLDATA     SIGN BACK INTO DATA BUFFER 
          CALL   ALTLES,1 
          CALL   IOLESSN,TBLDATA,4000B
* 
*          CALL   LINKS,WORK  SAVE RETURN JUMP TRAIL
          SB1    WORK 
+         RJ     =XLINKS
-         VFD    30/DATAFIN 
* 
          SA1    DECSLOC     ECS ADDRESS OF DATA BUFFER 
          BX5    X1          BACK TO X5 
          SX1    DRJSAVE     BIAS TO RJ TRAIL SAVE AREA 
          IX0    X1+X5
          SA0    WORK        CM ADDRESS OF RJ TRAIL 
+         WE     DRJLTH      SAVE RETURN JUMP TRAIL 
          RJ     ECSPRTY
          SX1    DBLK2       BIAS TO DISK BUFFER AREA 
          IX6    X1+X5
          SA6    DECSLOC     SET ECS ADDRESS OF BLOCK 
          BX0    X5          ECS ADDRESS OF DATA PARAMETERS 
          SA0    INF
+         WE     DPRMLTH     UPDATE DATA PARAMETERS 
          RJ     ECSPRTY
* 
          INTCLR X,I.DAT     RELEASE INTERLOCK
          INTCLR X,I.SIGN    DURING DISKIO, OK SINCE PINNED 
          DISKO  (INF+DFINF),(INF+DDISKU),DBLOKN,DECSLOC
          SA6    DERRFLG     SAVE DISK ERROR FLAG 
          NZ     X6,DF800    EXIT IF DISK ERROR 
* /---   BLOCK      DATAFIN    00 000   78/06/24  23.04 
* 
*         RETURN DIRECTORY BLOCK TO DISK
* 
          SA1    TBLDATA     RELOAD DATA PARAMETERS 
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH+DDIRECT
          IX6    X0+X1       ECS ADDRESS OF DIRECTORY BLOCK 
          SA6    DECSLOC
          DISKO  (INF+DFINF),(INF+DDISKU),K0,DECSLOC
          SA6    DERRFLG     SAVE DISK ERROR FLAG 
* 
 DF800    INTLOK X,I.SIGN,W  DISKIO DONE, BLOCK EM MANAGER
          INTLOK X,I.DAT,W   INTERLOCK DIRECTORY
          CALL   IOLESSN,TBLDATA,-4000B      UNPIN
          SA1    TBLDATA     RE-LOAD DATA BUFFER PARAMETERS 
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH     BIAS PAST HEADER RECORD
          IX0    X0+X1
          MX6    1           FORM MASK FOR FILE WRITE BIT 
          LX6    60-DWRITSH 
          SA1    INF+DATSTAT      LOAD BUFFER STATUS WORD 
          BX6    -X6*X1      CLEAR FILE WRITE BIT 
          SA1    DERRFLG     CHECK IF ANY DISK ERROR
          ZR     X1,DF810 
          MX1    1           SET UP DISK ERROR BIT
          LX1    60-DERRSH
          BX6    X1+X6       SET DISK ERROR BIT 
* 
 DF810    SA6    INF+DATSTAT      STORE UPDATED STATUS WORD 
          SA0    INF
+         WE     DPRMLTH     UPDATE BUFFER PARAMETERS 
          RJ     ECSPRTY
          SX1    DRJSAVE     BIAS TO SAVED RJ TRAIL 
          IX0    X0+X1
          SA0    WORK 
+         RE     DRJLTH      READ SAVED RJ TRAIL TO CM
          RJ     ECSPRTY
* 
*          CALL   LINKR,WORK       RESTORE RJ TRAIL 
          SB1    WORK 
+         RJ     =XLINKR
-         VFD    30/DATAFIN 
* 
          SA1    TBLDATA
          CALL   ALTLES,-1   SIGN OUT OF DATA BUFFER AGAIN
          SA1    NSTUDS 
          NZ     X1,DF100    EXIT IF BUFFER IN USE AGAIN
          SA1    TBLDATA
          CALL   DELETE      DELETE ECS DATA BUFFER 
          EQ     DF100       EXIT 
* 
* 
 DECSLOC  BSS    1
 DWORD    BSS    1
 DBLOKN   BSS    1
 DBLKLIM  BSS    1
 DERRFLG  BSS    1
 ISYSF    BSS    1
* 
 DATINF   BSS    LPRMLTH+DPRMLTH
 INF      EQU    DATINF+LPRMLTH 
* 
 DSLTH    EQU    1+DATAMAX+DRJLTH 
* 
 K0       DATA   0
 K1       DATA   1
 K2       DATA   2
* 
* 
          ENDOV 
* 
* /---   BLOCK      DATAOUT    00 000   78/11/12  21.42 
          TITLE  -DATOOV-    OUTPUT TO DATA FILE
* 
* 
*         ON ENTRY - *OVARG1* = 0 = INITIAL ENTRY 
*                               1 = ADVANCE TO NEXT FILE
*                               2 = NEXT DATA-FILE RE-ENTRY 
*                    *OVARG2* = LENGTH OF DATA RECORD 
* 
 DATOOV   OVRLAY (TBINTSV+15) 
          SA1    OVARG1      GET RE-ENTRY INDEX 
          SB1    X1 
          JP     B1+*+1 
* 
+         EQ     ENT         0 = INITIAL ENTRY
+         EQ     DATNXT      1 = ADVANCE TO NEXT DATA-FILE
+         EQ     REENT1      2 = ADVANCE FILE RE-ENTRY
* 
* 
 ENT      SA1    TBLDATA
          SX1    X1          GET DATA BUFFER LESSON NUM 
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH
          IX4    X0+X1       X4 = ECS ADDRESS OF INFO 
          SA1    OVARG2 
          SB1    X1          B1 = LENGTH OF DATA RECORD 
* 
* /---   BLOCK      DATAOUT    00 000   78/12/18  21.49 
* 
*         COPY CURRENT FULL BLOCK TO DISK BUFFER AREA AND 
*         RE-INITIALIZE WITH CURRENT DATA RECORD
* 
          SA3    INF+DATSTAT
          LX3    DWRITSH     CHECK IF FILE BEING WRITTEN
          NG     X3,DATWAIT  GO TO WAIT LOOP IF FILE BUSY 
          MX6    1
          BX6    X3+X6       SET FILE WRITE BIT 
          LX6    60-DWRITSH 
          MX1    -18         CLEAR THE OLD STATION NUMBER 
          BX6    X6*X1
          SA1    STATION     INSERT CURRENT STATION NUMBER
          BX6    X6+X1
          SA6    A3 
          SA1    INF+DATWORD LAST WORD FOR CURRENT BLOCK
          BX6    X1 
          SX7    B1          NEW WORD COUNT 
          SA7    A1 
          SA6    DWORD       SAVE OLD WORD COUNT
          SA1    DARG1       GET CM ADDRESS OF DATA RECORD
          SA0    X1 
          SA2    ATEMPEC     ECS SCRATCH BUFFER 
          BX0    X2 
+         WE     B1          WRITE CURRENT RECORD TO SCRATCH
          RJ     ECSPRTY
          SX3    DBLK1       BIAS TO CURRENT FILLED BLOCK 
          IX0    X3+X4
          SA0    INFO        CM SCRATCH BUFFER
+         RE     BLKLTH      MOVE FILLED BLOCK TO CM
          RJ     ECSPRTY
          SX1    DBLK2       BIAS TO DISK I/O BUFFER
          IX0    X1+X4
+         WE     BLKLTH      MOVE FILLED BLOCK TO BUFFER
          RJ     ECSPRTY
          ZERO   INFO,BLKLTH     PRE-ZERO *INFO*
          BX0    X2          ECS ADDRESS OF CURRENT RECORD
+         RE     B1          READ RECORD TO *INFO*
          RJ     ECSPRTY
          IX0    X3+X4       ADDRESS OF CURRENT BLOCK AREA
+         WE     BLKLTH      INITIALIZE NEW BLOCK 
          RJ     ECSPRTY
          BX6    X4          SAVE ADDRESS OF DATA LESSON
          SA6    DECSLOC
* 
* /---   BLOCK      DATAOUT    00 000   77/10/20  01.19 
* 
*         GET FILE INFO WORD AND CHECK IF DATA FILE NOW FULL
* 
          SA1    INF+DFILNAM
          CALL   FINDFN      GET POINTERS TO FILE INFO
          PL     X7,DD120    JUMP IF FILE OK
          MX6    1           SET UP ERROR BIT 
          LX6    60-DERRSH
          SA1    INF+DATSTAT      LOAD BUFFER STATUS WORD 
          BX6    X1+X6
          MX1    -18         CLEAR THE OLD STATION NUMBER 
          BX6    X6*X1
          SA1    STATION     INSERT CURRENT STATION NUMBER
          BX6    X6+X1
          SA6    INF+DATSTAT    STORE ERROR BIT AND STATION 
          EQ     DD130
* 
 DD120    SA7    INF+DDISKU       SAVE DISK UNIT NUMBER 
          SA1    X7+FITS
          IX0    X1+X6       ECS ADDRESS OF FILE INFO WORD
          SA0    INF+DFINF
+         RE     1           READ FILE INFO WORD
          RJ     ECSPRTY
          MX0    -6 
          SA1    A0          LOAD FILE INFO WORD
          AX1    24          POSITION NUMBER OF DISK SPACES 
          BX1    -X0*X1      MASK OFF NUMBER OF PARTS 
          SX2    DSBLKS      NUMBER OF BLOCKS PER PART
          IX6    X1*X2       COMPUTE NUMBER OF BLOCKS 
          SA6    DBLKLIM
          SX3    X6-1        LAST LEGAL BLOCK NUMBER
          SA1    INF+DATBLOK X1 = CURRENT BLOCK NUMBER
          IX2    X1-X3       CHECK IF FILE IS FULL
          NG     X2,DD150    JUMP IF NOT FULL YET 
          MX7    1
          LX7    60-DFULLSH       SET UP FILE FULL BIT
          SA3    INF+DATSTAT      LOAD FILE STATUS WORD 
          BX7    X3+X7
          SA7    A3          MARK DATA FILE FULL
          IX2    X1-X6
          NG     X2,DD150    CHECK FOR LEGAL BLOCK NUMBER 
          SA6    INF+DATBLOK      RE-SET TO LAST BLOCK + 1
          MX7    1
          LX7    60-DWRITSH       SET UP FILE WRITE BIT 
          BX7    -X7*X3      CLEAR FILE WRITE BIT 
          SA7    A3 
* 
 DD130    SA1    DECSLOC     ECS ADDRESS OF DATA BUFFERS
          BX0    X1 
          SA0    INF         CM ADDRESS OF DATA INFO
+         WE     DPRMLTH     UPDATE DATA INFO 
          RJ     ECSPRTY
          EQ     DAT990 
* 
* /---   BLOCK      DATAOUT    00 000   77/01/29  21.42 
* 
 DD150    NZ     X1,DD151    BLOCK NUMBER MUST NOT BE ZERO
          SX1    1
 DD151    SX6    X1          SAVE NUMBER OF BLOCK TO RETURN 
          SA6    DBLOKN 
          SX6    X1+1        ADVANCE BLOCK NUMBER 
          SA6    INF+DATBLOK
* 
*         UPDATE CURRENT BLOCK AND WORD POINTERS AND
*         DATE BLOCK BEGUN IN DIRECTORY AREA
* 
          CALL   DATDATE     GET HOLLERITH DATE / TIME
          SA1    DECSLOC
          BX5    X1          GET ECS ADDRESS OF DATA LESSON 
* /---   BLOCK      DATAOUT    00 000   77/10/20  01.24 
* 
          SA0    ITEMP       CURRENT HOLLERITH DATE 
          SA1    DBLKLIM     GET NUMBER OF BLOCKS IN LESSON 
          SA2    INF+DATBLOK X2 = NEW BLOCK (USED LATER)
          SB1    1           B1 = LENGTH FOR LATER
          IX0    X2-X1       CHECK IF DATA FILE NOW FULL
          PL     X0,DD165 
          SX1    DDIRECT+64+128  BIAS TO BLOCK NAMES
          IX1    X1+X2       ADD BIAS TO CURRENT BLOCK
          IX0    X5+X1
+         WE     1           WRITE OUT DATE BLOCK STARTED 
          RJ     ECSPRTY
          SB1    2           GET BOTH PREVIOUS AND CURRENT
* 
 DD165    SA1    DBLOKN      PREVIOUS BLOCK NUMBER
          SX1    DDIRECT+64+X1  BIAS TO BLOCK INFO WORD 
          IX0    X5+X1
+         RE     B1          READ PROPER BLOCK INFO WORD(S) 
          RJ     ECSPRTY
          SA1    A0 
          MX3    -9 
          LX3    9
          BX6    X3*X1       CLEAR OLD WORD COUNT 
          SA1    DWORD       PREVIOUS LAST WORD 
          LX1    9
          BX6    X6+X1
          SA6    A0 
          SX1    B1-2 
          NG     X1,DD170    JUMP IF FILE FULL
          SA1    A0+1 
          BX6    X3*X1       CLEAR OLD WORD COUNT 
          SA1    INF+DATWORD CURRENT LAST WORD
          LX1    9
          BX6    X6+X1
          SA6    A0+1 
* 
 DD170    WE     B1          UPDATE BLOCK INFO WORD(S)
          RJ     ECSPRTY
* 
          SX1    DDIRECT+3   BIAS TO FLAG / LAST BLOCK USED 
          IX0    X5+X1
          MX6    -18
+         RE     1
          RJ     ECSPRTY
          SA1    A0          FLAG / LAST BLOCK USED 
          BX6    X6*X1       ONLY LAST 18 BITS ARE BLOCK
          BX6    X6+X2       PUT IN NEW BLOCK NUMBER
          SA6    A0 
+         WE     1           UPDATE FLAG / LAST BLOCK USED
          RJ     ECSPRTY
* 
 DD175    BX0    X5          ECS ADDRESS OF DATA BUFFERS
          SA0    INF
+         WE     DPRMLTH     WRITE OUT STATUS WORDS 
          RJ     ECSPRTY
* /---   BLOCK      DATAOUT    00 000   78/11/12  21.33 
* 
*         SAVE STATUS / RJ TRAIL BEFORE BEGINNING I/O 
* 
          CALL   IOLESSN,TBLDATA,4000B
          SX6    B7          SAVE CURRENT CONTINGENCY 
          SA6    NCTYPEP
          NG     X6,DD200    JUMP IF NOT NORMAL EXECUTION 
          CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
* 
*         CALL   LINKS,WORK  SAVE RETURN JUMP TRAIL 
 DD200    SB1    WORK 
+         RJ     =XLINKS
-         VFD    30/DATAOUT 
* 
*         WRITE FILLED DATA BLOCK TO DISK 
* 
          SA5    DECSLOC     ECS ADDRESS OF DATA LESSON 
          SX1    DRJSAVE
          IX0    X1+X5       ADDRESS FOR RJ TRAIL BUFFER
          SA0    WORK 
+         WE     DRJLTH      WRITE OUT RJ TRAIL 
          RJ     ECSPRTY
          SX1    DBLK2       BIAS TO BLOCK TO WRITE 
          IX6    X1+X5       ECS ADDRESS OF BLOCK TO WRITE
          SA6    DECSLOC
* 
          INTCLR X,I.DAT     RELEASE INTERLOCK
          DISKO  (INF+DFINF),(INF+DDISKU),DBLOKN,DECSLOC
          SA6    DERRFLG     SAVE ERROR RETURN
          NZ     X6,DDEXIT   EXIT IF DISK ERROR 
* 
*         WRITE UPDATED DATA FILE DIRECTORY BLOCK TO DISK 
* 
          SA1    TBLDATA     RELOAD DATA BUFFER INFO WORDS
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH+DDIRECT
          IX6    X0+X1       ADDRESS OF DIRECTORY BLOCK 
          SA6    DECSLOC
          DISKO  (INF+DFINF),(INF+DDISKU),K0,DECSLOC
          SA6    DERRFLG     SAVE ERROR RETURN
          NZ     X6,DDEXIT   EXIT IF DISK ERROR 
* /---   BLOCK      DATAOUT    00 000   78/11/12  21.05 
* 
*         CLEAR DATA FILE WRITE BIT AND SET ERROR BIT IF
*         DISK ERROR OCCURRED 
* 
 DDEXIT   INTLOK X,I.DAT,W   INTERLOCK
          CALL   IOLESSN,TBLDATA,-4000B 
          SA1    TBLDATA     RESTORE DATA FILE PARAMETERS 
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH     BIAS PAST HEADER RECORD
          IX5    X0+X1
          MX6    1           FORM MASK FOR WRITE BIT
          LX6    60-DWRITSH 
          SA1    INF+DATSTAT      DATA FILE STATUS WORD 
          BX6    -X6*X1      CLEAR FILE WRITE BIT 
          SA2    DERRFLG
          ZR     X2,DD900    JUMP IF NO DISK ERROR OCCURRED 
          MX2    1
          LX2    60-DERRSH   POSITION DISK ERROR BIT
          BX6    X2+X6       SET BIT TO MARK ERROR OCCURRED 
          MX1    -18         CLEAR THE OLD STATION NUMBER 
          BX6    X6*X1
          SA1    STATION     INSERT CURRENT STATION NUMBER
          BX6    X6+X1
* 
DD900     SA6    INF+DATSTAT    STORE ERROR BIT AND STATION 
* 
*         RESTORE STATUS / RJ TRAIL AFTER I/O 
* 
          BX0    X5          ECS ADDRESS OF DATA INFO WORDS 
          SA0    INF
+         WE     DPRMLTH     UPDATE DATA FILE PARAMETERS
          RJ     ECSPRTY
          SX1    DRJSAVE     BIAS TO RJ TRAIL SAVE AREA 
          IX0    X1+X5
          SA0    WORK 
+         RE     DRJLTH      READ SAVED RJ TRAIL TO CM
          RJ     ECSPRTY
*         CALL   LINKR,WORK  RESTORE RJ TRAIL 
          SB1    WORK 
+         RJ     =XLINKR
-         VFD    30/DATAOUT 
          SA1    NCTYPEP
          SB7    X1          RESTORE CONTINGENCY
          NG     X1,DAT990   EXIT IF NOT IN NORMAL EXECUTION
          CALL   RESTLES     RESTORE LESSON, COMMON, ETC. 
          EQ     DAT990 
* 
* 
* /---   BLOCK      DATAOUT    00 000   78/11/12  21.06 
          TITLE  -DATOOV-    SET TO NEXT DATA FILE
* 
* 
*         GET NAME OF NEXT DATA FILE IF ANY 
* 
 DATNXT   SA1    TBLDATA     DATA BUFFER LESSON NUMBER
          SX1    X1 
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SX1    LPRMLTH
          IX5    X0+X1       ECS ADDRESS OF DATA BUFFER 
* 
          SX1    DDIRECT+4+O.NFNAM  OFFSET TO NEXT FILE NAME
          SA0    TBINTSV+1
          IX0    X5+X1
+         RE     1           *TBINTSV(1)* = NEXT FILE NAME
          RJ     ECSPRTY
          SA1    A0          CHECK IF ANY NEXT DATA FILE
          ZR     X1,DAT990   EXIT IF NONE 
          SA1    TBINTSV+3
          SX6    X1-1        CHECK IF LOOPING THROUGH TOO 
          NG     X6,DAT990   MANY DATA FILES
          SA6    A1 
* 
*         SAVE STATUS / DATA RECORD / RJ TRAIL
* 
          SA1    DARG1       ADDRESS OF DATA RECORD 
          SA0    X1 
          SA1    DARG2       LENGTH OF DATA RECORD
          SB1    X1 
          SA1    ADATAEC     ADDRESS OF TEMPORARY ECS BUFFER
          BX0    X1 
+         WE     B1          WRITE DATA RECORD TO TEMP ECS
          RJ     ECSPRTY
          SX6    B7          SAVE CURRENT CONTINGENCY 
          SA6    NCTYPEP
          NG     X6,DATN10   JUMP IF NOT IN NORMAL EXECUTION
* 
          CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
* /---   BLOCK      DATAOUT    00 000   78/11/12  21.25 
* 
*         CREATE STORAGE AREA FOR RJ TRAIL AND DATA RECORD
* 
 DATN10   CALL   XSTOR,DSNAME,DSLTH 
          SA1    LESNUM 
          NG     X1,DATW95   EXIT IF ECS IS NOT AVAILABLE 
          SX6    X1 
          SA6    TBINTSV     *TBINTSV(0)* = LESSON NUMBER 
          CALL   ALTLES,1 
          INTCLR X,I.ADDL    RELEASE LESNAM INTERLOCK 
* 
*         SAVE DATA RECORD AND RJ TRAIL IN STORAGE AREA 
* 
          SA1    DARG2       GET LENGTH OF DATA RECORD
          BX6    X1 
          SA6    INFO        MOVE TO CM BUFFER
          SB1    X1 
          SA1    ADATAEC     ECS ADDRESS OF SAVED RECORD
          BX0    X1 
          SA0    INFO+1      ADDRESS OF CM BUFFER 
+         RE     B1          BRING IN DATA RECORD 
          RJ     ECSPRTY
*         CALL   LINKS,(INFO+1+DATAMAX)    SAVE RJ TRAIL
          SB1    INFO+1+DATAMAX 
+         RJ     =XLINKS
-         VFD    30/DATAOUT 
          SA1    TBINTSV     GET ECS ADDRESS OF STORAGE 
          CALL   READLES,0,0
          SX1    LPRMLTH     BIAS PAST HEADER RECORD
          IX0    X0+X1
          SA0    INFO        CM ADDRESS OF STUFF TO SAVE
+         WE     DSLTH
          RJ     ECSPRTY
          EQ     DATAOA      ADVANCE TO NEXT DATA-FILE
* 
*         RETURNS TO *REENT1* AFTER ADVANCE 
* 
 REENT1   INTLOK X,I.DAT,W   INTERLOCK
          SA1    TBLDATA
          SX1    X1          CHECK IF NEW DATA FILE SET 
          ZR     X1,DATW95
          EQ     DATW40 
* 
* 
* /---   BLOCK      DATAOUT    00 000   78/11/12  21.10 
          TITLE  -DATOOV-    WAIT FOR DATA FILE AVAILABLE 
* 
* 
*         SAVE STATUS / DATA RECORD / RJ TRAIL BEFORE WAIT
*         ON DATA WRITE BUFFER AVAILABLE
* 
 DATWAIT  SA1    DARG1       ADDRESS OF DATA RECORD 
          SA0    X1 
          SA1    DARG2       LENGTH OF DATA RECORD
          SB1    X1 
          SA1    ADATAEC     ADDRESS OF TEMPORARY ECS BUFFER
          BX0    X1 
+         WE     B1          WRITE DATA RECORD TO TEMP ECS
          RJ     ECSPRTY
          SX6    B7          SAVE CURRENT CONTINGENCY 
          SA6    NCTYPEP
          NG     X6,DATW10   JUMP IF NOT IN NORMAL EXECUTION
          CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
* 
*         CREATE STORAGE AREA FOR RJ TRAIL AND DATA RECORD
* 
 DATW10   CALL   XSTOR,DSNAME,DSLTH 
          SA1    LESNUM 
          NG     X1,DATW95   EXIT IF ECS IS NOT AVAILABLE 
          SX6    X1 
          SA6    TBINTSV     SAVE STORAGE AREA LESSON NUM 
          CALL   ALTLES,1 
          INTCLR X,I.ADDL    RELEASE LESNAM INTERLOCK 
* 
*         SAVE DATA RECORD AND RJ TRAIL IN STORAGE AREA 
* 
          SA1    DARG2       GET LENGTH OF DATA RECORD
          BX6    X1 
          SA6    INFO        MOVE TO CM BUFFER
          SB1    X1 
          SA1    ADATAEC     ECS ADDRESS OF SAVED RECORD
          BX0    X1 
          SA0    INFO+1      ADDRESS OF CM BUFFER 
+         RE     B1          BRING IN DATA RECORD 
          RJ     ECSPRTY
*         CALL   LINKS,(INFO+1+DATAMAX)    SAVE RJ TRAIL
          SB1    INFO+1+DATAMAX 
+         RJ     =XLINKS
-         VFD    30/DATAOUT 
          SA1    TBINTSV     GET ECS ADDRESS OF STORAGE 
          CALL   READLES,0,0
          SX1    LPRMLTH     BIAS PAST HEADER RECORD
          IX0    X0+X1
          SA0    INFO        CM ADDRESS OF STUFF TO SAVE
+         WE     DSLTH
          RJ     ECSPRTY
* 
* /---   BLOCK      DATAOUT    00 000   78/11/12  21.22 
* 
*         WAIT FOR DATA OUTPUT BUFFER AVAILABLE 
* 
 DATW30   INTCLR X,I.DAT     RELEASE INTERLOCK
          TUTIM  250         PAUSE FOR A WHILE
          INTLOK X,I.DAT,W   INTERLOCK
          SA1    TBLDATA
          CALL   READLES,DATINF,(LPRMLTH+DPRMLTH) 
          SA1    INF+DATSTAT      LOAD STATUS WORD
          LX1    DWRITSH     CHECK IF FILE AVAILABLE
          NG     X1,DATW30
* 
 DATW40   SA1    NCTYPEP     RESTORE CURRENT CONTINGENCY
          SB7    X1 
          NG     B7,DATW45   JUMP IF NOT NORMAL EXECUTION 
          CALL   RESTLES     RESTORE LESSON, COMMON, ETC. 
* 
 DATW45   SA1    TBINTSV     STORAGE LESSON NUMBER
          CALL   ALTLES,-1   RELEASE STORAGE BLOCK
          SA1    TBINTSV
          CALL   READLES,INFO,(LPRMLTH+DSLTH) 
*         CALL   LINKR,(INFO+LPRMLTH+1+DATAMAX) 
          SB1    INFO+LPRMLTH+1+DATAMAX 
+         RJ     =XLINKR
-         VFD    30/DATAOUT 
          SA1    INFO+LPRMLTH 
          SB2    X1          LENGTH OF DATA RECORD
          SB1    INFO+LPRMLTH+1   ADDRESS OF DATA RECORD
          EQ     DATAO       GO BACK AND START OVER AGAIN 
* 
 DATW95   SA1    NCTYPEP     RESTORE CURRENT CONTINGENCY
          SB7    X1 
          NG     X1,DAT990   EXIT IF NOT NORMAL EXECUTION 
          CALL   RESTLES     RESTORE LESSON, COMMON, ETC. 
* 
 DAT990   INTCLR X,I.DAT     RELEASE INTERLOCK
          EQ     DATAOUT
* 
* 
 K0       DATA   0
 K1       DATA   1
 K2       DATA   2
* 
 DECSLOC  BSS    1
 DWORD    BSS    1
 DBLOKN   BSS    1
 DBLKLIM  BSS    1
 DERRFLG  BSS    1
 ISYSF    BSS    1
* 
 DATINF   BSS    LPRMLTH+DPRMLTH
 INF      EQU    DATINF+LPRMLTH 
* 
 DSLTH    EQU    1+DATAMAX+DRJLTH 
* 
 DSNAME   DATA   0
          DATA   0LDATATEMP 
          DATA   0LSTORAGE
+         VFD    12/1,48/0
* 
          ENDOV 
* 
* /---   BLOCK      BACKOUT    00 000   75/03/10  15.51 
          TITLE  -BACKOUT-
* 
*         *BACKOUT*, *BACK ON* AND *BACKTST* FUNCTIONS
 
*         -BACKOUT (-1),STATION- OR -BACKOUT (-1)-
 
*         'THIS COMMAND BACKS OUT EITHER A SINGLE STATION 
*         OR ALL STATIONS.  'THE SAME BASIC PROCESS IS USED 
*         IN BOTH CASES';  PRESSING KEY ',SSBKEY', ON A STATION 
*         STARTS A PROCESS ON THAT STATION THAT 
 
*         A) LOCKS OUT ALL KEYSET KEYS
 
*         B) PRESSES A SEQUENCE OF ',STOP1', AND ',BACK', KEYS
*         ON THE STATION, UNTIL EITHER THE STATION GIVES UP 
*         ITS STUDENT BANK, OR THE SEQUENCE REACHES AN END
 
*         C) THE PROCESS (EVEN FOR ALL TERMINALS) SHOULD REACH
*         COMPLETION IN A FEW SECONDS.
 
*         D) IF THE BACKOUT PROCESS REACHES THE END OF THE
*         SEQUENCE AND THE STATION IS NOT YET OUT, THE
*         BACKOUT BIT IS TURNED OFF.
 
*         'THE RESULTING STATUS OF A STATION IS DETERMINED
*         FROM THE FOLLOWING TABLE';
* 
*  'CONDITION-'STATUS     BACKOUT BIT  BANK ADDRESS 
* B.O. IN PROGRESS         ON           ON
* B.O. COMPLETED           ON           OFF 
* B.O. UNSUCCESSFUL        OFF          ON
* MAY HAVE LOST A 
* PRESS KEY, OR STATION 
* WAS SIGNED OUT AFTER
* UNSUCCESSFUL B.O.        OFF          OFF 
 
 
*         'THE -BACKOUT- COMMAND WILL NOT BACK OUT THE EXECUTING STATION
 
*         -BACKON-';
 
*         -BACKOUT (0),STATION- OR -BACKOUT  (0)- 
 
*         'THIS COMMAND TURNS OFF THE STATION'7S BACKOUT FLAG,
*         THEREBY LETTING IT BACK ON.  THE FLAG IS SIMPLY 
*         CLEARED.
 
*         -BACKOUT  (1),STATION OR -BACKOUT  (1)- 
 
*         'THIS COMMAND RETURNS (IN ERROR)';
*         SINGLE STATION';             ALL STATIONS 
*         -1 STATION BACKED OUT          -1 ALL BACKED OUT
*          0 STATION ACTIVE               0 NOT RETURNED
*          1 BEING BACKED OUT            (N) NUMBER OF
*          2 STATION INACTIVE, NOT           STATIONS NOT 
*            BACKED OUT                      BACKED OUT 
*          3 STATION LT 0 
*          4 STATION GT MAX 
 
* 
*         ERROR RETURNS FOR *BACKOUT* AND *BACKON* FUNCTIONS
* 
*         -1   FUNCTION REQUEST PERFORMED 
*          3 STATION LT 0 
*          4 STATION GT MAX 
*          5 ACTION REQUEST OVERFLOW
*         IN *TERROR* 
* /---   BLOCK      BACKOUX    00 000   79/07/15  21.39 
 BACKOTV  OVRLAY
          EXT    TEMP        -BACKOUT- USED TO BE IN *IOPUT*
 BACKOUX  SX7    -1 
          SA7    TERROR      PRESET 
          CALL   SAVKEY 
          NGETVAR 
          SA5    A5          CHECK FOR 2ND ARG
          LX5    XCODEL 
          ZR     X1,BACKON   JUMP IF -BACK ON-
          PL     X1,BACKTST  -BACKTST-
          PL     X5,SBACKX   BRANCH IF STATION SPECIFIED
* 
          CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
          PAUSE              FORMAT ANY OUTPUT
          SX6    RQBKOUT
          SA6    ACTOUT      REQUEST BACKOUT
          SX6    1
          SA6    AOUTLOC
          TUTIM  -1,,IOKEY   WAIT FOR IOKEY 
          CALL   RESTKEY
          EQ     RETPRO      TO PROCESSING, RELOAD COMMON,STO, ETC
* /---   BLOCK      SBACKX     00 000   77/12/01  23.16 
 
 SBACKX   NGETVAR            STATION NUMBER 
          NG     X1,SBERR0
          SX2    NUMSTAT-1   MAX STATION NUMBER 
          IX2    X2-X1
          NG     X2,SBERR1
          SA2    STATION
          IX2    X1-X2
          ZR     X2,PROCESS  EXIT IF THIS STATION 
 
*         THE FOLLOWING CODE PRESSES THE BACKOUT KEY ON 
*         THE DESIGNATED STATION
 
          SA2    AOUTLOC
          SX7    X2+3 
          SX3    X7-AOUTLTH 
          PL     X3,SBERR2   STANDARD CHECK FOR ROOM IN BUFFER
          SA7    A2 
          SX6    RQPRESS
          SA6    ACTOUT+X2
          SX6    SSBKEY 
          SA6    A6+1 
          BX6    X1          STATION
          SA6    A6+1 
          EQ     PROCESS
* 
*         CLEAR ',BACKOUT', STATUS TO LET TERMINAL(S) BACK ON 
 
 BACKON   BSS    0
          SA2    BCKOUT      FLAG, STATION SET FOR GENERAL BACKOUT
          MX6    1           CLEAR FLAG BIT 
          BX6    -X6*X2 
          SA6    A2          CLEARS GENERAL BACKOUT FLAG
          SA6    MASRQ+1     INTO REQUEST BUFFER
          SX6    XR.BKOU
          SA6    MASRQ       SET INTER-EXEC REQUEST CODE
          CALL   MXRQALL     TELL OTHER EXECUTORS TO CLEAR FLAG 
 BACKO2   PL     X5,SBCKONX  BRANCH IF SINGLE STATION 
 
          SB1    B0 
          MX1    0
 
* /---   BLOCK      SBACKX     00 000   77/04/04  23.46 
*         BOTH ALL AND SINGLE STATION ',BACKON', COMES HERE,
*         WITH B1 AND X1 SET APPROPRIATELY
 
 BCKONCX  BSS    0
          SX0    STFLAGS-STSTART
          SA3    NSYSBNK
          IX0    X0+X3
          SA3    NSYSLTH
          IX1    X3*X1       BIAS FOR STATION (X1)
          SB2    NUMSTAT-1
          SA0    TEMP 
          IX0    X0+X1       ADD BIAS FOR SINGLE STATION
          MX1    1
          LX1    SSBBIT 
          MX2    1
          LX2    SSCBIT 
          BX2    X1+X2       CLEAR SSBBIT AND SSCBIT
 
*         THE FOLLOWING LOOP CLEARS THE BACKOUT BIT IN ALL
*         STATION BANKS, INCLUDING THE ECS COPY FOR THIS
*         STATION--WHICH DOES NO HARM 
 BCKLP    BSS    0
          RE     1
          RJ     ECSPRTY
          SA1    A0 
          BX6    -X2*X1 
          SA6    A0 
          WE     1
          RJ     ECSPRTY
          IX0    X0+X3
          SB1    B1+1 
          LE     B1,B2,BCKLP
          EQ     PROCESS
 
 SBCKONX  NGETVAR            GET STATION NUMBER 
          NG     X1,SBERR0
          SX3    NUMSTAT-1 MAX STATION NUMBER 
          IX2    X3-X1
          NG     X2,SBERR1
*         THERE IS NO CHECK HERE FOR THIS STATION, AS IT
*         CAN NOT ARISE (EXCEPT THROUGH PRESS KEY ACTIONS)
*         NOR WOULD IT MATTER 
 
          SB1    X3          SET  B1 TO EXIT FROM LOOP
          EQ     BCKONCX
* 
 SBERR0   MX7    0           STATION ^$ LT 0
          EQ     SBERR
 
 SBERR1   SX7    1           STATION ^$ GT MAX
          EQ     SBERR
 
 SBERR2   SX7    2           ACTION REQUEST OVERFLOW
 SBERR    SA7    TERROR 
          EQ     PROCESS
* /---   BLOCK      BACKTST    00 000   77/04/04  23.33 
 BACKTST  BSS    0
          PL     X5,BKSSTST 
          SB2    NUMSTAT
          SB1    1           CONSTANT 
          MX6    0
 TSTALLP  BSS    0
          SB2    B2-B1       DECREMENT STATION NUMBER 
          LE     B2,TSTQUIT  SKIP CONSOLE 
          SX1    B2 
          SA2    STATION
          IX2    X1-X2
          ZR     X2,TSTALLP 
 
          CALL   SSTST       STATUS RETURNED IN X7
 
          NG     X7,TSTALLP 
          SX6    X6+B1
          EQ     TSTALLP
 
 TSTQUIT  BSS    0
          SX7    -1 
          ZR     X6,TSTSET
          BX7    X6          (N) NOT YET BACKED OUT 
 TSTSET   SA7    TERROR 
          EQ     PROCESS
 
 
 BKSSTST  BSS    0
          NGETVAR            STATION NUMBER 
 
* *       CHECK VALIDITY OF STATION NUMBER
 
          NG     X1,SBERR0
          SX2    NUMSTAT-1
          IX2    X2-X1
          NG     X2,SBERR1
 
          CALL   SSTST
 
 
          SA7    TERROR 
          EQ     PROCESS
          ENDOV 
* /---   BLOCK      SHOWE      00 000   81/01/14  11.42 
          TITLE  SHOWE
*         -SHOWE- 
* 
*            SHOWS TUTOR VARIABLE IN SCIENTIFIC NOTATION
*            THE SECOND ARGUMENT SPECIFIES THE NUMBER OF
*            SIGNIFICANT FIGURES.  'THERE IS ALWAYS A LEADING 
*            BLANK OR MINUS SIGN; THE DEFAULT IS 4 SIG . FIGS 
*         THIRD ARG IS 0 FOR REGULAR, NON-ZERO FOR ** 
* 
 SHOWEOV  OVRLAY
          EXT    ARAYFLG,ASHOWE,SHOWFIN,ASHOWIN 
*         ABOVE IS DUE TO OVERLAYING OF THIS COMMAND
 SHOWE    SX7    0
          SA7    ARAYFLG     GETVAR SETS NONZERO IF ARRAY 
          SA7    STARFLG     CLEAR FLAG 
          FGETVAR            EVALUATE 1ST ARGUMENT
          BX7    X1 
          SA7    SHOWVAL     SAVE IT
          SA5    A5          RESTORE COMMAND
          LX5    XCODEL      LEFT-ADJUST 2ND ARG CODE 
          NG     X5,SHOWE2   NEG MEANS DEFAULT 2ND ARGUMENT (6.3 OR 2.0)
          NGETVAR            DO THE CALC TO GET THE FORMAT
          BX6    X1 
          ZR     X6,PROCESS  OUT IF NOTHING TO DO 
* 
 SHOWE1   SA5    A5          REFETCH COMMAND WORD 
          LX5    2*XCODEL 
          PL     X5,SHOWE3   FOR THREE ARG SHOW 
* 
 SHOWE1A  SA6    NCHAR       INTERFACE (SAVE FOR ASHOWE)
          MX7    0
          SA7    SHOWOUT     REQUEST LEADING BLANK/SIGN 
          SX7    1
          SA7    SUPPFLG     NO ZERO SUPPRESSION
          SA1    ARAYFLG
          NZ     X1,ASHOWE   JUMP IF IS ARRAY 
          RJ     =XESHOW
          EQ     SHOWFIN
* 
****
 SHOWE2   SX6    4           INTERFACE DEFAULT
          EQ     SHOWE1 
*** 
 SHOWE3   SA6    NCHAR       STORE NCHAR (KLUDGE) 
          MX0    2*XCODEL+XCMNDL  FLAG BIT NOT SET IFGETHERE
          LX5    60-2*XCODEL-XCMNDL POSITION ADDRESS
          BX5    -X0*X5 
          SA1    B5+X5       FETCH 3RD ARG
          BX5    X1 
          NGETVAR 
          MX6    0           REMOVE -0
          IX6    X6+X1
          SA6    STARFLG
* 
          SA1    NCHAR
          BX6    X1          RESTORE NCHAR
          EQ     SHOWE1A      REENTER FLOW
* 
          ENDOV 
* 
* /---   BLOCK      SHOWO      00 000   78/09/01  21.37 
* 
          TITLE  SHOWO
*         -SHOWO-  (CODE=32)
* 
*            SHOWS IN OCTAL FORMAT THE CONTENTS OF A TUTOR VARIABLE.
* 
 SHOWOOV  OVRLAY
          EXT    ARAYFLG,ASHOWE,SHOWFIN,ASHOW3,ASHOWIN
*         ABOVE IS DUE TO OVERLAYING OF THIS COMMAND
 SHOWOX   SX7    0
          SA7    ARAYFLG     PREPARE FOR SHOWO(ARRAY) 
          NGETVAR            I/F BIT OUT AT CONDENSE TIME 
          BX7    X1 
          SA7    SHOWVAL     SAVE IT
          SA5    A5          RESTORE COMMAND
          LX5    XCODEL      LEFT-ADJUST 2ND ARG CODE 
          NGETVAR            ROUNDS TO INTEGER IN X1
          ZR     X1,PROCESS  OUT IF NOTHING TO DO 
          BX6    X1 
          SA6    NCHAR
          SA1    ARAYFLG
          NZ     X1,ASHOWO   JUMP IF WHOLE ARRAY
          RJ     =XOSHOW
          EQ     SHOWFIN
* 
 ASHOWO   SA3    SHOWO1      PLANT EQ SHOWO2 IN LOOP
          SX6    1           TYPE=1 FOR NGETVAR 
          EQ     ASHOWIN
* 
 SHOWO1   EQ     SHOWO2 
* 
 SHOWO2   RJ     OSHOW
          CALL   XYFIX
          CALL   TUTWRT 
          SA1    NX 
          SX7    X1+16
          SA7    A1          ADJUST WHEREX
          SX7    5555B         TWO SPACES 
          LX7    48 
          SA7    SHOWVAL     BETWEEN OCTAL VALUES 
          SB1    A7          PTR TO STRING
          SX7    2
          SA7    SHOWOUT
          SB2    A7          PTR TO COUNT 
          EQ     ASHOW3      CALL TUTWRT FOR SPACES + GO ON 
* 
          ENDOV 
* 
* /---   BLOCK      SHOWH      00 000   78/10/18  03.01 
* 
          TITLE  SHOWH
*         -SHOWH-  (CODE=43)
* 
*            'SHOWS THE CONTENTS OF A 'T'U'T'O'R VARIABLE IN HEX. 
* 
* 
 SHOWHOV  OVRLAY
          EXT    ARAYFLG,ASHOWE,SHOWFIN,ASHOW3,ASHOWIN
*         ABOVE IS DUE TO OVERLAYING OF THIS COMMAND
 SHOWHX   SX7    0
          SA7    ARAYFLG     PREPARE FOR SHOWH(ARRAY) 
          NGETVAR            I/F BIT OUT AT CONDENSE TIME 
          BX7    X1 
          SA7    SHOWVAL     SAVE IT
          SA5    A5          RESTORE COMMAND
          LX5    XCODEL      LEFT-ADJUST 2ND ARG CODE 
          NGETVAR            ROUNDS TO INTEGER IN X1
          ZR     X1,PROCESS  --- EXIT IF NOTHING TO DO
          BX6    X1 
          SA6    NCHAR
          SA1    ARAYFLG
          NZ     X1,ASHOWH   JUMP IF WHOLE ARRAY
          RJ     =XHSHOW
          EQ     SHOWFIN     --- FINAL EXIT 
 
 ASHOWH   SA3    SHOWH1      PLANT EQ SHOWH2 IN LOOP
          SX6    1           TYPE=1 FOR NGETVAR 
          EQ     ASHOWIN
* 
 SHOWH1   EQ     SHOWH2 
* 
 SHOWH2   RJ     HSHOW
          CALL   XYFIX
          CALL   TUTWRT 
          SA1    NX 
          SX7    X1+16
          SA7    A1          ADJUST WHEREX
          SX7    5555B         TWO SPACES 
          LX7    48 
          SA7    SHOWVAL     BETWEEN OCTAL VALUES 
          SB1    A7          PTR TO STRING
          SX7    2
          SA7    SHOWOUT
          SB2    A7          PTR TO COUNT 
          EQ     ASHOW3      CALL TUTWRT FOR SPACES + GO ON 
          ENDOV 
* 
* 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
          TITLE  -TALKREQ-   DOCUMENTATION
**        TALKREQ - TALK/MONITOR INITIATION/TERMINATION.
* 
*         ENTRY  (OVARG1) = ZERO IF CALLED BY TUTOR COMMAND 
*                            NZ  IF BY SIGNOUT PROCESS
* 
*         ALL THE VARIOUS FUNCTIONS ARE ACTUALLY OFF-SHOOTS 
*         OF THE ABILITY OF THE FORMATTER TO SWITCH OUTPUT
*         BETWEEN TERMINALS.  THE ',FORWARD POINTER', IS USED 
*         BY THE FORMATTER TO RE-ROUTE OUTPUT (AFTER BEING
*         SENT TO IT'7S ORIGINATOR).  FOR EXAMPLE'; TALK IS 
*         ACTUALLY MONITOR MODE, BUT THE TWO USERS ARE HELD 
*         AT THEIR INDIVIDUAL ARROWS.  MONITOR AND TELECONF 
*         ALLOW ONE USER TO MOVE AROUND THE SYSTEM WHILE THE
*         OTHER(S) ARE HELD.  MASTER MODE ALLOWS BOTH USERS 
*         TO MOVE AROUND (THOUGH ONE STATION IS USUALLY NOT 
*         SIGNED IN). 
* 
*         THE MOST IMPORTANT ASSOCIATED DECKS'; 
*           EXECUTOR DECK TUTORX, ROUTINE (I)MODE7. 
*           FORMATTER DECK FORMAT, ROUTINE FORMX. 
*           CONDENSOR DECK COVLAY2, OVERLAY TRQCOV. 
* 
* 
* 
*         *ATALK* -- TALK/MONITOR STATUS TABLE. 
* 
*         PROTECTED BY PROCESS INTERLOCK *I.TALK*;
*         1 WORD/STATION (CONFIGURED IN DECK MSUBS)'; 
* 
*          6/STATUS  (SEE TRS. EQUATES) 
*         18/EXTRA INFO  (PEOPLE LIST BUFFER NUMBER IN TLC) 
*         18/',BACK PTR', TO PREVIOUS STATION IN CHAIN
*         18/',FORWARD PTR', TO NEXT STATION IN CHAIN 
* 
* 
*         THE SIGN BIT OF *PSLAVE* (/STATION/ BANK) IS USED 
*         TO FLAG MONITOR STATUS IS ACTIVE'; FORMATTER RE-
*         ROUTING INFORMATION IS IN THE *ATALK* STATUS WORD 
*         FOR THIS STATION.  THIS IS ALSO USED BY THE EXEC
*         WHEN THE 'T'E'R'M KEY IS PRESSED. 
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
          EJECT 
**
* EFFECTS OF VARIOUS -TALKREQ- FUNCTIONS WITH REGARDS TO
* STATUS OF THE EXECUTING STATION AND THE TARGET STATION. 
* 
* NOTE - THE *PSLAVE* FLAG IS SET/CLEARED FOR THE EXECUTING 
* STATION ONLY.  IF THE OTHER STATION ISN'7T ',WATCHING', FOR 
* A STATUS CHANGE (I.E. MONITOR, MASTER), THE INITIATING
* STATION MUST USE THE -STCHANG- COMMAND TO SET/CLEAR THE 
* FLAG FOR HIM. 
**
*            ------ BEFORE -----    ----- AFTER ------
*             (US)       (THEM)      (US)      (THEM) 
*-----------------------------------------------------------
* REQUEST   0/SYSLIB       0         RTK        RTK 
*-----------------------------------------------------------
* CANCEL       0          N/A        N/A        N/A 
*           TELE-MAS    TELE-MON      0          0
*           TELE-MON    TELE-XXX      0      UNCHANGED
*           (ELSE)      TELE-XXX      0      UNCHANGED
*           (ELSE)      (ELSE)        0          0
*-----------------------------------------------------------
* ANSWER      RTK         RTK       TALK       TALK 
*-----------------------------------------------------------
* SETSLIB      0                   SYSLIB 
*-----------------------------------------------------------
* MONITOR      0           0       MONITOR   MONITORED
* MASTER       0           0       MASTER     MASTER
*-----------------------------------------------------------
* TLK2MON    TALK        TALK     MONITORED   MONITOR 
* MON2TLK   MONITORED   MONITOR     TALK       TALK 
*-----------------------------------------------------------
* STATUS      N/A 
*-----------------------------------------------------------
* JOIN    0/SYSLIB/RTK  TELEXXX    TELE-MON   TELEXXX 
*-----------------------------------------------------------
* CONFER       0          N/A      TELE-MAS     N/A 
*-----------------------------------------------------------
* PAGE     TELE-MAS        0      UNCHANGED     RTK 
*-----------------------------------------------------------
* UNPAGE      N/A         RTK        N/A         0
*-----------------------------------------------------------
* PASS     TELE-MAS    TELE-MON   TELE-MON   TELE-MAS 
*-----------------------------------------------------------
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
          TITLE  -TALKREQ-  TALK/MONITOR FUNCTIONS
 TALKRQV  OVRLAY
 
* 
*         STATUS EQUATES
* 
 TRS.0    EQU    0           0 = NOT BUSY 
 TRS.RTK  EQU    1           1 = REQUEST TALK/TELECONF
 TRS.TLK  EQU    2           2 = TALKING
 TRS.SLB  EQU    3           3 = IN NON-INTERRUPT SYSLIB FNC
 TRS.MTR  EQU    4           4 = MONITORING 
 TRS.MTB  EQU    5           5 = BEING MONITORED
 TRS.MST  EQU    6           6 = DUAL-STATION MASTER
 TRS.TLM  EQU    7           7 = TELECONFERENCE MASTER
 TRS.TLC  EQU    8           8 = TELECONFERENCE MONITOR 
 
* 
*         MAIN ENTRY -- CHECK FOR SUBROUTINE VS. COMMAND
* 
          SA1    OVARG1 
          ZR     X1,TRQCMND  -- JUMP IF TUTOR COMMAND 
* 
*         SUBROUTINE CALL DURING SIGNOUT PROCESS
* 
          INTLOK X,I.TALK,W 
          CALL   TRQBYE 
          INTCLR X,I.TALK 
          RETURN             -- EXIT OVERLAY
* 
* 
 
* 
*         -TALKREQ- COMMAND EXECUTION 
* 
 
*         ENTRY  (X5) = 20/STATION GETVAR CODE
*                       20/2ND ARGUMENT (NOT USED)
*                       11/REQUEST TYPE CODE
*                        9/-TALKREQ- COMMAND CODE 
* 
 
 TRQCMND  BSS    0           TUTOR COMMAND PROCESSOR
          BX1    X5 
          MX0    -11         MASK FOR REQUEST TYPE
          AX1    XCMNDL      SHIFT COMMAND CODE OFF 
          BX1    -X0*X1      X1 = REQUEST TYPE
          SB1    X1 
          JP     B1+TRQTAB   JUMP TO SPECIFIC ROUTINE 
* 
*         -TRQTAB-           TALK REQUEST JUMP TABLE
* 
*         NOTE -- THIS TABLE MUST MATCH THE CORRESPONDING 
*         ====    TABLE IN THE CONDENSOR (COVLAY2). 
* 
 TRQTAB   EQ     TRQ0        0 = REQUEST
          EQ     TRQ1        1 = CANCEL 
          EQ     TRQ2        2 = ANSWER 
          EQ     TRQ3        3 = SETSLIB
          EQ     TRQ4        4 = MONITOR
          EQ     TRQ5        5 = MASTER 
          EQ     TRQ6        6 = TLK2MON
          EQ     TRQ7        7 = MON2TLK
          EQ     TRQ8        8 = STATUS 
          EQ     TRQ9        9 = JOIN 
          EQ     TRQ10       10 = CONFER
          EQ     TRQ11       11 = PAGE
          EQ     TRQ12       12 = UNPAGE
          EQ     TRQ13       13 = PASS
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
          TITLE  -TALKREQ- COMMAND, KEYWORD ROUTINES
************************************************************
*  0 = REQUEST               ISSUE TERM-TALK REQUEST
************************************************************
 
*         OUR STATUS SHOULD BE 0 OR -IN SYSLIB- 
*         HIS STATUS SHOULD BE 0
 
 TRQ0     CALL   GETARG,TARGET
          INTLOK X,I.TALK,W 
          CALL   RDSTAT,STATION,S.WORD,S.STATUS 
          ZR     X6,TRQ0A    -- OUR STATUS IS 0; OK 
          SX1    X6-TRS.SLB 
          NZ     X1,TRQERR1  -- ERROR, OUR STATUS WRONG 
 TRQ0A    CALL   RDSTAT,TARGET,T.WORD,T.STATUS
          NZ     X6,TRQERR0  -- ERROR, HIS STATUS WRONG 
* 
          SX6    TRS.RTK     *REQUEST TALK* STATUS CODE 
          SA6    S.STATUS 
          SA6    T.STATUS 
          SA1    SELF        OUR STATION NUMBER 
          SA2    TARGET      HIS STATION NUMBER 
          BX6    X1 
          BX7    X2 
          SA6    T.TARGET    POINT TO EACH OTHER
          SA7    S.TARGET 
 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
          CALL   WRTSTAT,TARGET,T.WORD,T.STATUS 
          EQ     TRQDONE     -- COMPLETE, EXIT
* 
 
************************************************************
*  1 = CANCEL                CANCEL ANY EXISTING STATE
************************************************************
 
*         OUR STATUS COULD BE ANYTHING
 
 TRQ1     INTLOK X,I.TALK,W 
          CALL   TRQBYE 
          EQ     TRQDONE
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
************************************************************
*  2 = ANSWER                ANSWER TERM-TALK REQUEST 
************************************************************
 
*         BOTH STATIONS SHOULD BE IN *REQUEST TALK* 
*         AND POINTING AT EACH OTHER. 
 
 TRQ2     INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          SX3    X6-TRS.RTK 
          NZ     X3,TRQERR1  -- NOT BEING PAGED 
          CALL   RDSTAT,S.TARGET,T.WORD,T.STATUS
          SX3    X6-TRS.RTK 
          NZ     X3,TRQERR0 
 
          SA1    SELF        CHECK POINTERS 
          SA2    T.TARGET 
          IX3    X1-X2       COMPARE
          NZ     X3,TRQERR0 
 
          SX6    TRS.TLK     CHANGE TO *TALKING*
          SA6    S.STATUS 
          SA6    T.STATUS 
 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
          CALL   WRTSTAT,S.TARGET,T.WORD,T.STATUS 
 
          SA1    PSLAVE      SET PSLAVE FLAG FOR SELF 
          MX6    1
          BX6    X1+X6
          SA6    A1 
          EQ     TRQDONE
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
************************************************************
*  3 = SETSLIB               IN NON-INTERRUPT SYSLIB FUNCTN 
************************************************************
 
*         OUR STATUS SHOULD BE 0
 
 TRQ3     INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          NZ     X6,TRQERR1  -- ALREADY DOING SOMETHING 
 
          SX6    TRS.SLB
          SA6    S.STATUS 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
          EQ     TRQDONE
* 
 
************************************************************
*  4 = MONITOR               MONITOR ANOTHER STATION
************************************************************
 
*         BOTH STATIONS SHOULD HAVE STATUS = 0
 
 TRQ4     CALL   GETARG,TARGET
          INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          NZ     X6,TRQERR1  -- WE ARE DOING SOMETHING ELSE 
          CALL   RDSTAT,TARGET,T.WORD,T.STATUS
          NZ     X6,TRQERR0  -- HE IS DOING SOMETHING ELSE
 
          SX6    TRS.MTR     SET UP OUR STATUS FIRST
          SA6    S.STATUS 
          SA1    TARGET 
          SX6    X1 
          SA6    S.TARGET 
 
          SX6    TRS.MTB     NOW HIS STATUS 
          SA6    T.STATUS 
          SA1    SELF 
          SX6    X1 
          SA6    T.TARGET 
 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
          CALL   WRTSTAT,TARGET,T.WORD,T.STATUS 
 
          SA1    PSLAVE      SET PSLAVE BIT FOR SELF
          MX6    1
          BX6    X1+X6
          SA6    A1 
          EQ     TRQDONE
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
************************************************************
*  5 = MASTER                DUAL-STATION MASTER
************************************************************
 
*         BOTH STATIONS SHOULD HAVE STATUS = 0
 
 TRQ5     CALL   GETARG,TARGET
          INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          NZ     X6,TRQERR1  -- WE ARE DOING SOMETHING ELSE 
          CALL   RDSTAT,TARGET,T.WORD,T.STATUS
          NZ     X6,TRQERR0  -- HE IS DOING SOMETHING ELSE
 
          SX6    TRS.MST     BOTH STATIONS TO *MASTER*
          SA6    S.STATUS 
          SA6    T.STATUS 
 
          SA1    TARGET      POINT AT EACH OTHER
          SX6    X1 
          SA6    S.TARGET 
          SA1    SELF 
          SX6    X1 
          SA6    T.TARGET 
 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
          CALL   WRTSTAT,TARGET,T.WORD,T.STATUS 
 
          SA1    PSLAVE      SET PSLAVE FLAG FOR SELF 
          MX6    1
          BX6    X1+X6
          SA6    A1 
          EQ     TRQDONE
* 
 
************************************************************
*  6 = TLK2MON               SWITCH FROM TALK TO MONITOR
************************************************************
 
*         BOTH STATIONS SHOULD BE IN *TALK* STATE 
*         AND POINTING TO EACH OTHER
 
 TRQ6     INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          SX3    X6-TRS.TLK 
          NZ     X3,TRQERR1  -- WE AREN'7T TALKING
          CALL   RDSTAT,S.TARGET,T.WORD,T.STATUS
          SX3    X6-TRS.TLK 
          NZ     X3,TRQERR0  -- HE ISN'7T TALKING 
 
          SA1    SELF        OUR STATION NUMBER 
          SA2    T.TARGET    WHO IS HE TALKING TO 
          IX3    X1-X2       COMPARE
          NZ     X3,TRQERR0  -- NOT TALKING TO US 
 
          SX6    TRS.MTB     SET OUR STATUS TO *MONITORED*
          SA6    S.STATUS 
          SX6    TRS.MTR     SET HIS STATUS TO *MONITORING* 
          SA6    T.STATUS 
 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
          CALL   WRTSTAT,S.TARGET,T.WORD,T.STATUS 
          EQ     TRQDONE
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
************************************************************
*  7 = MON2TLK               SWITCH FROM MONITOR TO TALK
************************************************************
 
*         OUR STATUS SHOULD BE *MONITORED*
*         HIS STATUS SHOULD BE *MONITORING* 
*         SHOULD BE POINTING AT EACH OTHER
 
 TRQ7     INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          SX3    X6-TRS.MTB 
          NZ     X3,TRQERR1  -- NOT BEING MONITORED 
          CALL   RDSTAT,S.TARGET,T.WORD,T.STATUS
          SX3    X6-TRS.MTR 
          NZ     X3,TRQERR0  -- NOT MONITORING
 
          SA1    SELF        OUR STATION NUMBER 
          SA2    T.TARGET    HIS PARTNER
          IX3    X1-X2       COMPARE
          NZ     X3,TRQERR0  -- MONITORING SOMEONE ELSE 
 
          SX6    TRS.TLK     SET BOTH STATUS TO *TALK*
          SA6    S.STATUS 
          SA6    T.STATUS 
 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
          CALL   WRTSTAT,S.TARGET,T.WORD,T.STATUS 
          EQ     TRQDONE
* 
 
************************************************************
*  8 = STATUS                RETURN STATUS IN *ERROR* 
************************************************************
 
*         READ TARGET STATUS AND RETURN VIA EXIT PROCESS
 
 TRQ8     CALL   GETARG,TARGET
          INTLOK X,I.TALK,W 
          CALL   RDSTAT,TARGET,S.WORD,B0
          EQ     TRQDONE
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
************************************************************
*  9 = JOIN                  JOIN A TELECONFERENCE
************************************************************
 
*         OUR STATUS SHOULD BE 0, IN SYSLIB, OR REQUEST 
*         IF REQUEST, WE MUST BE TARGETING OUR REQUESTOR. 
*         HIS STATUS SHOULD BE EITHER TELE-MASTER/MONITOR.
 
 TRQ9     CALL   GETARG,TARGET
          INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          ZR     X6,TRQ9A    -- OK, NOT BUSY
          SX3    X6-TRS.SLB 
          ZR     X3,TRQ9A    -- OK, IN SYSLIB 
          SX3    X6-TRS.RTK 
          NZ     X3,TRQERR1  -- ERROR, NOT REQUESTED
 
          SA1    S.TARGET 
          SA2    TARGET 
          IX3    X1-X2
          NZ     X3,TRQERR1  -- REQUESTOR .NE. TARGET 
 
 TRQ9A    CALL   RDSTAT,TARGET,T.WORD,T.STATUS
          SX3    X6-TRS.TLM 
          ZR     X3,TRQ9B    -- TARGET IS TELE-MASTER 
          SX3    X6-TRS.TLC 
          NZ     X3,TRQERR0  -- TARGET NOT IN TELECONF
 TRQ9B    SA1    SELF 
          SA2    T.OTHER
          SX6    X1 
          SA6    A2 
          SX6    X2 
          SA6    S.OTHER
          CALL   WRTSTAT,TARGET,T.WORD,T.STATUS 
 
          CALL   RDSTAT,S.OTHER,O.WORD,O.STATUS 
          SA1    SELF 
          SA2    O.TARGET 
          SX6    X1 
          SA6    A2 
          SX6    X2 
          SA6    S.TARGET 
          CALL   WRTSTAT,S.OTHER,O.WORD,O.STATUS
 
          SA1    T.PLIST
          SX6    X1 
          SA6    S.PLIST
          SX6    TRS.TLC
          SA6    S.STATUS 
 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
 
          SA1    PSLAVE      SET PSLAVE FLAG FOR SELF 
          MX6    1
          BX6    X1+X6
          SA6    A1 
          EQ     TRQDONE
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
************************************************************
* 10 = CONFER                START A TELECONFERENCE 
************************************************************
 
*         OUR STATUS SHOULD BE 0 OR *IN SYSLIB* 
 
*         THE ARGUMENT IS THE LESSON NUMBER OF THE
*         PEOPLE LIST, NOT A STATION NUMBER.
 
 TRQ10    CALL   GETARG,TARGET
          INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          ZR     X6,TRQ10A   -- OK, NOT BUSY
          SX3    X6-TRS.SLB 
          NZ     X3,TRQERR1  -- ERR, ALREADY DOING SOMETHING
 
 TRQ10A   SX6    TRS.TLM     TELE-MASTER
          SA6    S.STATUS 
          SA1    SELF 
          SX6    X1+
          SA6    S.OTHER
          SA6    S.TARGET 
          SA1    TARGET 
          SX6    X1+
          SA6    S.PLIST
 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
 
          SA1    PSLAVE      SET PSLAVE FLAG FOR SELF 
          MX6    1
          BX6    X1+X6
          SA6    A1 
          EQ     TRQDONE
* 
 
************************************************************
* 11 = PAGE                  PAGE SOMEONE FOR A TELECONF
************************************************************
 
*         OUR STATUS SHOULD BE *TELE-MASTER*
*         HIS STATUS SHOULD BE 0
 
 TRQ11    CALL   GETARG,TARGET
          INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          SX3    X6-TRS.TLM 
          NZ     X3,TRQERR1  -- WE ARE NOT TELE-MASTER
 
          CALL   RDSTAT,TARGET,T.WORD,T.STATUS
          NZ     X6,TRQERR0  -- ALREADY DOING SOMETHING 
 
          SX6    TRS.RTK
          SA6    T.STATUS 
          SA1    SELF 
          SX6    X1 
          SA6    T.TARGET 
 
          CALL   WRTSTAT,TARGET,T.WORD,T.STATUS 
          EQ     TRQDONE
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
************************************************************
* 12 = UNPAGE                CLEAR SOMEONE'7S PAGING STATUS 
************************************************************
 
*         HIS STATUS SHOULD BE *REQUEST TALK* AND 
*         HE SHOULD BE POINTING AT US.
 
 TRQ12    CALL   GETARG,TARGET
          INTLOK X,I.TALK,W 
          CALL   RDSTAT,TARGET,T.WORD,T.STATUS
          SX3    X6-TRS.RTK 
          NZ     X3,TRQERR0  -- NOT BEING PAGED 
 
          SA1    SELF 
          SA2    T.TARGET 
          IX3    X1-X2
          NZ     X3,TRQERR0  -- PAGED BY SOMEONE ELSE 
 
          CALL   ZEROSTAT,TARGET
          EQ     TRQDONE
* 
 
************************************************************
* 13 = PASS                  PASS CONTROL OF TELECONF 
************************************************************
 
*         OUR STATUS SHOULD BE TELE-MASTER
*         HIS STATUS SHOULD BE TELE-MONITOR 
*         AND HE SHOULD BE IN SAME TELECONF.
 
 TRQ13    CALL   GETARG,TARGET
          INTLOK X,I.TALK,W 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          SX3    X6-TRS.TLM 
          NZ     X3,TRQERR1  -- OUR STATUS IS WORNG 
          CALL   RDSTAT,TARGET,T.WORD,T.STATUS
          SX3    X6-TRS.TLC 
          NZ     X3,TRQERR0  -- HIS STATUS IS WRONG 
 
          SA1    S.PLIST
          SA2    T.PLIST
          IX3    X1-X2
          NZ     X3,TRQERR0  -- NOT IN OUR TELECONF 
 
          SX6    TRS.TLM     MAKE HIM THE MASTER
          SA6    T.STATUS 
          SX6    TRS.TLC     AND US A MONITOR 
          SA6    S.STATUS 
 
          CALL   WRTSTAT,SELF,S.WORD,S.STATUS 
          CALL   WRTSTAT,TARGET,T.WORD,T.STATUS 
          EQ     TRQDONE
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
          TITLE  -TALKREQ- *CANCEL* FUNCTION
**        TRQBYE - COMMON TERMINATION FUNCTION. 
* 
*         REMOVE EXECUTING STATION FROM ANY MONITORS. 
*         DROP PEOPLE LIST IF LAST PERSON IN TELECONF.
* 
 
 TRQBYE   EQ     *           ENTRY/EXIT 
 
*         CLEAR OUR OWN PSLAVE FLAG 
          SA1    PSLAVE 
          MX6    1
          BX6    -X6*X1 
          SA6    A1 
 
          CALL   RDSTAT,SELF,S.WORD,S.STATUS
          ZR     X6,TRQBYE   -- NOTHING TO DO, EXIT 
          SX3    X6-TRS.TLM  CHECK FOR TELE-MASTER
          ZR     X3,TRQB0    -- ADJOURN TELECON 
 
          SA1    SELF        X1 = EXECUTING STATION NUMBER
          SA2    S.TARGET    X2 = FORWARD STATION 
          IX3    X1-X2       COMPARE
          NZ     X3,TRQB2    -- SOMEONE ELSE IS IN CHAIN
 
*         POINTING AT SELF
          SX3    X6-TRS.TLC 
          NZ     X3,TRQB1    -- NOT IN A TELECONF 
          CALL   S=LOG,TRQMSG,3 
          EQ     TRQB1       -- CLEAR SELF AND EXIT 
 
 TRQB0    BSS    0           ** ADJOURN TELECONFERENCE ** 
          CALL   ZEROSTAT,SELF
 
          SA1    S.TARGET    SAVE NEXT STATION IN CHAIN 
          SX6    X1 
          SA6    TARGET 
 
          SA1    S.PLIST     GET PEOPLE LIST LESSON NUMBER
          ZR     X1,ADJRN1   -- NO PEOPLE LIST
          SA1    OVARG1      DO WE NEED TO SAVLES'/ 
+         NZ     X1,*+1      -- NO, NOT CALLED BY COMMAND 
          RJ     =XSAVLES    SAVE COMMON/STORAGE/ETC
 
          SA1    S.PLIST     GET PEOPLE LIST LESSON NUMBER
          CALL   DELETE      DELETE BUFFER
 
          SA1    OVARG1      DO WE NEED TO RESTLES'/
+         NZ     X1,*+1      -- NO, CALLED BY COMMAND 
          RJ     =XRESTLES   RESTORE COMMON/STORAGE/ETC.
 
 ADJRN1   BSS    0
          CALL   RDSTAT,TARGET,T.WORD,T.STATUS
          ZR     X6,TRQBYE     -- EXIT, COMPLETED CHAIN 
          CALL   ZEROSTAT,TARGET
          SA1    T.TARGET 
          SX6    X1 
          SA6    TARGET      SAVE NEXT STATION NUMBER 
          EQ     ADJRN1 
 
 TRQB1    BSS    0           ** CLEAR OWN STATUS AND EXIT **
          CALL   ZEROSTAT,SELF
          EQ     TRQBYE 
 
 
 TRQB2    BSS    0           ** CHECK ON MONITOR'7S STATUS ** 
          SX3    X6-TRS.TLC  CHECK FOR TELECONFERENCE 
          ZR     X3,TRQB3    -- YES, WE ARE IN ONE
          CALL   RDSTAT,S.TARGET,T.WORD,T.STATUS
          SX3    X6-TRS.TLM 
          ZR     X3,TRQB1    -- TELE-MASTER, JUST CLEAR SELF
          SX3    X6-TRS.TLC 
          ZR     X3,TRQB1    -- TELE-MON, JUST CLEAR SELF 
          CALL   ZEROSTAT,S.TARGET   CLEAR HIS STATUS TOO 
          EQ     TRQB1       -- NOW CLEAR OUR STATUS
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
 TRQB3    BSS    0           ** REMOVE SELF FROM TELECONF **
*         CORRECT FORWARD LINK IN CHAIN 
          CALL   RDSTAT,S.TARGET,T.WORD,T.STATUS
          SX3    X6-TRS.TLM 
          ZR     X3,TRQB4    -- OK, HE'7S THE TELE-MASTER 
          SX3    X6-TRS.TLC 
          NZ     X3,TRQB1    -- OOPS, JUST CLEAR AND EXIT 
 TRQB4    SA1    S.OTHER     READ OWN BACKWRD POINTER 
          SX6    X1 
          SA6    T.OTHER     STORE IT AS THEIR BACK PTR 
          CALL   WRTSTAT,S.TARGET,T.WORD,T.STATUS 
 
*         CORRECT BACKWARD LINK IN CHAIN
          CALL   RDSTAT,S.OTHER,O.WORD,O.STATUS 
          SX3    X6-TRS.TLM 
          ZR     X3,TRQB5    -- OK, HE'7S THE TELE-MASTER 
          SX3    X6-TRS.TLC 
          NZ     X3,TRQB1    -- OOPS, JUST CLEAR AND EXIT 
 TRQB5    SA1    S.TARGET    READ OWN FORWARD POINTER 
          BX6    X1 
          SA6    O.TARGET    STORE IT AS THEIR FORWRD PTR 
          CALL   WRTSTAT,S.OTHER,O.WORD,O.STATUS
 
          EQ     TRQB1       -- NOW CLEAR OUR STATUS
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
          TITLE  -TALKREQ- SUBROUTINES
*********************************************************** 
*         SUBROUTINES FOR -TALKREQ- 
*********************************************************** 
 
**        RDSTAT - READ TALK/MONITOR STATUS FOR STATION.
* 
*         ENTRY  (B1) = ADDR OF DESIRED STATION NUMBER. 
*                (B2) = ADDRESS TO HOLD STATUS WORD.
*                (B3) = ADDRESS OF 4-WORD DETAILED BUFFER.
*                       (ZERO MEANS WORD NOT BROKEN DOWN) 
* 
*         EXIT   (X1) = DESIRED STATUS WORD (ALSO IN CM). 
*                (X6) = 6-BIT STATUS CODE, IF BROKEN DOWN.
* 
*         ERROR  IF INVALID STATION, EXITS TO TRQERR2.
* 
*         USES   A - 0, 1, 6. 
*                B - NONE.
*                X - 0, 1, 6. 
* 
 RDSTAT   EQ     *           ENTRY/EXIT POINT 
          SA1    B1          GET DESIRED STATION NUMBER 
          SX0    X1          TRUNCATE TO 18, MOVE TO X0 
          NG     X0,TRQERR2  -- ILLEGAL, NEG. STATION NUM.
          SX1    NUMSTAT     NUMBER OF STATIONS ON SYSTEM 
          IX1    X0-X1       COMPARE
          PL     X1,TRQERR2  -- ILLEGAL, STATION TOO LARGE
          SA1    ATALK       X1 = EM ADDR OF STATUS TABLE 
          IX0    X0+X1       X0 = EM ADDR FOR DESIRED WORD
          SA0    B2          CELL TO HOLD STATUS WORD 
          RE     1           READ STATUS WORD FROM EM TO CM 
          RJ     =XECSPRTY   HALF-EXIT IFF HARDWARE ERROR 
          SA1    A0          READ STATUS WORD FROM CM 
          ZR     B3,RDSTAT   -- NO BREAK-DOWN BUFFER SPECIF.
 
          SX6    X1          X6 = FORWARD POINTER 
          SA6    B3+3        SAVE IT
          AX1    18          SHIFT TO NEXT FIELD
          SX6    X1          X6 = BACKWARD POINTER
          SA6    B3+2        SAVE IT
          AX1    18          SHIFT TO NEXT FIELD
          SX6    X1          X6 = PEOPLE LIST NUMBER
          SA6    B3+1        SAVE IT
          AX1    18          SHIFT TO NEXT FIELD
          SX6    X1          X6 = STATUS
          SA6    B3          SAVE IT
          EQ     RDSTAT      -- RETURN TO CALLER
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
**        WRTSTAT - WRITE STATUS WORD FOR STATION.
* 
*         ENTRY  (B1) = ADDR OF STATION NUMBER. 
*                (B2) = ADDR OF NEW STATUS WORD.
*                (B3) = ADDR OF DETAILED STATUS BUFFER. 
*                       (ZERO MEANS ALREADY IN STATUS WD.)
* 
*         ERROR  IF INVALID STATION, EXITS TO TRQERR2.
* 
*         USES   A - 0, 1, 6. 
*                B - NONE.
*                X - 0, 1, 6. 
* 
 WRTSTAT  EQ     *           ENTRY/EXIT 
          ZR     B3,WRTS1    -- NO DETAILED BUFFER SPECIF.
          SA1    B3          GET 6-BIT STATUS CODE
          MX6    -6          MASK FOR STATUS CODE 
          BX6    -X6*X1      TRUNCATE 
          LX6    18          SHIFT
          SA1    B3+1        GET 18-BIT PEOPLE LIST NUMBER
          SX1    X1          TRUNCATE 
          BX6    X1+X6       UNION
          LX6    18          SHIFT
          SA1    B3+2        GET 18-BIT BACKWARD POINTER
          SX1    X1          TRUNCATE 
          BX6    X1+X6       UNION
          LX6    18          SHIFT
          SA1    B3+3        GET 18-BIT FORWARD POINTER 
          SX1    X1          TRUNCATE 
          BX6    X1+X6       UNION
          SA6    B2          STORE RESULT 
 
 WRTS1    SA1    B1          READ STATION NUMBER
          SX0    X1          TRUNCATE TO 18, MOVE TO X0 
          NG     X0,TRQERR2  -- ILLEGAL, NEG. STATION NUM.
          SX1    NUMSTAT     NUMBER OF STATIONS ON SYSTEM 
          IX1    X0-X1       COMPARE
          PL     X1,TRQERR2  -- ILLEGAL, STATION TOO LARGE
          SA1    ATALK       X1 = EM ADDR OF STATUS TABLE 
          IX0    X0+X1       EM ADDR OF STATUS WORD 
          SA0    B2          CELL HOLDING NEW STATUS WORD 
          WE     1           WRITE STATUS WORD TO EM
          RJ     =XECSPRTY   HALF-EXIT IFF HARDWARE ERROR 
          EQ     WRTSTAT     -- RETURN TO CALLER
* 
 
**        ZEROSTAT - ZERO STATUS WORD FOR SPECIFIED STATION.
* 
*         ENTRY  (B1) = ADDRESS OF STATION NUMBER.
* 
*         ERROR  EXITS TO TRQERR2 IF BAD STATION NUMBER.
* 
*         USES   A - 0, 1.
*                B - NONE.
*                X - 0, 1.
* 
 ZEROSTAT EQ     *           ENTRY/EXIT 
          SA1    B1          READ STATION NUMBER
          SX0    X1          TRUNCATE TO 18, MOVE TO X0 
          NG     X0,TRQERR2  -- ILLEGAL, NEG. STATION NUM.
          SX1    NUMSTAT     NUMBER OF STATIONS ON SYSTEM 
          IX1    X0-X1       COMPARE
          PL     X1,TRQERR2  -- ILLEGAL, STATION TOO LARGE
          SA1    ATALK       X1 = EM ADDR OF STATUS TABLE 
          IX0    X0+X1       EM ADDR OF STATUS WORD 
          SA0    KZERO       CONSTANT ZERO
          WE     1           WRITE STATUS WORD TO EM
          RJ     =XECSPRTY   HALF-EXIT IFF HARDWARE ERROR 
          EQ     ZEROSTAT    -- RETURN TO CALLER
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
 
**        GETARG - GET ARGUMENT FROM COMMAND WORD.
* 
*         ENTRY  (B1) = ADDRESS TO STORE ARGUMENT 
* 
 GETARG   PS                 ENTRY/EXIT 
          SX6    B1 
          SA6    CARG        SAVE ADDR
          NGETVAR 
          BX6    X1 
          SA1    CARG 
          SA6    X1 
          EQ     GETARG 
* 
 
* /---   BLOCK      -TALKREQ-  00 000   82/08/20  06.00 
          TITLE  -TALKREQ- EXITS AND STORAGE
*********************************************************** 
*         EXITS FOR -TALKREQ- 
*********************************************************** 
 
 TRQERR0  SX6    0           0 = TARGET HAS WRONG STATUS
          SA1    T.WORD      READ TARGET STATUS WORD
          EQ     TRQEXIT
 
 TRQERR1  SX6    1           1 = OUR STATUS IS WRONG
          SA1    S.WORD      READ OUR STATUS WORD 
          EQ     TRQEXIT
 
 TRQERR2  SX6    2           2 = BAD STATION NUMBER 
          SX1    0           NO STATUS WORD TO RETURN 
          EQ     TRQEXIT
 
 TRQDONE  SX6    -1          -1 = REQUEST PROCESSED OK
          SA1    S.WORD      READ OUR STATUS WORD 
 
 TRQEXIT  SA6    TRETURN     SET *ZRETURN* TO RETURN CODE 
          BX6    X1 
          SA6    TERROR      SET *ERROR* TO STATUS WORD 
          INTCLR X,I.TALK    CLEAR INTERLOCK
          SA1    OVARG1      COMMAND OR SIGNOUT'/ 
          ZR     X1,PROCESS  -- EXIT TO NEXT COMMAND
          RETURN             -- EXIT OVERLAY AS SUBR. 
 
 
*********************************************************** 
*         STORAGE CELLS FOR -TALKREQ- 
*********************************************************** 
 
* 
*         STATION NUMBER, STATUS WORD, DISASSEMBLED FIELDS. 
* 
 SELF     EQU    STATION     EXECUTING STATION
 S.WORD   BSSZ   1           STATUS WORD FROM EM
 S.STATUS BSSZ   1           6-BIT STATUS CODE
 S.PLIST  BSSZ   1           18-BIT PEOPLE LIST LESSON NUM. 
 S.OTHER  BSSZ   1           18-BIT BACKWARD POINTER
 S.TARGET BSSZ   1           18-BIT FORWARD POINTER 
* 
 TARGET   BSSZ   1           FORWARD STATION (COMMAND TAG)
 T.WORD   BSSZ   1           STATUS WORD FROM EM
 T.STATUS BSSZ   1           6-BIT STATUS CODE
 T.PLIST  BSSZ   1           18-BIT PEOPLE LIST LESSON NUM. 
 T.OTHER  BSSZ   1           18-BIT BACKWARD POINTER
 T.TARGET BSSZ   1           18-BIT FORWARD POINTER 
* 
 OTHER    BSSZ   1           BACKWARD STATION 
 O.WORD   BSSZ   1           STATUS WORD FROM EM
 O.STATUS BSSZ   1           6-BIT STATUS CODE
 O.PLIST  BSSZ   1           18-BIT PEOPLE LIST LESSON NUM. 
 O.OTHER  BSSZ   1           18-BIT BACKWARD POINTER
 O.TARGET BSSZ   1           18-BIT FORWARD POINTER 
* 
 KZERO    CON    0           CONSTANT ZERO
 CARG     BSSZ   1           COMMAND ARGUMENT ADDRESS 
 TRQMSG   DIS    ,* UNSAFE TELECONF CLEANUP.* 
 
          ENDOV 
 
 
* /---   BLOCK      FASTKOV    00 000   81/09/01  03.45 
* 
          TITLE  FASTKOV  -- KEY COLLECTION (PIO TO STORAGE)
 
*         -FASTKEY-  (CODE=360) 
 
*         FASTKEY  STORAGE,NUMKEYS
 
*         ON COMPLETION *TRETURN* IS SET AS FOLLOWS 
 
*         -1 = I/O COMPLETED SUCCESSFULLY 
*          0 = BAD STORAGE ADDRESS
*          1 = BAD NUMBER OF KEYS 
*          2 = NO STORAGE AVAILABLE 
*          3 = INSUFFICIENT STORAGE AVAILABLE 
 
 FASTKOV  OVRLAY
 
          FINISH             ILLEGAL IN FINISH UNIT 
 
          SA1    TBITS       KILL ANY FORCE FIRSTERASE
          MX2    1
          LX2    -FSTEBIT 
          BX6    -X2*X1 
          SA6    A1 
 
*          SA1    AUTKEY      CHECK IF NEED TO END TIMESLICE
*          NG     X1,FKINT    BRANCH IF IN BACKGROUND 
*          CALL   COMPTIM     CHECK CPU USAGE 
*          NG     B2,FKINT    BRANCH IF NO EXCESS 
*          EQ     FKBKUP
 
* /---   BLOCK      FASTKOV    00 000   81/09/02  02.38 
 
*         RESERVE THE PIO CONTROL BUFFER, IF POSSIBLE 
 
 FKINT    INTLOK X,I.SSON    INTERLOCK
          SA1    APIOFKB     CHK BUFFER FREE
          BX0    X1          SET FOR ECS READ 
          SA0    CPIOFKB
+         RE     2
-         RJ     ECSPRTY
          SA1    A0+1        CHECK 10TH BYTE (12BITS/BYTE)
          MX2    -12
          BX2    -X2*X1 
          ZR     X2,FKRES    BRANCH IF BUFFER AVAILABLE 
          INTCLR X,I.SSON    NOT AVAILABLE, CLEAR INTERLOCK 
 FKBKUP   SA5    A5+1        BACK UP COMMAND POINTER
          EQ     =XXSLICE    END TIME SLICE 
 
 FKRES    SA2    STATION     RESERVE THE BUFFER WITH STATION
          BX6    X2 
          SA6    A1 
+         WE     2
-         RJ     ECSPRTY
          INTCLR X,I.SSON    CLEAR INTERLOCK
 
*         GET ARGUMENTS 
 
          NGETVAR            GET STORAGE ADDRESS
          SX2    1             CHK LOWER BOUND
          IX6    X1-X2
          NG     X6,FKERR0   --- ERROR BAD STORAGE ADDR 
          SA6    FKECSAD     SAVE STORAGE ORDINAL 
 
          SA5    A5          RETRIEVE COMMAND WORD
          LX5    XCODEL      SHIFT TO SECOND GETVAR CODE
          NGETVAR            GET NUMBER OF KEYS TO COLLECT
          ZR     X1,FKNOERR    --- DONE IF 0
          NG     X1,FKERR1     --- ERROR IF NEGATIVE
          BX6    X1 
          SA6    FKNUMKY     SAVE NUMBER OF KEYS TO COLLECT 
 
* /---   BLOCK      FASTKOV    00 000   81/09/03  01.33 
 
          SX2    X1+4        COMPUTE NUMBER OF WORDS
          PX2    X2 
          NX2    X2 
          SX3    5
          PX3    X3 
          NX3    X3 
          FX4    X2/X3       NWORDS = (NKEYS+4)/5 
          UX4    X4,B2
          LX4    X4,B2
          BX6    X4 
          SA6    FKNUMWD     SAVE NUMBER OF WORDS NEEDED
 
          SA1    TBXSTOR     CHECK THAT STORAGE EXISTS
          ZR     X1,FKERR2   --- ERROR IF NO STORAGE
          CALL   SETSTOR     X1 IS INPUT; X6 AND *STORWRD*
*                            ARE OUTPUT = 24/ECSAD,18/LEN 
          SA1    FKECSAD     X1=RELATIVE ECS ADDRESS
          SA2    FKNUMWD     X2=NUMBER OF WORDS 
          IX3    X1+X2       LAST WORD
          AX6    18          GET LENGTH 
          SX4    X6          18 BIT FIELD 
          IX3    X4-X3       (LENGTH)-(LAST WORD) 
          NG     X3,FKERR3   --- ERROR IF BAD ECS ADDRESS 
 
*         BUILD PIO COMMAND BUFFER
 
          AX6    18          GET STORAGE ECS ADDR 
          SA1    FKECSAD     GET RELATIVE START 
          IX6    X6+X1
          LX6    36          MOVE ADDR TO TOP TWO BYTES 
          SA6    CPIOFKB     FIRST WORD OF PIO COMMAND BUFF 
          SA1    CPIOFKB+1   START WITH STATION IN LAST BYTE
          BX6    X1 
          LX6    -12         ALSO IN TOP BYTE 
          BX6    X6+X1
          SA1    FKNUMKY     NUMBER OF KEYS 
          LX1    12 
          BX6    X6+X1
          SA6    CPIOFKB+1   SECOND WORD OF PIO COMMAND BUFF
 
*         WRITE COMMAND BUFFER BACK TO ECS
 
          SA1    APIOFKB
          BX0    X1 
          SA0    CPIOFKB
+         WE     2
-         RJ     ECSPRTY
 
* /---   BLOCK      FASTKOV    00 000   81/09/06  23.19 
 
*         UNLOAD COMMON/STORAGE AND SAVE LESSON POINTERS
 
          CALL SAVLES        SAVE COMMMON, STORAGE, ETC.
 
*         CHECK FOR STEP MODE 
 
 FKSTEP   SA1    TBITS
          LX1    STEPBIT
          PL     X1,FKIOLN
          CALL   STEPXX      PLOT '7WAITING FOR KEY'7 
 
*         MARK STORAGE AS NON-RELOCATABLE AND NON-DELETABLE 
 
 FKIOLN   CALL   IOLESSN,TBXSTOR,4000B
 
*         TURN ON COLLECTION BIT IN KEYBUFFER 
 
          SA1    NKEYECS     X1 = STARTING ECS ADDR KEYBUFF 
          SA2    STATION     X2 = STATION 
          LX2    NKEYSHF
          IX0    X1+X2       SET FOR ECS READ 
          SA0    FKKEYBF
+         RE     NKEYLTH
-         RJ     ECSPRTY
          SA1    A0+1        X1 = SECOND WORK OF KEYBUFFER
          MX2    -1          X2 = ONE BIT MASK
          LX2    23          MOVE TO TOP BIT OF STOP1 BYTE
          BX6    -X2+X1      TURN ON THE BIT
          SA6    A1 
          SX1    1           WRITE ONLY 1 WORD BACK 
          IX0    X0+X1
          SA0    A0+1 
+         WE     NKEYLTH-1   WRITE IT BACK TO ECS 
-         RJ     ECSPRTY
 
*         CHECK FOR VARIOUS UNPROCESSED TIMING KEYS 
 
          SA2    TIMING      X2 = TIMING FLAGS
          LX2    59-TMRDONE 
          NG     X2,FKTR     BRANCH TO PROCESS -TIMER-
 
          LX2    TMRDONE-TMEDONE  CHECK FOR UNPROS. TIME
          PL     X2,FKTTL    BRANCH IF NO 
          MX6    1           CLEAR UNPROCESSED BIT
          BX6    -X6*X2 
          LX6    TMEDONE-59 
          SA6    A2 
          EQ     FKLONG      GO TO END PROCESSING 
 
* /---   BLOCK      FASTKOV    00 000   81/09/06  22.55 
 
*         WAIT FOR REQUEST TO BE COMPLETED
 
 FKTTL    TUTIM  -1,,ANYKEY 
 
*         PROCESS THE ENDING KEY
 
          SA1    KEY
          SX2    X1-STOP1    CHECK FOR STOP1
          NG     X2,FKDN     BRANCH IF LESS THAN STOP1
          ZR     X2,FKSTP1   BRANCH IF STOP1
          SX2    X1-LONGUP
          ZR     X2,FKLONG   BRANCH IF -TIMEL-
          SX2    X1-ROUTUP
          NZ     X2,FKDN     BRANCH IF NOT -TIMER-
 
*         PROCESS -TIMER- 
 
 FKTR     SA2    TIMING      SEE IF A -TIMER- UNIT
          MX6    -12
          LX6    12 
          BX1    -X6*X2 
          ZR     X1,FKTTL    IGNORE KEY IF NO -TIMER- UNIT
          MX1    1           TURN OFF -UNPROCESSED- BIT 
          LX1    TMRDONE-59     IN *TMRDONE* POSITION 
          BX2    -X1*X2 
          CALL   INROUTE     X1=-1(IN ROUTER),0(NO ROUTER), 
*                            1(HAS ROUTER BUT NOT IN IT)
          PL     X1,FKTR1    PROCESS IF NOT IN ROUTER NOW 
          BX6    X6*X2       AM IN ROUTER-CLEAR UNIT NUMBER,
          SA6    A2          WRITE BACK TIMING WORD 
          EQ     FKLONG      GO RESET KEY AND EXIT
 
 FKTR1    MX6    1           INDICATE -STOP1- KEY 
          LX6    TMRSTOP-59    IS TO EXIT TO -TIMER- UNIT 
          BX6    X6+X2         BY SETTING NEXT TO TOP BIT 
          SA6    A2            IN TIMING WORD.
          SX6    STOP1       THEN PROCESS AS -STOP1-
          SA6    KEY
 
*         PROCESS STOP1 KEY 
 
 FKSTP1   CALL   STOPCHK     SEE IF SPECIAL SYSTEM LESSON 
          ZR     X2,FKDN     YES, SO TREAT AS NORMAL KEY
 
          CALL   FKOKBB      TURN OFF THE KEYBUFFER BIT 
          PAUSE              PAUSE TO MAKE SURE PIO IS DONE 
          CALL   FKRCB       RELEASE FASTKEY COMMAND BUFFER 
          CALL   RTCLEAR     REMOVE TIMING REQUESTS 
          EQ     FINISH      AND DO FINISH PROCESSING 
 
* /---   BLOCK      FASTKOV    00 000   81/09/06  23.20 
 
 FKLONG   SX6    TIMEUP      RESET KEY TO TIMEUP
          SA6    KEY
 
*         NORMAL EXIT PROCESSING
 
 FKDN     CALL   FKOKBB      TURN OFF FASTKEY BIT IN KEYBUFF
          PAUSE              WAIT TO BE SURE PIO IS DONE
          SA1    APIOFKB     RETURN NUMBER OF KEYS COLLECTED
          BX0    X1          IN ERROR (CHANGE LATER)
          SA0    CPIOFKB
+         RE     2
-         RJ     ECSPRTY
          SA1    CPIOFKB
          LX1    -12
          SX6    X1 
          SA6    TERROR 
          CALL   RTCLEAR     REMOVE LEFTOVER TIMING REQUEST 
          CALL   IOLESSN,TBXSTOR,-4000B   FREE STORAGE
          CALL   RESTLES     RESTORE COMMON, LESSON, ETC
 
 FKNOERR  SX6    -1          SET *ZRETURN* TO NO ERROR
 FKERRX   SA6    TRETURN
          CALL   FKRCB       RELEASE THE COMMAND BUFFER 
 
*         RETURN TO PROCESS NEXT COMMAND
 
          SA1    TRETURN
          NG     X1,=XCKPROC
          EQ     PROCESS     DONE 
 
*         ERROR EXITS 
 
 FKERR0   SX6    0           0 = BAD STORAGE ADDRESS
          EQ     FKERRX 
 FKERR1   SX6    1           1 = BAD NUMBER OF KEYS 
          EQ     FKERRX 
 FKERR2   SX6    2           2 = NO STORAGE 
          EQ     FKERRX 
 FKERR3   SX6    3           3 = TOO MANY KEYS
          EQ     FKERRX 
 
* /---   BLOCK      FASTKOV    00 000   81/09/06  16.49 
 
*         SUBROUTINES 
 
*         SUBROUTINE TO TURN OFF FASTKEY BIT IN KEY BUFFER
 
 FKOKBB   PS                 ENTRY / EXIT 
          SA1    NKEYECS     X1 = STARTING ECS ADDR KEYBUFF 
          SA2    STATION     X2 = STATION 
          LX2    NKEYSHF
          IX0    X1+X2       SET FOR ECS READ 
          SA0    FKKEYBF
+         RE     NKEYLTH
-         RJ     ECSPRTY
          SA1    A0+1        X1 = SECOND WORD OF KEY BUFFER 
          MX2    -1          X2 = 1 BIT MASK
          LX2    23          POSITION TO TOP OF STOP1 BYTE
          BX6    X2*X1       TURN OFF 
          SA6    A1 
          SX1    1
          IX0    X0+X1
          SA0    A0+1 
+         WE     NKEYLTH-1   WRITE IT BACK TO ECS 
-         RJ     ECSPRTY
          EQ     FKOKBB      RETURN 
 
*         SUBROUTINE TO RELEASE FASTKEY COMMAND BUFFER
 
 FKRCB    PS                 ENTRY / EXIT 
          MX6    0           ZERO OUT THE BUFFER
          SA6    CPIOFKB
          SA6    CPIOFKB+1
          SA1    APIOFKB     WRITE IT BACK TO ECS 
          BX0    X1 
          SA0    CPIOFKB
+         WE     2
-         RJ     ECSPRTY
          EQ     FKRCB       RETURN 
 
 
*         STORAGE, ETC. 
 
 NKEYSHF  EQU    1
 NKEYLTH  EQU    2
 
 CPIOFKB  OVDATA 2
 FKECSAD  OVDATA 1
 FKNUMKY  OVDATA 1
 FKNUMWD  OVDATA 1
 FKKEYBF  OVDATA 2
 
          ENDOV 
* 
* /---   BLOCK      HASHOV     00 000   84/09/23  15.11 
          TITLE  -HASH- COMMAND EXECUTION.
**        HASHOV - EXECUTE -HASH- COMMAND.
* 
*         COMMAND WORD FORMAT --
*           20 / GETVAR CODE FOR INPUT. 
*           20 / GETVAR CODE FOR RESULT.
*           11 / POINTER TO EXTRA STORAGE (IF THIRD TAG)
*            9 / -HASH- COMMAND.
* 
*         USES THE *MRKLAST* CONVENTION (TOP BIT OF LAST
*         GETVAR CODE IS SET).  ALSO, THE SECOND BIT OF 
*         THE RESULT GETVAR CODE IS SET IF THE *PASSWORD* 
*         KEYWORD IS SPECIFIED. 
* 
*         ENTRY  (A5/X5) = COMMAND WORD.
* 
*         EXIT   TO *PROCESS*.
* 
*         CALLS  PURDYOV (LEVEL 1 OVERLAY). 
* 
 
 
 HASHOV   OVRLAY
 
          SX6    3           UP TO 3 ARGUMENTS
          CALL   GETARGS
          SX1    X6-3        CHECK 2- OR 3- ARGUMENT FORM 
          PL     X1,OWNHASH  -- GET USER SPECIFIED PRIME
          SX6    X6-2        CHECK FOR 1- OR 2- ARG FORMS 
          PL     X6,TWOHASH  -- IF 2 ARGUMENT FORM
          SA1    VARBUF      ELSE, COPY FIRST ARG TO SECOND 
          BX6    X1 
          SA6    VARBUF+1 
 TWOHASH  BSS    0
          SX6    PWPRIME     PRIME FOR SIGNON PASSWORDS 
          SA5    A5          GET ORIGINAL COMMAND WORD
          LX5    XCODEL+1    SHIFT TO 2ND BIT OF 2ND CODE 
          NG     X5,SETHASH  -- *PASSWORD* SPECIFIED
          SA1    LESSCM+LSTOUSE  CHECK FOR SYSTEM LESSON
          SX6    SYSPRIME    PRIME FOR SYSTEM LESSONS 
          NG     X1,SETHASH  -- IT IS A SYSTEM LESSON 
          SX6    USRPRIME    PRIME FOR USER LESSONS 
 SETHASH  BSS    0
          SA6    OVARG2      *OVARG2* = INPUT FOR PRIME 
 
          SA1    VARBUF      GET WORD TO BE HASHED
          BX5    X1 
          NGETVAR 
          BX6    X1 
          SA6    OVARG1      *OVARG1* = WORD TO BE HASHED 
 
          X      PURDYOV     LEVEL 1 OVERLAY
 
          SA1    VARBUF+1    RESULT VAR CODE
          SA2    OVRET1      RESULT FROM PURDYOV
          BX5    X1 
          BX6    X2 
          NPUTVAR            STORE RESULT IN USER'7S VARS 
 
          EQ     PROCESS     -- EXIT
* 
* 
 OWNHASH  BSS    0
          SA1    VARBUF+2    GET THIRD ARGUMENT (PRIME) 
          BX5    X1 
          NGETVAR 
          BX6    X1 
          AX1    59          SHIFT SIGN BIT THRU ENTIRE WORD
          BX6    X6-X1       ABSOLUTE VALUE 
          SX1    X6-PWPRIME  CHECK FOR RESTRICTED PRIME 
          NZ     X1,SETHASH  -- NOT THE SAME, ALLOW VALUE 
          SA1    BADPRIME    SUBSTITUTE DIFF VALUE
          BX6    X1 
          EQ     SETHASH     -- STORE USER-SPECIFIED PRIME
* 
*         THE PRIME MODULUS IS ACTUALLY (2**60 - OVARG2). 
*         THE FOLLOWING DEFINES ARE THE DEFAULTS FOR SYSTEM 
*         AND NON-SYSTEM LESSONS, ACCORDINGLY.
* 
* /---   BLOCK      HASHOV     00 000   84/09/23  15.11 
 SYSPRIME EQU    2RFK        SYSTEM LESSONS 
 USRPRIME EQU    2RGE        USER LESSONS 
 BADPRIME DATA   377777B     IF USER SPECIFIED *PWPRIME*
* 
* 
 
          ENDOV 
* /---   BLOCK      PURDYOV    00 000   84/09/23  15.35 
          TITLE  PURDY - IRREVERSIBLE ENCIPHERING.
**        PURDYOV - APPLY A ONE-WAY HASHING ALGORITHM.
* 
*         ENTRY  *OVARG1* = WORD TO ENCIPHER. 
*                *OVARG2* = INPUT TO PRIME MODULUS, 
*                           ( 2**60 - OVARG2 ). 
* 
*         EXIT   *OVRET1* = ENCIPHERED RESULT.
*                A5, B5, AND B7 ARE SAVED AND RESTORED. 
*                (X5) = COMMAND WORD. 
* 
*         NOTES  IT IS GUARANTEED THAT BITS 54-59 (THE
*                FIRST CHARACTER) OF THE RESULT ARE NOT 
*                ALL 0. 
* 
*         THE FUNCTION EVALUATED IS --
* 
*         Y = [X**(2**19+5) + ACOEFF(1)*X**(2**18+3)
*             + ACOEFF(2)*X**3 + ACOEFF(3)*X**2 
*             + ACOEFF(4)*X + ACOEFF(5)]
*             MOD (2**60 - OVARG2). 
* 
 
 
* /---   BLOCK      PURDYOV    00 000   84/09/23  15.31 
 PURDYOV  OVRLAY
* 
*         SAVE REGISTERS. 
* 
          SX6    A5 
          SX7    B5 
          SA6    PDY.SAV     SAVE A5
          SA7    PDY.SAV+1   SAVE B5
          MX0    -30         MASK TO SPLIT INPUT
          SX6    B7 
          SA6    PDY.SAV+2   SAVE B7
* 
*         SPLIT INPUT INTO TWO WORDS PRIOR TO *PURDY*.
* 
          SA1    OVARG1      (X1) = INPUT 
          BX7    -X0*X1 
          SA7    PDY.BUF+1   LOWER HALF 
 
          LX1    0-30 
          BX6    -X0*X1 
          SA6    PDY.BUF     UPPER HALF 
* 
*         SET UP PARAMETERS AND CALL *PURDY*. 
* 
          SB1    A6          (B1) = VALUE TO ENCIPHER 
          SB2    PDY.AC      (B2) = COEFFICIENTS
          SB3    PDY.NM1     (B3) = (N-1) 
          SB4    OVARG2      SPECIFIES PRIME MODULUS
          RJ     PURDY       RESULT IN *PDY.BUF*
* 
*         PUT THE RESULT TOGETHER.
* 
          SA1    PDY.BUF
          SA2    A1+1 
          LX1    30 
          BX6    X1+X2
* 
*         ENSURE THAT THE FIRST CHARACTER IS NONZERO. 
* 
          BX1    X6 
          AX1    -6 
          NZ     X1,PDY1     IF NOT 00
          NG     X1,PDY1     IF NOT 00
 
          MX0    1
          BX6    X6+X0       SET TOP BIT
 
 PDY1     BSS    0
* 
*         STORE RESULT, RESTORE REGISTERS, AND EXIT.
* 
          SA6    OVRET1 
          SA1    PDY.SAV     (X1) = A5
          SA2    A1+B1       (X2) = B5
          SA3    A2+B1       (X3) = B7
          SA5    X1 
          SB5    X2 
          SB7    X3 
 
          RETURN             EXIT 
 
* 
*         PARAMETER BUFFERS.
* 
 PDY.BUF  OVDATA 2           INPUT AND RESULT 
 PDY.AC   DATA   7777777777B,7777777641B     ACOEFF(1)
          DATA   7777777777B,7777777603B     ACOEFF(2)
          DATA   7777777777B,7777777573B     ACOEFF(3)
          DATA   7777777777B,7777777636B     ACOEFF(4)
          DATA   7777777777B,7777777402B     ACOEFF(5)
 PDY.NM1  CON    1S18+2      N = 2**18 + 3
 
 PDY.SAV  OVDATA 3           A5, B5, B7 
* /---   BLOCK      PURDY-DOC  00 000   84/09/15  22.11 
 DOCUMENT TITLE  PURDY - IRREVERSIBLE ENCIPHERING.
**        PURDY - EVALUATE PURDY-S IRREVERSIBLE ENCIPHERING 
*                 FUNCTION, F(X) = P(X) MOD PRIME, WHERE
*                 P(X) IS A POLYNOMIAL OF LARGE DEGREE, AND 
*                 PRIME IS A LARGE PRIME NUMBER.
* 
*         MARK B. ZVILIUS            84/08/22 
* 
* 
*         IN GENERAL, P(X) HAS THE FORM,
*                P(X) = SUM(A(I) * X**N(I)), I = 1,2,...,NN.
*         WHERE THE A(I) ARE ARBITRARY COEFFICIENTS, AND
*         THE N(I) ARE ARBITRARY POWERS OF X. 
* 
*         HOWEVER, FOR THE SAKE OF SPEED, THIS ROUTINE ONLY 
*         EVALUATES POLYNOMIALS WITH THE FOLLOWING FORM.
* 
*         P(X) = X**(2*N-1) + ACOEFF(1)*X**N +
*                ACOEFF(2)*X**3 + ACOEFF(3)*X**2 +
*                ACOEFF(4)*X + ACOEFF(5). 
* 
*         MULTI-PRECISION INTEGER ARITHMETIC IS USED
*         THROUGHOUT.  THE FOLLOWING PARAMETERS DEFINE THE
*         MULTI-PRECISION FORMAT. 
* 
*         NP     THE NUMBER OF COMPUTER WORDS THAT MAKE UP
*                A MULTI-PRECISION NUMBER.  *NP* IS AN
*                ASSEMBLY-TIME CONSTANT BECAUSE IT DEFINES
*                THE LENGTH OF WORKING BUFFERS. 
* 
*         M      IN EACH WORD OF A MULTI-PRECISION NUMBER 
*                THE LOWER M BITS ARE SIGNIFICANT.  SINCE 
*                MULTIPLICATION MUST BE PERFORMED ON TWO
*                M-BIT NUMBERS, M MUST BE <= 48.  M IS AN 
*                ASSEMBLY-TIME CONSTANT, BUT COULD BE AN
*                EXECUTION-TIME PARAMETER WITH CHANGES TO 
*                *MPMLT* AND *MPADD*.  THE COST IS ABOUT
*                0.5 MS PER EVALUATION. 
* 
*         Q      TOTAL NUMBER OF BITS IN A MULTI-PRECISION
*                NUMBER.  Q = NP*M.  Q IS NOT REFERENCED IN 
*                THE CODE, BUT IS USED IN THE DOCUMENTATION.
* 
*         MULTI-PRECISION NUMBERS ARE STORED IN CONSECUTIVE 
*         WORDS WITH THE HIGH-ORDER WORD FIRST.  THE UPPER
*         60-M BITS OF EACH WORD MUST BE 0. 
* 
*         THE PRIME MODULUS HAS THE SPECIAL FORM, 
*                PRIME = 2**Q - A 
*         WHERE *A* IS A SINGLE-PRECISION NUMBER.  THAT IS, 
*         A < 2**M. 
* /---   BLOCK      PURDY-DOC  00 000   84/09/23  14.56 
 DOCUMENT EJECT 
*         THE PARAMETERS PASSED TO THIS ROUTINE ARE-- 
*         X      MULTI-PRECISION VALUE TO ENCIPHER. 
*         ACOEFF(I)  MULTI-PRECISION COEFFICIENTS.  I = 1..5
*         (N-1)  WHERE N SPECIFIES THE FIRST TWO EXPONENTS. 
*         A      SINGLE-PRECISION NUMBER SPECIFYING THE 
*                PRIME MODULUS. 
* 
*         THE ENCIPHERED RESULT IS RETURNED IN THE SAME 
*         BUFFER WHERE X WAS PASSED.
* 
* 
*         ENTRY  (B1) = FWA OF NP-WORD X. 
*                (B2) = FWA OF 5 BY NP-WORD ACOEFF(I) IN
*                       ROW-MAJOR ORDER.
*                (B3) = ADDR OF (N-1).
*                (B4) = ADDR OF A.
* 
*         EXIT   F(X) IS RETURNED IN THE BUFFER FOR X.
*                (B1) = 1.
* 
*         ERROR  IF ANY OF THE PARAMETERS IS INVALID, F(X)
*                WILL BE UNPREDICTABLE. 
* 
*         USES   ALL REGISTERS ARE DESTROYED. 
* 
*         CALLS  EXPP, MULTP, ADDP, MPSUB.
* 
*         MACROS ZERO, MPSET, CALLL.
* 
*         DEFINE (B1) = 1.
* 
*         NOTES  THIS ROUTINE WAS ADAPTED FROM ALGORITHM 536
*                IN THE COLLECTED ALGORITHMS OF THE ACM.
*                THAT ALGORITHM WAS WRITTEN BY H. D. KNOBLE,
*                PENN STATE UNIVERSITY COMPUTATION CENTER,
*                JUNE 1977. 
* 
*                THE PAPER DESCRIBING ALGORITHM 536 IS
*                KNOBLE, H. D., FORNEY, C., AND BADER, F. S.
*                AN EFFICIENT ONE-WAY ENCIPHERING ALGORITHM.
*                ACM TRANS. MATH. SOFTWARE 5, 1 
*                (MARCH 1979), 97-107.
* 
*                THE ALGORITHM WAS ORIGINALLY PROPOSED IN 
*                PURDY, G. B. 
*                A HIGH SECURITY LOG-IN PROCEDURE.
*                COMM. ACM 17, 8 (AUGUST 1974), 442-444.
* 
*                MULTI-PRECISION ARITHMETIC ROUTINES FROM 
*                KNUTH, D. E. 
*                THE ART OF COMPUTER PROGRAMMING, VOL. 2, 
*                SEMINUMERICAL ALGORITHMS.
*                ADDISON-WESLEY, READING, MASS., 1969.
* 
* /---   BLOCK      PURDY-MAC  00 000   84/09/15  02.53 
 MACROS   EJECT 
* 
*         EQUATES.
* 
 NP       EQU    2           WORDS IN MP NUMBERS
 M        EQU    30          BITS PER WORD IN M-P NUMBERS 
 Z=       SPACE  4,20 
**        Z= - OPDEFS TO SET B-REGISTER.
* 
*         Z=     BREG,VAL 
* 
*         ENTRY  *BREG* = B-REGISTER TO SET.
*                *VAL* = A REGISTER TO SET *BREG* TO, OR A
*                        VALUE TO LOAD INTO *BREG*. 
*                (B1) = 1.
* 
*         NOTES  THE FOLLOWING OPTIMIZATIONS ARE PERFORMED. 
* 
*                IF *VAL* IS THE SAME REGISTER AS *BREG*, NO
*                CODE IS GENERATED. 
* 
*                IF *VAL* IS A CONSTANT, A 15-BIT SET 
*                INSTRUCTION WILL BE GENERATED, IF
*                POSSIBLE, USING (B1) = 1.
* 
 
 
 Z=B,Q    OPDEF  I,VAL
* 
*         IF NOT DEFINED YET, CANNOT DO OPTIMIZATION CHECKS.
* 
          IF     -DEF,VAL,1 
 ELSE     SKIP
* 
          IFEQ   VAL,0,2     VAL = 0
          SB.I   B0 
 DONE     SKIP
* 
          IFEQ   VAL,1,2     VAL = 1
          SB.I   B1 
 DONE     SKIP
* 
          IFEQ   VAL,2,2     VAL = 2
          SB.I   B1+B1
 DONE     SKIP
* 
          IFEQ   VAL,-1,2    VAL = -1 
          SB.I   -B1
 DONE     SKIP
* 
 ELSE     ENDIF 
* 
*         VAL = ANYTHING ELSE.
* 
          SB.I   VAL
* 
 DONE     ENDIF 
          ENDM
 
 
 Z=B,X    OPDEF  I,J
          SB.I   X.J
          ENDM
 
 
 Z=B,A    OPDEF  I,J
          SB.I   A.J
          ENDM
 
 
 Z=B,B    OPDEF  I,J
          IFC    NE,*I*J*,1 
          SB.I   B.J
          ENDM
* /---   BLOCK      PURDY-MAC  00 000   78/12/19  00.30 
 CALLL    SPACE  4,15 
**        CALLL - CALL LOCAL ROUTINE WITH PARAMETERS. 
* 
*         CALLL  NAME,P1,P2,P3,P4,P5
* 
*         ENTRY  *NAME* = NAME OF ROUTINE.
*                *PI* = OPTIONAL PARAMETERS PASSED IN B-
*                       REGISTERS.  P1 IN B2, P2 IN B3, ETC.
* 
*         EXIT   TO ROUTINE *NAME* WITH PARAMETERS IN 
*                B-REGISTERS. 
* 
*         USES   B - 2, 3, 4, 5, 6. 
* 
*         MACROS Z=.
* 
 
 
 CALLL    MACRO  NAME,P1,P2,P3,P4,P5
          MACREF CALLL
* 
 PARAMS   ECHO   ,PI=(P1,P2,P3,P4,P5),N=(2,3,4,5,6) 
          IFC    NE,*PI**,1 
          Z=     B.N,PI 
 PARAMS   ENDD
* 
          RJ     NAME 
 CALLL    ENDM
 ZEROL    SPACE  4,25 
**        ZEROL - ZERO A CM BUFFER (LOCAL TO *EXEC6*) 
* 
*         ZEROL   BUF,LTH 
* 
*         ENTRY  *BUF* = FWA OF BUFFER. 
*                *LTH* = LENGTH OF BUFFER.
*                (B1) = 1.
* 
*         EXIT   BUFFER ZEROED. 
*                (A7) = *BUF* + *LTH* - 1 
*                (X7) = 0.
* 
*         USES   X - 7. 
*                A - 7. 
*                B - 7. 
* 
*         MACROS LOAD.
* 
*         NOTES  IF *NP* IS GREATER THAN ABOUT 5, IT BECOMES
*                MORE EFFICIENT TO READ ZEROES FROM AN ESM
*                BUFFER.
* 
 
 
 ZEROL    MACRO  BUF,LTH
          MACREF ZEROL
          MX7    0
          LOAD   BUF,LTH
 ZEROL    ENDM
 LOAD     SPACE  4,20 
**        LOAD - LOAD EACH WORD OF A CM BUFFER. 
* 
*         LOAD   BUF,LTH
* 
*         ENTRY  *BUF* = FWA OF BUFFER. 
*                *LTH* = LENGTH OF BUFFER.
*                (X7) = VALUE TO LOAD INTO EACH WORD. 
*                (B1) = 1.
* 
*         EXIT   EACH WORD IN *BUF* LOADED WITH VALUE IN X7.
*                (A7) = *BUF* + *LTH* - 1 
* 
*         USES   A - 7. 
*                B - 7. 
* 
*         MACROS Z=.
* 
 
 
 LOAD     MACRO  BUF,LTH
          MACREF LOAD 
* 
*         ERROR IF *LTH* IS LESS THAN 1 OR MORE THAN 100. 
* 
          IFLE   LTH,0,1
          ERR 
          IFGT   LTH,100,1
          ERR 
* 
*         LOAD FIRST WORD.
* 
          SA7    BUF
* 
*         LOAD REMAINING WORDS. 
* 
 LD1      IFNE   LTH,1
* 
*         IF 2 <= *LTH* <= 6
* 
 LD2      IFLE   LTH,6
          DUP    LTH-1,1
          SA7    A7+B1
* 
*         IF *LTH* > 6. 
* 
 LD2      ELSE
          Z=     B7,LTH-1 
+         SA7    A7+B1
          SB7    B7-B1
          NZ     B7,* 
 LD2      ENDIF 
 LD1      ENDIF 
 LOAD     ENDM
* /---   BLOCK      PURDY-MAC  00 000   84/09/03  20.46 
 MPSET    SPACE  4,20 
**        MPSET - COPY ONE M-P NUMBER INTO ANOTHER. 
* 
*         MPSET  TO,FROM,LTH
* 
*         ENTRY  *TO* = FWA OF DESTINATION BUFFER.
*                *FROM* = FWA OF SOURCE BUFFER. 
*                *LTH* = NUMBER OF WORDS TO COPY. 
*                (B1) = 1.
* 
*         USES   X - 1, 7.
*                A - 1, 7.
*                B - 7. 
* 
*         MACROS Z=.
* 
*         NOTES  SINCE *LTH* IS *NP* FOR MOST CALLS, AND
*                SINCE *NP* IS SMALL, THIS ROUTINE COPIES 
*                WORD BY WORD INSTEAD OF USING A SCRATCH
*                ESM BUFFER.
* 
 
 
 MPSET    MACRO  TO,FROM,LTH
          MACREF MPSET
* 
*         ERROR IF *LTH* IS LESS THAN 1 OR MORE THAN 100. 
* 
          IFLE   LTH,0,1
          ERR 
          IFGT   LTH,100,1
          ERR 
* 
*         COPY FIRST WORD.
* 
          SA1    FROM 
          BX7    X1 
          SA7    TO 
* 
*         COPY REMAINING WORDS. 
* 
 SET1     IFNE   LTH,1
* 
*         IF *LTH* = 2. 
* 
 SET2     IFEQ   LTH,2
          SA1    A1+B1
          BX7    X1 
          SA7    A7+B1
* 
*         IF *LTH* > 2. 
* 
 SET2     ELSE
          Z=     B7,LTH-1 
+         SA1    A1+B1
          BX7    X1 
          SA7    A7+B1
          SB7    B7-B1
          NZ     B7,*-1 
 SET2     ENDIF 
 SET1     ENDIF 
 MPSET    ENDM
* /---   BLOCK      PURDY-MAC  00 000   84/09/07  19.09 
 KOMP     SPACE  4,20 
**        KOMP - COMPARE TWO M-P NUMBERS. 
* 
*         KOMP   X,Y,N
* 
*         ENTRY  *X* = FWA OF N-PRECISION NUMBER. 
*                *Y* = FWA OF N-PRECISION NUMBER. 
*                *N* = PRECISION OF INPUTS. 
*                (B1) = 1.
* 
*         EXIT   (X0) POSITIVE IF X >= Y, NEGATIVE IF X < Y.
* 
*         USES   X - 0, 1, 2. 
*                A - 1, 2.
*                B - 7. 
* 
*         MACROS Z=.
* 
 
 
 KOMP     MACRO  X,Y,N
          LOCAL  QUIT5678 
          MACREF KOMP 
* 
*         ERROR IF *N* IS LESS THAN 1 OR MORE THAN 100. 
* 
          IFLE   N,0,1
          ERR 
          IFGT   N,100,1
          ERR 
* 
*         COMPARE HIGH-ORDER WORDS. 
* 
          SA1    X
          SA2    Y
          IX0    X1-X2
* 
*         COMPARE REMAINING WORDS, HIGH-ORDER FIRST.
* 
 K1       IFNE   N,1
          NZ     X0,QUIT5678
* 
*         IF *N* = 2. 
* 
 K2       IFEQ   N,2
          SA1    A1+B1
          SA2    A2+B1
          IX0    X1-X2
* 
*         IF *N* > 2. 
* 
 K2       ELSE
          Z=     B7,N-1 
+         ZR     B7,QUIT5678
          SA1    A1+B1
          SA2    A2+B1
          IX0    X1-X2
          SB7    B7-B1
          ZR     X0,*-1 
 K2       ENDIF 
 QUIT5678 BSS    0
 K1       ENDIF 
 KOMP     ENDM
* /---   BLOCK      PURDY      00 000   78/12/19  00.27 
 MAIN     SPACE  4,25 
* 
*         MAIN ROUTINE. 
* 
 PURDY    EQ     *+1S17      ENTRY/EXIT 
* 
*         SAVE ADDRESSES. 
* 
          SX6    B1 
          SX7    B2 
          SA6    PUR.AX      SAVE FWA OF X
          SA7    PUR.AC      SAVE FWA OF ACOEFF 
          SX7    B4+
          SA7    AA          SAVE ADDR OF A 
* 
*         (X4) = FWA OF X.
*         (X5) = ADDR OF (N-1). 
*         THESE ARE PRESERVED OVER THE CALL TO *MPSUB*. 
* 
          SX5    B3+         (X5) = ADDR OF (N-1) 
          BX4    X6          (X4) = FWA OF X
 
          SB1    1           CONSTANT 1 
* 
*         COMPUTE PRIME = 2**Q - A. 
* 
*         WORK1 <-- 0.  (SINCE *MPSUB* IGNORES THE BORROW IT
*         IS AS IF WORK1 = 2**Q.) 
* 
          ZEROL  PUR.W1,NP
* 
*         WORK2 <-- A.  (X7 IS ALREADY 0.)
* 
          LOAD   PUR.W2,NP-1
          SA1    B4          (X1) = A 
          BX7    X1 
          SA7    A7+1        WORK2(NP) &lt;-- A
* 
*         PRIME <-- WORK1-WORK2.
* 
          CALLL  MPSUB,PUR.W1,PUR.W2,PRIME,NP-1 
* /---   BLOCK      PURDY      00 000   84/09/15  22.19 
* 
*         X**(2*N-1) + K*X**N 
*         FACTORS INTO
*         ((X**(N-1) + K)*X**(N-1))*X 
*         WHERE K = ACOEFF(1).
* 
*         WORK1 <-- X**(N-1) MOD PRIME. 
* 
          CALLL  EXPP,X4,X5,PUR.W1
* 
*         (X4) = FWA OF ACOEFF(J).
*         PRESERVED OVER CALLS TO *ADDP* AND *MULTP*. 
* 
          SA4    PUR.AC      (X4) = FWA OF ACOEFF(1)
* 
*         WORK2 <-- (X**(N-1) + K) MOD PRIME. 
* 
          CALLL  ADDP,PUR.W1,X4,PUR.W2
* 
*         WORK2 <-- (X**(N-1) + K)*X**(N-1) MOD PRIME.
* 
          CALLL  MULTP,PUR.W2,PUR.W1,PUR.W2 
* 
*         WORK1 <-- (X**(N-1) + K)*X**(N-1)*X MOD PRIME.
* 
          SA1    PUR.AX      (X1) = FWA OF X
          CALLL  MULTP,PUR.W2,X1,PUR.W1 
* 
*         B*X**3 + C*X**2 + D*X + E 
*         FACTORS INTO
*         ((B*X + C)*X + D)*X + E 
*         WHERE B = ACOEFF(2), C = ACOEFF(3), ETC.
* 
*         WORK2 <-- ACOEFF(2),  I <-- 3,  J <-- 3 
*         REPEAT
*           WORK2 <-- WORK2 * X 
*           WORK2 <-- WORK2 + ACOEFF(J) 
*           I <-- I-1,  J <-- J+1 
*         UNTIL  I=0
* 
          SX4    X4+NP       (X4) = FWA OF ACOEFF(2)
          MPSET  PUR.W2,X4,NP        WORK2 &lt;-- AC(2)
* 
*         (X5) = LOOP COUNT.
*         PRESERVED OVER CALLS TO *ADDP* AND *MULTP*. 
* 
          SX5    3           I &lt;-- 3
 
 PURDY1   BSS    0           REPEAT 
 
          SA1    PUR.AX      (X1) = FWA OF X
          CALLL  MULTP,PUR.W2,X1,B2  WORK2 &lt;-- WORK2*X
 
          SX4    X4+NP       (X4) = FWA OF ACOEFF(J)
          CALLL  ADDP,PUR.W2,X4,B2   WORK2 &lt;-- WORK2+AC(J)
 
          SX5    X5-1        I &lt;-- I-1
          NZ     X5,PURDY1   UNTIL  I=0 
* 
*         WORK1 HAS THE TWO HIGH-ORDER TERMS.  WORK2 HAS THE
*         LOW-ORDER TERMS.  ADD TOGETHER AND STORE OVER X.
* 
          SA1    PUR.AX      (X1) = FWA OF X
          CALLL  ADDP,PUR.W1,PUR.W2,X1
 
* 
*         DONE. 
* 
          EQ     PURDY       EXIT 
 
* 
*         DATA DEFINITIONS. 
* 
 PUR.AX   OVDATA             ADDR OF X
 PUR.AC   OVDATA             ADDR OF ACOEFF 
 AA       OVDATA             ADDR OF A.  USED GLOBALLY. 
 
 PUR.W1   OVDATA NP          M-P SCRATCH BUFFER 
 PUR.W2   OVDATA NP          M-P SCRATCH BUFFER 
* 
*         USED IN CONJUNCTION WITH *PRIME*, *XPRIME* IS 
*         AN (N+1)-WORD BUFFER WHOSE VALUE IS THE MODULUS.
*         ROUTINE MOD2Q REQUIRES THIS.
* 
 XPRIME   DATA   0
 PRIME    BSS    NP          PRIME MODULUS.  USED GLOBALLY. 
* /---   BLOCK      EXPP       00 000   78/12/19  00.28 
 EXPP     SPACE  4,25 
**        EXPP - COMPUTE Y = X**K MOD PRIME.  X AND Y ARE 
*                M-P NUMBERS.  K IS A ONE-WORD EXPONENT.
*                SEE KNUTH, ALGORITHM 4.6.3 A.
* 
*         ENTRY  (B2) = FWA OF NP-WORD X. 
*                (B3) = ADDR OF K.
*                (B4) = FWA OF NP-WORD Y. 
*                *PRIME* = NP-WORD MODULUS. 
*                *AA* = ADDR OF A.  A = 2**Q MOD PRIME. 
*                (B1) = 1.
* 
*         USES   X - 0, 1, 4, 5, 7. 
*                A - 1, 4, 7. 
*                B - 2, 3, 4, 7.
* 
*         CALLS  MULTP. 
* 
*         MACROS MPSET, ZEROL, CALLL. 
* 
*         DEFINE (X4) = K; THE EXPONENT.
*                (X5) = FWA OF Y. 
*                BOTH ARE PRESERVED OVER *MULTP*. 
* 
 
 EXPP     EQ     *+1S17      ENTRY/EXIT 
* 
*         FORM SQUARES OF X IN SCRATCH BUFFER Z.  Z <-- X.
* 
          MPSET  EXP.Z,B2,NP
* 
*         INITIALIZE RESULT.  Y <-- 1.
* 
          ZEROL  B4,NP-1
          SX7    B1 
          SA7    A7+1        Y(NP) &lt;-- 1
* 
*         MAIN LOOP.
* 
          SA4    B3          (X4) = K 
          SX5    B4          (X5) = FWA OF Y
          ZR     X4,EXPP     IF ZERO EXPONENT 
 
 EXP1     MX0    -1 
          BX1    -X0*X4      (X1) = BIT OF EXPONENT 
          BX4    X0*X4       CLEAR IT 
          LX4    -1          POSITION NEXT BIT
* 
*         IF  BIT = 1 
*           Y <-- Y*Z MOD PRIME 
*           EXIT IF K=0 
*         ENDIF 
* 
          ZR     X1,EXP2     IF BIT = 0 
 
          SB3    EXP.Z
          CALLL  MULTP,X5,B3,X5 
 
          ZR     X4,EXPP     IF NO MORE BITS IN EXPONENT
* 
*         CONTINUE SQUARING Z.
* 
 EXP2     CALLL  MULTP,EXP.Z,EXP.Z,EXP.Z
 
          EQ     EXP1        CONTINUE LOOPING 
 
* 
*         DATA DEFINITIONS
* 
 EXP.Z    OVDATA NP          M-P BUFFER TO FORM SQUARES OF X
* /---   BLOCK      MULTP/ADDP 00 000   84/09/15  22.22 
 MULTP    SPACE  4,20 
**        MULTP - COMPUTE RS = R*S MOD PRIME.  RS, R, AND S 
*                 ARE M-P NUMBERS.
* 
*         ENTRY  (B2) = FWA OF NP-WORD R. 
*                (B3) = FWA OF NP-WORD S. 
*                (B4) = FWA OF NP-WORD RS.
*                *PRIME* = NP-WORD MODULUS. 
*                *AA* = ADDR OF A.  A = 2**Q MOD PRIME. 
*                (B1) = 1.
* 
*         USES   A - 0. 
*                B - 2, 3, 4. 
* 
*         CALLS  MPMLT, MOD2Q.
* 
*         MACROS CALLL. 
* 
 
 MULTP    EQ     *+1S17      ENTRY/EXIT 
 
          SA0    B4+         SAVE FWA OF RS OVER CALL 
* 
*         WORK <-- R*S.  WORK IS 2*NP-PRECISION.
* 
          CALLL  MPMLT,B2,B3,MUL.WK 
* 
*         RS <-- WORK MOD PRIME.
* 
          CALLL  MOD2Q,MUL.WK,A0
 
          EQ     MULTP       EXIT 
 
* 
*         DATA DEFINITIONS. 
* 
 MUL.WK   OVDATA NP+NP       MULTIPLICATION RESULT
 ADDP     SPACE  4,20 
**        ADDP - COMPUTE RPS = R+S MOD PRIME.  RPS, R, AND S
*                ARE M-P NUMBERS. 
* 
*         ENTRY  (B2) = FWA OF NP-WORD R. 
*                (B3) = FWA OF NP-WORD S. 
*                (B4) = FWA OF NP-WORD RPS. 
*                *PRIME* = NP-WORD MODULUS. 
*                *AA* = ADDR OF A.  A = 2**Q MOD PRIME. 
*                (B1) = 1.
* 
*         USES   A - 0. 
*                B - 2, 3, 4. 
* 
*         CALLS  MPADD, MODQ1.
* 
*         MACROS CALLL. 
* 
 
 ADDP     EQ     *+1S17      ENTRY/EXIT 
 
          SA0    B4+         SAVE FWA OF RPS OVER CALL
* 
*         WORK <-- R+S.  WORK IS NP+1-PRECISION.
* 
          CALLL  MPADD,B2,B3,ADD.WK 
* 
*         RPS <-- WORK MOD PRIME. 
* 
          CALLL  MODQ1,ADD.WK,A0
 
          EQ     ADDP        EXIT 
 
* 
*         DATA DEFINITIONS. 
* 
 ADD.WK   OVDATA NP+1        ADDITION RESULT
* /---   BLOCK      MOD2Q      00 000   84/09/15  22.23 
 MOD2Q    SPACE  4,20 
**        MOD2Q - COMPUTE R = W MOD PRIME, FOR 2Q-BIT W.
* 
*         ENTRY  (B2) = FWA OF 2*NP-WORD W. 
*                (B3) = FWA OF NP-WORD R. 
*                *PRIME* = NP-WORD MODULUS. 
*                *AA* = ADDR OF A.  A = 2**Q MOD PRIME. 
*                (B1) = 1.
* 
*         USES   X - 0, 1, 2, 6.
*                A - 0, 1, 2, 6.
*                B - 2, 3, 4, 5, 6, 7.
* 
*         CALLS  MPML, MPSUB, ADDP. 
* 
*         MACROS CALLL, KOMP. 
* 
*         DEFINE (A0) = FWA OF W0.
*                (B6) = FWA OF R. 
*                BOTH ARE PRESERVED OVER *MPML* AND *MPSUB*.
* 
 
 MOD2Q    EQ     *+1S17      ENTRY/EXIT 
* 
*         SAVE ADDRESSES. 
* 
          SA0    B2+NP       (A0) = FWA OF W0 
          SB6    B3+         (B6) = FWA OF R
* 
*         LET W = W0 + W1*2**Q.  FORM U = A*W1. 
* 
          SA1    AA          (X1) = ADDR OF A 
          CALLL  MPML,B2,X1,M2Q.U 
* 
*         USE KNUTH-S THEOREM 4.3.1 B AND LEADING DIGIT 
*         THEOREM TO SOLVE FOR J SUCH THAT, 
*         J*PRIME <= U < (J+1)*PRIME. 
* 
*         U(1) UNDERESTIMATES J BY AT MOST 1. 
* 
          SA1    M2Q.U       (X1) = U(1)
          MX6    -1 
          IX6    X1-X6
          SA6    M2Q.J       J &lt;-- U(1)+1 
* 
*         JP <-- J*PRIME. 
* 
          CALLL  MPML,PRIME,M2Q.J,M2Q.JP
* 
*         COMPARE U AND J*PRIME.  RESULT IN X0. 
* 
          KOMP   M2Q.U,M2Q.JP,NP+1
          PL     X0,M2Q1     IF U >= J*PRIME
* 
*         IF U < J*PRIME, THEN J <-- J-1 AND JP <-- J*PRIME.
*         IN OTHER WORDS, JP <-- JP - PRIME.
* 
          CALLL  MPSUB,M2Q.JP,XPRIME,M2Q.JP,NP
 
 M2Q1     BSS    0
* 
*         R <-- U - J*PRIME.  THAT IS, R = A*W1 MOD PRIME.
* 
          CALLL  MPSUB,M2Q.U+1,M2Q.JP+1,B6,NP-1 
* 
*         HAVE R = A*W1 MOD PRIME.
*         WANT R = (W0 + (A*W1 MOD PRIME)) MOD PRIME. 
*         NOTE THAT (B6) = (B4) = FWA OF R. 
* 
          CALLL  ADDP,A0,B6,B4
 
          EQ     MOD2Q       EXIT 
 
* 
*         DATA DEFINITIONS. 
* 
 M2Q.U    OVDATA NP+1        U = A*W1 
 M2Q.J    OVDATA             J
 M2Q.JP   OVDATA NP+1        JP = J*PRIME 
* /---   BLOCK      MODQ1      00 000   78/12/19  00.28 
 MODQ1    SPACE  4,20 
**        MODQ1 - COMPUTE Y = S MOD PRIME, FOR (Q+1)-BIT S. 
* 
*         ENTRY  (B2) = FWA OF (NP+1)-WORD S. 
*                (B3) = FWA OF NP-WORD Y. 
*                *PRIME* = NP-WORD MODULUS. 
*                *AA* = ADDR OF A.  A = 2**Q MOD PRIME. 
*                (B1) = 1.
* 
*         USES   X - 1, 3, 7. 
*                A - 1, 7.
*                B - 2, 3, 4, 6, 7. 
* 
*         CALLS  MODQ, MPADD. 
* 
*         MACROS CALLL. 
* 
*         DEFINE (X3) = S1; HIGH-ORDER WORD OF S. 
*                (B6) = FWA OF Y. 
*                BOTH ARE PRESERVED OVER *MODQ* AND *MPADD*.
* 
 
 MODQ1    EQ     *+1S17      ENTRY/EXIT 
 
          SA1    B2 
          BX3    X1          (X3) = HIGH-ORDER WORD OF S
          SB6    B3          (B6) = FWA OF Y
* 
*         LET S = S0 + S1*2**Q.  THEN S1 IS EITHER 0 OR 1.
* 
*         Y <-- S0 MOD PRIME. 
* 
          SB2    B2+B1       (B2) = FWA OF S0 
          CALLL  MODQ,B2,B3 
* 
*         IF S1=0, THEN DONE. 
* 
          ZR     X3,MODQ1    EXIT 
 
          SB3    MQ1.WK      (B3) = FWA OF WORK 
* 
*         HAVE Y = S0 MOD PRIME.
*         WANT Y = ((S0 MOD PRIME) + A) MOD PRIME.
* 
          ZEROL  B3,NP-1
          SA1    AA          (X1) = ADDR OF A 
          SA1    X1          (X1) = A 
          BX7    X1 
          SA7    A7+B1       WORK(NP) &lt;-- A 
 
          CALLL  MPADD,B6,B3,B3      WORK &lt;-- Y + WORK
* 
*         WORK(1), THE HIGH-ORDER WORD, IS GUARANTEED ZERO. 
* 
          SB2    B3+B1       (B2) = ADDR OF WORK(2) 
          CALLL  MODQ,B2,B6 
 
          EQ     MODQ1       EXIT 
 
* 
*         DATA DEFINITIONS. 
* 
 MQ1.WK   OVDATA NP+1        (NP+1)-PRECISION SCRATCH BUFFER
* /---   BLOCK      MODQ       00 000   84/09/08  23.11 
 MODQ     SPACE  4,15 
**        MODQ - COMPUTE Y = X MOD PRIME FOR Q-BIT X. 
* 
*         ENTRY  (B2) = FWA OF NP-WORD X. 
*                (B3) = FWA OF NP-WORD Y. 
*                *PRIME* = NP-WORD MODULUS. 
*                (B1) = 1.
* 
*         USES   X - 0, 1, 2, 7.
*                A - 1, 2, 7. 
*                B - 3, 4, 5, 7.
* 
*         CALLS  MPSUB. 
* 
*         MACROS KOMP, MPSET, CALLL.
* 
 
 MOD1     BSS    0
* 
*         X >= PRIME, THEREFORE Y = X - PRIME.
* 
          SB4    B3          (B4) = FWA OF Y
          CALLL  MPSUB,B2,PRIME,B4,NP-1 
 
 MODQ     EQ     *+1S17      ENTRY/EXIT 
 
          KOMP   B2,PRIME,NP
          PL     X0,MOD1     IF X >= PRIME
* 
*         X < PRIME, THEREFORE Y = X. 
* 
          MPSET  B3,B2,NP 
          EQ     MODQ        EXIT 
* /---   BLOCK      MPMLT      00 000   78/12/19  00.28 
 MPMLT    SPACE  4,30 
**        MPMLT - UNSIGNED, MULTI-PRECISION INTEGER 
*                 MULTIPLICATION.  W = U*V.  U AND V ARE
*                 NP-PRECISION; W IS 2*NP-PRECISION.
* 
*         ENTRY  (B2) = FWA OF NP-WORD U. 
*                (B3) = FWA OF NP-WORD V. 
*                (B4) = FWA OF 2*NP-WORD W. 
*                (B1) = 1.
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
* 
*         MACROS ZERO1. 
* 
*         DEFINE (B2) = FWA OF U. 
*                (B3) = FWA OF V. 
*                (B4) = FWA OF W. 
*                (B5) = I; INDEX INTO U.
*                (B6) = J; INDEX INTO V.
*                (X3) = MASK TO SPLIT UP RESULT.
*                (X6) = K; CARRY. 
*                (X7) = VALUE TO STORE BACK TO W(I+J).
* 
*         NOTES  IF *NP* IS 4 OR MORE, IT BECOMES WORTHWHILE
*                TO PACK EACH WORD OF U AND V INTO FLOATING 
*                POINT FORMAT BEFORE STARTING THE MAIN LOOP.
*                OF COURSE THIS REQUIRES 2, NP-WORD SCRATCH 
*                BUFFERS. 
* 
 
 MPMLT    EQ     *+1S17      ENTRY/EXIT 
* 
*         BEGIN KNUTH-S ALGORITHM 4.3.1 M.
* 
*     (1) INITIALIZE. 
* 
          ZEROL  B4+NP,NP    ZERO LOW HALF OF RESULT
 
          MX3    60-M        SET UP MASK FOR LATER
* 
*         DECREMENT THE BUFFER ADDRESSES SO THE INDICES 
*         CAN RUN FROM NP --> 1.
* 
          SB2    B2-B1       U
          SB3    B3-1        V
          SB4    B4-1        W
 
          SB6    NP          J &lt;-- NP 
* 
*     (2) PROBABILITY OF V(J)=0 IS SMALL; SKIP STEP 2.
* 
*     (3) INITIALIZE I. 
* 
 MLT1     BSS    0           REPEAT 
 
          SB5    NP          I &lt;-- NP 
          SX6    0           K &lt;-- 0
* /---   BLOCK      MPMLT      00 000   84/09/03  19.33 
* 
*     (4) MULTIPLY AND ADD. 
*         COMPUTE T <-- U(I)*V(J) + W(I+J) + K. 
*         T IS GUARANTEED TO BE LESS THAN 2**(2*M). 
* 
 MLT2     BSS    0           REPEAT 
 
          SA1    B2+B5       (X1) = U(I)
          SA2    B3+B6       (X2) = V(J)
          PX1    X1 
          PX2    X2 
          FX0    X1*X2       (X0) = HIGH 48 BITS OF UI*VJ 
          DX7    X1*X2       (X7) = LOW 48 BITS OF UI*VJ
* 
*         IN ONE UNLIKELY CASE, AN AUTOMATIC NORMALIZE IS 
*         DONE.  OTHERWISE, NO SHIFTS ARE NECESSARY.
* 
          UX0    X0 
          UX7,B7 X7          (B7) = -1 IF SHIFT NEEDED
          ZR     B7,MLT0     IF NO SHIFT NEEDED 
 
          LX0    -1          UN-DO NORMALIZING SHIFT
          LX7    -1          UN-DO NORMALIZING SHIFT
* 
*         SHIFT LOW BIT OUT OF (X0) INTO HIGH BIT OF (X7).
* 
          MX2    1
          BX2    X2*X0       PICK OFF BIT 59 (WAS BIT 0)
          BX0    -X2*X0      CLEAR IT IN HIGH-ORDER WORD
          LX2    47-59       POSITION TO BIT 47 
          BX7    X7+X2       MERGE INTO THE LOW-ORDER WORD
 
 MLT0     BSS    0
* 
*         ADD IN W(I+J) AND K.  NO OVERFLOW IS POSSIBLE.
* 
          SB7    B5+B6       (B7) = I+J 
          SA1    B4+B7       (X1) = W(I+J)
          IX1    X1+X6       (X1) = W(I+J) + K
          IX6    X7+X1       (X6) = W(I+J)+K+(LOW ORDER WD) 
 
          BX7    -X3*X6      (X7) = LOWER M BITS OF T 
          SA7    A1          W(I+J) &lt;-- LOWER HALF OF T 
 
          AX6    M-0         CHOP OFF LOWER M BITS
* 
*         NOW X6 HAS THE LOWER (48-M) SIGNIFICANT BITS OF 
*         THE UPPER HALF OF T.  IT ALSO HAS CARRY BITS TO 
*         ADD INTO THE OTHER (2*M-48) BITS WHICH ARE IN X0. 
* 
          LX0    48-M        POSITION UPPER (2*M-48) BITS 
          IX6    X0+X6       (X6) = K = UPPER HALF OF T 
* 
*     (5) LOOP ON I.
* 
          SB5    B5-B1       I &lt;-- I-1
          NZ     B5,MLT2     UNTIL  I=0 
 
          SA6    B4+B6       W(J) &lt;-- K 
* 
*     (6) LOOP ON J.
* 
          SB6    B6-B1       J &lt;-- J-1
          NZ     B6,MLT1     UNTIL  J=0 
 
          EQ     MPMLT       EXIT 
* /---   BLOCK      MPML       00 000   84/09/08  23.11 
 MPML     SPACE  4,30 
**        MPML - UNSIGNED, MULTI-PRECISION INTEGER
*                MULTIPLICATION FOR THE SPECIAL CASE WHERE
*                ONE OPERAND IS SINGLE-PRECISION. 
*                W <-- S*U, WHERE U IS NP-PRECISION; S IS 
*                SINGLE PRECISION; W IS (NP+1)-PRECISION. 
* 
*         ENTRY  (B2) = FWA OF NP-WORD U. 
*                (B3) = ADDR OF S.
*                (B4) = FWA OF (NP+1)-WORD W. 
*                (B1) = 1.
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2, 5, 7. 
* 
*         DEFINE (B2) = FWA OF U. 
*                (X1) = S.
*                (B4) = FWA OF W. 
*                (B5) = I; INDEX INTO U.
*                (X3) = MASK TO SPLIT UP RESULT.
*                (X6) = K; CARRY. 
*                (X7) = VALUE TO STORE BACK TO W(I+1).
* 
*         NOTES  THIS IS DERIVED FROM KNUTH-S ALGORITHM 
*                4.3.1 M FOR THE SPECIAL CASE OF A SINGLE-
*                PRECISION MULTIPLIER.  SEE KNUTH-S PROBLEM 
*                4.3.1-13.
* 
 
* /---   BLOCK      MPML       00 000   84/09/08  23.08 
 MPML     EQ     *+1S17      ENTRY/EXIT 
* 
*         DECREMENT FWA OF U SO THAT I RUNS FROM NP --> 1.
*         BUT LEAVE FWA OF W ALONE, THUS TAKING CARE OF THE 
*         OFFSET OF 1 IN W(I+1).
* 
          SB2    B2-B1
 
          MX3    60-M        SET UP MASK FOR LATER
 
          SA1    B3          (X1) = S 
          PX1    X1          FLOATING POINT FORMAT
* 
*     (3) INITIALIZE I. 
* 
          SB5    NP          I &lt;-- NP 
          SX6    0           K &lt;-- 0
* 
*     (4) MULTIPLY AND ADD.  COMPUTE T <-- U(I)*S + K.
* 
 ML1      BSS    0           REPEAT 
 
          SA2    B2+B5       (X2) = U(I)
          PX2    X2          FLOATING POINT FORMAT
          FX0    X1*X2       (X0) = HIGH 48 BITS OF UI*VJ 
          DX7    X1*X2       (X7) = LOW 48 BITS OF UI*VJ
* 
*         IN ONE UNLIKELY CASE, AN AUTOMATIC NORMALIZE IS 
*         DONE.  OTHERWISE, NO SHIFTS ARE NECESSARY.
* 
          UX0    X0 
          UX7,B7 X7          (B7) = -1 IF SHIFT NEEDED
          ZR     B7,ML0      IF NO SHIFT NEEDED 
 
          LX0    -1          UN-DO NORMALIZING SHIFT
          LX7    -1          UN-DO NORMALIZING SHIFT
* 
*         SHIFT LOW BIT OUT OF (X0) INTO HIGH BIT OF (X7).
* 
          MX2    1
          BX2    X2*X0       PICK OFF BIT 59 (WAS BIT 0)
          BX0    -X2*X0      CLEAR IT IN HIGH-ORDER WORD
          LX2    47-59       POSITION TO BIT 47 
          BX7    X7+X2       MERGE INTO THE LOW-ORDER WORD
 
 ML0      BSS    0
* 
*         ADD IN K.  NO OVERFLOW IS POSSIBLE. 
* 
          IX6    X6+X7       (X6) = K + (LOW ORDER WORD)
 
          BX7    -X3*X6      (X7) = LOWER M BITS OF T 
          SA7    B4+B5       W(I+1) &lt;-- LOWER HALF OF T 
 
          AX6    M-0         CHOP OFF LOWER M BITS
* 
*         NOW X6 HAS THE LOWER (48-M) SIGNIFICANT BITS OF 
*         THE UPPER HALF OF T.  IT ALSO HAS CARRY BITS TO 
*         ADD INTO THE OTHER (2*M-48) BITS WHICH ARE IN X0. 
* 
          LX0    48-M        POSITION UPPER (2*M-48) BITS 
          IX6    X0+X6       (X6) = K = UPPER HALF OF T 
* 
*     (5) LOOP ON I.
* 
          SB5    B5-1        I &lt;-- I-1
          NZ     B5,ML1      UNTIL  I=0 
 
          SA6    B4+         W(1) &lt;-- K 
 
          EQ     MPML        EXIT 
* /---   BLOCK      MPADD      00 000   84/09/09  00.54 
 MPADD    SPACE  4,25 
**        MPADD - UNSIGNED, NP-PRECISION INTEGER ADDITION.
*                 W = U+V.  U AND V ARE NP-PRECISION; W IS
*                 (NP+1)-PRECISION. 
* 
*         ENTRY  (B2) = FWA OF NP-WORD U. 
*                (B3) = FWA OF NP-WORD V. 
*                (B4) = FWA OF (NP+1)-WORD W. 
*                (B1) = 1.
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - 4, 5.
* 
*         DEFINE (B2) = FWA OF U. 
*                (B3) = FWA OF V. 
*                (B4) = 1 + (FWA OF W). 
*                (B5) = J; INDEX INTO BUFFERS.
*                (X0) = MASK FOR CARRY. 
*                (X6) = K; CARRY. 
*                (X7) = W(J+1); BYTE ADDITION RESULT. 
* 
 
 MPADD    EQ     *+1S17      ENTRY/EXIT 
* 
*         INCREMENT FWA OF W TO ACCOUNT FOR THE OFFSET OF 1 
*         IN W(J+1).  J RUNS FROM (NP-1) --> 0, ALTHOUGH THE
*         DOCUMENTATION IS AS IF IT RUNS FROM NP --> 1. 
* 
          SB4    B4+1 
* 
*         BEGIN KNUTH-S ALGORITHM 4.3.1 A.
* 
*     (1) INITIALIZE. 
* 
          SB5    NP-1        J &lt;-- NP 
          MX6    0           K &lt;-- 0
          MX0    60-M        MASK FOR CARRY 
* 
*     (2) ADD DIGITS.  W(J+1) <-- (U(J)+V(J)+K) MOD 2**M. 
* 
 MPA1     BSS    0           REPEAT 
 
          SA1    B2+B5       (X1) = U(J)
          SA2    B3+B5       (X2) = V(J)
          IX1    X1+X2       (X1) = U(J)+V(J) 
          IX6    X1+X6       (X6) = U(J)+V(J)+K 
 
          BX7    -X0*X6      MASK OFF CARRY 
          SA7    B4+B5       W(J+1) &lt;-- U(J)+V(J)+K MOD 2**M
          AX6    M-0         (X6) = CARRY = K 
* 
*     (3) LOOP ON J.
* 
          SB5    B5-B1       J &lt;-- J-1
          PL     B5,MPA1     UNTIL  J=0 
 
          SA6    B4-1        W(1) &lt;-- K 
 
          EQ     MPADD       EXIT 
* /---   BLOCK      MPSUB      00 000   84/09/09  00.54 
 MPSUB    SPACE  4,25 
**        MPSUB - UNSIGNED, N-PRECISION INTEGER SUBTRACTION,
*                 W = U-V, IGNORING POSSIBLE BORROW IF U<V. 
*                 U, V, AND W ARE ALL N-PRECISION INTEGERS. 
* 
*         ENTRY  (B2) = FWA OF N-WORD U.
*                (B3) = FWA OF N-WORD V.
*                (B4) = FWA OF N-WORD W.
*                (B5) = (N-1), WHERE N = OPERAND PRECISION. 
*                (B1) = 1.
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 2, 7. 
*                B - 5. 
* 
*         DEFINE (B2) = FWA OF U. 
*                (B3) = FWA OF V. 
*                (B4) = FWA OF W. 
*                (B5) = J; INDEX INTO BUFFERS.
*                (X0) = MASK FOR BORROW.
*                (X6) = K; BORROW.
*                (X7) = W(J); BYTE SUBTRACTION RESULT.
* 
 
 MPSUB    EQ     *+1S17      ENTRY/EXIT 
* 
*         J RUNS FROM (N-1)..0, ALTHOUGH THE DOCUMENTATION
*         IS AS IF IT RUNS FROM N..1. 
* 
*         BEGIN KNUTH-S ALGORITHM 4.3.1 A.
* 
*     (1) INITIALIZE. 
* 
          SX6    1           K &lt;-- 1
          MX0    60-M        MASK FOR BORROW
          BX0    -X0         MASK OFF BORROW
* 
*     (2) SUBTRACT DIGITS.  W(J) <-- (U(J)-V(J)+K) MOD 2**M.
* 
 MPS1     BSS    0           REPEAT 
 
          SA1    B2+B5       (X1) = U(J)
          SA2    B3+B5       (X2) = V(J)
          IX1    X1-X2       (X1) = U(J)-V(J) 
          IX6    X1+X6       (X6) = U(J)-V(J)+K 
          IX6    X6+X0       TO AVOID 1-S COMPLEMENT
 
          BX7    X0*X6       MASK OFF BORROW
          SA7    B4+B5       W(J) &lt;-- U(J)-V(J)+K MOD 2**M
          AX6    M-0         (X6) = BORROW = K
* 
*     (3) LOOP ON J.
* 
          SB5    B5-1        J &lt;-- J-1
          PL     B5,MPS1     UNTIL  J=0 
 
          EQ     MPSUB       EXIT 
* /---   BLOCK      PURDYOV    00 000   84/09/15  22.34 
          ENDOV 
* /---   BLOCK      END        00 000   81/08/20  23.07 
* 
* 
          OVTABLE 
* 
* 
          END    EXEC6$
Retro1.org codex

Table of Contents

EXEC6

Table Of Contents

Source Code
