Retro1.org codex

EXEC4 
* /---   FILE TYPE = E
* /---   BLOCK      EXEC4      00 000   78/12/18  21.22 
          IDENT  PLAT3$ 
          LCC    OVERLAY(PLATO,1,0) 
          END 
          IDENT  EXEC4
          TITLE  EXEC4       OVERLAYS FOR COMMAND EXECUTION 
* 
* 
          CST 
* 
* 
 EXEC4$   OVFILE
* 
* 
          EXT    ECSPRTY
          EXT    PROCESS,PROC,CKPROC,RETPROC
          EXT    PDWRITE
          EXT    DIOREQ,DIOREQ1 
          EXT    WINDOW 
          EXT    ILOC 
          EXT    RNETSF,RNETSN,LNETSF,LNETSN
          EXT    REQCHK 
          EXT    SAVKEY,RESTKEY 
          EXT    SAVLES,RESTLES 
          EXT    S=MAS
          EXT    FIPCHK 
* 
 CONV$    EQU    0           GENERATE ERROR CODE CONV. TABLE
          LIST   X
*CALL     PLASMRC 
* 
*         NEEDED TO DEFINE QUALIFIED CODE 
* 
*CALL     PLASFIP 
* 
          LIST   *
* /---   BLOCK      MACROS     00 000   76/05/10  00.23 
          TITLE  MACROS 
* 
* 
          PURGMAC CLRBIT
 CLRBIT   MACRO  INDEX,TABLE
          LOCAL  A,K
          SX1    INDEX
          SA2    K           LOAD DIVIDE LITERAL
          PX3    X1 
          FX2    X2*X3       INDEX/48 
          UX2    X2          X2 = WORD POSITION 
          SX3    48 
          DX3    X2*X3       COMPUTE REMAINDER
          IX3    X1-X3
          SB2    X3          B2 = SHIFT COUNT 
          MX3    1
          LX3    60-12       FORM MASK FOR SINGLE BIT 
          AX3    X3,B2
          SB2    TABLE
          SA2    X2+B2       LOAD APPROPRIATE WORD
          BX6    -X3*X2      CLEAR BIT
          SA6    A2 
          EQ     A           EXIT 
 K        DATA   17170125252525252526B  1/48*2**-48 
 A        BSS    0
          ENDM
* 
* 
* 
          PURGMAC SETBIT
 SETBIT   MACRO  INDEX,TABLE
          LOCAL  A,K
          SX1    INDEX
          SA2    K           LOAD DIVIDE LITERAL
          PX3    X1 
          FX2    X2*X3       INDEX/48 
          UX2    X2          X2 = WORD POSITION 
          SX3    48 
          DX3    X2*X3       COMPUTE REMAINDER
          IX3    X1-X3
          SB2    X3          B2 = SHIFT COUNT 
          MX3    1
          LX3    60-12       FORM MASK FOR SINGLE BIT 
          AX3    X3,B2
          SB2    TABLE
          SA2    X2+B2       LOAD APPROPRIATE WORD
          BX6    X3+X2       SET BIT
          SA6    A2 
          EQ     A           EXIT 
 K        DATA   17170125252525252526B  1/48*2**-48 
 A        BSS    0
          ENDM
* /---   BLOCK      STATS      00 000   75/04/02  03.38 
          TITLE  -STATS- COMMAND (CODE = 202) 
 
**        -STATS- COMMAND EXECUTION OVERLAY 
* 
*         STATS   ARG,LESSON
*         STATS   ARG,ACCOUNT';LESSON 
*         STATS   ARG,'OLD';LESSON
*         STATS   ARG,(N1)';(N2)
*         STATS   ARG,(N2)
*         STATS   ARG,0      $$  ALL LESSONS
*         STATS   ARG        $$  ALL LESSONS
* 
*                ARG =  1 = CONDENSING STATS OFF
*                       0 = EXECUTION STATS OFF 
*                      -1 = EXECUTION STATS ON
*                      -2 = CONDENSOR STATS ON
*                      -3 = MAXIMUM-TIME EXECUTION STATS ON 
* 
*         GETVAR CODE 1 = ARG AS DEFINED ABOVE
*                     2 = ACCOUNT NAME
*                     3 = LESSON NAME 
* 
*         ENTRY  (X5) = NEG. IF LESSON NAME/ACCOUNT OMITTED 
* 
* 
*         -STATS- COMMAND OVERVIEW
* 
*         THE -STATS- COMMAND FIRST PROCESSES THE ARGUMENT
*         (-3, -2, -1, 0, 1) AND THE OPTIONAL FILE NAME AND 
*         CHECKS TO SEE THAT THE FIRST ARGUMENT IS LEGAL. 
*         IT THEN POSTS A REQUEST TO ALL EXECUTORS OR 
*         CONDENSORS. 
* 
*         REQUESTS TO EXECUTORS ARE POSTED BY (1) PLACING 
*         THREE WORDS OF PARAMETERS IN ECS, (2) POSTING AN
*         INTER-EXECUTOR REQUEST TO OTHER EXECUTORS, AND
*         (3) POSTING AN ACTION REQUEST TO YOURSELF.
* 
*         (EXSTPRM) CONTAINS THE ADDRESS OF THE THREE WORDS 
*         OF ECS PARAMETERS FOR COMMAND EXECUTION STATS,
*         WHICH CONTAIN THE FOLLOWING DATA -- 
* 
*T        60/0 TO TURN OFF, 1 FOR NORMAL, 2 FOR MAXIMUM TIME
*T,       42/ACCOUNT NAME,18/ATTRIBUTES 
*T,       60/FILE NAME
* 
*         THE FORMAT OF AN INTER-EXECUTOR REQUEST TO TURN 
*         COMMAND EXECUTION STATISTICS ON OR OFF IS --
* 
*T        42/0, 18/XR.STAT
* 
*         THE FORMAT AN ACTION-REQUEST TO TURN COMMAND
*         EXECUTION STATS ON OR OFF IS -- 
* 
*T        42/0, 18/RQSTAT 
* 
* 
*         UPON RECEIVING A REQUEST TO TURN COMMAND EXECUTION
*         STATS ON OR OFF, AN EXECUTOR CALLS THE *EXSTATV*
*         OVERLAY IN DECK *EXEC4* WITH (OVARG1) = 1.  THIS
*         OVERLAY THEN EVALUATES THE THREE WORDS IN ECS AND 
*         TAKES THE APPROPRIATE ACTION -- 
* 
*                IF STATS WERE PREVIOUSLY OFF AND ARE NOW 
*                BEING TURNED ON, THE TIME-SLICE LENGTH IS
*                INCREASED BY 25 PERCENT. 
* 
*                (SCOMFLG) IS SET TO 0 IF STATS ARE OFF, 1
*                FOR NORMAL STATS, 2 FOR MAXIMUM TIME STATS.
* 
*                IF STATS ARE BEING TURNED ON, (SCOMACT) IS 
*                SET TO THE ACCOUNT NAME OR 0, (SCOMLES) IS 
*                SET TO THE LESSON NAME OR 0, AND THE STATS 
*                BUFFER FOR THAT EXECUTOR IS ZEROED.
* 
*                IF EXECUTION STATS WERE PREVIOUSLY ON AND
* /---   BLOCK      STATS      00 000   75/04/02  03.38 
*                ARE NOW BEING TURNED OFF, THE ORIGINAL 
*                TIME-SLICE LENGTH IS RESTORED. 
* 
*         THE PLATO EXECUTOR WILL NOW RECORD COMMAND EXECU- 
*         TION STATISTICS.  EACH EXECUTOR HAS ITS OWN STATS 
*         BUFFER, THE ADDRESS OF WHICH IS (ACMNDEX)+(EXID). 
*         THERE IS ONE CELL PER COMMAND NUMBER (512 TOTAL). 
* 
*         FOR NORMAL STATISTICS, EACH CELL CONTAINS --
* 
*T        30/TOTAL OCCURRENCES, 30/TOTAL TIME 
* 
*         FOR MAXIMUM EXECUTION TIMES, EACH CELL CONTAINS --
* 
*T        60/MAXIMUM TIME 
* 
*         A COUPLE OTHER CELLS ARE ALSO MAINTAINED IN 
*         /STATCOM/ SO THAT THE STATS OF ANY EXECUTOR CAN 
*         BE ACCESSED --
* 
*                (SCOMNDT) = TOTAL TIME FOR ALL COMMANDS
*                (SCOMNDN) = TOTAL COMMANDS 
* 
*         THE *EXSTATV* OVERLAY IS ALSO INVOKED ON A COUPLE 
*         OTHER OCCASIONS --
* 
*                WITH (OVARG1) = 2 TO INITIALIZE STATS FOR
*                A NEWLY-LOADED EXECUTOR
* 
*                WITH (OVARG1) = 3 TO CLEAR THE STATS BUFFER
*                WHEN AN EXECUTOR IS ABOUT TO BE DROPPED
* 
*         IN PLATO INITIALIZATIONS (DECK *MSUBS*), STATS
*         BUFFERS ARE DE-ALLOCATED (1) FOR UNUSED EXECUTORS 
*         AND (2) FOR ALL EXECUTORS IF ESTAT=OFF IN THE 
*         CONFIG FILE.
* 
*         COMMAND CONDENSE STATISTICS ARE HANDLED IN A
*         SOMEWHAT DIFFERENT MANNER.  IN THE EXECUTOR 
*         (ACDSTAT) CONTAINS THE ADDRESS OF THE STATS BUFFER
*         FOR THE ORDINAL 0 CONDENSOR.  WHEN A CONDENSOR
*         IS BEING INITIALIZED, THIS ADDRESS IS ADJUSTED SO 
*         THAT (ACDSTAT) IN A CONDENSOR POINTS TO THE STATS 
*         BUFFER FOR THAT INDIVIDUAL CONDENSOR. 
* 
*         A STATS BUFFER FOR A CONDENSOR CONTAINS THE 
*         FOLLOWING --
* 
*T        60/1 IF STATS ARE ON, 0 IF OFF
*T,       60/1 IF BUFFER SHOULD BE ZEROED, 0 IF NOT 
*T,       42/ACCOUNT NAME,18/ATTRIBUTES 
*T,       60/LESSON NAME
*T,       60/TOTAL COMMAND COUNT
*T,       60/TOTAL TIME 
*T,       CMNDMAX*60/ONE CELL PER COMMAND 
* 
*         EACH CELL CONTAINS THE FOLLOWING INFO --
* 
*T        30/TOTAL OCCURRENCES, 30/TOTAL TIME 
* 
*         THE INITIALIZATIONS THAT ARE DONE IN *COVLAY2*
*         WHEN A LESSON IS ABOUT TO BE CONDENSED CHECK
*         TO SEE IF STATISTICS ARE TURNED ON AND, IF ON,
*         IF STATS FOR THE CURRENT LESSON SHOULD BE TAKEN;
*         IF STATS ARE TO BE COLLECTED FOR THE CURRENT
*         LESSON, A FLAG (*SCOMFG1*) IS SET, AND THE BUFFER 
*         AND TOTALS ARE ZEROED IF REQUESTED. 
 
 STATOV   OVRLAY
 
          CALL   MXTEST,-1,XR.THR  CHECK FOR REQ. OVERFLOW
          NG     X6,=XRETRNZ  IF TOO MANY INTER-EXECUTOR REQ
 
          SA1    AOUTLOC     (X1) = CURRENT ACTION REQ PTR
* /---   BLOCK      STATS      00 000   75/04/02  03.38 
          SX1    X1+1-AOUTLTH  NEED 1 WORD FOR STATS REQUEST
          PL     X1,=XRETRNZ  IF NOT ENOUGH ROOM
 
*         PROCESS GETVAR CODES. 
 
          NGETVAR            (X1) = ARGUMENT
          BX6    X1 
          SA6    ST.ARG 
 
          SX6    0
          SA6    VARBUF      PRESET FOR ZERO ACCOUNT NAME 
          SA6    VARBUF+1    PRESET FOR ZERO FILE NAME
 
          SA5    A5+0        RESTORE COMMAND WORD 
          NG     X5,STATS1   IF ACCOUNT';FILE OMITTED 
 
          BX6    X5 
          LX6    XCODEL      (X6) = 20/ACCT GETVAR, 40/TRASH
          SA6    VARBUF      STORE GETVAR CODE FOR ACCT NAME
          AX5    XCMNDL      POSITION POINTER 
          MX1    -XSPTRL
          BX1    -X1*X5      (X1) = EXTRA STORAGE POINTER 
          SA1    X1+B5       (X1) = 20/FILE GETVAR, 40/TRASH
          BX6    X1 
          SA6    VARBUF+1 
 
 STATS1   CALL   ACCFILE,VARBUF,ST.ACCT,0 
 
*         JUMP ON FIRST ARGUMENT. 
 
          SA1    ST.ARG      (X1) = ARGUMENT
          SX3    3
          IX2    X1+X3       (X2) = JUMP TABLE INDEX
          NG     X2,=XERXVAL  ERROR IF (ST.ARG) .LT. -3 
          SX3    2
          IX3    X1-X3
          PL     X3,=XERXVAL  ERROR IF (ST.ARG) .GT. 1
          SB1    X2          (B1) = JUMP TABLE INDEX
          JP     B1+*+1 
 
+         SX6    2           -3 = MAXIMUM EXECUTION STATS ON
          EQ     EXECSTS
 
+         SX6    1           -2 = CONDENSE STATS ON 
          EQ     CNDSTAT
 
+         SX6    1           -1 = EXECUTION STATS ON
          EQ     EXECSTS
 
+         SX6    0            0 = EXECUTION STATS OFF 
          EQ     EXECSTS
 
+         SX6    0            1 = CONDENSE STATS OFF
          EQ     CNDSTAT
 
 CNDSTAT  SPACE  5,15 
**        CNDSTAT -- TURN COMMAND CONDENSE STATS ON/OFF 
* 
*         ENTRY  (X6) = 1 TO TURN ON, 0 TO TURN OFF 
*                (ST.ACCT) = ACCOUNT NAME OR 0
*                (ST.LESS) = LESSON NAME OR 0 
* 
*         EXIT   REQUEST POSTED TO ALL CONDENSORS IF STATS
*                BUFFER HAS BEEN ALLOCATED
 
 CNDSTAT  SA1    ACDSTAT     (X1) = ECS ADDR OF BUFFER
          ZR     X1,=XPROCESS  EXIT IF NO BUFFER
 
          BX0    X1          (X0) = ECS ADDR OF BUFFER
          SA0    CNDSTATS    (A0) = CM COPY OF REQUEST
          RE     /CSTAT/SCOMNDP  READ BACK LAST REQUEST 
          RJ     ECSPRTY
 
          SA6    CNDSTATS+/CSTAT/SCOMFG1  STORE ON/OFF FLAG 
          ZR     X6,CNDSTAT1  IF TURNING STATS OFF
 
          SA2    ST.ACCT     (X2) = ACCOUNT NAME
          SA3    ST.LESS     (X3) = LESSON NAME 
          BX6    X2 
          BX7    X3 
          SA6    CNDSTATS+/CSTAT/SCOMACT
          SA7    CNDSTATS+/CSTAT/SCOMLES
 
* /---   BLOCK      STATS      00 000   75/04/02  03.38 
          SX6    1
          SA6    CNDSTATS+/CSTAT/SCOMZER  ZERO REQ BUFFER 
 
*         PASS THE REQUEST TO ALL THE CONDENSORS. 
 
 CNDSTAT1 SX2    /CSTAT/SCOMNDH+CMNDMAX  (X2) = BUFFER LTH
          SB1    0           (B1) = CURRENT CONDENSOR 
          SB2    NCONDEN-1   (B2) = LAST CONDENSOR ORDINAL
          IX0    X1-X2       PRESET FOR BUFFER -1 
 CNDSTAT2 IX0    X0+X2       INCREMENT BUFFER ADDRESS 
          WE     /CSTAT/SCOMNDP  WRITE REQUEST TO ECS 
          RJ     ECSPRTY
          SB1    B1+1 
          LE     B1,B2,CNDSTAT2  DO FOR NEXT CONDENSOR
          EQ     =XPROCESS
 
 EXECSTS  SPACE  5,15 
**        EXECSTS -- TURNS EXECUTION STATS ON/OFF 
* 
*         ENTRY  (X6) = 2 FOR MAXIMUM EXECUTION STATS, 1 FOR
*                       NORMAL STATS, 0 TO TURN THEM OFF
*                (ST.ACCT) = ACCOUNT NAME OR 0
*                (ST.LESS) = LESSON NAME (0 FOR ALL LESSONS)
* 
*         EXIT   TO *PROCESS* 
*                EXECUTION STATS PARAMETERS IN ECS UPDATED
*                REQUEST POSTED TO ALL EXECUTORS
* 
*         CALLS  ECSPRTY, MXRQALL 
* 
*         MACROS CALL 
 
*         UPDATE EXECUTION STATS PARAMETERS IN ECS. 
 
 EXECSTS  SA6    ST.ARG      SAVE STATS ON/OFF PARAMETER
          SA1    EXSTPRM     (X1) = ECS ADDR OF PARAMETERS
          BX0    X1 
          SA0    A6          (A0) = CM ADDR OF PARAMETERS 
          WE     3           WRITE PARAMETERS TO ECS
          RJ     ECSPRTY
 
*         REQUEST OTHER EXECUTORS TO TURN LESSON EXECUTION
*         STATISTICS ON OR OFF. 
 
          SX6    XR.STAT     (X6) = INTER-EXECUTOR REQ. CODE
          SA6    MASRQ
          CALL   MXRQALL     POST REQUEST TO OTHER EXECUTORS
 
*         POST REQUEST TO THIS EXECUTOR, TOO. 
 
          SA1    AOUTLOC     (X1) = ACTION REQUEST POINTER
          SX6    RQSTAT      (X6) = ACTION REQUEST CODE 
          SA6    ACTOUT+X1   STORE REQUEST CODE 
          SX6    X1+1        INCREMENT POINTER
          SA6    A1          STORE UPDATED POINTER
 
*         EXIT. 
 
          EQ     =XPROCESS
 
*         DATA FIELDS (THE FIRST THREE MUST ALWAYS BE 
*         CONSECUTIVE). 
 
 ST.ARG   OVDATA 1           1ST COMMAND ARGUMENT 
 ST.ACCT  OVDATA 1           ACCOUNT NAME 
 ST.LESS  OVDATA 1           LESSON NAME
 
*         WHEN COMMAND CONDENSE STATISTICS ARE TURNED ON IN 
*         THE CONFIGURATION FILE, EACH CONDENSOR HAS A
*         STATISTICS BUFFER (SCOMNDH + CMNDMAX) WORDS LONG. 
* 
*         THE FOLLOWING SYMBOLS DEFINE OFFSETS WITHIN ONE 
*         OF THESE STATISTICS BUFFERS.
* 
*         THESE DEFINITIONS ARE REPEATED IN COTEXT, EXEC4,
*         AND MSUBS.  IN PLATO (EXEC4 AND MSUBS) THEY ARE 
*         QUALIFIED BY /CSTAT/. 
 
          QUAL   CSTAT
 
* /---   BLOCK      STATS      00 000   75/04/02  03.38 
 SCOMFG1  EQU    0           CONDENSE STATISTICS FLAG 
 SCOMZER  EQU    1           NON-ZERO IF BUFFER TO BE ZEROED
 SCOMACT  EQU    2           ACCOUNT FOR LESSON 
 SCOMLES  EQU    3           LESSON TO COLLECT STATS ON 
 
 SCOMNDP  EQU    SCOMLES-SCOMFG1+1  LTH OF PARMS FROM PLATO 
 
 SCOMNDN  EQU    4           TOTAL COMMAND COUNT
 SCOMNDT  EQU    5           TOTAL TIME 
 
 SCOMNDH  EQU    SCOMNDT-SCOMFG1+1  HEADER LENGTH 
 
 SCOMNDS  EQU    6           STATS BUFFER *CMNDMAX* WDS LONG
 
          QUAL   *
 
 CNDSTATS OVDATA /CSTAT/SCOMNDH  CM COPY OF BUFFER HEADER 
 
          ENDOV 
 
 EXSTATV  SPACE  5,15 
**        EXSTATV - TURN LESSON EXECUTION STATS ON/OFF
* 
*         ENTRY  (OVARG1) = 1 IF -STATS- COMMAND REQUEST
*                           2 IF INITIALIZING NEW EXECUTOR
*                           3 IF EXECUTOR IS DROPPING 
* 
*         EXIT   LESSON EXECUTION STATISTICS TURNED ON OR 
*                            OFF AND EXECUTOR'7S STATS BUFFER 
*                            ZEROED IF NECESSARY (SEE BELOW)
 
 EXSTATV  OVRLAY
 
          SA1    OVARG1      (X1) = OVERLAY ARGUMENT
          SB1    X1+
          JP     B1+*+1      JUMP TO APPROPRIATE ROUTINE
 
+         EQ     *+1S17      0 = IMPOSSIBLE 
+         EQ     ONOFF       1 = TURN STATS ON/OFF
+         EQ     ONOFF       2 = SAME FOR A NEW EXECUTOR
+         EQ     DRPEXEC     3 = IF EXECUTOR DROPPING 
 
 ONOFF    SPACE  5,15 
**        ONOFF - TURN EXECUTION STATISTICS ON OR OFF 
* 
*         LESSON EXECUTION STATISTICS WILL BE TURNED ON OR
*         OFF BASED ON THE PARAMETERS IN ECS.  IF THE 
*         STATISTICS ARE BEING TURNED ON, THE STATISTICS
*         BUFFER FOR THIS EXECUTOR WILL ALSO BE ZEROED. 
* 
*         CALLS  CLEARBUF, ECSPRTY
* 
*         MACROS CALL, RETURN 
 
 ONOFF    SA1    EXSTPRM     (X1) = ECS ADDR OF STATS PARMS 
          BX0    X1 
          SA0    ST.ARG      (A0) = CM ADDR OF STATS PARMS
          RE     3           READ PARAMETERS TO CM
          RJ     ECSPRTY
 
          SA1    ST.ARG      (X1) = NEW ON/OFF FLAG 
          SA2    SCOMFLG     (X2) = CURRENT ON/OFF STATS
          ZR     X1,OFF      IF TURNING STATS OFF 
 
*         TURN LESSON EXECUTION STATISTICS ON.
 
          NZ     X2,ON1      IF ALREADY ON
 
          SA2    ITIMESL     ADD QUARTER-TIME-SLICE TO ALL
          BX6    X2               TIME-SLICES 
          AX6    2
          IX6    X2+X6
          SA6    TIMESL      (TIME-SLICE) = 1.25(TIME-SLICE)
 
 ON1      CALL   CLEARBUF    ZERO STATISTICS BUFFER 
          SA1    ST.ARG 
          BX6    X1          (X6) = 1 FOR NORMAL, 2 FOR MAX.
          BX7    X1 
          AX7    1           (X7) = 0 FOR NORMAL, 1 FOR MAX.
* /---   BLOCK      STATS      00 000   78/12/18  21.23 
          SA6    SCOMFLG     MARK EXECUTION STATS ON
          SA7    SCOMNDT     SET MAXIMUM TIME FLAG
          SA1    ST.ACCT     (X1) = ACCOUNT NAME
          SA2    ST.LESS     (X2) = LESSON NAME 
          BX6    X1 
          BX7    X2 
          SA6    SCOMACT     SET ACCOUNT NAME 
          SA7    SCOMLES     SET LESSON NAME
          RETURN
 
*         TURN LESSON EXECUTION STATISTICS OFF. 
 
 OFF      ZR     X2,OFF1     IF ALREADY OFF 
 
          SA1    ITIMESL     RESTORE NORMAL TIME-SLICE LTH
          BX6    X1 
          SA6    TIMESL 
 
          SX6    0           TURN EXECUTION STATS OFF 
          SA6    SCOMFLG
 
 OFF1     RETURN
 
 DRPEXEC  SPACE  5,15 
**        DRPEXEC - CLEAR STATS BUFFER WHEN EXECUTOR DROPS
* 
*         IF AN EXECUTOR IS DROPPED, ITS LESSON EXECUTION 
*         STATISTICS BUFFER MUST BE ZEROED. 
* 
*         CALLS  CLEARBUF 
* 
*         MACROS CALL, RETURN 
 
 DRPEXEC  CALL   CLEARBUF 
          RETURN
 
 CLEARBUF SPACE  5,15 
**        CLEARBUF - ZERO LESSON EXECUTION STATISTICS BUFFER
* 
*         THIS ROUTINE IS CALLED TO RESET COMMAND EXECUTION 
*         STATISTICS WHEN THE STATISTICS ARE TURNED ON OR 
*         AN EXECUTOR IS DROPPED. 
* 
*         USES   A - 0, 1, 2
*                B - NONE 
*                X - 0, 1, 2
* 
*         CALLS  NONE 
* 
*         MACROS NONE 
 
 CLEARBUF EQ     *
          SA1    EXID        (X1) = EXECUTOR ID 
          SA1    ACMNDEX+X1  (X1) = ECS ADDR OF STATS BUFFER
          ZR     X1,CLEARBUF  IF NO BUFFER PRESENT
          ZERO   ZBUFFER,SCOMLTH   ZERO CM BUFFER 
          BX0    X1          (X0) = ECS ADDR. OF STAT BUFFER
          WE     SCOMLTH     ZERO STATS BUFFER
          RJ     ECSPRTY
          EQ     CLEARBUF    EXIT 
 
*         DATA FIELDS (THE FIRST THREE MUST ALWAYS BE 
*         CONSECUTIVE). 
 
 ST.ARG   OVDATA 1           1ST COMMAND ARGUMENT 
 ST.ACCT  OVDATA 1           ACCOUNT NAME 
 ST.LESS  OVDATA 1           LESSON NAME
 
*         DEFINE A CM BUFFER TO BE ZEROED.  THIS
*         BUFFER WILL THEN BE USED TO INITIALIZE STATISTICS 
*         BUFFERS.  EXISTING CM BUFFERS LIKE *WORK* AND 
*         *INFO* CAN NOT BE USED SINCE THIS OVERLAY IS
*         EXECUTED DURING INITIALIZATIONS AND THE INITIALI- 
*         ZATION CODE IS OVERLAYED ON THOSE BUFFERS.
 
 ZBUFFER  OVDATA SCOMLTH     CM BUFFER FOR ZEROING
 
          ENDOV 
* /---   BLOCK      ALLOCOV    00 000   76/11/12  03.15 
          TITLE  ALLOCOV  ALLOCATE DISK SPACE 
* 
* 
* 
*         -ALLOCOV-          -CREATE- COMMAND OVERLAY 
* 
*         ON ENTRY -
*            OVARG1 = FILE NAME 
*            OVARG2 = DISK SPACE ALLOCATION REQUEST WORD
*                        36 BITS = 0
*                        12 BITS = ADDITIONAL INFO
*                         6 BITS = FILE TYPE NUMBER 
*                         6 BITS = NUMBER OF SPACES 
* 
*         ON EXIT - 
*         *TERROR* = -1 = FILE CREATION SUCCESSFUL
*                     0 = ERROR--PACK NAME (NOT LOADED) 
*                     1 = ERROR--FILE NAME (ALREADY EXISTS) 
*                     2 = ERROR--IMPROPER REQUEST 
*                     3 = ERROR--NO ROOM FOR MORE FILES 
*                     4 = ERROR--CANNOT FIND ENOUGH SPACE 
* 
*         ++ NOTE ++  'THE CM BUFFER *WORK* IS USED IN
*                     UPDATING THE ECS FILE TABLES. 
* 
* /---   BLOCK      ALLOCOV    00 000   76/03/10  20.15 
* 
 ALLOCOV  OVRLAY
          CALL   PACKCHK,TDISKU     CHECK DIRECTORY INTACT
          SA1    OVARG1      LOAD FILE NAME 
          NG     X1,AERR2A   EXIT IF BAD FILE NAME
          ZR     X1,AERR2A
          BX7    X1          SAVE FILE NAME 
          SA7    AFNAME 
          CALL   FNDFILE,TDISKU,TPNAME
*         ON EXIT - X6 = FILE INDEX, X7 = 1 IF NOT FOUND
*                   PINF = BASIC PACK INFO
          BX7    -X7         CHECK IF FILE ALREADY EXISTS 
          SX7    X7          CHANGE -0 TO +0
          SA7    TERROR      PRESET ERROR FLAG
          ZR     X7,AERR0    EXIT IF PACK NOT LOADED
          PL     X7,AERR1    EXIT IF DUPLICATE FILE NAME
          SA7    TRETURN     ALSO SET *ZRETURN* 
          SA6    AINDEX      SAVE FILE INDEX
          SA1    TDISKU 
          SA2    PITS+X1     ECS ADDRESS OF PACK INFO TABLE 
          SA3    PINF+4      LENGTH OF PIT
          BX0    X2 
          SB2    X3 
          SA0    PINF 
+         RE     B2          READ COMPLETE PIT FROM ECS 
          RJ     ECSPRTY
* /---   BLOCK      ALLOCOV    00 000   77/08/17  03.53 
          SB1    1           B1 = 1 (STANDARD INCREMENT)
          SA1    OVARG2      X1 = ALLOCATION REQUEST WORD 
          MX0    -6 
          BX5    -X0*X1      X5 = NUMBER OF SPACES REQUESTED
          BX7    X1 
          LX7    24          RE-POSITION FILE INFO
          SA7    FINF        SAVE IN *FINF* 
          AX1    6
          BX2    -X0*X1      GET FILE TYPE NUMBER 
          ZR     X2,AERR2B   EXIT IF NO FILE TYPE SPECIFIED 
          MX2    -18         ALLOW 12 MORE INFO BITS
          BX1    X2*X1
          NZ     X1,AERR2C   EXIT IF JUNK IN WORD 
          SB2    X5-1        B2 = SPACE COUNT - 1 
          NG     B2,AERR2D   EXIT IF SPACE REQUESTED = 0
          SX2    B2-63
          PL     X2,AERR2D   EXIT IF SPACE REQUESTED GT 77B 
          SA3    PINF+3      FILE COUNT WORD
          SX2    X3          CURRENT NUMBER OF FILES
          AX3    18 
          SX3    X3          FILE LIMIT 
          IX1    X2-X3
          PL     X1,AERR3    EXIT IF FILE TABLE FULL
          SA2    PINF+2      SPACE ALLOCATION COUNT WORD
          SX1    X2          CURRENT NUMBER OF SPACES IN USE
          AX2    18 
          SX2    X2          TOTAL SPACES ON PACK 
          IX1    X2-X1       SPACES AVAILABLE 
          IX1    X1-X5       COMPARE WITH REQUEST 
          NG     X1,AERR4    EXIT IF INSUFFICIENT SPACE 
* /---   BLOCK      ALLOCATE   00 000   79/12/07  16.21 
          EJECT 
* 
* 
* 
*         SEARCH FILE SPACE BIT TABLE TO LOCATE ADEQUATE
*         FREE SPACE FOR AMOUNT REQUESTED 
* 
*         ALLOCATION SEARCH ROUTINE WILL ACCEPT SPACES OF 
*         THE FOLLOWING SIZES IN THE PRECEDENCE SPECIFIED - 
* 
*           1.  EXACT MATCH WITH AMOUNT REQUESTED 
*           2.  SMALLEST FREE SPACE FOUND WHICH IS AT LEAST 
*               TWO PARTS LARGER THAN AMOUNT REQUESTED
*           3.  FIRST SPACE WHICH WILL LEAVE 1 UN-ALLOCATED 
*               PART
* 
* 
          BX6    X5          SAVE AMOUNT OF SPACE REQUIRED
          SA6    ASPACE 
* 
*         INITIALIZE FOR SPACE BIT TABLE SEARCH 
* 
          SB3    X5          B3 = AMOUNT OF SPACE REQUIRED
          MX0    12          X0 = MASK FOR COEF^FICIENT 
          BX0    -X0
          SA1    PINF+5-1    X1 = CURRENT BIT TABLE WORD
          MX4    0           X4 = BEST FIND POINTER 
          MX5    0           X5 = LENGTH OF BEST FIND 
          MX6    12          X6 = MASK FOR CLEARING SET BITS
* 
*         SEARCH FOR NEXT FREE SPACE
* 
 A200     SA1    A1+1        LOAD NEXT WORD OF BIT TABLE
          ZR     X1,A300
* 
 A210     UX2    X1,B2       BITS IN WORD NOT CHECKED YET 
          SX7    -B2         SAVE FOR LATER SUBTRACTION 
          NX1    X1,B2       FIND NEXT SET BIT
*                            B2 = WIDTH OF ZEROS FIELD
          ZR     X1,A200
          BX2    X0-X1       COMPLEMENT COEFFICIENT 
          NX2    X2,B1       FIND END OF SET BITS 
*                            B1 = WIDTH OF ONES FIELD 
          AX3    X6,B1
          BX2    X0*X3       FORM MASK FOR SET BITS 
          BX1    -X2*X1      CLEAR BITS 
          SA3    A1 
          BX3    X1          SAVE A1,X1 OF AREA 
          SB2    B1+B2       WIDTH OF THIS PAIR OF FIELDS 
          SB2    X7+B2       WIDTH OF REMAINDER OF WORD 
          NZ     B2,A250     IF NEXT WORD NOT CONTIGUOUS
* 
* /---   BLOCK      ALLOCATE   00 000   79/12/07  16.21 
* 
*         SEARCH THROUGH CONTIGUOUS SPACE OVERLAPING WORD 
*         BOUNDARIES
* 
 A220     SA1    A1+1        LOAD NEXT BIT TABLE WORD 
          ZR     X1,A250
          NX2    X1,B2       FIND NEXT SET BIT
          NZ     B2,A250     JUMP IF NOT CONTIGUOUS 
          ZR     X2,A250     JUMP IF NO SET BITS
          BX1    X2 
          BX2    X0-X1       COMPLEMENT COEFFICIENT 
          NX2    X2,B2       FIND END OF SET BITS 
          SB1    B1+B2       INCREMENT TOTAL SPACES FOUND 
          AX2    X6,B2
          ZR     X2,A220     CHECK NEXT WORD CONTIGUOUS 
          BX2    X0*X2       FORM MASK FOR SET BITS 
          BX1    -X2*X1      CLEAR BITS 
* 
*         CHECK IF THIS IS BEST FIND SO FAR 
* 
 A250     LT     B1,B3,A260  JUMP IF NOT ENOUGH SPACE 
          EQ     B1,B3,A310  JUMP IF FOUND EXACT AMOUNT 
          SB2    B1-B3       COMPUTE AMOUNT OF EXTRA SPACE
          SB2    B2-1 
+         NZ     B2,*+1      JUMP IF NOT SINGLE EXTRA SPACE 
          NZ     X5,A260     JUMP IF A SPACE ALREADY FOUND
+         ZR     X5,A255     JUMP IF NO PREVIOUS FIND 
          SB2    X5-1 
          SB2    B2-B3       CHECK SIZE OF PREVIOUS FIND
          ZR     B2,A255     JUMP IF PREVIOUS LEAVES 1 EXTRA
          SB2    X5 
          GE     B1,B2,A260  JUMP IF PREVIOUS SPACE SMALLER 
* 
 A255     SA4    A3          SAVE ADDR/WORD OF BEST FIND
          BX4    X3 
          SX5    B1          SAVE SIZE OF FIND
* 
 A260     NZ     X1,A210     JUMP IF NOT END OF TABLE 
          EQ     A300 
* 
* /---   BLOCK      ALLOCATE   00 000   76/03/10  21.24 
* 
*         COMPUTE INDEX OF BEST SPACE FOUND 
* 
 A300     SA3    A4          A3 = TABLE ADDRESS OF BEST FIND
          BX3    X4 
          ZR     X5,A990     EXIT IF INADEQUATE SPACE 
* 
 A310     SX4    PINF+5      X4 = BEGIN ADDRESS OF BIT TABLE
          SX2    A3          ADDRESS OF STARTING WORD 
          IX2    X2-X4       COMPUTE WORD BIAS INTO TABLE 
          SX1    48 
          DX6    X1*X2       CONVERT TO BIT BIAS
          UX2    X3,B1
          SB2    48          COMPUTE BIT BIAS WITHIN WORD 
          SX1    B2-B1
          IX6    X1+X6       COMPUTE INDEX OF SPACE FOUND 
          SA6    ITEMP       SAVE SPACE INDEX 
* 
*         CLEAR APPROPRIATE BITS FROM BIT TABLE 
* 
          SX1    X6          X1 = INDEX TO CURRENT BIT
* 
 A400     CLRBIT X1,PINF+5   CLEAR NEXT BIT 
          SX1    X1+1 
          SB3    B3-1        END TEST 
          GT     B3,B0,A400 
          SA1    ASPACE 
          BX5    X1          X5 = AMOUNT OF SPACE REQUESTED 
          SA1    ITEMP
          SA2    FINF        ATTACH SPACE INDEX TO INFO WORD
          BX6    X1+X2
          SA6    A2          *FINF* = FILE INFO WORD
          EQ     AUPDATE
* 
*         ERROR EXIT IF INSUFFICIENT SPACE AVALIABLE
* 
 A990     EQ     AERR4       EXIT IF SPACE NOT AVAILABLE
* 
* 
* /---   BLOCK      AUPDATE    00 000   76/03/10  20.42 
          EJECT 
* 
* 
*         UPDATE THE PACK INFORMATION TABLE IN ECS. 
* 
*         ON ENTRY - X5 = AMOUNT OF SPACE REQUESTED 
* 
 AUPDATE  SB1    1           B1 = 1 
          SA1    PINF+2 
          IX7    X1+X5       INC COUNT OF SPACES ALLOCATED
          SA7    A1 
          SA2    PINF+3 
          SX6    B1          X6 = 1 (USED LATER ALSO) 
          IX7    X2+X6       INCREMENT COUNT OF FILES USED
          SA7    A2          *** NOTE--X7 USED LATER
          SA1    TDISKU 
          SA2    PITS+X1     ECS ADDRESS OF PACK INFO TABLE 
          SA3    PINF+4      LENGTH OF PIT
          BX0    X2 
          SB2    X3 
          SA0    PINF 
+         WE     B2          WRITE UPDATED PIT TO ECS 
          RJ     ECSPRTY
* /---   BLOCK      AUPDATE    00 000   76/03/10  19.52 
* 
*         UPDATE THE FILE NAME TABLE IN ECS.
* 
          SA0    WORK        A0 = ADDRESS OF TRANSFER BUFFER
          SX5    WORKLTH     X5 = LENGTH OF TRANSFER BUFFER 
          SA2    AINDEX      INDEX TO NEW FILE
          SA3    TDISKU      X3 = DISK UNIT 
          SA4    FNTS+X3     ECS ADDRESS OF FILE NAME TABLE 
          SX1    X7          EXTRACT UPDATED FILE COUNT 
          IX1    X1-X6       X1 = OLD FILE COUNT
          IX2    X1-X2       X2 = LENGTH TO MOVE
          IX0    X4+X1       ADDRESS AFTER END OF TABLE 
          SB2    X2          PRE-SET LENGTH 
          IX4    X0-X2       PRE-SET ECS ADDRESS
          IX7    X2-X5       X7 = LENGTH LEFT TO DO 
          NG     X7,AUPFNT2 
          IX0    X0-X5       SET ECS ADDRESS
* 
 AUPFNT1  RE     WORKLTH     READ FILE NAMES
          RJ     ECSPRTY
          SB2    X7          LENGTH IF DONE NEXT TIME 
          IX4    X0-X7       ECS ADDRESS IF DONE NEXT TIME
          IX7    X7-X5       DECREMENT LENGTH TO DO 
          IX0    X0+X6       ADD 1
+         WE     WORKLTH     WRITE BACK 1 WORD DOWN 
          RJ     ECSPRTY
          IX0    X0-X6       SUBTRACT 1 BACK
          IX0    X0-X5       NEXT ECS ADDRESS IF NOT DONE 
          PL     X7,AUPFNT1 
* 
 AUPFNT2  BX0    X4          GET SAVED ECS ADDRESS
          SA4    AFNAME      X4 = FILE NAME 
          NG     X4,"CRASH"  IF BAD FILE NAME 
          SA0    A0+B1       LEAVE ROOM FOR IT
+         RE     B2          READ FILE NAMES THAT SHOULD
          RJ     ECSPRTY     FOLLOW NEW FILE NAME 
          BX7    X4 
          SA0    A0-B1       BACK UP
          SA7    A0          PUT NEW FILE NAME AT START 
          SB2    B2+B1       INCREMENT LENGTH BY 1
+         WE     B2          WRITE BACK WITH NEW FILE NAME
          RJ     ECSPRTY
* /---   BLOCK      AUPDATE    00 000   76/05/17  22.07 
* 
*         UPDATE THE FILE INFORMATION TABLE IN ECS. 
* 
          SA4    FITS+X3     ECS ADDRESS OF FILE INFO TABLE 
          IX0    X4+X1       ADDRESS AFTER END OF TABLE 
          SB2    X2          PRE-SET LENGTH 
          IX4    X0-X2       PRE-SET ECS ADDRESS
          IX7    X2-X5       X7 = LENGTH LEFT TO DO 
          NG     X7,AUPFIT2 
          IX0    X0-X5       SET ECS ADDRESS
* 
 AUPFIT1  RE     WORKLTH     READ FILE INFO WORDS 
          RJ     ECSPRTY
          SB2    X7          LENGTH IF DONE NEXT TIME 
          IX4    X0-X7       ECS ADDRESS IF DONE NEXT TIME
          IX7    X7-X5       DECREMENT LENGTH TO DO 
          IX0    X0+X6       ADD 1
+         WE     WORKLTH     WRITE BACK 1 WORD DOWN 
          RJ     ECSPRTY
          IX0    X0-X6       SUBTRACT 1 BACK
          IX0    X0-X5       NEXT ECS ADDRESS IF NOT DONE 
          PL     X7,AUPFIT1 
* 
 AUPFIT2  BX0    X4          GET SAVED ECS ADDRESS
          SA4    FINF        X4 = FILE INFO WORD
          SA0    A0+B1       LEAVE ROOM FOR IT
+         RE     B2          READ FILE INFO WORDS THAT
          RJ     ECSPRTY     SHOULD FOLLOW NEW ONE
          BX7    X4 
          SA0    A0-B1       BACK UP
          SA7    A0          PUT NEW FILE INFO WORD AT START
          SB2    B2+B1       INCREMENT LENGTH BY 1
+         WE     B2          WRITE BACK WITH NEW INFO WORD
          RJ     ECSPRTY
* 
*         FORM NEW PACK DIRECTORY SUM-CHECK.
* 
          CALL   PACKSUM,TDISKU 
          EQ     ALLOCX 
* 
* 
 AERR0    SX6    3           *ZRETURN* = 3 = PACK NOT LOADED
          EQ     AERRX1      *ERROR* IS ALREADY SET 
* 
 AERR1    SX6    11          *ZRETURN = 11 = DUP. FILE NAME 
          EQ     AERRX1      *ERROR* IS ALREADY SET 
* 
 AERR2A   SX6    4           ZRETURN = 4 = BAD FILE NAME
          EQ     AERR2
 AERR2B   SX6    12          ZRETURN = 12 = BAD FILE TYPE 
          EQ     AERR2
 AERR2C   SX6    13          ZRETURN = 13 = BAD DIR. INFO 
          EQ     AERR2
 AERR2D   SX6    14          *ZRETURN* = 14 = BAD FILE LTH
 AERR2    SX7    2           IMPROPER ALLOCATION REQUEST
          EQ     AERRX
* 
 AERR3    SX7    3           FILE LIMIT 
          SX6    15          *ZRETURN* = 15 = PACK DIR FULL 
          EQ     AERRX
* 
 AERR4    SX7    4           SPACE NOT AVAILABLE
          SX6    16          *ZRETURN* = 16 = NOT ENUF ROOM 
          EQ     AERRX
* 
 AERRX    SA7    TERROR      STORE ERROR FLAG 
 AERRX1   SA6    TRETURN     ALSO SET *ZRETURN* 
          EQ     ALLOCX      EXIT 
* 
* 
 AINDEX   BSS    1           INDEX TO FILE
 AFNAME   BSS    1           NAME OF FILE 
 ASPACE   BSS    1           AMOUNT OF SPACE REQUESTED
* 
* 
 ALLOCX   RETURN
* 
* 
          ENDOV 
* /---   BLOCK      DEALLOV    00 000   77/08/17  03.47 
          TITLE  DEALLOV  RELEASE DISK SPACE
* 
* 
* 
*         -DEALLOV-          -DESTROY- COMMAND OVERLAY
* 
*         ON ENTRY -
*            OVARG1 = FILE NAME 
* 
*         ON EXIT - 
*         *TERROR* = -1 = FILE DESTRUCTION SUCCESSFUL 
*                     0 = ERROR--PACK NAME (NOT LOADED) 
*                     1 = ERROR--FILE NAME (NOT ON PACK)
*                     2 = ERROR--IMPROPER REQUEST 
* 
*         ++ NOTE ++  'THE CM BUFFER *WORK* IS USED IN
*                     UPDATING THE ECS FILE TABLES. 
* 
* 
 DEALLOV  OVRLAY
          CALL   PACKCHK,TDISKU     CHECK DIRECTORY INTACT
          SA1    OVARG1      FILE NAME
          NG     X1,DERR1    EXIT IF BAD FILE NAME
          ZR     X1,DERR1 
          CALL   FNDFILE,TDISKU,TPNAME
*         ON EXIT - X6 = FILE INDEX, X7 = 1 IF NOT FOUND
*                   PINF = BASIC PACK INFO
          SA7    TERROR      SET ERROR FLAG 
          ZR     X7,DERR0    EXIT IF PACK NOT LOADED
          PL     X7,DERR1A   EXIT IF FILE NOT FOUND 
          SA7    TRETURN     SET *ZRETURN* TOO
          SA6    DINDEX      SAVE FILE INDEX
* /---   BLOCK      DEALLOV    00 000   76/03/10  21.31 
          EJECT 
* 
* 
*         RELEASE SPACE FOR THIS FILE IN ALLOCATION TABLE 
* 
          SA1    A0          GET FILE INFORMATION WORD
          MX0    -15
          BX3    -X0*X1      X3 = SPACE INDEX 
          AX1    24 
          MX0    -6 
          BX5    -X0*X1      X5 = NUMBER OF SPACES ALLOCATED
          SA1    TDISKU 
          SA1    PITS+X1     ECS ADDRESS OF PACK INFO TABLE 
          SA4    PINF+4      LENGTH OF PIT
          BX0    X1 
          SB2    X4 
          SA0    PINF 
+         RE     B2          READ COMPLETE PIT FROM ECS 
          RJ     ECSPRTY
          BX1    X3          X1 = INDEX OF FILE SPACE 
          SB3    X5          B3 = NUMBER OF SPACES
* 
 R100     SETBIT X1,PINF+5   SET NEXT BIT 
          SX1    X1+1 
          SB3    B3-1        END TEST 
          GT     B3,B0,R100 
          EQ     DUPDATE
* 
* 
* /---   BLOCK      DUPDATE    00 000   76/03/10  21.22 
          EJECT 
* 
* 
*         UPDATE THE PACK INFORMATION TABLE IN ECS. 
* 
 DUPDATE  SA1    PINF+2 
          IX7    X1-X5       DEC COUNT OF SPACES ALLOCATED
          SA7    A1 
          SA2    PINF+3 
          SX6    1           X6 = 1 (USED LATER ALSO) 
          IX7    X2-X6       DECREMENT COUNT OF FILES USED
          SA7    A2          *** NOTE--X7 USED LATER
          SA1    TDISKU 
          SA2    PITS+X1     ECS ADDRESS OF PACK INFO TABLE 
          SA3    PINF+4      LENGTH OF PIT
          BX0    X2 
          SB2    X3 
          SA0    PINF 
+         WE     B2          WRITE UPDATED PIT TO ECS 
          RJ     ECSPRTY
* 
*         UPDATE ECS FILE NAME TABLE
* 
          SA0    WORK        A0 = ADDRESS OF TRANSFER BUFFER
          SX5    WORKLTH     X5 = LENGTH OF TRANSFER BUFFER 
          SA2    DINDEX      INDEX TO OLD FILE
          SA3    TDISKU      X3 = DISK UNIT 
          SA4    FNTS+X3     ECS ADDRESS OF FILE NAME TABLE 
          SX1    X7          EXTRACT UPDATED FILE COUNT 
          IX1    X1-X2       X1 = LENGTH TO MOVE
          IX2    X2+X6       X2 = STARTING INDEX
          IX0    X4+X2       STARTING ECS ADDRESS 
          SB2    X1          PRE-SET LENGTH 
          IX7    X1-X5       X7 = LENGTH LEFT TO DO 
          NG     X7,DUPFNT2 
* 
 DUPFNT1  RE     WORKLTH     READ FILE NAMES
          RJ     ECSPRTY
          SB2    X7+0        LENGTH IF DONE NEXT TIME 
          IX7    X7-X5       DECREMENT LENGTH TO DO 
          IX0    X0-X6       SUBTRACT 1 
+         WE     WORKLTH     WRITE BACK 1 WORD UP 
          RJ     ECSPRTY
          IX0    X0+X6       ADD 1 BACK 
          IX0    X0+X5       NEXT ECS ADDRESS 
          PL     X7,DUPFNT1 
* /---   BLOCK      DUPDATE    00 000   77/08/17  03.50 
* 
 DUPFNT2  RE     B2          READ NAMES FOLLOWING OLD ONE 
          RJ     ECSPRTY
          IX0    X0-X6
+         WE     B2          WRITE BACK OVER OLD FILE NAME
          RJ     ECSPRTY
* 
*         UPDATE THE FILE INFORMATION TABLE IN ECS. 
* 
          SA4    FITS+X3     ECS ADDRESS OF FILE INFO TABLE 
          IX0    X4+X2       STARTING ECS ADDRESS 
          SB2    X1          PRE-SET LENGTH 
          IX7    X1-X5       X7 = LENGTH LEFT TO DO 
          NG     X7,DUPFIT2 
* 
 DUPFIT1  RE     WORKLTH     READ FILE INFO WORDS 
          RJ     ECSPRTY
          SB2    X7+0        LENGTH IF DONE NEXT TIME 
          IX7    X7-X5       DECREMENT LENGTH TO DO 
          IX0    X0-X6       SUBTRACT 1 
+         WE     WORKLTH     WRITE BACK 1 WORD UP 
          RJ     ECSPRTY
          IX0    X0+X6       ADD 1 BACK 
          IX0    X0+X5       NEXT ECS ADDRESS 
          PL     X7,DUPFIT1 
* 
 DUPFIT2  RE     B2          READ  WORDS FOLLOWING OLD ONE
          RJ     ECSPRTY
          IX0    X0-X6
+         WE     B2          WRITE BACK OVER OLD INFO WORD
          RJ     ECSPRTY
          CALL   PACKSUM,TDISKU 
          EQ     DEALLX 
* 
* 
 DERR0    SX6    3           *ZRETURN* = 3 = PACK NOT LOADED
          EQ     DERRX1      *ERROR* IS ALREADY SET 
 DERR1    SX7    1           NO SUCH FILE 
          SX6    4           *ZRETURN* = 4 = BAD FILE NAME
          EQ     DERRX
 DERR1A   SX6    0           *ZRETURN* = 0 = FILE NOT FOUND 
          EQ     DERRX1      *ERROR* IS ALREADY SET 
* 
 DERRX    SA7    TERROR      STORE ERROR FLAG 
 DERRX1   SA6    TRETURN     ALSO SET *ZRETURN* 
          EQ     DEALLX      --- ERROR EXIT 
* 
* 
 DINDEX   BSS    1           INDEX TO FILE
* 
* 
 DEALLX   RETURN
* 
* 
          ENDOV 
* /---   BLOCK      RENAMOV    00 000   75/06/22  16.52 
          TITLE  RENAMOV  CHANGE NAME OF DISK FILE
*         RENAMOV 
* 
*         'THIS ROUTINE RENAMES A FILE ON AN 844 DISK PACK. 
*         'IT IS USED BY THE -RENAME- COMMAND (FILE IOPUT). 
* 
*         'ON ENTRY, IT REQUIRES--
*            OVARG1 = CURRENT FILE NAME 
*            OVARG2 = NEW FILE NAME 
* 
*         'ON EXIT, *TERROR* IS SET AS FOLLOWS--
*            -1 = FILE RENAMED SUCCESSFULLY 
*             0 = ERROR--PACK NAME (NO LONGER LOADED) 
*             1 = ERROR--OLD FILE NAME (NOT ON PACK)
*             2 = ERROR--NEW FILE NAME (ALREADY EXISTS) 
*             3 = ERROR--NEW FILE NAME (IMPROPER NAME)
* 
*            'THE FILE NAME AND INFO TABLES IN ECS ARE
*         UPDATED IF THE RENAMING IS SUCCESSFUL.
* 
*         ++ NOTE ++  'THE CM BUFFER *WORK* IS USED IN
*                     UPDATING THE ECS FILE TABLES. 
* 
* 
 RENAMOV  OVRLAY
* 
*         'CHECK IF PACK DIRECTORY IS STILL INTACT. 
* 
          CALL   PACKCHK,TDISKU 
* 
          SA1    OVARG1      OLD FILE NAME
          NG     X1,RERR1    --- ERROR IF OLD NAME NEGATIVE 
          ZR     X1,RERR1    --- ERROR IF NO OLD NAME 
          CALL   FNDFILE,TDISKU,TPNAME   X1=OLD FILE NAME, X6=FILE INDEX
          SA7    TERROR      PRESET ERROR FLAG
          ZR     X7,RERR0    --- ERROR IF PACK NOT LOADED 
          PL     X7,RERR1A   --- ERROR IF FILE NOT FOUND
          SA7    TRETURN     SET *ZRETURN* TOO
          SA6    RINDEX      SAVE OLD INDEX 
          SA1    OVARG2      NEW FILE NAME
          NG     X1,RERR3    --- ERROR IF NEW NAME NEGATIVE 
          ZR     X1,RERR3    --- ERROR IF NO NEW NAME 
          CALL   FNDFILE,TDISKU,TPNAME   X1=NEW FILE NAME, X6=FILE INDEX
          NG     X7,RERR2    --- ERROR IF NEW FILE NAME ALREADY EXISTS
          SA2    RINDEX      X2 = OLD INDEX 
          BX7    X1 
          SA7    RFNAME      SAVE NEW FILE NAME 
          IX7    X2-X6       OLD INDEX - NEW INDEX
          ZR     X7,RSAME    JUMP IF NEW NAME IN SAME SPOT
          PL     X7,RBEFORE  JUMP IF NEW NAME BEFORE OLD
          SX6    1           X6 = 1 (USED LATER ALSO) 
          BX7    -X7
          IX7    X7-X6       SUBTRACT 1 TO GET LENGTH 
          ZR     X7,RSAME    JUMP IF IN SAME SPOT 
          EQ     RAFTER      JUMP IF NEW NAME AFTER OLD 
* 
* 
 RERR0    SX6    3           *ZRETURN* = 3 = PACK NOT LOADED
          EQ     RERRX1      *ERROR* IS ALREADY SET 
 RERR1    SX7    1           IMPROPER OLD FILE NAME 
          SX6    4           *ZRETURN* = 4 = BAD FILE NAME
          EQ     RERRX
 RERR1A   SX6    0           *ZRETURN* = 0 = FILE NOT FOUND 
          EQ     RERRX1      *ERROR* IS ALREADY SET 
 RERR2    SX7    2           NEW FILE NAME ALREADY EXISTS 
          SX6    11          *ZRETURN* = 11 = DUP. FILE NAME
          EQ     RERRX
* /---   BLOCK      RENAMOV    00 000   75/06/22  16.52 
 RERR3    SX7    3           IMPROPER NEW FILE NAME 
          SX6    4           *ZRETURN* = 4 = BAD FILE NAME
          EQ     RERRX
* 
 RERRX    SA7    TERROR      STORE ERROR FLAG 
 RERRX1   SA6    TRETURN     SET *ZRETURN* TOO
          EQ     RENAMX      --- ERROR EXIT 
* 
* 
 RINDEX   BSS    1           STORAGE FOR INDEX
 RFNAME   BSS    1           NEW NAME FOR FILE
 RFINFO   BSS    1           STORAGE FOR FILE INFO WORD 
* /---   BLOCK      RAFTER     00 000   75/04/03  03.03 
* 
* 
*         'NEW FILE NAME GOES AFTER OLD ONE.
* 
 RAFTER   IX1    X2+X6       X1 = STARTING INDEX FOR MOVE (OLD INDEX+1) 
          BX2    X7          X2 = LENGTH TO BE MOVED
* 
*         'UPDATE THE FILE NAME TABLE IN ECS. 
* 
          SA0    WORK        A0 = ADDRESS OF TRANSFER BUFFER
          SX5    WORKLTH     X5 = LENGTH OF TRANSFER BUFFER 
          SA3    TDISKU      X3 = DISK UNIT 
          SA4    FNTS+X3     ECS ADDRESS OF FILE NAME TABLE 
          SB2    X2          PRE-SET LENGTH 
          IX0    X4+X1       SET ECS ADDRESS
          IX7    X2-X5       X7 = LENGTH LEFT TO DO 
          NG     X7,RAFNT2
* 
 RAFNT1   RE     WORKLTH     READ FILE NAMES
          RJ     =XECSPRTY
          SB2    X7+0        LENGTH IF DONE NEXT TIME 
          IX7    X7-X5       DECREMENT LENGTH TO DO 
          IX0    X0-X6       -1 
          WE     WORKLTH     WRITE BACK 1 WORD UP 
          RJ     =XECSPRTY
          IX0    X0+X6       +1 
          IX0    X0+X5       NEXT ECS ADDRESS 
          PL     X7,RAFNT1
 RAFNT2   RE     B2          READ FILE NAMES THAT SHOULD PRECEDE NEW ONE
          RJ     =XECSPRTY
          SA4    RFNAME      NEW NAME 
          NG     X4,"CRASH"  IF BAD FILE NAME 
          BX7    X4 
          SA7    A0+B2       STORE NEW NAME AT END
          IX0    X0-X6       -1 
          SB2    B2+1        ADD 1 TO LENGTH
          WE     B2          WRITE BACK WITH NEW FILE NAME
          RJ     =XECSPRTY
* 
*         'UPDATE THE FILE INFORMATION TABLE IN ECS.
* 
          SA4    FITS+X3     ECS ADDRESS OF FILE INFO TABLE 
          SB2    X2          PRE-SET LENGTH 
          IX0    X4+X1       SET ECS ADDRESS
          IX0    X0-X6       ADDRESS BEFORE 1ST INFO WORD TO MOVE 
          SA0    RFINFO 
          RE     1           READ INFO WORD FOR THIS FILE 
          RJ     =XECSPRTY
          SA0    WORK 
          IX0    X0+X6       RESET ECS ADDRESS
          IX7    X2-X5       X7 = LENGTH LEFT TO DO 
          NG     X7,RAFIT2
* 
 RAFIT1   RE     WORKLTH     READ FILE INFO WORDS 
          RJ     =XECSPRTY
          SB2    X7+0        LENGTH IF DONE NEXT TIME 
          IX7    X7-X5       DECREMENT LENGTH TO DO 
          IX0    X0-X6       -1 
          WE     WORKLTH     WRITE BACK 1 WORD UP 
          RJ     =XECSPRTY
          IX0    X0+X6       +1 
          IX0    X0+X5       NEXT ECS ADDRESS 
          PL     X7,RAFIT1
 RAFIT2   RE     B2          READ INFO WORDS THAT SHOULD PRECEDE THIS 
          RJ     =XECSPRTY
          SA4    RFINFO      FILE INFO WORD 
          BX7    X4 
          SA7    A0+B2       STORE THIS INFO WORD AT END
          IX0    X0-X6       -1 
          SB2    B2+1        ADD 1 TO LENGTH
          WE     B2          WRITE BACK WITH THIS INFO WORD 
          RJ     =XECSPRTY
* /---   BLOCK      RAFTER     00 000   75/04/03  03.03 
          EQ     RPSUM       --- GET NEW SUMCHECK AND EXIT
* /---   BLOCK      RBEFORE    00 000   75/01/29  03.41 
* 
* 
*         'NEW FILE NAME GOES BEFORE OLD ONE. 
* 
 RBEFORE  BX1    X6          X1 = STARTING INDEX FOR MOVE 
          BX2    X7          X2 = LENGTH TO BE MOVED
* 
*         'UPDATE THE FILE NAME TABLE IN ECS. 
* 
          SB1    1           B1 = 1 (STANDARD INCREMENT)
          SA0    WORK        A0 = ADDRESS OF TRANSFER BUFFER
          SX5    WORKLTH     X5 = LENGTH OF TRANSFER BUFFER 
          SA3    TDISKU      X3 = DISK UNIT 
          SA4    FNTS+X3     ECS ADDRESS OF FILE NAME TABLE 
          SX6    B1          X6 = 1 
          SB2    X2          PRE-SET LENGTH 
          IX4    X4+X1       PRE-SET ECS ADDRESS
          IX0    X4+X2       ADDRESS AFTER LAST NAME TO MOVE
          IX7    X2-X5       X7 = LENGTH LEFT TO DO 
          NG     X7,RBFNT2
          IX0    X0-X5       SET ECS ADDRESS
* 
 RBFNT1   RE     WORKLTH     READ FILE NAMES
          RJ     =XECSPRTY
          SB2    X7          LENGTH IF DONE NEXT TIME 
          IX4    X0-X7       ECS ADDRESS IF DONE NEXT TIME
          IX7    X7-X5       DECREMENT LENGTH TO DO 
          IX0    X0+X6       ADD 1
          WE     WORKLTH     WRITE BACK 1 WORD DOWN 
          RJ     =XECSPRTY
          IX0    X0-X6       SUBTRACT 1 BACK
          IX0    X0-X5       NEXT ECS ADDRESS IF NOT DONE 
          PL     X7,RBFNT1
 RBFNT2   BX0    X4          GET SAVED ECS ADDRESS
          SA4    RFNAME      X4 = NEW NAME
          NG     X4,"CRASH"  IF BAD FILE NAME 
          SA0    A0+B1       LEAVE ROOM FOR IT
          RE     B2          READ FILE NAMES THAT SHOULD FOLLOW NEW ONE 
          RJ     =XECSPRTY
          BX7    X4 
          SA0    A0-B1       BACK UP
          SA7    A0          PUT NEW FILE NAME AT START 
          SB2    B2+B1       INCREMENT LENGTH BY 1
          WE     B2          WRITE BACK WITH NEW FILE NAME
          RJ     =XECSPRTY
* /---   BLOCK      RBFIT      00 000   76/05/17  22.11 
* 
*         'UPDATE THE FILE INFORMATION TABLE IN ECS.
* 
          SA4    FITS+X3     ECS ADDRESS OF FILE INFO TABLE 
          SB2    X2          PRE-SET LENGTH 
          IX4    X4+X1       PRE-SET ECS ADDRESS
          IX0    X4+X2       ADDRESS AFTER LAST INFO WORD TO MOVE 
          IX7    X2-X5       X7 = LENGTH LEFT TO DO 
          SA0    RFINFO      STORAGE FOR FILE INFO WORD 
          RE     1           READ INFO WORD FOR THIS FILE 
          RJ     =XECSPRTY
          SA0    WORK 
          NG     X7,RBFIT2
          IX0    X0-X5       SET ECS ADDRESS
* 
 RBFIT1   RE     WORKLTH     READ FILE INFO WORDS 
          RJ     =XECSPRTY
          SB2    X7          LENGTH IF DONE NEXT TIME 
          IX4    X0-X7       ECS ADDRESS IF DONE NEXT TIME
          IX7    X7-X5       DECREMENT LENGTH TO DO 
          IX0    X0+X6       ADD 1
          WE     WORKLTH     WRITE BACK 1 WORD DOWN 
          RJ     =XECSPRTY
          IX0    X0-X6       SUBTRACT 1 BACK
          IX0    X0-X5       NEXT ECS ADDRESS IF NOT DONE 
          PL     X7,RBFIT1
 RBFIT2   BX0    X4          GET SAVED ECS ADDRESS
          SA4    RFINFO      X4 = FILE INFO WORD
          SA0    A0+B1       LEAVE ROOM FOR IT
          RE     B2          READ INFO WORDS THAT SHOULD FOLLOW THIS ONE
          RJ     =XECSPRTY
          BX7    X4 
          SA0    A0-B1       BACK UP
          SA7    A0          PUT THIS INFO WORD AT START
          SB2    B2+B1       INCREMENT LENGTH BY 1
          WE     B2          WRITE BACK WITH THIS INFO WORD 
          RJ     =XECSPRTY
          EQ     RPSUM       --- GET NEW SUMCHECK AND EXIT
* 
* 
 RSAME    SA3    TDISKU 
          SA4    FNTS+X3     ECS ADDRESS OF FILE NAME TABLE 
          SA0    RFNAME 
          IX0    X4+X2
          WE     1           WRITE NEW NAME IN PLACE OF OLD 
          RJ     =XECSPRTY
* 
*         'FORM NEW PACK DIRECTORY SUM-CHECK. 
* 
 RPSUM    CALL   PACKSUM,TDISKU 
* 
* 
 RENAMX   RETURN
* 
* 
          ENDOV 
* /---   BLOCK      RETYPOV    00 000   77/11/03  02.35 
          TITLE  RETYPE - CHANGE FILE TYPE
 RETYPOV  OVRLAY
* 
*  RETYPOV
* 
*    ROUTINE REPLACES THE 6-BIT FILE TYPE FIELD IN FIW
* 
* 
*    ON ENTRY';   OVARG1 = FILE NAME
*                OVARG2 = NEW FILE TYPE 
* 
*    ON EXIT';   *TERROR*  IS SET AS FOLLOWS';
*        -1     OPERATION COMPLETED W/O PROBLEMS
*         0      ERROR -- PACK NOT LOADED 
*         1      ERROR -- FILE DOES NOT ON PACK 
*         2      ERROR -- NEW FILE TYPE FIELD INVALID 
* 
*   USES  A/X 1-3, 6-7
* 
* 
*  BEFORE STARTING, CHECK PACK SUMCHECK 
* 
          CALL   PACKCHK,TDISKU 
* 
          SA1    OVARG1      GET FILE NAME
          NG     X1,RTERR1   -- FILE NAME LEGALITY
          ZR     X1,RTERR1   -- 
* 
*  FIND FILE ON PACK SET BY TDISKU/TPNAME, RETURNS';
*    X1 = FILE NAME, X6 = FILE INDEX, X7 = *ERROR* RETURN 
* 
          CALL   FNDFILE,TDISKU,TPNAME
          SA7    TERROR      PRESET ERROR RETURN
          ZR     X7,RTERR0   -- PACK NOT LOADED 
          PL     X7,RTERR1A  -- FILE NOT FOUND
          SA7    TRETURN     SET *ZRETURN* TOO
* 
          SA3    OVARG2      GET NEW FILE TYPE
          MX1    -6          MASK FIELD (COMPLEMENT)
          BX2    -X1*X3      X2 _ 6 BITS  (FILE TYPE) 
          BX3    X1*X3       X3 _ REST OF INPUT ARGUMENT
          NZ     X3,RTERR2   --  UNUSED FIELD NOT EMPTY 
          ZR     X2,RTERR2   --  USED FIELD EMPTY 
* 
          SA3    TDISKU      GET DISK UNIT NUMBER 
          SA3    FITS+X3     GET ECS ADDR OF FILE INFO TABLE
          IX0    X3+X6       ADDR + FILE INDEX = ECS PTR
          SA0    RTFINFO     CM BUFFER FOR FIW  (1 WD)
* 
+         RE     1           READ FILE INFO WORD FROM ECS 
          RJ     =XECSPRTY
* 
          SA3    A0          READ WORD FROM CM BUFFER 
          LX1    30          MOVE MASK TO PROPER POSITION 
          BX1    X1*X3       CLEAR FILE TYPE FIELD IN FIW 
          LX2    30          MOVE NEW TYPE TO SAME POSITION 
          BX6    X1+X2       UNION NEW FILE TYPE INTO FIW 
          SA6    A0          PUT NEW FIW IN CM TO ECS WORD
* 
+         WE     1           WRITE OUT NEW FILE INFO WORD 
          RJ     =XECSPRTY
* 
*   MODIFY COMPLETE, GET NEW PACK DIRECTORY CHECKSUM, EXIT
* 
          CALL   PACKSUM,TDISKU 
* 
 RETYPX   RETURN             --- EXIT TO CALLING PROGRAM
* 
* 
 RTERR0   SX6    3           *ZRETURN* = 3 = PACK NOT LOADED
          EQ     RTERRX1     *ERROR* IS ALREADY SET 
* 
 RTERR1   SX7    1           FILE DOES NOT EXIST
          SX6    4           *ZRETURN* = 4 = BAD FILE NAME
          EQ     RTERRX 
* 
 RTERR1A  SX6    0           *ZRETURN* = 0 = FILE NOT FOUND 
          EQ     RTERRX1     *ERROR* IS ALREADY SET 
* 
 RTERR2   SX7    2           INVALID NEW TYPE FIELD 
* /---   BLOCK      RETYPOV    00 000   77/11/03  02.35 
          SX6    12          *ZRETURN* = 12 = BAD FILE TYPE 
          EQ     RTERRX 
* /---   BLOCK      RETYPOV    00 000   77/11/03  02.35 
* 
 RTERRX   SA7    TERROR      PASS *ERROR* RETURN
 RTERRX1  SA6    TRETURN     SET *ZRETURN* TOO
          EQ     RETYPX 
* 
* 
 RTFINFO  BSS    1           STORAGE FOR FILE INFO WORD 
* 
* 
          ENDOV 
* /---   BLOCK      DIOGOV     00 000   77/08/17  04.45 
          TITLE  DIOGOV  DISK I/O PROCESSING
*         DIOGOV
* 
*            'THIS OVERLAY PROCESSES DISK I/O REQUESTS FROM 
*         THE FOLLOWING COMMANDS--
*            -DREAD-
*            -DWRITE- 
*            -DSKREAD-
*            -DSKWRIT-
*         'IT IS CALLED FROM ROUTINE *DIOGO* (FILE IOPUT) 
* 
*         'ON ENTRY-- 
*            OVARG1 = BLOCK SIZE (BLKLTH=320, DBSIZE=64)
* 
* 
 DIOGOV   OVRLAY
          SA5    A5          GUARANTEE X5 INTACT
          LX5    18          POSITION EXTRA STORAGE POINTER 
          SA1    X5+B5
          BX5    X1          TO X5 FOR -NGETVAR-
          BX6    X1 
          SA6    DIOSAVE
          NGETVAR            GET BLOCK NUMBER 
          SX6    X1 
          NG     X6,DIOERR2  --- ERROR IF BLOCK NUMBER NEGATIVE 
          SA6    DIOBLK      SAVE STARTING BLOCK NUMBER 
          SA1    DIOSAVE     SET UP NEXT -GETVAR- CODE
          BX5    X1 
          LX5    XCODEL 
          NGETVAR            GET ECS ADDRESS
          SX6    X1-1 
          NG     X6,DIOERR3  --- ERROR IF ECS ADDRESS NOT POSITIVE
          SA6    DIOECS      SAVE RELATIVE ECS ADDRESS
          SA1    DIOSAVE     SET UP NEXT -GETVAR- CODE
          BX5    X1 
          LX5    2*XCODEL 
          NGETVAR            GET BLOCK COUNT
          SX6    X1-1        X6 = BLOCK COUNT-1 
          NG     X6,DIOERR2  --- ERROR IF BLOCK COUNT NOT POSITIVE
          SA1    TDISKU      X1 = DISK UNIT 
          SA2    TPNAME 
          SA3    PNAMES+X1   CURRENT PACK ON THAT UNIT
          BX4    X2-X3
          ZR     X3,DIOERR0  --- ERROR IF NO PACK LOADED
          NZ     X4,DIOERR0  --- ERROR IF PACK NAME NON-AGREEMENT 
          SA1    TFINFO      X1 = FILE INFORMATION WORD 
          ZR     X1,DIOERR1  --- ERROR IF FILE INFO WORD NOT SET
          SA2    DIOBLK      X2 = STARTING BLOCK NUMBER 
          BX3    X1 
          AX3    24 
          MX0    -6 
          BX3    -X0*X3      DISK SPACE COUNT 
          SX4    DSBLKS*BLKLTH  WORDS PER DISK SPACE
          IX3    X3*X4       X3 = NUMBER OF WORDS IN FILE 
          SA4    OVARG1      X4 = BLOCK SIZE
          IX7    X2*X4       STARTING WORD
          IX7    X7-X3
          PL     X7,DIOERR2  --- ERROR IF STARTING WORD TOO BIG 
          IX7    X2+X6       ENDING BLOCK NUMBER
          IX7    X7*X4       ENDING WORD
          IX7    X7-X3
          PL     X7,DIOERR2  --- ERROR IF ENDING WORD TOO BIG 
          SX6    X6+1 
          SA6    DIOSAVE     SAVE BLOCK COUNT 
          SA3    TDISKU      X3 = DISK UNIT 
* /---   BLOCK      DIOGOV     00 000   77/08/17  04.25 
*---
          SA4    OVARG1      BLOCK SIZE 
          SX4    X4-BLKLTH
          ZR     X4,DIOGO1   JUMP IF OLD BLOCK SIZE 
*---
* 
*         X1 = FILE INFO WORD 
*         X2 = SECTOR NUMBER
*         X3 = DISK UNIT
* 
          CALL   DSKADDR     SETS *DISKINF* TO DISK ADDRESS 
* 
*-----
          EQ     DIOGO2 
* 
*         X1 = FILE INFO WORD 
*         X2 = BLOCK NUMBER 
*         X3 = DISK UNIT
* 
 DIOGO1   BSS    0
          CALL   DISKADD     SETS *DISKINF* TO DISK ADDRESS 
* 
 DIOGO2   BSS    0
*-----
          SA1    TBXSTOR
          CALL   SETSTOR     SET UP *STORWRD* 
          SA1    DIOECS      X1 = RELATIVE ECS ADDRESS
          SA4    STORWRD     X4 = EXTRA STORAGE ECS POINTERS
          NG     X4,SERXECS  --- SYSTEM ERROR IF ECS BASE NEGATIVE
          AX4    18          POSITION ECS LENGTH FOR STATION AT RIGHT 
          SA2    DIOSAVE     X2 = NUMBER OF BLOCKS
          SA3    OVARG1      BLOCK SIZE 
          IX0    X2*X3
          SX3    X4          LENGTH OF STORAGE
          IX3    X3-X0
          IX3    X3-X1       LENGTH-N*SIZE-(START-1)
          NG     X3,DIOERR3  --- FINAL ECS ADDRESS TOO BIG
          AX4    18          X4 = BASE OF ECS FOR THIS STATION
          IX6    X4+X1       ADD OFFSET FOR THIS REQUEST
          LX6    36          POSITION ECS ADDRESS 
          SA1    DISKINF     RETRIEVE OTHER DISK INFO 
          BX6    X6+X1
          SA6    A1          STORE DISK INFORMATION PACKAGE 
          SX7    -1          I/O REQUEST OK 
          SA7    TERROR 
          SA1    DIOTYPE     X1 = DISK I/O REQUEST TYPE 
*                            X2 = NUMBER OF BLOCKS
          EQ     DIOREQ1     --- EXIT TO MAKE DISK I/O REQUEST
* 
 SERXECS  BX1    X4 
          EXECERR 918        SYSTEM ERROR, BAD ECS LOCATION.
* 
* 
 DIOERR0  SX7    0           PACK NOT LOADED
          EQ     DIOERRX
 DIOERR1  SX7    1           FILE INFO WORD NOT SET 
          EQ     DIOERRX
 DIOERR2  SX7    2           BLOCK NUMBER OUT OF RANGE
          EQ     DIOERRX
 DIOERR3  SX7    3           ECS ADDRESS OUT OF RANGE 
          EQ     DIOERRX
* 
 DIOERRX  SA7    TERROR      STORE ERROR FLAG 
          EQ     =XCKPROC    --- ERROR RETURN 
* 
* 
 DIOBLK   BSS    1           STARTING BLOCK NUMBER
 DIOECS   BSS    1           STARTING ECS ADDRESS (RELATIVE)
 DIOSAVE  BSS    1           (EVENTUALLY HOLDS BLOCK COUNT) 
* 
* 
          ENDOV 
* /---   BLOCK      FBIT       00 000   77/10/18  02.34 
          TITLE  FBIT COMMAND 
* 
*         -FBIT- COMMAND
*         SETS OR UNSETS -BACKUP- BIT IN FILE INFO WORD 
* 
*         (OVARG1) = -1 IF -SYSFILE-, 0 IF -FBIT- 
* 
*         FOR -SYSFILE-, (TBINTSV) = FILE NAME
*                        (TBINTSV+1) = 0 IF OFF, 1 IF ON
*                        (TBINTSV+3) = ADDRESS OF FIP 
* 
* 
 FBITOV   OVRLAY
          INTLOK X,I.DDIR,W  INTERLOCK DISK DIRECTORIES 
          CALL   S=UDSKR     READ DISK PARAMETERS 
          SA1    OVARG1      CHECK IF -FBIT- OR -SYSFILE- 
          ZR     X1,FBIT1    --- IF -FBIT-
          SA1    TBINTSV     (X1) = FILE NAME 
          CALL   FNDFILE,TDISKU,TPNAME
          PL     X7,FBERR    EXIT IF FILE NOT FOUND 
          BX6    X0 
          SA6    FBWK        SAVE ECS ADDRESS OF INFO WORD
          SA1    A0 
          BX6    X1          SAVE FILE INFO WORD
          SA6    FBWK1
          SA1    TBINTSV+1   (X1) = 0 FOR OFF, 1 FOR ON 
          EQ     FBIT2
 
 FBIT1    BSS    0
          CALL   GETFILE     GET FILE INFO WORD 
          PL     X7,FBERR    EXIT IF FILE NOT FOUND 
          BX6    X0 
          SA6    FBWK        SAVE ECS ADDRESS OF INFO WORD
          SA1    A0 
          BX6    X1          SAVE FILE INFO WORD
          SA6    FBWK1
          SA5    A5 
          LX5    XCODEL      POSITION NEXT -GETVAR- CODE
          NGETVAR            GET -OFF- OR -ON-
 FBIT2    BSS    0
          MX6    1
          ZR     X1,FBITOFF  JUMP IF -OFF-
          SA1    FBWK1       LOAD FILE INFO WORD
          BX6    X1+X6
          SA6    A1          STORE WITH BIT SET 
          EQ     FBIT10 
* 
 FBITOFF  SA1    FBWK1       LOAD FILE INFO WORD
          BX6    -X6*X1 
          SA6    A1          STORE WITH BIT CLEAR 
* 
 FBIT10   SA0    FBWK1
          SA1    FBWK        ECS ADDRESS OF FILE INFO WORD
          BX0    X1 
+         WE     1           RE-WRITE FILE INFO WORD
          RJ     ECSPRTY
          MX6    0           MARK NO ERROR
          SA6    TERROR 
          MX7    -1          ZRETURN WILL BE -1 IF -SYSFILE-
 FBEXIT   SA1    OVARG1      CHECK IF -FBIT- OR -SYSFILE- 
          ZR     X1,FBEXIT2  --- IF -FBIT-
          SA7    TRETURN     SET ZRETURN IF -SYSFILE- 
          PL     X7,FBEXIT2  --- IF FILE WAS NOT FOUND
          SA1    TBINTSV+3   (X1) = ADDRESS OF FIP
          SA1    X1+/FIP/MFF (X1) = MISC. FIP FIELDS
          MX6    1
          LX6    1+/MFF/S.FBIT SHIFT MASK TO POSITION 
          SA2    TBINTSV+1   (X2) = 0 IF CLEARED, 1 IF SET
          ZR     X2,FBEXIT1  --- IF BACKUP BIT WAS CLEARED
          BX6    X1+X6       SET BIT IN FIP 
          SA6    A1          STORE
          EQ     FBEXIT2
 
 FBEXIT1  BX6    -X6*X1      CLEAR BIT IN FIP 
          SA6    A1          STORE
 
 FBEXIT2  INTCLR X,I.DDIR    RELEASE DIRECTORY INTERLOCK
* /---   BLOCK      FBIT       00 000   77/10/18  02.34 
          EQ     PROCESS     --- EXIT 
 
 FBERR    MX6    -1          ERROR = -1 IF FILE NOT FOUND 
          MX7    0           ZRETURN WILL BE 0 IF -SYSFILE- 
          EQ     FBEXIT 
 
 FBWK     OVDATA
 FBWK1    OVDATA
 
          ENDOV 
* /---   BLOCK      TERMSET    00 000   74/03/12  01.48 
          TITLE  -TERMSET-
* 
* 
*         -TERMSET- 
*         SETS UP A CALL TO GETUNIT TO GET THE TERM TABLE,
*         WHICH IS UNIT NUMBER ZERO IN THE UNIT LOC TABLE.
* 
*         RETURNS UNIT TO BRANCH TO IN ARG WHICH IS POINTED 
*         TO BY (OVARG1) AT ENTRY.
*         THIS ARG IS -1 IF THE TERM IS NOT FOUND.
* 
          EXT    GETUNIT
* 
* 
 TERMSET  OVRLAY
          SA1    OVARG1      LOAD ARGUMENT ADDRESS
          BX6    X1 
          SA6    ARG         SAVE ARG 
          MX5    0           UNIT=0 
          RJ     GETUNIT
          SB2    B5          ADDRESS OF TERM TABLE (UNIT) TO B2 
          SA1    ARG
          SB1    X1 
          SB3    B1          SET UP ARGS FOR SEARCH 
          SA1    B1 
          AX1    12 
          MX0    12 
          BX6    -X0*X1      LEFT JUSTIFY TERM, AND CLEAN EXTRA BITS
          SA6    B1 
          RJ     LOCATE      FIND TERM
          EQ     TERMEX      EXIT 
* 
 ARG      BSS    1
* 
* 
* /---   BLOCK      LOCATE     00 000   76/05/29  00.21 
          TITLE  LOCATE 
*         LOCATE
* 
*         DOES BINARY CHOP SEARCH TO FIND TERM. 
* 
*         UPON ENTRY, 
*            (B1) = ADDRESS OF TERM, WHICH IS RIGHT JUSTIFIED 
*            (B2) = ADDRESS OF TERM TABLE 
*            (B3) = ADDRESS OF RETURN VARIABLE
* 
*         UPON EXIT,
*            CONTENTS OF RETURN VARIABLE';
* 
*         +      UNIT NUMBER TO BRANCH TO IF TERM FOUND,
*         0      IF TERM NOT FOUND
*         -      COMPLEMENT OF UNIT NUMBER TO BRANCH TO FOR 
*                   CATCH-ALL TERM
* 
* 
*         BREAK EVEN POINT FOR STRAIGHT SEARCH VS BINARY CHOP 
 BKEVEN   EQU    10 
* 
* 
* 
* 
 LOCATE   EQ     *
          SA2    B1          TERM TO FIND TO X2 
          SA5    B2          NO. OF TERMS TO X5 
          ZR     X2,NOTFND   --- EXIT IF NO TERM ENTERED
          ZR     X5,NOTFND   EXIT IF NO TERMS TO SEARCH 
          SB1    1           UIC TO B1
          SB7    X5          NO. TERMS TO B7
          MX0    12          UNIT POINTER MASK
          SB6    X5-BKEVEN
          NG     B6,SHORT    DO STRAIGHT SEARCH IF IT WILL BE FASTER
          AX5    1
          BX7    X5          FIRST CHOP OFFSET TO X7
          SB2    B2+B1       ADDRESS OF TERM TABLE TO B2
* 
*         BINARY CHOP LOOP
* 
 BCLOOP   SA1    B2+X7       LOAD TERM FROM TABLE 
          BX3    -X0*X1      CLEAR UNIT POINTER 
          IX3    X2-X3       COMPARE TERMS
          ZR     X3,FINDEX   TERM FOUND 
          AX5    1
          ZR     X5,ENDGO 
          NG     X3,NGSET    BRANCH TO MOVE BACK IN TABLE 
          IX7    X7+X5       NEW POINTER TO TABLE TO X7 
          SB6    B1          FLAG THAT LAST MOVE FORWARD TO B6
          EQ     BCLOOP 
* 
 NGSET    IX7    X7-X5       NEW TABLE INDEX TO X7
          SB6    -B1         FLAG THAT LAST MOVE BACKWARD TO B6 
          EQ     BCLOOP 
* 
* 
* 
 ENDGO    NG     X3,NGEND 
          NG     B6,LOSTEX   NOT FOUND IF REVERSAL IN SINGLE STEP 
          SX7    X7+B1
          SB4    X7 
          EQ     B4,B7,LOSTEX  NOT FOUND IF RUNS OFF END
          SB6    B1          FLAG LAST MOVE FORWARD 
          EQ     BCLOOP 
* 
 NGEND    PL     B6,LOSTEX
          SX7    X7-1 
          NG     X7,LOSTEX   NOT FOUND IF RUN OFF TABLE 
          SB6    -B1         FLAG THAT LAST MOVE BACKWARD 
          EQ     BCLOOP 
* 
* 
* 
*         TERM FOUND
* 
 FINDEX   BX6    X1*X0       GET UNIT POINTER 
          LX6    12          RIGHT JUSTIFY
          SA6    B3          STORE UNIT NUMBER, 
          EQ     LOCATE      --- EXIT 
* 
* 
*         FASTEST SEARCH STRAIGHT, DUE TO SHORT UNIT TABLE LENGTH 
* 
 SHORT    SB4    B0 
* /---   BLOCK      LOCATE     00 000   76/05/28  21.23 
 SLOOP    SB4    B4+B1       INCREMENT
          SA1    B2+B4
          BX3    -X0*X1 
          BX3    X3-X2       CHECK IF FOUND 
          ZR     X3,FINDEX   DONE IF TERM FOUND 
          NE     B4,B7,SLOOP LOOP IF MORE LIST
          SB2    B2+B1       ADDRESS OF TERM TABLE TO B2
* 
*         TERM REQUESTED NOT FOUND, CHECK FOR CATCH-ALL TERM
* 
 LOSTEX   SA1    B2          GET FIRST ENTRY IN TABLE 
          BX3    -X0*X1      MASK OFF UNIT
          NZ     X3,NOTFND   NO BLANK TERM
          BX6    X1*X0       GET UNIT POINTER 
          LX6    12          RIGHT JUSTIFY
          BX6    -X6         COMPLEMENT FOR CATCH-ALL TERM
          SA6    B3 
          EQ     LOCATE      ---EXIT
* 
 NOTFND   SX6    0
          SA6    B3          STORE AS NOT FOUND TERM
          EQ     LOCATE      ---EXIT
* 
* 
 TERMEX   RETURN
* 
* 
          ENDOV 
* /---   BLOCK      -ATTACHF-  00 000   79/11/15  20.58 
          TITLE  -ATTACHF- AND -FILEF-
* 
*         -ATTACHF-  (CODE = 449, OVARG1 = 0) 
*         -FILEF-    (CODE = 471, OVARG1 = 1) 
* 
*         ATTACHF FIP;KEYWORD,VALUE;KEYWORD,VALUE;
*                 KEYWORD;VALUE 
* 
*         THE FIRST ARGUMENT SPECIFIES A FILE INFOR-
*         MATION PACKET (FIP), WHICH CONTAINS THE FILE
*         NAME, AN OPTIONAL PACK NAME, A LOCATION FOR 
*         INFO RETURNED FROM MASTOR, AND A LOCATION FOR 
*         THE FILE INFORMATION WORD.  THE OPTIONAL KEYWORDS 
*         ARE AS FOLLOWS -- 
* 
*                PACK        PACK NAME
*                FILE        FILE NAME
*                MODE        0 = R/O = DEFAULT, -1 = R/W
* 
*         ONLY THE *PACK* AND *FILE* TAGS ARE VALID 
*         WITH -FILEF-
* 
* /---   BLOCK      -ATTACHF-  00 000   79/11/15  20.46 
* 
*         MASTOR REQUEST FORMAT --
*         MASRQ+2 - FILE NAME 
*         MASRQ+3 - OPTIONAL PACK NAME OR ZERO
*         MASRQ+4 - 1/ATTACH TYPE(READ=0,WRITE=1) 
*                   1/COMMAND(0=ATTACHF,1=FILEF)
*                   58/UNUSED 
*         MASRQ+5 - UNUSED(NEEDED FOR REPLY ONLY) 
*         MASRQ+6 - STATION NUMBER PLUS 1 OF ATTACHER 
* 
*         MASTOR REPLY FORMAT --
*         MASRQ+2 - FILE NAME 
*         MASRQ+3 - PACK NAME 
*         MASRQ+4 - 1/ATTACH TYPE 
*                   1/COMMAND(0=ATTACHF,1=FILEF), 
*                   31/UNUSED,
*                   9/UNIT NO.,18/POINTER TO FILE INFO WORD 
*         MASRQ+5 - FILE INFO WORD
*         MASRQ+6 - ATTACHED STATION + 1
*         MASRQ+7 - ERROR CODE OR -1 IF ALL OKAY
* 
*         THE PACK NAME IS RETURNED TO THE SECOND WORD OF 
*         THE FIP FOLLOWING A SUCCESSFUL ATTACH.
* 
*         MASRQ+4 IS RETURNED TO THE THIRD WORD OF THE
*         FIP FOLLOWING A SUCCESSFUL ATTACH.
* 
*         THE FILE INFO WORD IS RETURNED TO THE FOURTH WORD 
*         OF THE FIP FOLLOWING A SUCCESSFUL ATTACH. 
* 
*         ON COMPLETION *TRETURN* IS SET AS FOLLOWS 
*         -2 = REDUNDANT ATTACH 
*         -1 = ATTACH SUCCESSFUL OR REDUNDANT 
*          0 = ERROR -- FILE DOES NOT EXIST 
*          1 = ERROR -- FILE ATTACHED TO ANOTHER STATION
*                        (SEE *TERROR* FOR STATION NUMBER)
*          2 = ERROR -- IMPROPER MASTOR REQUEST 
*          3 = ERROR -- BAD PACK NAME 
*          4 = ERROR -- BAD FILE NAME 
* 
*         *TERROR* IS SET TO THE STATION NUMBER OF THE
*         ATTACHED STATION WHEN *TRETURN* IS 4, OTHERWISE 
*         UNUSED. 
* 
* /---   BLOCK      SETUP      00 000   80/02/07  04.19 
 ATTFOV   OVRLAY
* 
* *       SAVE ATTACHF/FILEF FLAG 
* 
          SA1    OVARG1      X1 = ATTACHF/FILEF FLAG
          NG     X1,TAGSDONE --- IF -SYSFILE- COMMAND 
          BX6    X1 
          SA6    SAVETYP
* 
* *       CHECK REQUEST BUFFERS FOR SPACE AND SAVE *KEY*
* 
          CALLX  REQCHK 
          CALL   RESTKEY     RESTORE *KEY*
* 
* *       UNPACK ARGUMENTS INTO *VARBUF*
* 
          SX6    63          X6 = MAX. NUMBER OF ARGUMENTS
          SA5    A5          RETRIEVE COMMAND WORD
          CALL   GETARGS     MOVE GETVAR CODES TO *VARBUF*
          SA6    NUMARGS     STORE NUMBER OF ARGUMENTS
* 
* *       PROCESS FIRST ARGUMENT (FIP)
* 
          SA1    VARBUF      X1 = FIRST GETVAR CODE 
          BX5    X1 
          NGETVAR            A1 = ADDR. OF FIP
 
          SX6    A1 
          SA6    FIPADDR     SAVE IT
 
          SX1    0           MARK NOT IN -CALC- FOR FIPCHK
          CALL   FIPCHK      CHECKS BOUNDS ON FIP 
 
          SX6    1
          SA6    ARGSDONE    FIRST ARG HAS BEEN PROCESSED 
* /---   BLOCK      TAGS       00 000   80/02/07  04.54 
* 
* *       LOOP TO PROCESS TAGS
* 
 TAGLOOP  SA1    ARGSDONE 
          SA2    NUMARGS
          IX2    X1-X2
          ZR     X2,TAGSDONE --- IF ALL TAGS PROCESSED
 
          SX6    X1+2        INCREMENT COUNT OF ARGS DONE 
          SA6    A1          STORE INCREMENTED COUNT
 
          SA1    VARBUF+X1   X1 = NEXT GETVAR CODE
          LX1    XCODEL      SHIFT CODE TO BITS 0-19
          SB1    X1          B1 = TAG NUMBER
 
          SA1    A1+1        X1 = NEXT GETVAR CODE
          BX5    X1 
          JP     TAGTAB+B1   --- PROCESS THIS TAG 
* 
* *       JUMP TABLE FOR KEYWORD ARGUMENTS
* 
 TAGTAB   BSS    0
 
+         EQ     FILENAM     0 = FILE NAME
+         EQ     PACKNAM     1 = PACK NAME
+         EQ     ACCMODE     2 = ACCESS MODE
* 
* *       GET FILE NAME 
* 
 FILENAM  X      GETFILV,ARGSDONE,ACCT,FILE 
          SA1    FILE        X1 = FILE NAME 
          BX6    X1 
          SA1    FIPADDR     X1 = ADDR OF FIP 
          SA6    X1+/FIP/FILE  STORE FILE NAME IN FIP 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
* 
* *       GET PACK NAME 
* 
 PACKNAM  NGETVAR            X1 = PACK NAME 
          BX6    X1 
          SA1    FIPADDR     X1 = ADDR. OF FIP
          SA6    X1+/FIP/DIR  STORE PACK NAME IN FIP
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
* 
* *       GET ACCESS MODE 
* 
 ACCMODE  NGETVAR            X1 = -1 FOR R/W, 0 FOR R/O 
          SX6    MA.READ     PRESET FOR R/O ACCESS
          PL     X1,ACCMOD1  --- IF R/O ACCESS
          SX6    MA.RW       SET FOR R/W ACCESS 
 ACCMOD1  BSS    0
          SA1    FIPADDR     X1 = ADDR. OF FIP
          SA1    X1+/FIP/MFF  (X1) = MISC. FIP FIELDS 
          MX0    -/MFF/M.ATTACH  (X0) = MASK FOR ATTACH MODE
          LX0    /MFF/S.ATTACH  SHIFT MASK TO POSITION
          BX1    X0*X1       CLEAR OLD ATTACH MODE
          LX6    /MFF/S.ATTACH  POSITION NEW ATTACH MODE
          BX6    X1+X6
          SA6    A1          STORE IN FIP 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
* /---   BLOCK      PREPARE    00 000   80/02/07  04.19 
* 
* *       PREPARE MASTOR REQUEST
* 
 TAGSDONE SA1    FIPADDR     X1 = ADDR. OF FIP
 
          SX6    MS.AFFS     X6 = -ATTACH- MASTOR REQ. CODE 
          SA6    MASRQ       SET REQUEST CODE 
 
          SA2    X1+/FIP/FILE  (X2) = FILE NAME 
          ZR     X2,ATTFE4   --- IF FILE NAME IS BAD
          NG     X2,ATTFE4   --- IF FILE NAME IS BAD
          BX6    X2          (X6) = FILE NAME 
          SA6    MASRQ+2     STORE FILE NAME IN REQUEST 
 
          SA2    X1+/FIP/DIR  (X2) = PACK NAME
          NG     X2,ATTFE3   --- IF PACK NAME IS BAD
          BX6    X2          (X6) = PACK NAME 
          SA6    MASRQ+3     STORE PACK NAME IN MASTOR REQ. 
 
          SA2    SAVETYP    X2 = 0 IF ATTACHF, 1 IF FILEF 
          NZ     X2,TAGSDON2 --- IF EXECUTING -FILEF- 
 
          CALL   ZFILACC,X1  (X1) = -1 FOR R/W, 0 FOR R/O 
          MX0    1           X0 = MASK FOR SIGN BIT 
          BX6    X0*X1       X6 = SIGN BIT = ACCESS MODE
          EQ     TAGSDON3 
 
 TAGSDON2 MX6    1           SET -FILEF- BIT
          LX6    59          SHIFT TO BIT 58
 
 TAGSDON3 SA6    MASRQ+4     STORE ACCESS MODE/FILEF FLAGS
 
          SA1    STATION     X1 = STATION NUMBER
          SX6    X1+1        X6 = STATION + 1 
          SA6    MASRQ+6     STORE STATION NO. IN REQUEST 
* /---   BLOCK      REQUEST    00 000   80/02/07  04.54 
* 
* *       SAVE COMMON, STORAGE, ETC. AND POST REQUEST 
* 
          CALL   SAVKEY 
          CALL   SAVLES 
          CALL   S=MAS,MASRQ,STATION
* 
* *       WAIT FOR REQUEST TO COMPLETE
* 
 ATTFX2   TUTIM  -1,,IOKEY
 
          SA1    KEY
          SX1    X1-IOKEY 
          NZ     X1,ATTFX2   --- IF NOT IOKEY 
* 
* *       RETURN COMPLETION STATUS TO REQUESTOR 
* 
          SA1    MASRQ+7     X1 = MASTOR STATUS WORD
          BX6    X1 
          SA6    TRETURN     *ZRETURN* = COMPLETION STATUS
* 
* *       RETURN NUMBER OF ATTACHED STATION 
* 
          SA1    MASRQ+6     X1 = ATTACHED STATION + 1
          SX6    X1-1        GET EXACT STATION NUMBER 
          SA6    TERROR      *ERROR* = ATTACHED STATION 
* 
* *       RESTORE COMMON, LESSON, ETC.
* 
          CALL   RESTKEY     RESTORE *KEY*
          CALL   RESTLES     RESTORE COMMON, LESSON, ETC. 
* 
* *       RETURN FIP TO CALLER
* 
          SA1    FIPADDR     X1 = ADDR. OF FIP
          X      NEWFIPV,(MASRQ+2),X1  CONVERT TO NEW FORMAT
* 
* *       EXIT
* 
          EQ     CKPROC      --- PROCESS NEXT COMMAND 
* 
* *       ERROR -- BAD PACK NAME
* 
 ATTFE3   SX6    3
          EQ     ATTFE
* 
* *       ERROR -- BAD FILE NAME
* 
 ATTFE4   SX6    4
* 
* *       SET ERROR CODES AND EXIT
* 
 ATTFE    SA6    TRETURN     SET *ZRETURN*
          EQ     PROCESS
 
 FIPADDR  EQU    TBINTSV     ADDR. OF FIP 
 NUMARGS  EQU    TBINTSV+1   NO. OF GETVAR CODES
 ARGSDONE EQU    TBINTSV+2   NO. OF GETVAR CODES PROCESSED
 SAVETYP  EQU    TBINTSV+3   TO SAVE FILEF/ATTACHF FLAG 
 ACCT     EQU    TBINTSV+4   ACCOUNT NAME 
 FILE     EQU    TBINTSV+5   FILE NAME
 
          ENDOV 
* /---   BLOCK      -DETACHF-  00 000   79/11/11  23.30 
          TITLE  -DETACHF-
* 
*         -DETACHF-  (CODE = 454) 
* 
*         DETACHF FIP;KEYWORD,VALUE;KEYWORD,VALUE;
*                 KEYWORD 
* 
*         THE FIRST ARGUMENT SPECIFIES A FOUR WORD FILE 
*         INFORMATION PACKET (FIP).  THE OPTIONAL KEYWORDS
*         MAY BE USED TO SPECIFY -- 
* 
*         FILE,N1 - FILE NAME 
*         PACK,N1 - PACK NAME 
*         STATION - DETACH ONLY IF THIS STATION HAS THE 
*                   FILE ATTACHED (DEFAULT) 
*         MASTER - DETACH NO MATTER WHAT STATION HAS THE
*                  FILE ATTACHED
* 
*         MASTOR REQUEST FORMAT --
*         MASRQ+2 - FILE NAME 
*         MASRQ+3 - OPTIONAL PACK NAME OR ZERO
*         MASRQ+4 - 1/ATTACH TYPE(READ=0,WRITE=1),59/UNUSED 
*         MASRQ+5 - UNUSED(NEEDED FOR REPLY ONLY) 
*         MASRQ+6 - STATION NUMBER PLUS 1 OF ATTACHER 
*         MASRQ+7 - DETACH TYPE(0=STATION,1=MASTER) 
* 
*         MASTOR REPLY FORMAT --
*         MASRQ+2 - FILE NAME 
*         MASRQ+3 - PACK NAME 
*         MASRQ+4 - 1/ATTACH TYPE,32/UNUSED 
*                   9/UNIT NO.,18/POINTER TO FILE INFO WORD 
*         MASRQ+5 - FILE INFO WORD
*         MASRQ+6 - STATION+1 THAT WAS ATTACHED 
*         MASRQ+7 - ERROR CODE OR -1 IF ALL OKAY
* 
*         ON COMPLETION *TRETURN* IS SET AS FOLLOWS 
*         -2 = FILE NOT ATTACHED
*         -1 = DETACH SUCCESSFUL
*          0 = ERROR -- FILE DOES NOT EXIST 
*          1 = ERROR -- FILE ATTACHED TO ANOTHER STATION
*          2 = ERROR -- IMPROPER MASTOR REQUEST 
*          3 = ERROR -- BAD PACK NAME 
*          4 = ERROR -- BAD FILE NAME 
* 
*         ON COMPLETION *ERROR* CONTAINS THE NUMBER OF THE
*         STATION WHICH HAD THE FILE ATTACHED.
* 
* /---   BLOCK      SETUP      00 000   79/12/28  16.21 
 DETFOV   OVRLAY
          SA1    OVARG1 
          NG     X1,TAGSDONE --- IF -SYSFILE- COMMAND 
* 
* *       CHECK REQUEST BUFFERS FOR SPACE AND SAVE *KEY*
* 
          CALLX  REQCHK 
          CALL   RESTKEY     RESTORE *KEY*
* 
* *       UNPACK ARGUMENTS INTO *VARBUF*
* 
          SX6    63          X6 = MAX. NUMBER OF ARGUMENTS
          SA5    A5          RETRIEVE COMMAND WORD
          CALL   GETARGS     MOVE GETVAR CODES TO *VARBUF*
          SA6    NUMARGS     STORE NUMBER OF ARGUMENTS
* 
* *       PROCESS FIRST ARGUMENT (FIP)
* 
          SA1    VARBUF      X1 = FIRST GETVAR CODE 
          BX5    X1 
          NGETVAR            A1 = ADDR. OF FIP
 
          SX6    A1 
          SA6    FIPADDR     SAVE IT
 
          SX1    0           MARK NOT IN -CALC- FOR FIPCHK
          CALL   FIPCHK      CHECKS BOUNDS ON FIP 
 
          SX6    1
          SA6    ARGSDONE    FIRST ARG HAS BEEN PROCESSED 
 
          SX6    0           DEFAULT TO *STATION* -DETACHF- 
          SA6    SMCODE      (RATHER THAN *MASTER*) 
* /---   BLOCK      TAGS       00 000   80/02/07  04.54 
* 
* *       LOOP TO PROCESS TAGS
* 
 TAGLOOP  SA1    ARGSDONE 
          SA2    NUMARGS
          IX2    X1-X2
          ZR     X2,TAGSDONE --- IF ALL TAGS PROCESSED
 
          SX6    X1+2        INCREMENT COUNT OF ARGS DONE 
          SA6    A1          STORE INCREMENTED COUNT
 
          SA1    VARBUF+X1   X1 = NEXT GETVAR CODE
          LX1    XCODEL      SHIFT CODE TO BITS 0-19
          SB1    X1          B1 = TAG NUMBER
 
          SA1    A1+1        X1 = NEXT GETVAR CODE
          BX5    X1 
          JP     TAGTAB+B1   --- PROCESS THIS TAG 
* 
* *       JUMP TABLE FOR KEYWORD ARGUMENTS
* 
 TAGTAB   BSS    0
 
+         EQ     FILENAM     0 = FILE NAME
+         EQ     PACKNAM     1 = PACK NAME
+         SX6    0           2 = STATION
          EQ     STAMAST
+         SX6    1           3 = MASTER 
          EQ     STAMAST
* 
* *       GET FILE NAME 
* 
 FILENAM  X      GETFILV,ARGSDONE,ACCT,FILE 
          SA1    FILE        X1 = FILE NAME 
          BX6    X1 
          SA1    FIPADDR     X1 = ADDR OF FIP 
          SA6    X1+/FIP/FILE  STORE FILE NAME IN FIP 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
* 
* *       GET PACK NAME 
* 
 PACKNAM  NGETVAR            X1 = PACK NAME 
          BX6    X1 
          SA1    FIPADDR     X1 = ADDR. OF FIP
          SA6    X1+/FIP/DIR  STORE PACK NAME IN FIP
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
* 
* *       STATION/MASTER FLAG 
* 
 STAMAST  SA6    SMCODE      STORE FLAG (0=STATION,1=MASTER)
          SA1    ARGSDONE    BACK UP RUNNING GETVAR COUNTER 
          SX6    X1-1 
          SA6    A1 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
* /---   BLOCK      PREPARE    00 000   79/11/11  23.32 
* 
* *       PREPARE MASTOR REQUEST
* 
 TAGSDONE SA1    FIPADDR     X1 = ADDR. OF FIP
 
          SX6    MS.DFFS     DETACHF MASTOR REQUEST 
          SA6    MASRQ       SET REQUEST CODE 
 
          SA2    X1+/FIP/FILE  (X2) = FILE NAME 
          ZR     X2,DETFE4   --- IF FILE NAME IS BAD
          NG     X2,DETFE4   --- IF FILE NAME IS BAD
 
          SA2    X1+/FIP/DIR  (X2) = PACK NAME
          NG     X2,DETFE3   --- IF PACK NAME IS BAD
 
          X      OLDFIPV,X1,(MASRQ+2)  CONVERT TO OLD FORMAT
 
          SA1    STATION     X1 = STATION NUMBER
          SX6    X1+1        STATION PLUS 1 FOR -DETACHF- 
          SA6    MASRQ+6     STORE IN REQUEST 
 
          SA1    SMCODE      X1 = STATION/MASTOR INDICATOR
          BX6    X1 
          SA6    MASRQ+7     STORE IN REQUEST 
* /---   BLOCK      REQUEST    00 000   80/02/07  04.55 
* 
* *       SAVE COMMON, STORAGE, ETC. AND POST REQUEST 
* 
          CALL   SAVLES 
          CALL   SAVKEY 
          CALL   S=MAS,MASRQ,STATION
* 
* *       WAIT FOR REQUEST TO COMPLETE
* 
 DETFX2   TUTIM  -1,,IOKEY
 
          SA1    KEY
          SX1    X1-IOKEY 
          NZ     X1,DETFX2   IGNORE IF NOT IOKEY
* 
* *       RETURN COMPLETION STATUS TO REQUESTOR 
* 
          SA1    MASRQ+7     X1 = COMPLETION STATUS 
          BX6    X1 
          SA6    TRETURN     *ZRETURN* = COMPLETION STATUS
* 
* *       RETURN STATION NUMBER IN CASE *ZRETURN* IS 4
* 
          SA1    MASRQ+6     X1 = STATION NUMBER + 1
          SX6    X1-1        GET EXACT STATION NUMBER 
          SA6    TERROR      *ERROR* = STATION NUMBER 
* 
* *       RESTORE COMMON, LESSON, ETC., AND EXIT
* 
          CALL   RESTKEY     RESTORE *KEY*
          CALL   RESTLES     RESTORE COMMON, LESSON, ETC. 
 
          EQ     CKPROC      --- PROCESS NEXT COMMAND 
* 
* *       ERROR -- BAD PACK NAME
* 
 DETFE3   SX6    3
          EQ     DETFE
* 
* *       ERROR -- BAD FILE NAME
* 
 DETFE4   SX6    4
* 
* *       SET ERROR CODE AND EXIT 
* 
 DETFE    SA6    TRETURN
          EQ     PROCESS
 
 FIPADDR  EQU    TBINTSV     ADDR. OF FIP 
 NUMARGS  EQU    TBINTSV+1   NO. OF GETVAR CODES
 ARGSDONE EQU    TBINTSV+2   NO. OF GETVAR CODES PROCESSED
 SMCODE   EQU    TBINTSV+3   STATION/MASTER INDICATOR 
 ACCT     EQU    TBINTSV+4   ACCOUNT NAME 
 FILE     EQU    TBINTSV+5   FILE NAME
 
          ENDOV 
* /---   BLOCK      -READF-    00 000   79/11/11  23.33 
          TITLE  -READF-/-WRITEF- 
* 
*         READF/WRITEF  (CODE = 450/451)
* 
*         READF  FIP,STARTING BLOCK,STORAGE<,NO. OF BLOCKS> 
*         WRITEF FIP,STARTING BLOCK,STORAGE<,NO. OF BLOCKS> 
* 
*         READ/WRITE 64 WORD DISK BLOCKS
* 
*         THE FIRST ARGUMENT IS THE ADDRESS OF THE FILE 
*         INFORMATION PACKET WHICH IS FOUR WORDS LONG.
*         THE FIP CONTAINS THE FOLLOWING INFORMATION -
*         FILE NAME, PACK NAME, A POINTER WORD WHICH
*         CAN BE USED TO LOCATE THE FILE INFO WORD
*         IN THE PACK DIRECTORY, AND THE FILE INFO WORD.
*         THE FIP IS SETUP BY THE -ATTACHF- COMMAND.  THE 
*         2ND ARGUMENT SPECIFIES THE STARTING BLOCK NUMBER
*         THE 3RD THE ECS ADDRESS, AND THE 4TH THE NUMBER 
*         OF BLOCKS TO READ.
* 
*         MASTOR REQUEST FORMAT --
*         MASRQ   = MASTOR FUNCTION CODE
*         MASRQ+2 = FILE NAME 
*         MASRQ+3 = PACK NAME 
*         MASRQ+4 = 1/ATTACH TYPE,32/UNUSED 
*                   9/UNIT NO,18/PTR TO FILE INFO WORD
*         MASRQ+5 = UNUSED
*         MASRQ+6 = 12/STATION+1,18/UNUSED
*                   18/NO. OF SECTORS TO TRANSFER,
*                   12/IO TYPE(READ=3,WRITE=4)
*         MASRQ+7 = 24/ABS ECSFWA,18/UNUSED,
*                   18/STARTING SECTOR
* 
*         MASTOR REPLY FORMAT --
*         MASRQ+2 - FILE NAME 
*         MASRQ+3 - PACK NAME 
*         MASRQ+4 - SAME AS REQUEST 
*         MASRQ+5 - FILE INFO WORD
*         MASRQ+6 - SAME AS REQUEST 
*         MASRQ+7 - ERROR CODE OR -1 IF ALL OKAY
* 
*         ON COMPLETION *TRETURN* IS SET AS FOLLOWS 
*         -1 = I/O COMPLETE SUCCESSFULLY
*          0 = FILE DOES NOT EXIST
*          1 = FILE NOT ATTACHED TO THIS STATION
*          2 = BAD MASTOR REQUEST 
*          3 = BAD PACK NAME
*          4 = BAD FILE NAME
*          5 = BAD STARTING BLOCK NUMBER
*          6 = NUMBER OF BLOCKS IS BAD
*          7 = TRANSFER LENGTH TOO LONG FOR STORAGE 
*          8 = BAD ECS ADDRESS
*          9 = I/O TRANSFER LENGTH PAST END OF FILE 
*         10 = SYSTEM DISK ERROR (SEE *TERROR*) 
* 
*         ON COMPLETION *TERROR* IS SET AS FOLLOWS- 
*         -1 = NO SYSTEM DISK ERROR 
*          N = SYSTEM DISK ERROR CODE 
* 
* /---   BLOCK      SETUP      00 000   79/11/30  07.29 
 FIOV     OVRLAY
 
          SA1    OVARG1      X1 = 3 TO READ, 4 TO WRITE 
          NG     X1,FIOX0    --- IF -SYSFILE- COMMAND 
          BX6    X1 
          SA6    IOTYPE      SAVE I/O TYPE
* 
* *       CHECK REQUEST BUFFERS FOR SPACE AND SAVE *KEY*
* 
          CALLX  REQCHK 
          CALL   RESTKEY     RESTORE *KEY*
* 
* *       GET ADDRESS OF FIP
* 
          NGETVAR            A1 = ADDR. OF FIP
          SX6    A1 
          SA6    FIPADDR     SAVE ADDR. OF FIP
 
          SX1    0           MARK NOT IN -CALC- FOR FIPCHK
          CALL   FIPCHK      CHECKS BOUNDS ON FIP 
* 
* *       GET STARTING BLOCK NUMBER 
* 
          SA5    A5          RETRIEVE COMMAND WORD
          LX5    XCODEL      SHIFT TO 2ND GETVAR CODE 
          NGETVAR            X1 = NO. OF FIRST BLOCK
          SX2    X1 
          NG     X2,FIOE5    --- ERROR IF BAD NUMBER
          NG     X1,FIOE5    --- ERROR IF NEGATIVE BLOCK NO.
          BX6    X1 
          SA6    FRSTBLK     SAVE STARTING BLOCK NO.
* 
* *       GET ECS ADDRESS 
* 
          SA5    A5          RETRIEVE COMMAND WORD
          MX0    -XSPTRL     X0 = MASK FOR STORAGE POINTER
          AX5    XCMNDL      SHIFT OFF COMMAND CODE 
          BX5    -X0*X5      X5 = EXTRA STORAGE PTR.
          SA1    B5+X5       X1 = EXTRA STORAGE WORD
          BX5    X1          SET UP FOR GETVAR ROUTINES 
          BX6    X1 
          SA6    TEMP        SAVE A COPY FOR LATER USE
          NGETVAR            X1 = STORAGE ADDRESS 
          SX6    1
          IX6    X1-X6
          NG     X6,FIOE8    --- ERROR IF ECS ADDR. &lt;= 0
          SA6    ECSADDR     SAVE ECS ADDRESS 
* 
* *       GET NUMBER OF BLOCKS
* 
          SA1    TEMP        X1 = EXTRA STORAGE WORD
          BX5    X1          SET UP FOR GETVAR CALL 
          LX5    XCODEL      SHIFT TO NEXT GETVAR CODE
          NGETVAR            X1 = NUMBER OF BLOCKS
          SX2    X1 
          NG     X2,FIOE6    --- ERROR IF BAD NUMBER
          NG     X1,FIOE6    --- ERROR IF NEGATIVE
          ZR     X1,FIOE6    --- ERROR IF ZERO
          BX6    X1 
          SA6    NUMBLKS     SAVE NO. OF BLOCKS 
* /---   BLOCK      PREPARE    00 000   79/11/11  23.34 
* 
* *       PREPARE MASTOR REQUEST
* 
 FIOX0    BSS    0
          SX6    MS.NFIO     X6 = READF/WRITEF REQ. CODE
          SA6    MASRQ       STORE MASTOR REQUEST CODE
 
          SA1    FIPADDR     X1 = ADDR. OF FIP
 
          SA2    X1+/FIP/FILE  (X2) = FILE NAME 
          NG     X2,FIOE4    --- IF FILE NAME IS BAD
          ZR     X2,FIOE4    --- IF FILE NAME IS BAD
 
          SA2    X1+/FIP/DIR  (X2) = PACK NAME
          NG     X2,FIOE3    --- IF PACK NAME IS BAD
          ZR     X2,FIOE3    --- IF PACK NAME IS BAD
 
          X      OLDFIPV,X1,(MASRQ+2)  CONVERT TO OLD FORMAT
 
          SA1    NUMBLKS     X2 = NO. OF BLOCKS 
          LX1    12          POSITION TRANSFER LENGTH 
          SA2    IOTYPE      I/O TYPE (3 = READ, 4 = WRITE) 
          BX6    X1+X2
          SA1    STATION     X1 = STATION NUMBER
          SX1    X1+1        ADD ONE TO STATION NUMBER
          LX1    48          POSTION IT 
          BX6    X1+X6       COMBINE
          SA6    MASRQ+6     STORE IN REQUEST 
 
          SA1    TBXSTOR     X1 = STORAGE INFO
          CALL   SETSTOR     SETS UP *STORWRD*
          SA4    STORWRD     X4 = 24/ECS ADDR,18/LENGTH,18/0
          AX4    18          SHIFT TO STORAGE LENGTH
          SA1    ECSADDR     X1 = STARTING ECS ADDR.
          SX0    DBSIZE      X0 = WORDS/DISK SECTOR 
          SA2    NUMBLKS     NO. BLOCKS TO READ/WRITE 
          IX0    X0*X2       X0 = TOTAL WORDS TO READ/WRITE 
          SX3    X4          X3 = STORAGE LENGTH
          IX3    X3-X0       SUBTRACT I/O LENGTH
          IX3    X3-X1       SUBTRACT STARTING ADDRESS
          NG     X3,FIOE7    --- ERROR IF OUT OF RANGE
          AX4    18          X4 = ABS. ADDR. OF STORAGE 
          IX6    X4+X1       X6 = ABS. STARTING ADDRESS 
          LX6    36          SHIFT TO TOP 
          SA1    FRSTBLK     X1 = NO. OF FIRST BLOCK
          BX6    X1+X6       MERGE ADDR. AND STARTING BLOCK 
          SA6    MASRQ+7     STORE IN REQUEST 
* /---   BLOCK      REQUEST    00 000   79/11/12  23.45 
* 
* *       COLLECT STATISTICS INFO 
* 
          SA2    NUMBLKS     X2 = NO. OF BLOCKS 
          SB4    0           SET USER TYPE TO SYSTEM
          SB2    SDEATTS     B2 = ADDR. OF STATISTICS CELLS 
          SA1    IOTYPE      X1 = I/O TYPE
          CALL   DSKST       UPDATE STATS 
* 
* *       UNLOAD COMMON/STORAGE AND SAVE LESSON POINTERS
* 
          CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
          CALL   SAVKEY      SAVE *KEY* 
* 
* *       MARK STORAGE AS NON-RELOCATABLE AND NON-DELETABLE 
* 
          CALL   IOLESSN,TBXSTOR,4000B
* 
* *       SET *SDINFO* SO PLATO IGNORES DISK ERRORS 
* 
          MX6    -1 
          SA6    SDINFO 
* /---   BLOCK      REQUEST    00 000   79/11/12  23.47 
* 
* *       POST REQUEST TO MASTOR
* 
          CALL   S=MAS,MASRQ,STATION
* 
* *       INCREMENT NUMBER OF DISK REQUESTS POSTED
* 
          SA1    POSTED 
          SX6    X1+1 
          SA6    A1 
* 
* *       WAIT FOR REQUEST TO BE COMPLETED
* 
 FIOX1    TUTIM  -1,,IOKEY
          SA1    KEY
          SX1    X1-IOKEY 
          NZ     X1,FIOX1    --- IF NOT = *IOKEY* 
* 
* *       DECREMENT NUMBER OF DISK REQUESTS POSTED
* 
          SA1    POSTED 
          SX6    X1-1 
          SA6    A1 
* 
* *       FREE STORAGE FOR RELOCATION 
* 
          SA1    TBXSTOR
          SX1    X1 
          ZR     X1,FIOX2    JUMP IF NO STORAGE 
          CALL   IOLESSN,TBXSTOR,-4000B 
* 
* *       RESTORE COMMON, LESSON, ETC.
* 
 FIOX2    CALL   RESTLES
          CALL   RESTKEY
* 
* *       RETURN SYSTEM DISK STATUS IN *ERROR*
* 
          SA1    MASRQ+6
          SX6    X1 
          SA6    TERROR      RETURN TO USER IN *ERROR*
* 
* *       CHECK FOR ERROR TO RETURN IN *ZRETURN*
* 
          SA1    MASRQ+7
          BX6    X1 
          SA6    TRETURN     SET *ZRETURN*
          PL     X6,CKPROC   --- PROCESS NEXT COMMAND 
* 
* *       IF NO ERROR, RETURN PACK NAME, FIW POINTER, 
* *       AND FIW 
* 
          SA1    FIPADDR     X1 = ADDR. OF FIP
 
          X      NEWFIPV,(MASRQ+2),X1  CONVERT TO NEW FORMAT
 
          EQ     CKPROC      --- PROCESS NEXT COMMAND 
* /---   BLOCK      ERRORS     00 000   80/12/02  02.00 
* 
* *       BAD PACK NAME 
* 
 FIOE3    SX6    3
          EQ     FIOERRX
* 
* *       BAD FILE NAME 
* 
 FIOE4    SX6    4
          EQ     FIOERRX
* 
* *       BAD STARTING BLOCK
* 
 FIOE5    SX6    5
          EQ     FIOERRX
* 
* *       BAD NO. OF BLOCKS 
* 
 FIOE6    SX6    6
          EQ     FIOERRX
* 
* *       TRANSFER LENGTH IS TOO LONG FOR STORAGE 
* 
 FIOE7    SX6    7
          EQ     FIOERRX
* 
* *       BAD ECS ADDRESS 
* 
 FIOE8    SX6    8
* 
* *       SET *ZRETURN* AND *ERROR* 
* 
 FIOERRX  SA6    TRETURN     SET *ZRETURN*
 
          SX6    -1 
          SA6    TERROR      SET *ERROR* TO -1 (NO DISK ERR)
 
          EQ     PROCESS
 
 FIPADDR  EQU    TBINTSV     ADDR. OF FIP 
 FRSTBLK  EQU    TBINTSV+1   STARTING BLOCK NO. 
 NUMBLKS  EQU    TBINTSV+2   NO. OF BLOCKS
 IOTYPE   EQU    TBINTSV+3   3 = READ, 4 = WRITE
 ECSADDR  EQU    TBINTSV+4   STARTING STORAGE ADDRESS 
 TEMP     EQU    TBINTSV+5   SCRATCH VAR
 
          ENDOV 
* /---   BLOCK      FILENAM    00 000   80/12/02  02.00 
          TITLE  -FILENAM- COMMAND
* 
*         -FILENAM- HAS TWO POSSIBLE FORMS -- 
* 
*         FILENAM ACCOUNT';FILE,ONEWORD       (FORM 0)
*         FILENAM ONEWORD,ACCOUNT';FILE       (FORM 1)
* 
*         THE FIRST GETVAR CODE IS SET UP AS A FAKE ARGUMENT
*         TO INDICATE WHICH FORM IS USED. 
* 
*         NOTE -- AFTER THE ACCOUNT NAME/NUMBER CONVERSION
*         IS AVAILABLE SOME ERROR CHECKING SHOULD BE ADDED
*         TO ZERO THE RESULT IN CASE OF AN INCONVERTIBLE
*         FILE NAME.
* 
* 
 FILNAMV  OVRLAY
 
          SX6    4
          CALL   GETCODX     UNPACK 4 GETVAR CODES TO VARBUF
          SA1    VARBUF      GET FIRST GETVAR CODE
          MX0    XCODEL 
          BX1    X0*X1       CLEAR OFF OTHER JUNK 
          NZ     X1,FN100    IF ONE-WD TO TWO-WD CONVERSION 
* 
* 
*         TWO-WORD TO ONE-WORD CONVERSION 
* 
* 
          SA1    VARBUF+1    GET ACCOUNT ARGUMENT 
          BX5    X1 
          NGETVAR 
          CALL   LJUST,(1R ),0
          BX6    X1 
          SA6    FNBUF       SAVE ACCOUNT WORD
 
          SA1    VARBUF+2    GET FILE NAME ARGUMENT 
          BX5    X1 
          NGETVAR 
          CALL   LJUST,(1R ),0
 
          SA2    FNBUF       RETRIEVE ACCOUNT NAME
          SA3    KOLD 
          IX3    X2-X3
          ZR     X3,FN50     IF ALREADY A ONE-WORD NAME 
 
          BX6    X1 
          SA6    FNBUF+1     SAVE FILE WORD 
          CALL   ACCFILC,FNBUF   CONVERT ACCOUNT KEYWORDS 
          CALL   FSQUISH,FNBUF   COMPRESS FILE NAME 
 
 FN50     BX6    X1          (X6) = ONE-WORD NAME 
          SA1    VARBUF+3    GET RETURN VARIABLE
          BX5    X1 
          NPUTVAR 
          EQ     PROCESS
* 
* 
*         ONE-WORD TO TWO-WORD CONVERSION 
* 
* 
 FN100    BSS    0
 
          SA1    VARBUF+1    GET ONE-WORD FILENAME ARGUMENT 
          BX5    X1 
          NGETVAR 
          BX6    X1          (X6) = ONE-WORD NAME 
          SA6    FNBUF+1
          SA1    KOLD        SPECIAL FOR OLD-STYLE FILES
          PL     X6,FN150    IF NAME NOT COMPRESSED 
 
          CALL   FEXPAND,FNBUF    PERFORM CONVERSION
          SA1    FNBUF       (X1) = ACCOUNT NAME
 
 FN150    SA2    VARBUF+2    GET FIRST RETURN VARIABLE
          BX6    X1          (X6) = ACCOUNT NAME
          BX5    X2          (X5) = GETVAR CODE 
          NPUTVAR 
 
          SA1    FNBUF+1     GET FILE NAME
* /---   BLOCK      FILENAM    00 000   80/12/02  01.59 
          SA2    VARBUF+3    GET SECOND RETURN VARIABLE 
          BX6    X1          (X6) = FILE NAME 
          BX5    X2          (X5) = GETVAR CODE 
          NPUTVAR 
 
          EQ     PROCESS
 
 KOLD     DATA   0L'OLD       SPECIAL ACCOUNT KEYWORD 
 FNBUF    OVDATA 2           TEMPORARY BUFFER FOR FILE NAME 
 
          ENDOV 
          TITLE  -NVERS- COMMAND
* 
*         -NVERS- COMMAND 
* 
*         NVERS  ACCOUNT';FILE,ACCOUNT';FILE
* 
*         CONVERTS SPECIFIED FILE NAME TO ITS N-VERSION FORM. 
* 
 NVERSV   OVRLAY
 
          SX6    4           UNPACK 4 ARGUMENTS 
          CALL   GETCODX     UNPACK ARGUMENTS TO VARBUF 
          CALL   ACCFILE,VARBUF,VARBUF,0
 
          CALL   NVERSC,VARBUF,NVNAM
 
          SA1    VARBUF+2    GET RETURN ACCOUNT ARGUMENT
          MX0    XCODEL 
          BX5    X0*X1
          ZR     X5,NVONE    IF NO ACCOUNT ARG
          SA1    NVNAM
          CALL   ACNOUT      MAKE ACCOUNT NAME DISPLAYABLE
          BX6    X1          (X6) = N-VERSION ACCOUNT 
          NPUTVAR 
 
          SA1    NVNAM+1     (X1) = N-VERSION FILE NAME 
 
 NVFRET   SA2    VARBUF+3    GET RETURN FILE ARGUMENT 
          BX5    X2 
          BX6    X1          (X6) = N-VERSION FILE NAME 
          NPUTVAR 
          EQ     PROCESS
 
*         IF NO RETURN ACCOUNT ARGUMENT SPECIFIED,
*         SQUISH FILE NAME INTO ONE WORD. 
 
 NVONE    CALL   FSQUISH,NVNAM  (X1) = ONE-WORD NAME
          EQ     NVFRET 
 
 NVNAM    OVDATA 2           TEMPORARY FOR N-VERSION NAME 
 
          ENDOV 
 
* /---   BLOCK      SYSFILE    00 000   80/12/02  02.00 
          TITLE  -SYSFILE- EXECUTION OVERLAY
* 
*         -SYSFILE- 
* 
*         COMMAND FOR SYSTEM FILE OPERATIONS (ATTACH, READ, 
*         WRITE, CREATE, ETC.)
* 
*         SOME POSSIBLE FORMS ARE --
* 
*           SYSFILE FIP;ATTACH;    $$  ATTACH FILE
*                   PACK,N1;FILE,N2;MODE,N3 
* 
*           SYSFILE FIP;CHECK;     $$  CHECK EXISTENCE
*                   PACK,N1;FILE,N2 
* 
*           SYSFILE FIP;DETACH;    $$  DETACH FILE
*                   PACK,N1;FILE,N2;STATION 
* 
*           SYSFILE FIP;READ,0,1   $$  READ BLOCK 0 
* 
*           SYSFILE FIP;WRITE,0,1  $$  WRITE BLOCK 0
* 
*           SYSFILE FIP;CREATE;    $$  CREATE FILE
*                   PACK,N1;FILE,N2;TYPE,',A',;LENGTH,5 
* 
*           SYSFILE FIP;DESTROY;   $$  DESTROY FILE 
*                   PACK,N1;FILE,N2 
* 
*           SYSFILE FIP;RENAME;    $$  CHANGE FILE NAME 
*                   PACK,N1;FILE,N2;NEW NAME,N3 
* 
*           SYSFILE FIP;RETYPE;    $$  CHANGE FILE TYPE 
*                   PACK,N1;FILE,N2;TYPE,',E',
* 
*           SYSFILE FIP;FBIT;ON  $$  SET BACKUP BIT 
*           SYSFILE FIP;FBIT;OFF $$  CLEAR BACKUP BIT 
* 
*           SYSFILE FIP;RECREATE  $$  RE-CREATE FILE
*                   FILE,N1';N2;TYPE,N3;LENGTH,N4 
* 
*         FIPS (FILE INFO PACKETS) ARE IDENTICAL TO THOSE 
*         USED FOR -ATTACHF-, ETC.
* 
*         AFTER EXECUTION OF A -SYSFILE- COMMAND, *ZRETURN* 
*         IS SET AS FOLLOWS --
* 
*           -2 = REDUNDANT ATTACH / UNNECESSARY DETACH
*           -1 = FILE OPERATION SUCCESSFUL
*            0 = FILE DOES NOT EXIST
*            1 = FILE NOT ATTACHED TO THIS STATION AND/OR 
*                FILE ATTACHED TO OTHER STATION 
*            2 = BAD MASTOR REQUEST 
*            3 = BAD PACK NAME / PACK NOT LOADED
*            4 = BAD FILE NAME
*            5 = STARTING BLOCK NUMBER IS BAD 
*            6 = NUMBER OF BLOCKS TO READ OR WRITE IS BAD 
*            7 = TRANSFER LENGTH IS TOO LONG FOR STORAGE
*            8 = BAD EXTENDED MEMORY ADDRESS
*            9 = ATTEMPT TO TRANSFER PAST END OF FILE 
*           10 = SYSTEM DISK ERROR
*           11 = DUPLICATE FILE NAME
*           12 = BAD FILE TYPE
*           13 = BAD FILE DIRECTORY PARAMETERS
*           14 = BAD FILE LENGTH
*           15 = NO ROOM FOR MORE FILES 
*           16 = NOT ENOUGH DISK SPACE
*           17 = ILLEGAL I/O CODE 
*           18 = ILLEGAL MS.FILE FUNCTION 
*           19 = MORE THAN ONE FILE MEETS SPECS 
*           20 = NON-EXISTANT DIRECTORY 
*           21 = AFT POINTER INVALID
*           22 = ACCOUNT ATTACHED 
*           23 = NO SUCH ACCOUNT FILE 
*           24 = ACCOUNT FILE IS TURNED OFF 
*           25 = ILLEGAL ATTACH CODE PROVIDED 
*           26 = ILLEGAL ATTACH SIGNATURE GIVEN 
* /---   BLOCK      SYSFILE    00 000   80/12/02  02.00 
*           27 = INSUFFICIENT SPACE IN ACCOUNT
*           28 = INSUFFICIENT SPACE IN SUB-ACCOUNT
*           29 = NO SUCH SUB-ACCOUNT
*           30 = ACCOUNT FILE IS FULL 
*           31 = DIRECTORY FILE IS FULL 
*           32 = CHECKSUM ERROR 
*           33 = BLOCK NAME IN ERROR
*           34 = NOT ENOUGH ROOM FOR HEADER 
*           35 = HEADER PARAMETERS IN ERROR 
*           36 = FILE VERSION MISMATCH
*           37 = ILLEGAL NAME ORDERING
*           38 = DUPLICATE ACCOUNT NUMBERS
*           39 = ACCOUNT NUMBER TOO LARGE 
*           40 = PACK OR ACCOUNT NOT LOADED 
*           41 = A SYSTEM ERROR OCCURRED
*           42 = COULD NOT ATTACH THE FILE
* 
*         THE SYSTEM RESERVED WORD *ERROR* IS ALSO SET
*         OCCASIONALLY -- 
* 
*           IF AN ATTACH OPTION FAILS BECAUSE A FILE IS 
*           ATTACHED ELSEWHERE, *ERROR* CONTAINS THE NUMBER 
*           OF THE STATION WHICH HAS THE FILE ATTACHED. 
* 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
*           AFTER THE DETACH OPTION IS USED, *ERROR*
*           CONTAINS THE NUMBER OF THE STATION WHICH HAD
*           THE FILE ATTACHED.  THIS WORKS ONLY FOR THE OLD 
*           DISK SYSTEM.
* 
*           THE READ AND WRITE OPTIONS LEAVE THE SYSTEM 
*           DISK ERROR STATUS (-1 IF NO ERROR) IN *ERROR*.
* 
*           THE CREATE, DESTROY, RENAME AND RETYPE OPTIONS
*           MAY SET *ERROR* IF THE FILE IS CREATED OR FOUND 
*           ON THE OLD DISK SYSTEM (DO NOT RELY ON THIS). 
* 
 
 SYSFILV  OVRLAY
 
* SYSFDBG  EQU    0           DEBUG CODE ENABLED IF DEFINED 
 
*         CHECK FOR IMPENDING MASTOR REQUEST BUFFER 
*         OVERFLOW. 
 
          CALLX  REQCHK      CHECK FOR MASTER REQ OVERFLOW
          CALL   RESTKEY     RESTORE *KEY*
 
*         INITIALIZE SOME CELLS SO GARBAGE VALUES WILL
*         NOT BE USED IF THE CORRESPONDING TAGS ARE NOT 
*         SPECIFIED.
 
          SX6    0
          SA6    MSGADDR     ADDRESS OF ERROR MESSAGE BUFFER
          SA6    SMCODE      STATION/MASTER DETACH FLAG 
          SA6    NFILE       NEW FILE NAME
          SA6    NACCT       NEW ACCOUNT NAME 
          SA6    F.TYP       FILE TYPE
          SA6    F.LTH       FILE LENGTH
          SA6    F.DIR       SIZE OF DIRECTORY (IN SECTORS) 
          SA6    F.RMT       SIZE/16 OF RMT (WORDS) 
          SA6    NPDWRIT     PACK DIRECTORY CHECKPOINT FLAG 
          SA6    OLDPACK     CLEAR *OLDPACK* FLAG 
          SA6    PACK        CLEAR PACK NAME
          SA6    DIRECT      CLEAR DIRECTORY NAME 
          SA6    NEWFBIT     NEW BACKUP BIT VALUE 
          SA6    ACCTRES     ACCOUNT OF RESIDENCE 
          SA6    SUBACCT     SUB-ACCOUNT
          SA6    ATTRIBS     ATTRIBUTE BITS 
 
*         UNPACK COMMAND ARGUMENTS TO *VARBUF*. 
 
          SX6    63          (X6) = MAX. NUMBER OF ARGUMENTS
          SA5    A5+0        RETRIEVE COMMAND WORD
          CALL   GETARGS     MOVE GETVAR CODES TO *VARBUF*
          SA6    NUMARGS     STORE NUMBER OF ARGUMENTS
 
*         PROCESS FIP (FILE INFO PACKET) ARGUMENT.
 
          SA1    VARBUF      (X1) = FIRST GETVAR CODE 
          BX5    X1 
          NGETVAR            (A1) = ADDRESS OF FIP
          SX6    A1 
          SA6    FIPSAVE     SAVE IT
          MX1    0           MARK NOT IN -CALC- FOR *FIPCHK*
          CALL   FIPCHK      CHECK BOUNDS ON FIP
 
*         GET PRIMARY COMMAND OPTION. 
 
          SA1    VARBUF+1    (X1) = OPTION (ATTACH, ETC.) 
          LX1    XCODEL      RIGHT-JUSTIFY GETVAR CODE
          SX6    X1 
          SA6    TYPSAVE     SAVE PRIMARY OPTION NUMBER 
 
*         PRESET FILE NAME FOR OLD-DISK-SYSTEM
*         DESTROY/RENAME/RETYPE/FBIT FUNCTIONS. 
 
          SA1    FIPSAVE     (A1) = ADDRESS OF FIP
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          SA1    X1+/FIP/FILE  (A1) = FILE NAME 
          BX6    X1 
          SA6    FILE        PRESET FILE NAME 
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          SA1    TBLESAC
          SA2    TBLESSN
          SA3    TUNAME 
          SA4    TUNAMEC
          MX6    42 
          BX6    X6*X1
          BX7    X2 
          SA6    DEBUGM1B+1 
          SA7    DEBUGM1C+1 
          MX1    48 
          BX6    X1*X3
          LX4    12 
          BX7    X1*X4
          SA6    DEBUGM1D+1 
          SA7    DEBUGM1E+1 
          SA1    TYPSAVE     (X1) = PRIMARY OPTION
          SB6    A5          SAVE A5
          CALL   S=OTOA 
          SA5    B6          RESTORE A5 
          SA7    DEBUGM1F+2  STORE OCTAL IN MESSAGE 
          CALL   S=MSG,DEBUGM1A 
          CALL   S=MSG,DEBUGM1B 
          CALL   S=MSG,DEBUGM1C 
          CALL   S=MSG,DEBUGM1D 
          CALL   S=MSG,DEBUGM1E 
          CALL   S=MSG,DEBUGM1F 
          CALL   S=MSG,FIPMSG 
          SA1    FIPSAVE
          CALL   OCTDUMP,X1,FIPLTH
          EQ     DEBUG1 
 DEBUGM1A DIS    ,/***********************************/ 
 DEBUGM1B DIS    ,* ACCT   - XXXXXXXXXX*
 DEBUGM1C DIS    ,* LESSON - XXXXXXXXXX*
 DEBUGM1D DIS    ,* M UNIT - XXXXXXXXXX*
 DEBUGM1E DIS    ,* C UNIT - XXXXXXXXXX*
 DEBUGM1F DATA   20HSYSFILE OPTION
          DATA   0,0
 DEBUG1   BSS    0
 .1       ENDIF 
 
 
*         PRESET PACK AND DIRECTORY NAMES.
 
          SA1    FIPSAVE     (X1) = ADDRESS OF FIP
          SA2    X1+/FIP/MFF  (X2) = MISC. FIP FIELDS 
          LX2    59-/MFF/S.OLD  SEE IF OLD-DISK-SYSTEM FIP
          SA3    X1+/FIP/DIR
          BX6    X3          (X6) = PACK/DIRECTORY NAME 
          NG     X2,SYSFIL1  IF OLD-DISK-SYSTEM FIP 
          SA6    DIRECT      NEW-DISK-SYSTEM DIRECTORY NAME 
          EQ     SYSFIL2
 
 SYSFIL1  SA6    PACK        OLD-DISK-SYSTEM PACK NAME
 
*         IF ATTACH OPTION AND NO ATTACH MODE IS LEFT OVER
*         IN THE FIP, SET IT TO R/O AS DEFAULT. 
 
 SYSFIL2  SA1    TYPSAVE     (X1) = PRIMARY OPTION
          SX1    X1-F.ATTACH
          NZ     X1,SYSFIL3  IF NOT ATTACH
          SA1    FIPSAVE     (X1) = ADDRESS OF FIP
          SA1    X1+/FIP/MFF
          MX2    -/MFF/M.ATTACH  (X2) = MASK FOR ATTACH MODE
          LX2    /MFF/S.ATTACH  POSITION MASK 
          BX2    -X2*X1      (X2) = ATTACH MODE IN FIP
          NZ     X2,SYSFIL3  IF ALREADY SET 
          SX6    MA.RO       DEFAULT TO READ/ONLY 
          LX6    /MFF/S.ATTACH
          BX6    X1+X6
          SA6    A1          STORE IN FIP 
 
*         CHECK FOR READ AND WRITE SECONDARY OPTIONS, WHICH 
*         DO NOT USE NORMAL SECONDARY KEYWORD PROCESSING. 
 
 SYSFIL3  SA1    TYPSAVE     (X1) = PRIMARY OPTION
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          SX2    X1-F.READ
          ZR     X2,SPECIAL  IF READ OPTION 
          SX2    X1-F.WRITE 
          ZR     X2,SPECIAL  IF WRITE OPTION
          EJECT 
 
*         PROCESS SECONDARY KEYWORDS
 
 
          SX6    2
          SA6    ARGSDONE    TWO ARGUMENTS ARE PROCESSED
 
 TAGLOOP  SA1    ARGSDONE    (X1) = NO. ARGUMENTS PROCESSED 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          SA2    NUMARGS     (X2) = TOTAL ARGUMENTS 
          IX2    X1-X2
          ZR     X2,TAGSDONE --- IF ALL TAGS PROCESSED
 
          SX6    X1+2        INCREMENT COUNT OF ARGS DONE 
          SA6    A1+0        STORE UPDATED COUNT
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          SA1    VARBUF+X1   (X1) = NEXT GETVAR CODE
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          LX1    XCODEL      SHIFT CODE TO BITS 0-19
          SB1    X1          (B1) = TAG NUMBER
          SA1    A1+1        (X1) = NEXT GETVAR CODE
          BX5    X1 
          JP     TAGTAB+B1   PROCESS THIS TAG 
 
*         JUMP TABLE FOR KEYWORD ARGUMENTS. 
 
 TAGTAB   BSS    0
 
+         EQ     FILENAM      0 = FILE NAME 
 
+         EQ     PACKNAM      1 = PACK NAME 
 
+         EQ     DIRNAM       2 = DIRECTORY NAME
 
+         EQ     ACCMODE      3 = ACCESS MODE 
 
+         MX6    0            4 = STATION DETACH
          EQ     STAMAST
 
+         SX6    1            5 = MASTER DETACH 
          EQ     STAMAST
 
+         EQ     FILETYP      6 = FILE TYPE 
 
+         EQ     FILELTH      7 = FILE LENGTH 
 
+         MX6    -1           8 = PACK DIR. WRITE FLAG
          EQ     PDWFLAG
 
+         EQ     NEWFNAM      9 = NEW FILE NAME 
 
+         EQ     DIRSIZE     10 = FILE DIR. SIZE
 
+         EQ     RMTSIZE     11 = FILE RMT SIZE 
 
+         SX6    1           12 = SET BACKUP BIT
          EQ     SETFBIT
 
+         MX6    0           13 = CLEAR BACKUP BIT
          EQ     SETFBIT
 
+         EQ     OLDPN       14 = OLD SYSTEM PACK NAME
 
+         EQ     MESSAG      15 = DISPLAYABLE ERROR MESSAGE 
 
+         EQ     NOATTACH    16 = OK TO READ W/O ATTACH 
 
+         EQ     ACCRES      17 = ACCOUNT OF RESIDENCE
 
+         EQ     SUBACC      18 = SUB-ACCOUNT 
 
+         EQ     ORIGNAL     19 = ORIGINAL FILE FLAG
 
*         GET FILE NAME (KEYWORD NO. 0).
 
 FILENAM  X      GETFILV,ARGSDONE,ACCT,FILE 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         GET PACK NAME (KEYWORD NO. 1).
 
 PACKNAM  NGETVAR            (X1) = PACK NAME 
          BX6    X1 
          MX7    0
          SA6    PACK        STORE PACK NAME
          SA7    OLDPACK     CLEAR *OLDPACK* FLAG 
 .1       IF     DEF,SYSFDBG
*          SX7    -1
*          SA7    OLDPACK     ALL OLD PACKS FOR NOW 
 .1       ENDIF 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         GET DIRECTORY NAME (KEYWORD NO. 2). 
 
 DIRNAM   NGETVAR            (X1) = DIRECTORY NAME
          BX6    X1 
          SA6    DIRECT      STORE DIRECTORY NAME 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         GET ACCESS MODE (KEYWORD NO. 3).
 
 ACCMODE  NGETVAR            (X1) = -1 FOR R/W, 0 FOR R/O 
          SX6    MA.READ     PRESET FOR R/O ACCESS
          PL     X1,ACCMOD1  --- IF R/O ACCESS
          SX6    MA.RW       SET FOR R/W ACCESS 
 ACCMOD1  BSS    0
          SA1    FIPSAVE     (X1) = ADDR. OF FIP
          SA1    X1+/FIP/MFF  (X1) = MISC. FIP FIELDS 
          MX0    -/MFF/M.ATTACH  (X0) = MASK FOR ATTACH MODE
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          LX0    /MFF/S.ATTACH  SHIFT MASK TO POSITION
          BX1    X0*X1       CLEAR OLD ATTACH MODE
          LX6    /MFF/S.ATTACH  POSITION NEW ATTACH MODE
          BX6    X1+X6
          SA6    A1          STORE IN FIP 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         SET STATION/MASTER FLAG (KEYWORDS 4-5). 
 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
 STAMAST  SA6    SMCODE      STORE FLAG (0=STATION,1=MASTER)
          SA1    ARGSDONE    BACK UP RUNNING GETVAR COUNTER 
          SX6    X1-1 
          SA6    A1+0 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         GET FILE TYPE (KEYWORD 6).
 
 FILETYP  NGETVAR            (X1) = FILE TYPE CODE
          MX0    -6 
          BX2    X0*X1       TOP 54 BITS MUST BE ZERO 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          NZ     X2,SYSFE12  --- ERROR IF GARBAGE PRESENT 
          SX6    X1+0        (X6) = FILE TYPE 
          SA6    F.TYP
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         GET FILE LENGTH (KEYWORD 7).
 
 FILELTH  NGETVAR            (X1) = FILE TYPE WORD
          MX0    -6 
          BX2    X0*X1       TOP 54 BITS MUST BE ZERO 
          NZ     X2,SYSFE14  --- ERROR IF GARBAGE PRESENT 
          SX6    X1+0        (X6) = FILE LENGTH 
          SA6    F.LTH
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         INHIBIT RETURN OF PACK DIRECTORY (KEYWORD 8). 
 
 PDWFLAG  SA6    NPDWRIT
          SA1    ARGSDONE    BACK UP RUNNING GETVAR COUNTER 
          SX6    X1-1 
          SA6    A1+0 
          EQ     TAGLOOP
 
 
*         GET NEW FILE NAME (KEYWORD NO. 9) 
 
 NEWFNAM  X      GETFILV,ARGSDONE,NACCT,NFILE 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         GET DIRECTORY SIZE (KEYWORD 10).
 
 DIRSIZE  NGETVAR            (X1) = DIRECTORY SIZE (SECTORS)
          MX0    -6 
          BX2    X0*X1       TOP 54 BITS MUST BE ZERO 
          NZ     X2,SYSFE13  --- ERROR IF GARBAGE PRESENT 
          SX6    X1+0        (X6) = DIRECTORY SIZE
          SA6    F.DIR
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         GET RECORD MANAGEMENT TABLE SIZE (KEYWORD 11).
 
 RMTSIZE  NGETVAR            (X1) = RMT SIZE / 16 WORDS 
          MX0    -6 
          BX2    X0*X1       TOP 54 BITS MUST BE ZERO 
          NZ     X2,SYSFE13  --- ERROR IF GARBAGE PRESENT 
          SX6    X1+0        (X6) = RMT SIZE
          SA6    F.RMT
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         SET/CLEAR BACKUP BIT (KEYWORDS 12-13).
 
 SETFBIT  SA6    NEWFBIT
          SA1    ARGSDONE    BACK UP RUNNING GETVAR COUNTER 
          SX6    X1-1 
          SA6    A1+0 
          EQ     TAGLOOP
 
*         GET PACK NAME THAT WILL BE USED ONLY IF A 
*         FILE IS BEING CREATED ON THE OLD DISK 
*         SYSTEM (KEYWORD 14).
 
 OLDPN    NGETVAR            (X1) = OLD SYSTEM PACK NAME
          BX6    X1 
          MX7    -1 
          SA1    FIPSAVE     (X1) = ADDRESS OF FIP
          SA6    X1+/FIP/DIR
          SA7    OLDPACK     SET *OLDPACK* FLAG 
          EQ     TAGLOOP     --- PROCESS NEXT TAG 
 
*         PROCESS ADDRESS OF BUFFER TO RECEIVE DISPLAYABLE
*         MESSAGE IN CASE OF ERROR. 
 
 MESSAG   NGETVAR            (A1) = ADDRESS OF BUFFER 
          SX6    A1 
          SA6    MSGADDR     SAVE THE ADDRESS 
          SA0    X6          (A0) = ADDRESS OF BUFFER 
          SX1    5           (X1) = LENGTH OF BUFFER
          CALL   BOUNDS      CHECK BOUNDS ON BUFFER 
          EQ     TAGLOOP     PROCESS NEXT TAG 
 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
*         FLAG THAT IT IS OK TO READ A FILE WITHOUT 
*         FIRST ATTACHING IT. 
 
 NOATTACH SA1    FIPSAVE     (X1) = ADDRESS OF FIP
          SA1    X1+/FIP/MFF  (X1) = MISC. FIP FIELDS 
          MX6    1
          LX6    1+/MFF/S.NOATT 
          BX6    X1+X6       SET NO ATTACH BIT IN FIP 
          SA6    A1 
          SA1    ARGSDONE    BACK UP RUNNING GETVAR COUNTER 
          SX6    X1-1 
          SA6    A1 
          EQ     TAGLOOP
 
*         PROCESS *ACCOUNT OF RESIDENCE*  (KEYWORD 17)
 
 ACCRES   NGETVAR 
          SA0    ACCTRES
          EQ     ALFINT      -- PROCESS ALPHA OR INTEGER
 
*         PROCESS *SUB-ACCOUNT*           (KEYWORD 18)
 
 SUBACC   NGETVAR 
          SA0    SUBACCT
          EQ     ALFINT      -- PROCESS ALPHA OR INTEGER
 
*         PROCESS ALPHA OR INTEGER IDENTIFIER FOR *ACCOUNT
*         OF RESIDENCE* OR *SUB-ACCOUNT* KEYWORDS.  NOTE
*         THAT THE RESULT ALWAYS OCCUPIES THE UPPER 42 BITS 
*         OF THE CELL DESIGNATED BY *A0* ON ENTRY.  (SO THE 
*         INTEGER FIELD IS SHIFTED BEFORE STORING).  *X1* 
*         CONTAINS THE USER'7S INPUT ON ENTRY.
 
 ALFINT   MX0    42          MASK TO SPLIT ALPHA/INTEGERS 
          BX6    X0*X1       X6 = ALPHA FIELD 
          NZ     X6,ALFINT1  -- ALPHA FIELD DESIGNATED
          BX6    -X0*X1      X6 = INTEGER FIELD 
          LX6    18          (SHIFT INTEGER FIELD)
 ALFINT1  SA6    A0          STORE IN SPECIFIED CELL
          EQ     TAGLOOP     -- EXIT TO NEXT KEYWORD
 
*         PROCESS ORIGINAL FILE FLAG    (KEYWORD 19)
 
 ORIGNAL  NGETVAR            (X1) = FLAG STATUS (0/NON-0) 
          SA2    ATTRIBS     GET ATTRIBUTE FLAGS WORD 
          SX6    200000B     ORIGINAL FILE FLAG BIT (LX 59) 
          ZR     X1,ORIGN0   -- BRANCH IF TURNING IT OFF
          BX6    X2+X6       ELSE UNION ORIGINAL FLAG IN
          SA6    A2          STORE NEW ATTRIBUTES FLAG
          EQ     TAGLOOP     -- PROCESS NEXT TAG
 ORIGN0   BX6    -X6*X2      CLEAR ORIGINAL FILE FLAG 
          SA6    A2          STORE NEW ATTRIBUTES FLAG
          EQ     TAGLOOP     -- PROCESS NEXT TAG
 
          EJECT 
 
*         SPECIAL HANDLING FOR READ/WRITE OPTIONS -- TWO
*         GETVAR CODES (STARTING BLOCK NUMBER AND STORAGE 
*         INDEX) ARE ALWAYS PRESENT.  'THE THIRD GETVAR 
*         CODE (NUMBER OF BLOCKS) MAY BE PRESENT OR MARKED
*         AS OMITTED; IN THE LATTER CASE A VALUE OF ONE (1) 
*         IS ASSUMED. 
* 
*         THE FOURTH GETVAR CODE IS OPTIONAL.  IF PRESENT IT
*         IS THE FIRST WORD OF A 5-WORD BUFFER TO RECEIVE 
*         DISPLAYABLE ERROR MESSAGES. 
 
 SPECIAL  SA1    NUMARGS     (X1) = NUMBER OF GETVAR CODES
          SX1    X1-2-4      SEE IF 4TH CODE PRESENT
          NZ     X1,SPECIAL1  IF 4TH GETVAR CODE NOT PRESENT
          SA1    VARBUF+5 
          BX5    X1 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          NGETVAR            (A1) = ADDRESS OF MSG BUFFER 
          SX6    A1 
          SA6    MSGADDR
          SA0    X6          (A0) = ADDRESS OF BUFFER 
          SX1    5           (X1) = LENGTH OF BUFFER
          CALL   BOUNDS      CHECK BOUNDS ON BUFFER 
 SPECIAL1 SA1    VARBUF+2    (X1) = 3RD GETVAR CODE 
          BX5    X1 
          NGETVAR            (X1) = STARTING BLOCK NUMBER 
          SX6    X1 
          NG     X6,SYSFE5   --- ERROR IF BAD NUMBER
          NG     X1,SYSFE5   --- ERROR IF NEG. BLOCK NUMBER 
          BX6    X1 
          SA6    START
 
          SA1    VARBUF+3    (X1) = 4TH GETVAR CODE 
          BX5    X1 
          NGETVAR            (X1) = STORAGE INDEX 
          SX6    1
          IX6    X1-X6
          NG     X6,SYSFE8   --- ERROR IF &lt; 0 
          SA6    STORAGE
 
          SX6    1           PRESET TO READ/WRITE ONE BLOCK 
          SA1    VARBUF+4    (X1) = 5TH GETVAR CODE 
          BX5    X1 
          LX1    1           SHIFT OMITTED ARG. BIT TO SIGN 
          NG     X1,SPECIAL2 --- IF DEFAULT NUMBER OF BLOCKS
          NGETVAR            (X1) = NUMBER OF BLOCKS
          SX6    X1 
          NG     X6,SYSFE6   --- ERROR IF BAD NUMBER
          NG     X1,SYSFE6   --- ERROR IF NEGATIVE
          ZR     X1,SYSFE6   --- ERROR IF ZERO
          BX6    X1 
 SPECIAL2 SA6    NUMBER 
 
          EJECT 
 
*         DETERMINE THE DISK SYSTEM ON WHICH THE OPERATION
*         SHOULD TAKE PLACE.
* 
*         FOR OPTIONS WHICH REQUIRE THAT A FILE BE ATTACHED,
*         WE CAN SIMPLY CHECK THE OLD DISK SYSTEM BIT IN THE
*         FIP.
 
 .MDS     IFNE   *F,0 
 TAGSDONE SA1    TYPSAVE     (X1) = PRIMARY OPTION
          SA1    ATTRTAB+X1  (X1) = OPTION ATTRIBUTES 
          LX1    R.AFIP 
          PL     X1,TAGSD0   --- IF ATTACH NOT REQUIRED 
 
          SA1    FIPSAVE     (X1) = ADDRESS OF FIP
          SA1    X1+/FIP/MFF (X1) = MISC. FIP FIELDS
          LX1    59-/MFF/S.OLD
          NG     X1,OLDDSYS  --- IF OLD DISK SYSTEM FILE
          EQ     NEWDSYS     --- IF NEW DISK SYSTEM FILE
 
*         SPECIAL RIGHT-JUSTIFIED DIRECTORY NAMES OF *OLD*
*         AND *NEW* ARE USED TO FORCE FILE OPERATIONS TO THE
*         OLD AND NEW DISK SYSTEMS, RESPECTIVELY.  ANY OTHER
*         NON-ZERO DIRECTORY NAMES WILL ALWAYS SELECT THE 
*         NEW DISK SYSTEM.
 
 TAGSD0   SA1    DIRECT      (X1) = DIRECTORY NAME
          NZ     X1,TAGSD1   IF DIRECTORY SPECIFIED 
          SA1    TYPSAVE     (X1) = PRIMARY OPTION
          SX1    X1-F.RECRE  CHECK FOR RE-CREATE OPTION 
          NZ     X1,TAGSD1   IF NOT RE-CREATE 
          SX6    3RNEW
          SA6    DIRECT      FORCE RE-CREATE TO NEW SYSTEM
 
 TAGSD1   SA1    DIRECT      (X1) = DIRECTORY NAME
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          ZR     X1,TAGSD2   IF NO DIRECTORY SPECIFIED
          SX2    3ROLD
          BX2    X1-X2       TEST FOR 3ROLD 
          ZR     X2,OLDDSYS  IF FORCING OLD DISK SYSTEM 
          SX2    3RNEW
          BX2    X1-X2       TEST FOR 3RNEW 
          NZ     X2,NEWDSYS  IF NOT DEFAULT DIRECTORY 
          SX6    0
          SA6    DIRECT      CHANGE 3RNEW TO DEFAULT DIR. 
          EQ     NEWDSYS     USE NEW DISK SYSTEM
 
*         CHECK THE VALUE OF *DEFDS* (DEFAULT DISK SYSTEM). 
*         IF IT IS 0 OR 3, THE OLD OR NEW DISK SYSTEM,
*         RESPECTIVELY, MUST BE CHOSEN. 
 
 TAGSD2   SX1    DEFDS       (X1) = DEFAULT DISK SYSTEM 
          ZR     X1,OLDDSYS  --- IF OLD DISK SYSTEM ALWAYS
          SX1    DEFDS-3
          ZR     X1,NEWDSYS  --- IF NEW DISK SYSTEM ALWAYS
 
*         IF *DEFDS* IS 1 OR 2, BOTH DISK SYSTEMS MUST BE 
*         SEARCHED. 
 
          SX1    DEFDS-2     CHECK FOR DEFDS .EQ. 2 
          ZR     X1,TAGSD3   IF NEW DISK SYSTEM FIRST 
 
          RJ     OLDSRCH     SEARCH OLD DISK SYSTEM 
          SB1    -1          MARK OLD DISK SYSTEM SEARCHED
          RJ     SEARCHED    CREATE/RENAME OPTION CHECKS
          NG     X6,OLDDSYS  TO OLD DISK SYSTEM IF FOUND
 
 TAGSD3   RJ     NEWSRCH     SEARCH NEW DISK SYSTEM 
          SB1    0           MARK NEW DISK SYSTEM SEARCHED
          RJ     SEARCHED    CREATE/RENAME OPTION CHECKS
          NG     X6,NEWDSYS  TO NEW DISK SYSTEM IF FOUND
 
          SX1    DEFDS-1     CHECK FOR DEFAULT = OLD
          ZR     X1,TAGSD4   IF OLD ALREADY SEARCHED
 
          RJ     OLDSRCH     SEARCH OLD DISK SYSTEM 
          SB1    -1          MARK OLD DISK SYSTEM SEARCHED
          RJ     SEARCHED    CREATE/RENAME OPTION CHECKS
          NG     X6,OLDDSYS  TO OLD DISK SYSTEM IF FOUND
 
 TAGSD4   SA1    TYPSAVE     CHECK PRIMARY OPTION 
          SX1    X1-F.CREATE  CHECK FOR CREATE OPTION 
          NZ     X1,SYSFE0   IF NOT CREATE AND NOT FOUND
          SX1    DEFDS-1
          ZR     X1,OLDDSYS  CREATE ON OLD DISK SYSTEM
          EQ     NEWDSYS     CREATE ON NEW DISK SYSTEM (2)
 
 NEWSRCH  SPACE  4,15 
**        NEWSRCH - SEARCH NEW DISK SYSTEM FOR FILE 
* 
*         ENTRY  (FILE) = FILE NAME.
*                (PACK) = PACK NAME OR ZERO.
* 
*         EXIT   (X6) = -1 IF FILE FOUND, 0 IF NOT. 
* 
*         USES   A - 1, 2, 6, 7.
*                B - 1, 2, 3, 4.
*                X - 1, 2, 6, 7.
* 
*         CALLS  INITDRQ, OVRUP, REQCHK, RESTKEY, RESTLES,
*                SAVLES, SYSFRST, SYSFSAV, S=MAS. 
* 
*         MACROS CALL, TUTIM. 
 
 NEWSRCH  EQ     *           MUST BE AN -EQ-, SEE *RJSAVE*
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          CALL   S=MSG,DEBUGM2
          EQ     DEBUG2 
 DEBUGM2  DIS    ,* SEARCHING NEW DISK SYSTEM.* 
 DEBUG2   BSS    0
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
 .1       ENDIF 
 
 NEWSRCH0 RJ     SYSFSAV     SAVE OVDATAS OVER INTERRUPT
          CALLX  REQCHK      CHECK FOR MASTOR REQ. OVERFLOW 
          RJ     SYSFRST     RESTORE OVDATAS
 
          RJ     =XINITDRQ   INITIALIZE *MS.FILE* REQUEST 
          SX6    MF.ATT      PRIMARY OPTION = ATTACH
          SX7    MA.NONE     ATTACH TYPE = NONE 
          LX7    36          POSITION ATTACH TYPE 
          BX6    X6+X7       MERGE
          SA6    MASRQ+FP.FUNC
          SA1    ACCT        (X1) = ACCOUNT NAME
          SA2    FILE        (X2) = FILE NAME 
          BX6    X1 
          BX7    X2 
          SA6    MASRQ+FP.ACCO  STORE ACCT NAME IN REQUEST
          SA7    MASRQ+FP.FNAME  STORE FILE NAME IN REQUEST 
          SA1    DIRECT      (X1) = DIRECTORY NAME
          SA2    PACK        (X2) = PACK NAME OR TYPE 
          BX6    X1 
          BX7    X2 
          SA6    MASRQ+FP.DNAME  STORE DIR. NAME IN REQUEST 
          SA1    OLDPACK     CHECK *OLDPACK* FLAG 
          NG     X1,NEWSRCH1 IF FOR OLD DISK SYSTEM ONLY
          SA7    MASRQ+FP.PACK  STORE PACK NAME IN REQUEST
 NEWSRCH1 SA1    NEWSRCH     SAVE RJ TRAIL
          AX1    30          MOVE RETURN ADDRESS TO LOW END 
          SX6    X1          EXTRACT RETURN ADDRESS 
          SA6    RJSAVE 
          RJ     SYSFSAV     SAVE OVDATAS OVER INTERRUPT
          RJ     =XSAVLES    SAVE LESSON, COMMON, ETC.
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          CALL   S=MSG,DEBUGM4
          EQ     DEBUG4 
 DEBUGM4  DIS    ,/ POSTING REQUEST FOR *NEWSRCH*./ 
 DEBUG4   CALL   OCTDUMP,MASRQ,MS.RDIM
 .1       ENDIF 
 
          CALL   S=MAS,MASRQ,STATION  POST REQUEST TO MASTOR
 NEWSRCH2 TUTIM  -1,,IOKEY
          SA1    KEY         CHECK FOR *IOKEY*
          SX1    X1-IOKEY 
          NZ     X1,NEWSRCH2  IF WRONG KEY
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          CALL   S=MSG,DEBUGM5
          EQ     DEBUG5 
 DEBUGM5  DIS    ,/ REPLY RECEIVED FOR *NEWSRCH*./
 DEBUG5   CALL   OCTDUMP,MASRQ,MS.RDIM
 .1       ENDIF 
 
          RJ     =XRESTKEY   RESTORE *KEY*
          RJ     =XRESTLES   RESTORE LESSON, COMMON, ETC. 
          RJ     SYSFRST     RESTORE OVDATAS
          SA2    NEWSRCH     USE ENTRY POINT FOR MODEL -EQ- 
          MX1    6           MASK OFF THE OP-CODE 
          BX2    X1*X2       X2 = FORCED-UPPER -EQ- OP-CODE 
          SA1    RJSAVE      RETRIEVE 18-BIT RETURN ADDRESS 
          LX1    30          SHIFT TO OPERAND FIELD FOR -EQ-
          BX6    X1+X2       FORM COMPLETE RETURN INSTRUCT. 
          SA6    NEWSRCH
          SA1    MASRQ+FR.ERR  CHECK ERROR RETURN 
          SX2    X1-/ERRCODE/BUSY 
          ZR     X2,NEWSRCH0  REPEAT IF BUSY CONDITION
          PL     X1,NEWSRCH3  IF FILE NOT FOUND 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          MX6    -1          (X6) = -1 = FILE FOUND 
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          RJ     YFOUND 
 .1       ENDIF 
 
          EQ     NEWSRCH
 
 NEWSRCH3 MX6    0           (X6) = 0 = FILE NOT FOUND
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          RJ     NFOUND 
 .1       ENDIF 
 
          EQ     NEWSRCH
 OLDSRCH  SPACE  4,14 
**        OLDSRCH -- SEARCH OLD DISK SYSTEM FOR FILE
* 
*         ENTRY  (FILE) = FILE NAME.
*                (PACK) = PACK NAME OR ZERO.
* 
*         EXIT   (X6) = -1 IF FILE FOUND, 0 IF NOT. 
* 
*         USES   A - 1, 2, 6, 7.
*                B - 1, 2.
*                X - 1, 2, 3, 6, 7. 
* 
*         CALLS  FINDFN, FNDFILE. 
* 
*         MACROS CALL.
 
 OLDSRCH  EQ     *
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          CALL   S=MSG,DEBUGM3
          EQ     DEBUG3 
 DEBUGM3  DIS    ,* SEARCHING OLD DISK SYSTEM.* 
 DEBUG3   BSS    0
 .1       ENDIF 
 
          SA1    PACK        (X1) = PACK TO SEARCH
          NG     X1,OLDSRCH4  NOT FOUND IF BAD PACK NAME
          ZR     X1,OLDSRCH3  IF SHOULD SEARCH ALL PACKS
 
*         IF SEARCHING ONE PACK, LOCATE PACK IN PACK NAME 
*         TABLE AND CALL ROUTINE (*FNDFILE*) TO SEARCH ONE
*         PACK. 
 
          SB1    0           (B1) = CURRENT DISK UNIT 
          SB2    NDSUS       (B2) = NUMBER OF DISK UNITS
 OLDSRCH1 SA2    PNAMES+B1   CHECK NEXT PACK NAME 
          BX3    X1-X2       SEE IF NAMES MATCH 
          ZR     X3,OLDSRCH2 IF PACK NAMES MATCHED
          SB1    B1+1        INCREMENT CURRENT UNIT 
          LT     B1,B2,OLDSRCH1  IF MORE NAMES TO CHECK 
          EQ     OLDSRCH4    IF SPECIFIED PACK NOT MOUNTED
 
 OLDSRCH2 SX6    B1          (X6) = DISK UNIT 
          BX7    X2          (X7) = PACK NAME 
          SA6    OLDSRCHA 
          SA7    OLDSRCHB 
          SA1    FILE        (X1) = FILE NAME 
          CALL   FNDFILE,OLDSRCHA,OLDSRCHB  SEARCH ONE PACK 
          NG     X7,OLDSRCH5  IF FILE FOUND 
          EQ     OLDSRCH4    IF FILE NOT FOUND
 
*         SEARCH ALL PACKS. 
 
 OLDSRCH3 SA1    FILE 
          RJ     =XFINDFN 
          PL     X7,OLDSRCH5  IF FILE FOUND 
 
*         MARK FILE NOT FOUND 
 
 OLDSRCH4 MX6    0           (X6) = 0 = FILE NOT FOUND
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          RJ     NFOUND 
 .1       ENDIF 
 
          EQ     OLDSRCH
 
*         MARK FILE FOUND.
 
 OLDSRCH5 MX6    -1          (X6) = -1 = FILE FOUND 
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          RJ     YFOUND 
 .1       ENDIF 
 
          EQ     OLDSRCH
 
 OLDSRCHA OVDATA             DISK UNIT
 OLDSRCHB OVDATA             PACK NAME
 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
 SEARCHED SPACE  4,15 
**        SEARCHED -- INITIAL CHECKS AFTER LOOKING FOR FILE 
* 
*         ENTRY  (X6) = -1 IF FILE FOUND, 0 IF NOT. 
*                (B1) = -1 IF OLD DISK SYSTEM SEARCHED, 0 IF
*                       NEW DISK SYSTEM SEARCHED
*                (TYPSAVE) = PRIMARY KEYWORD OPTION.
* 
*         EXIT   TO *SYSFE11* IF CREATE OPTION AND FILE 
*                ALREADY EXISTS OR IF RENAME OPTION AND THE 
*                OLD NAME EXISTS ON ONE DISK SYSTEM AND THE 
*                NEW NAME EXISTS ON THE OTHER DISK SYSTEM.
* 
*         USES   A - 1, 2, 6. 
*                B - NONE.
*                X - 1, 2, 6. 
* 
*         CALLS  NEWSRCH, OLDSRCH, SWAPFNS. 
* 
*         MACROS NONE.
 
 SEARCHED EQ     *           MUST BE AN -EQ-, SEE *RJSAVE1* 
          ZR     X6,SEARCHED  EXIT IF FILE WAS NOT FOUND
          SA1    TYPSAVE     (X1) = PRIMARY KEYWORD OPTION
          SX2    X1-F.RENAME  CHECK FOR RENAME OPTION 
          ZR     X2,SEARCHD1  IF RENAME OPTION
          SX2    X1-F.CREATE  CHECK FOR CREATE OPTION 
          NZ     X2,SEARCHED  EXIT IF NOT CREATE OPTION 
 
*         IF CREATE OPTION AND FILE WAS FOUND ON EITHER DISK
*         SYSTEM, RETURN A DUPLICATE FILE ERROR.
 
          EQ     SYSFE11     DUPLICATE FILE NAME ERROR
 
*         IF RENAME OPTION AND FILE IS FOUND ON ONE DISK
*         SYSTEM, CHECK THE OTHER DISK SYSTEM FOR A DUPLI-
*         CATE NAME.  DUPLICATE NAMES ON THE SAME DISK
*         DISK SYSTEM WILL BE DETECTED WHEN YOU TRY TO
*         RENAME THE FILE.
 
 SEARCHD1 SA1    SEARCHED    SAVE RJ TRAIL
          AX1    30          SHIFT RETURN ADDRESS TO LOW END
          SX6    X1          EXTRACT 18-BIT RETURN ADDRESS
          SA6    RJSAVE1
          RJ     SWAPFNS     SWAP OLD AND NEW FILE NAMES
          PL     B1,SEARCHD2  IF FOUND ON NEW DISK SYSTEM 
          RJ     NEWSRCH     SEARCH NEW DISK SYSTEM 
          NG     X6,SYSFE11  DUPLICATE FILE ERROR IF FOUND
          EQ     SEARCHD3    IF NOT FOUND 
 
 SEARCHD2 RJ     OLDSRCH     SEARCH OLD DISK SYSTEM 
          NG     X6,SYSFE11  DUPLICATE FILE ERROR IF FOUND
 
 SEARCHD3 RJ     SWAPFNS     SWAP FILE NAMES BACK 
          SA2    SEARCHED    USE ENTRY POINT FOR MODEL -EQ- 
          MX1    6           MASK OFF THE OP-CODE 
          BX2    X1*X2       X2 = FORCED-UPPER -EQ- OP-CODE 
          SA1    RJSAVE1     RETRIEVE 18-BIT RETURN ADDRESS 
          LX1    30          SHIFT TO OPERAND FIELD FOR -EQ-
          BX6    X1+X2       FORM COMPLETE RETURN INSTRUCT. 
          SA6    SEARCHED    RESTORE RETURN INSTRUCTION 
          SX6    -1          RESTORE (X6) = -1 = FILE FOUND 
          EQ     SEARCHED    -- EXIT
 
 SWAPFNS  SPACE  4,10 
**        SWAPFNS -- SWAP OLD AND NEW FILE NAMES
* 
*         SWAP OLD AND NEW ACCOUNT AND FILE NAMES IN ORDER
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
*         TO CHECK FOR A DUPLICATE FILE NAME ON A DIFFERENT 
*         DISK SYSTEM BEFORE RENAMING A FILE. 
* 
*         USES   A - 1, 2, 6, 7.
*                B - NONE.
*                X - 1, 2, 6, 7.
* 
*         CALLS  NONE.
* 
*         MACROS NONE.
* 
 
 SWAPFNS  EQ     *
          SA1    ACCT        (X1) = ACCOUNT NAME
          SA2    NACCT       (X2) = NEW ACCOUNT NAME
          BX6    X1 
          BX7    X2 
          SA6    A2 
          SA7    A1 
          SA1    FILE        (X1) = FILE NAME 
          SA2    NFILE       (X2) = NEW FILE NAME 
          BX6    X1 
          BX7    X2 
          SA6    A2 
          SA7    A1 
          EQ     SWAPFNS
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
 NFOUND   EQ     *
          CALL   S=MSG,NFOUNDA
          RJ     FILACCTL 
          MX6    0
          EQ     NFOUND 
 NFOUNDA  DIS    ,* FILE NOT FOUND.*
 
 YFOUND   EQ     *
          CALL   S=MSG,YFOUNDA
          RJ     FILACCTL 
          MX6    -1 
          EQ     YFOUND 
 YFOUNDA  DIS    ,* FILE FOUND.*
 
 FILACCTL EQ     *
          SA1    FILE 
          SB6    A5          SAVE A5
          CALL   S=OTOA 
          SA5    B6          RESTORE A5 
          SA6    FILEMSG+1
          SA7    FILEMSG+2
          CALL   S=MSG,FILEMSG
          SA1    ACCT 
          SB6    A5          SAVE A5
          CALL   S=OTOA 
          SA5    B6          RESTORE A5 
          SA6    ACCTMSG+1
          SA7    ACCTMSG+2
          CALL   S=MSG,ACCTMSG
          EQ     FILACCTL 
 
 FILEMSG  DATA   10H FILE - 
          DATA   0,0,0
 ACCTMSG  DATA   10H ACCT - 
          DATA   0,0,0
 .1       ENDIF 
 
 
 SYSFRST  SPACE  4,13 
**        SYSFRST - RESTORE OVDATAS FOR -SYSFILE- 
* 
*         ENTRY  NONE.
* 
*         EXIT   OVDATA VARIABLES RESTORED FROM *TBINTSV*.
* 
*         USES   A - 1, 6.
*                B - 1, 2, 3. 
*                X - 1, 6.
* 
*         CALLS  NONE.
* 
*         MACROS NONE.
 
 SYSFRST  EQ     *
 
          SB1    SAVE60L-1   (B1) = NO. OF 60-BIT FIELDS - 1
 SYSFRST1 SA1    TBINTSV+B1  (X1) = NEXT FIELD TO RESTORE 
          BX6    X1 
          SA6    SAVE60+B1   RESTORE IT 
          SB1    B1-1        END TEST 
          PL     B1,SYSFRST1  IF MORE TO RESTORE
 
          SB1    SAVE18L-1   (B1) = WORDS TO RESTORE - 1
          SB2    0           COUNT OF SAVED WORDS RESTORED
 SYSFRST2 SA1    TBINTSV+SAVE60L+B2  (X1) = NEXT 3 FIELDS 
          SB3    3           (B3) = NO. FIELDS / WORD 
 SYSFRST3 LX1    18          POSITION NEXT 18-BIT FIELD 
          SX6    X1          (X6) = NEXT 18-BIT FIELD 
          SA6    SAVE18+B1   RESTORE THE FIELD
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          SB1    B1-1        END TEST 
          NG     B1,SYSFRST  RETURN IF ALL DONE 
          SB3    B3-1        SEE IF MORE FIELDS IN X1 
          NZ     B3,SYSFRST3 IF MORE IN X1
          SB2    B2+1        INCREMENT SAVED WORDS RESTORED 
          EQ     SYSFRST2 
 
 SYSFSAV  SPACE  4,13 
**        SYSFSAV - SAVE OVDATAS FOR -SYSFILE-
* 
*         ENTRY  NONE.
* 
*         EXIT   OVDATA VARIABLES SAVED IN *TBINTSV*. 
* 
*         USES   A - 1, 6.
*                B - 1, 2, 3, 4.
*                X - 0, 1, 6. 
* 
*         CALLS  NONE.
* 
*         MACROS NONE.
 
 SYSFSAV  EQ     *
 
          SB1    SAVE60L-1   (B1) = NO. OF 60-BIT FIELDS - 1
 SYSFSAV1 SA1    SAVE60+B1   (X1) = NEXT FIELD TO SAVE
          BX6    X1 
          SA6    TBINTSV+B1  SAVE IT
          SB1    B1-1        END TEST 
          PL     B1,SYSFSAV1  IF MORE TO SAVE 
 
          SB1    SAVE18L     (B1) = NO. OF 18-BIT FIELDS
          SB2    B0          (B2) = COUNTER FOR WORDS STORED
          MX0    -18         (X0) = MASK FOR 18-BIT FIELDS
 SYSFSAV2 SB3    18+18+6     (B3) = SHIFT COUNT 
          SX6    B0          PRESET NEXT 3 FIELDS TO ZERO 
          SB4    B0          FLAG NOTHING IN X6 YET 
 SYSFSAV3 SB1    B1-1        END TEST 
          NG     B1,SYSFSAV4  IF NO MORE TO SAVE
          SA1    SAVE18+B1   (X1) = NEXT FIELD TO SAVE
          BX1    -X0*X1      LIMIT TO 18 BITS 
          LX1    X1,B3       SHIFT TO POSITION
          BX6    X1+X6       MERGE
          SB4    -1          FLAG SOMETHING IN X6 
          SB3    B3-18       ADJUST SHIFT-COUNT 
          PL     B3,SYSFSAV3  IF ROOM FOR MORE IN X6
 SYSFSAV4 PL     B4,SYSFSAV  IF NOTHING IN X6 
          SA6    TBINTSV+SAVE60L+B2  STORE NEXT WORD
          NG     B1,SYSFSAV  RETURN IF ALL DONE 
          SB2    B2+1        INCREMENT COUNT OF WORDS STORED
          EQ     SYSFSAV2 
 .MDS     ELSE
 TAGSDONE BSS    0
 .MDS     ENDIF 
          EJECT 
 
*         FINISH PREPARATIONS NEEDED FOR THE PRIMARY
*         OPTIONS (ATTACH, DETACH, ETC.) AND BRANCH TO
*         THE APPROPRIATE ROUTINE.
* 
*         THE FOLLOWING CODE HANDLES TRANSACTIONS ON THE
*         OLD DISK SYSTEM.
 
 OLDDSYS  SA1    FILE        (X1) = FILE NAME 
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          CALL   S=MSG,ONOLD
          SA1    FILE 
          EQ     ONOLD2 
 ONOLD    DIS    ,* USING OLD DISK SYSTEM.* 
 ONOLD2   BSS    0
 .1       ENDIF 
 
          SA2    PACK        (X2) = PACK NAME 
          BX6    X1 
          BX7    X2 
          SA3    FIPSAVE     (X3) = ADDRESS OF FIP
          SA6    X3+/FIP/FILE  SET FILE NAME IN FIP 
          SA7    X3+/FIP/DIR  SET PACK NAME IN FIP
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
 
          CALL   S=MSG,FIPMSG 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          SA1    FIPSAVE
          CALL   OCTDUMP,X1,FIPLTH
 .1       ENDIF 
 
 
          SA1    TYPSAVE     (X1) = PRIMARY OPTION
          SB1    X1+0 
          JP     B1+TYPJTAB  --- JUMP ON PRIMARY OPTION 
 
 TYPJTAB  BSS    0
 
+         SX6    0           0 = ATTACH FILE
          EQ     O.ATTACH 
 
+         SA1    FIPSAVE     1 = DETACH FILE
          EQ     O.DETACH 
 
+         SX6    1           2 = CHECK EXISTENCE OF A FILE
          EQ     O.ATTACH 
 
+         SX6    3           3 = READ FILE
          EQ     O.RW 
 
+         SX6    4           4 = WRITE FILE 
          EQ     O.RW 
 
+         SA1    FIPSAVE     5 = CREATE FILE
          EQ     O.CREATE 
 
+         SA1    FIPSAVE     6 = DESTROY FILE 
          EQ     O.DEST 
 
+         SA1    FIPSAVE     7 = RENAME FILE
          EQ     O.RENAME 
 
+         SA1    FIPSAVE     8 = CHANGE FILE TYPE 
          EQ     O.RETYPE 
 
+         SA1    FIPSAVE     9 = SET/CLEAR BACKUP BIT 
          EQ     O.FBIT 
 
+         EQ     SYSFE99     10 = RECREATE FILE (CANNOT DO) 
 
 
*         ATTACH OPTION AND CHECK EXISTENCE OF A
*         FILE -- SET/CLEAR THE -FILEF- FLAG AND EXECUTE
*         THE -ATTACHF- OVERLAY.
 
 O.ATTACH SA6    /ATTFOV/SAVETYP  SET/CLEAR -FILEF- FLAG
          SX6    -1 
          SA6    OVARG1      FLAG FROM -SYSFILE- COMMAND
          SA1    FIPSAVE     (X1) = ADDRESS OF FIP
          SX6    X1+0 
          SA6    /ATTFOV/FIPADDR
          EXEC   EXEC4,ATTFOV 
 
*         DETACH OPTION -- SET THE STATION/MASTER FLAG AND
*         EXECUTE THE -DETACHF- OVERLAY.
 
 O.DETACH SX6    X1          (X6) = ADDRESS OF FIP
          SA6    /DETFOV/FIPADDR
          SA1    SMCODE 
          BX6    X1 
          MX7    -1 
          SA6    /DETFOV/SMCODE 
          SA7    OVARG1      FLAG FROM -SYSFILE- COMMAND
          EXEC   EXEC4,DETFOV 
 
*         READ/WRITE OPTIONS -- MOVE STARTING BLOCK, STORAGE
*         INDEX, NUMBER OF BLOCKS AND I/O TYPE TO THE PROPER
*         CELLS AND EXECUTE THE -READF-/-WRITEF- OVERLAY. 
 
 O.RW     SA6    /FIOV/IOTYPE  SET I/O TYPE 
          SA1    START       (X1) = STARTING BLOCK NUMBER 
          SA2    STORAGE     (X2) = STORAGE INDEX 
          BX6    X1 
          BX7    X2 
          SA6    /FIOV/FRSTBLK
          SA7    /FIOV/ECSADDR
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          SA1    NUMBER      (X1) = NUMBER OF BLOCKS
          BX6    X1 
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
          MX7    -1 
          SA6    /FIOV/NUMBLKS
* /---   BLOCK      SYSFILE    00 000   80/12/02  03.41 
          SA7    OVARG1      FLAG FROM -SYSFILE- COMMAND
          SA1    FIPSAVE     (X1) = ADDRESS OF FIP
          SX6    X1+0 
          SA6    /FIOV/FIPADDR
          EXEC   EXEC4,FIOV 
 
 
*         CREATE OPTION -- DO -SETPACK- EQUIVALENT AND PLACE
*         THE DESIRED FILE NAME, SPACE ALLOCATION INFO AND
*         PACK DIRECTORY RETURN FLAG IN THE PROPER CELLS. 
 
 O.CREATE SX6    X1          (X6) = ADDRESS OF FIP
          SA6    /CREATE/FIPADDR
          RJ     SETPACK
          SA1    F.LTH       (X1) = FILE LENGTH 
          SA2    F.TYP       (X2) = FILE TYPE 
          SA3    F.DIR       (X3) = DIRECTORY SIZE
          SA4    F.RMT       (X4) = RMT SIZE
          LX2    6           SHIFT FIELDS TO POSITION 
          LX3    12 
          LX4    18 
          BX6    X1+X2       MERGE
          BX6    X6+X3
          BX6    X6+X4
          SA6    /CREATE/INFO  STORE SPACE ALLOC. INFO WORD 
          SA1    FILE        (X1) = DESIRED FILE NAME 
          SA2    NPDWRIT     (X2) = PACK DIR. CHECKPT FLAG
          BX6    X1          (X6) = DESIRED FILE NAME 
          BX7    X2 
          SA6    /CREATE/FILE 
          SA7    /CREATE/CHECKPT
          EQ     =XCREATE1   --- JUMP TO -CREATE- COMMAND 
 
*         DESTROY OPTION -- DO -SETPACK- EQUIVALENT AND 
*         PLACE THE FILE NAME IN THE CORRECT CELL 
 
 O.DEST   SX6    X1          (X6) = ADDRESS OF FIP
          SA6    /DESTROY/FIPADDR 
          RJ     SETPF       SET TO PACK AND FILE 
          SA1    FILE        (X1) = DESIRED FILE NAME 
          BX6    X1 
          SA6    /DESTROY/FILE
          EQ     =XDESTRY1   --- JUMP TO -DESTROY- COMMAND
 
* /---   BLOCK      SYSFILE    00 000   80/12/02  04.00 
*         RENAME OPTION -- DO -SETPACK- EQUIVALENT AND
*         PLACE THE FILE NAME AND DESIRED NEW NAME IN THE 
*         PROPER CELLS. 
 
 O.RENAME SX6    X1          (X6) = ADDRESS OF FIP
          SA6    /RENAME/FIPADDR
          RJ     SETPF       SET TO PACK AND FILE 
          SA1    FILE        (X1) = FILE NAME 
          SA2    NFILE       (X2) = NEW NAME
          BX6    X1 
          BX7    X2 
          SA6    /RENAME/FILE 
          SA7    /RENAME/NFILE
          SX6    0
          SA6    /RENAME/FLAG  SET -RENAMEF-/-RETYPEF- FLAG 
* 
 RENAME1  MX6    0           CLEAR OVERLAY STACK
          SA6    OVRSTAK
          X      DSKCOV,3    EXECUTE -RENAMEF- COMMAND CODE 
 
 
*         RETYPE OPTION -- DO -SETPACK- EQUIVALENT AND
*         PLACE THE FILE NAME AND NEW FILE TYPE IN THE
*         PROPER CELLS. 
 
 O.RETYPE SX6    X1          (X6) = ADDRESS OF FIP
          SA6    /RETYPE/FIPADDR
          RJ     SETPF       SET TO PACK AND FILE 
          SA1    FILE        (X1) = FILE NAME 
          SA2    F.TYP       (X2) = NEW FILE TYPE 
          BX6    X1 
          BX7    X2 
          SA6    /RETYPE/FILE 
          SA7    /RETYPE/TYPE 
          SX6    -1 
          SA6    /RETYPE/FLAG  SET -RENAMEF-/-RETYPEF- FLAG 
          EQ     RENAME1
 
*         FBIT OPTION -- DO -SETPACK- EQUIVALENT AND PLACE
*         THE FILE NAME AND ON/OFF FLAG IN THE APPROPRIATE
*         CELLS.
 
 O.FBIT   SX6    X1          (X6) = ADDRESS OF FIP
          SA6    /FBIT/FIPADDR
          RJ     SETPF
          SA1    FILE        (X1) = FILE NAME 
          SA2    NEWFBIT     (X2) = NEW BACKUP BIT
          BX6    X1 
          BX7    X2 
          SA6    /FBIT/FILE 
          SA7    /FBIT/NEWFBIT
          SX6    -1 
          SA6    OVARG1      FLAG FROM -SYSFILE- COMMAND
          EXEC   EXEC4,FBITOV 
* /---   BLOCK      SYSFILE    00 000   80/12/02  03.44 
 
          EJECT 
**        SETPF - SET TO PLATO PACK AND FILE
* 
*         THIS SUBROUTINE IMITATES THE ACTION OF -SETPACK-
*         AND -SETFILE- COMMANDS. 
* 
*         IF A PACK NAME IS PROVIDED, *SETPACK* IS CALLED 
*         SET TO THAT SPECIFIC PACK.
* 
*         IF NO PACK NAME IS PROVIDED, *FINDFN* IS CALLED 
*         TO SEARCH ALL ACTIVE PACKS. 
* 
*         ENTRY  (FIPSAVE) = ADDRESS OF FIP 
* 
*         EXIT   (TDISKU) = DISK UNIT IF SUCCESSFUL, ELSE 0 
*                (TPNAME) = PACK NAME IF SUCCESSFUL, ELSE 0 
*                TO *SYSFE0* IF FILE DOES NOT EXIT
*                TO *SYSFE3* IF PACK NAME IS BAD
*                TO *SYSFE4* IF FILE NAME IS BAD
* 
*         CALLS  FINDFN, SETPACK
* 
*         USES   X - 1, 2, 7. 
*                A - 1, 2, 7. 
*                B - NONE.
* 
 
 SETPF    EQ     *
 
          SA2    FIPSAVE     (X2) = ADDRESS OF FIP
 
          SA1    X2+/FIP/FILE  (X1) = FILE NAME 
          ZR     X1,SYSFE4   --- ERROR IF BAD FILE NAME 
          NG     X1,SYSFE4   --- ERROR IF BAD FILE NAME 
 
          SA2    X2+/FIP/DIR (X2) = PACK NAME 
          NG     X2,SYSFE3   --- ERROR IF BAD PACK NAME 
          ZR     X2,SETPF1   --- TO SEARCH ALL PACKS
 
          RJ     SETPACK     SET TO SPECIFIED PACK
          EQ     SETPF       --- RETURN 
 
 SETPF1   RJ     =XFINDFN    SEARCH ALL ACTIVE PACKS
          NG     X7,SYSFE0   --- ERROR IF FILE NOT FOUND
 
          SA7    TDISKU      STORE DISK UNIT NUMBER 
          SA1    PNAMES+X7   (X1) = PACK NAME 
          BX7    X1 
          SA7    TPNAME      STORE PACK NAME
 
          EQ     SETPF       --- RETURN 
 
          EJECT 
 
**        SETPACK - IMITATION -SETPACK- COMMAND 
* 
*         ENTRY  (FIPSAVE) = ADDRESS OF FIP 
* 
*         EXIT   (TDISKU) = DISK UNIT IF SUCCESSFUL, ELSE 0 
*                (TPNAME) = PACK NAME IF SUCCESSFUL, ELSE 0 
*                TO *SYSFE3* IF PACK NAME IS BAD
*                TO *SYSFE3* IF PACK IS NOT LOADED
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 0, 1, 2, 6, 7. 
*                B - 2, 3.
* 
 
 SETPACK  EQ     *
 
          SA1    TDISKU      (X1) = CURRENT DISK UNIT 
          SA2    X1+PNAMES   (X2) = CURRENT PACK NAME 
 
          SA1    FIPSAVE     (X1) = ADDRESS OF FIP
          SA1    X1+/FIP/DIR (X1) = PACK TO SET TO
          ZR     X1,SETPACK2 --- ERROR IF NO PACK NAME
          NG     X1,SETPACK2 --- ERROR IF BAD PACK NAME 
          BX2    X1-X2       SEE IF ALREADY SET TO THE PACK 
          ZR     X2,SETPACK4 --- IF ALREADY DONE
 
          SB2    B0          (B2) = DISK UNIT INDEX 
          SB3    NDSUS       (B3) = NUMBER OF DISK UNITS
          SA0    PNAMES      (A0) = ADDRESS OF PACK NAMES 
 
* /---   BLOCK      SYSFILE    00 000   80/12/02  03.44 
 SETPACK1 SA2    A0+B2       (X2) = NEXT PACK NAME
          BX3    X1-X2       SEE IF THE MATCH 
          ZR     X3,SETPACK3 --- IF PACK NAMES IDENTICAL
          SB2    B2+1        INCREMENT DISK UNIT INDEX
          LT     B2,B3,SETPACK1  --- IF MORE PACKS TO CHECK 
 SETPACK2 SX6    0
          SA6    TPNAME      CLEAR PACK NAME
          SA6    TDISKU      CLEAR DISK UNIT
          EQ     SYSFE3      --- TO ERROR EXIT
 
 SETPACK3 SX6    B2          (X6) = DISK UNIT NUMBER
          BX7    X2          (X2) = PACK NAME 
          SA6    TDISKU 
          SA7    TPNAME 
          EQ     SETPACK
 
 SETPACK4 BX6    X1          (X6) = PACK NAME 
          SA6    TPNAME      MAKE SURE PACK NAME IS CORRECT 
          EQ     SETPACK
 
          EJECT 
 .MDS     IFNE   *F,0 
 
*         THE FOLLOWING CODE HANDLES TRANSACTIONS ON THE
*         NEW DISK SYSTEM.
 
 NEWDSYS  RJ     SYSFSAV     SAVE OVDATAS OVER INTERRUPT
          CALLX  REQCHK      CHECK FOR MASTOR REQ. OVERFLOW 
          RJ     SYSFRST     RESTORE OVDATAS
 
          SX6    0
          SA6    PINNED      MARK STORAGE NOT PINNED
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          CALL   S=MSG,ONNEW
          EQ     ONNEW2 
 ONNEW    DIS    ,* USING NEW DISK SYSTEM.* 
 ONNEW2   BSS    0
 .1       ENDIF 
 
 
          RJ     =XINITDRQ   INITIALIZE MASTOR REQUEST AREA 
 
          SA1    TYPSAVE     (X1) = PRIMARY OPTION
          SA2    X1+ATTRTAB  (X2) = OPTION ATTRIBUTES 
          SA1    FIPSAVE     (X1) = ADDR. OF FIP
 
          SX6    X2          (X6) = SUB-FUNCTION CODE 
          ZR     X6,SYSFOK   IF NO-OP ON NEW DISK SYSTEM
          BX0    X2          (X0) = OPTION ATTRIBUTES 
          LX0    R.MODE 
          PL     X0,NEWDSYS0  IF ATTACH MODE NOT NEEDED 
          SA3    X1+/FIP/MFF  (X3) = MISC. FIP FIELDS 
          LX3    60-/MFF/S.ATTACH 
          MX4    -/MFF/M.ATTACH 
          BX4    -X4*X3      (X4) = ATTACH MODE 
          LX4    18          POSITION ATTACH MODE 
          BX6    X4+X6       MERGE WITH SUB-FUNCTION CODE 
 NEWDSYS0 SA3    MSGADDR     (X3) = ADDR OF MESSAGE BUFFER
          ZR     X3,NEWDS0.1  IF NO MESSAGE BUFFER
          SX3    1
          LX3    FO.ERROR    POSITION FLAG FOR MSG. OPTION
          BX6    X3+X6
 NEWDS0.1 LX0    R.NOATT-R.MODE 
          PL     X0,NEWDS0.2  IF *NOATTACH* NOT ALLOWED 
          SA3    X1+/FIP/MFF
          LX3    59-/MFF/S.NOATT
          ERRNZ  /MFF/M.NOATT-1 
          PL     X3,NEWDS0.2  IF ATTACH REQUIRED
          MX3    1
          LX3    1+FO.IGNA
          BX6    X3+X6
 NEWDS0.2 SA6    MASRQ+FP.FUNC
 
          LX0    R.AFT-R.NOATT
          PL     X0,NEWDSYS1  IF AFT SHOULD NOT BE SPECIFIED
 
          SA3    X1+/FIP/MFF   (X3) = MISC. FIP FIELDS
* /---   BLOCK      SYSFILE    00 000   80/12/02  03.44 
          MX0    -/MFF/M.AFT   (X0) = MASK FOR AFT INDEX
          BX6    -X0*X3        (X6) = AFT INDEX 
          SA6    MASRQ+FP.AFT 
 
 NEWDSYS1 SA3    FILE        (X3) = FILE NAME 
          BX6    X3 
          SA6    MASRQ+FP.FNAME 
 
          SA3    ACCTRES     SEE IF ACCT OF RES SPECIFIED 
          NZ     X3,NEWDS1.1  USE NEW VALUE IF SPECIFIED
          SA3    X1+/FIP/FAW  ELSE USE VALUE FROM /FIP/ 
          AX3    /FAW/S.ACCRES
          MX0    -/FAW/M.ACCRES 
          BX3    -X0*X3 
          LX3    18 
 NEWDS1.1 SA4    MASRQ+FP.ACCR
          BX6    X3+X4       RETAIN STATION NUMBER FIELD
          SA6    A4          STORE ACCT OF RES IN MASRQ BUFF
 
          SA3    ACCT        (X3) = ACCOUNT NAME
          BX6    X3 
          SA6    MASRQ+FP.ACCO
 
          SA3    SUBACCT     (X3) = SUB-ACCOUNT IDENTIFIER
          BX6    X3 
          SA6    MASRQ+FP.SUBA
 
          SA3    DIRECT      (X3) = DIRECTORY NAME
          SX6    3RNEW       CHECK FOR GLOBAL DIRECTORY 
          IX6    X3-X6
          ZR     X6,NEWDS1.2  IF GLOBAL DIRECTORY DESIRED 
          BX6    X3 
 NEWDS1.2 SA6    MASRQ+FP.DNAME 
 
          SA3    OLDPACK     IF PACK FOR OLD SYSTEM ONLY
          NG     X3,NOPNAME  IF NOT FOR NEW DISK SYSTEM 
          SA3    PACK        (X3) = PACK NAME OR TYPE 
          BX6    X3 
          SA6    MASRQ+FP.PACK
 
 NOPNAME  BX0    X2          (X0) = OPTION ATTRIBUTES 
          LX0    R.NAME 
          NG     X0,NEWDSYS6  IF NEW ACCOUNT';NAME REQUIRED 
 
*         FOR SINGLE FILE OPERATION, UNION ATTR BITS
*         INTO ACCT-OF-ORIGIN WORD FOR THAT FILE. 
 
          SA3    MASRQ+FP.ACCO
          SA4    ATTRIBS     (X4) = ATTRIBUTE BITS
          LX4    1           SHIFT ATTRIBUTE BITS INTO POS. 
          BX6    X3+X4       UNION ATTR BITS
          SA6    A3          UPDATE REQUEST BUFFER
 
          MX6    0           PRE-CLEAR X6 
          LX0    R.LTH-R.NAME 
          PL     X0,NEWDSYS2  IF FILE LENGTH NOT NEEDED 
          SA3    F.LTH       (X3) = FILE LENGTH 
          SX4    35          (X4) = SECTORS / PART
          IX3    X3*X4       (X3) = LENGTH IN SECTORS 
          LX3    24+18       SHIFT TO POSITION
          BX6    X3+X6       MERGE
 
 NEWDSYS2 LX0    R.DIR-R.LTH
          PL     X0,NEWDSYS3  IF DIRECTORY SIZE NOT NEEDED
          SA3    F.DIR       (X3) = DIRECTORY SIZE
          LX3    9+18        SHIFT TO POSITION
          BX6    X3+X6       MERGE
 
 NEWDSYS3 LX0    R.RMT-R.DIR
          PL     X0,NEWDSYS4 IF RMT SIZE NOT NEEDED 
          SA3    F.RMT       (X3) = RMT SIZE
          LX3    18          SHIFT TO POSITION
          BX6    X3+X6       MERGE
 
 NEWDSYS4 LX0    R.TYP-R.RMT
          PL     X0,NEWDSYS5  IF FILE TYPE NOT NEEDED 
* /---   BLOCK      SYSFILE    00 000   80/12/02  03.44 
          SA3    F.TYP       (X3) = DESIRED FILE TYPE 
          BX6    X3+X6       MERGE
 
 NEWDSYS5 SA6    MASRQ+FP.INFO
 
          AX2    18          POSITION I/O CODE
          SX6    X2          (X6) = I/O CODE
          ZR     X6,NEWDSYS7  IF NO I/O INVOLVED
          LX6    18+12+24    POSITION I/O CODE
          SA6    MASRQ+FP.IO  STORE I/O CODE
 
          SA1    TBXSTOR     (X1) = STORAGE INFO
          CALL   SETSTOR     SET UP *STORWRD* 
          SA4    STORWRD     (X4) = 24/EM ADDR,18/LTH,18/0
          AX4    18          POSITION STORAGE LENGTH
          SA1    STORAGE     (X1) = STARTING STORAGE ADDR.
          SX0    DBSIZE      (X0) = WORDS / SECTOR
          SA2    NUMBER      (X2) = NO. BLOCKS TO READ/WRITE
          IX0    X0*X2       (X0) = NO. WORDS TO READ/WRITE 
          SX3    X4          (X3) = STORAGE LENGTH
          IX3    X3-X0       SUBTRACT I/O LENGTH
          IX3    X3-X1       SUBTRACT STARTING ADDRESS
          NG     X3,SYSFE7   ERROR IF OUT OF RANGE
          AX4    18          (X4) = ABS. STORAGE ADDRESS
          IX6    X4+X1       (X6) = ABS. STARTING ADDRESS 
          SA1    MASRQ+FP.IO  (X1) = 6/IO CODE,54/0 
          SA2    START       (X2) = STARTING SECTOR 
          SA3    NUMBER      (X3) = SECTORS TO READ/WRITE 
          LX2    12+24       POSITION STARTING SECTOR 
          LX3    24          POSITION NUMBER OF SECTORS 
          BX6    X1+X6       MERGE
          BX6    X2+X6
          BX6    X3+X6
          SA6    MASRQ+FP.IO  STORE IN MASTOR REQUEST BUFFER
 
          SA2    NUMBER      (X2) = NUMBER OF SECTORS 
          SB4    0           SET USER TYPE TO SYSTEM
          SB2    SDEATTS     (B2) = ADDR. OF STATS CELLS
          AX6    54          (X6) = 54/0, 6/IO CODE 
          SX1    X6+2        (X1) = 3 TO READ, 4 TO WRITE 
          RJ     =XDSKST     UPDATE DISK STATISTICS 
 
          CALL   IOLESSN,TBXSTOR,4000B  PIN STORAGE 
          SX6    -1 
          SA6    PINNED      MARK STORAGE PINNED
          EQ     NEWDSYS7 
 
*         FOR OPERATIONS INVOLVING TWO FILE NAMES,
*         UNION ATTR BITS INTO THE NEW FILE NAME. 
 NEWDSYS6 SA1    NACCT       (X1) = NEW ACCOUNT NAME
          SA2    ATTRIBS     (X2) = NEW ATTRIBUTES
          LX2    1           SHIFT ATTR BITS INTO POS.
          BX6    X1+X2
          SA6    MASRQ+FP.ACCO2 
          SA1    NFILE       (X1) = NEW FILE NAME 
          BX6    X1 
          SA6    MASRQ+FP.FNAM2 
 
 NEWDSYS7 RJ     =XSAVLES    SAVE COMMON, LESSON, ETC.
          RJ     SYSFSAV     SAVE *OVDATA* CELLS
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          CALL   S=MSG,DEBUGM6
          EQ     DEBUG6 
 DEBUGM6  DIS    ,/ POSTING REQUEST FOR *NEWDSYS*./ 
 DEBUG6   CALL   OCTDUMP,MASRQ,MS.RDIM
 .1       ENDIF 
 
* /---   BLOCK      SYSFILE    00 000   80/12/02  03.44 
          CALL   S=MAS,MASRQ,STATION  POST REQUEST TO MASTOR
 
 NEWDSYS8 TUTIM  -1,,IOKEY
          SA1    KEY         CHECK FOR *IOKEY*
          SX1    X1-IOKEY 
          NZ     X1,NEWDSYS8  IF WRONG KEY
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          CALL   S=MSG,DEBUGM7
          EQ     DEBUG7 
 DEBUGM7  DIS    ,/ REPLY RECEIVED FOR *NEWDSYS*./
 DEBUG7   CALL   OCTDUMP,MASRQ,MS.RDIM
 .1       ENDIF 
 
 
          RJ     SYSFRST     RESTORE *OVDATA* CELLS 
          SA1    PINNED      (X1) = -1 IF STORAGE WAS PINNED
          ZR     X1,NEWDSYS9  IF NOT PINNED 
          CALL   IOLESSN,TBXSTOR,-4000B 
 
 NEWDSYS9 RJ     =XRESTLES   RESTORE LESSON, COMMON, ETC. 
          RJ     =XRESTKEY   RESTORE *KEY*
 
*         CHECK FOR BUSY CONDITION. 
 
          SA1    MASRQ+FR.ERR  (X1) = ERROR RETURN
          SX1    X1-/ERRCODE/BUSY 
          ZR     X1,NEWDSYS  REPEAT IF BUSY CONDITION 
 
*         RETURN THE FIP. 
 
          ERRNZ  /MFF/M.AFT-18
          ERRNZ  /MFF/M.STATN-18
 
          SA1    FIPSAVE     (X1) = ADDRESS OF FIP
          SA2    X1+/FIP/MFF  (X2) = MISC. FIP FIELDS 
          MX6    -/MFF/M.ATTACH  (X6) = MASK FOR ATTACH MODE
          LX6    /MFF/S.ATTACH  POSITION THE MASK 
          BX6    -X6*X2      (X6) = ATTACH MODE 
          MX3    -/MFF/M.NOATT
          LX3    /MFF/S.NOATT 
          BX3    -X3*X2      PRESERVE *NOATTACH* BIT
          BX6    X3+X6       MERGE WITH ATTACH MODE FIELD 
          SA2    MASRQ+FR.AFT  (X2) = 27/0,15/STATN,18/AFT
          MX3    -18         (X3) = MASK FOR AFT POINTER
          BX3    -X3*X2      (X3) = AFT POINTER 
          LX3    /MFF/S.AFT  POSITION AFT POINTER 
          BX6    X3+X6       INSERT AFT POINTER INTO FIP
          SA3    MASRQ+FR.ERR  CHECK ERROR RETURN 
          SX3    X3-/ERRCODE/ATTACHED 
          NZ     X3,NOCONFL  IF NOT ALREADY ATTACHED
          AX2    18          SHIFT STATION NUMBER DOWN
          MX3    -15
          BX3    -X3*X2      (X3) = CONFLICTING STATION 
          SX3    X3+1        FIP NEEDS STATION + 1
          LX3    /MFF/S.STATN  POSITION STATION NUMBER
          BX6    X3+X6       INSERT STATION INTO FIP
 NOCONFL  SA6    X1+/FIP/MFF  STORE FIRST WORD OF FIP 
          SA2    MASRQ+FR.FNAME  (X2) = FILE NAME 
          SA3    MASRQ+FR.FAW  (X3) = FAW 
          BX6    X2 
          BX7    X3 
          SA6    X1+/FIP/FILE 
          SA7    X1+/FIP/FAW
          SA2    MASRQ+FR.FIW  (X2) = FIW 
          SA3    MASRQ+FR.DNAME  (X3) = DIRECTORY 
          NZ     X3,GOTDIRN 
          SX3    3RNEW
 GOTDIRN  BX6    X2 
          BX7    X3 
          SA6    X1+/FIP/FIW
          SA7    X1+/FIP/DIR
 
*         SET *ZRETURN* AND *ERROR*.
 
* /---   BLOCK      SYSFILE    00 000   80/12/02  03.44 
          SA1    MASRQ+FR.ERR  CHECK ERROR RETURN 
          PL     X1,NEWDONE  IF ERROR OCCURRED
          MX6    -1 
          MX7    0
          SA6    TRETURN
          SA7    TERROR 
 
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          EQ     DEBUG8 
 .1       ENDIF 
 
          EQ     =XCKPROC 
 
 NEWDONE  SA2    MSGADDR     SEE IF DISPLAYABLE MSG WANTED
          ZR     X2,NEWDONE2  IF MESSAGE NOT DESIRED
          SB1    4
 NEWDONE1 SA3    MASRQ+FR.MSG+B1  (X1) = NEXT WORD OF MSG.
          BX6    X3 
          SA6    X2+B1       STORE IN USER MESSAGE BUFFER 
          SB1    B1-1 
          PL     B1,NEWDONE1
 
 NEWDONE2 SX2    X1-/ERRCODE/IOFUNC  DISK ERRS .LT. IOFUNC
          PL     X2,NEWCONV  IF NOT DISK ERROR
          SX6    10 
          SX7    X1+
          SA6    TRETURN     *ZRETURN* = 10 FOR DISK ERROR
          SA7    TERROR      RETURN *ERROR* = DISK ERROR
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          EQ     DEBUG8 
 .1       ENDIF 
 
          EQ     =XCKPROC 
 
*         CONVERT *MS.FILE* RETURN TO -SYSFILE- *ZRETURN* 
 
 NEWCONV  SA2    CONVTAB-1
 NEWCONV1 SA2    A2+1        (X2) = 24/0,18/ZRETURN,18/CODE 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          ZR     X2,*+1S17   WEIRD ERROR, CRASH PLATO 
 .1       ELSE
          ZR     X2,SYSFE98  RETURN BAD ZRETURN 
 .1       ENDIF 
          SX3    X2 
          BX3    X1-X3       SEE IF ERROR CODES MATCH 
          NZ     X3,NEWCONV1  IF NOT, TRY NEXT ONE
          AX2    18 
          SX6    X2 
          SA6    TRETURN     SET *ZRETURN*
          SX6    0
          SX2    X1-/ERRCODE/ATTACHED 
          NZ     X2,NEWCONV2  IF NOT ATTACHED ELSEWHERE 
          SA2    MASRQ+FR.AFT  (X2) = 27/0,15/STATN,18/AFT
          AX2    18          POSITION STATION NUMBER
          MX6    -15
          BX6    -X6*X2      (X6) = CONFLICTING STATION NO. 
 NEWCONV2 SA6    TERROR      SET *ERROR*
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          EQ     DEBUG8 
 .1       ENDIF 
 
          EQ     =XCKPROC 
 .MDS     ENDIF 
          EJECT 
 
*         EXITS FROM THE -SYSFILE- COMMAND -- 
 
 SYSFOK   SX6    -1          -1 = ALL OK
 
 SYSFEX   SA6    TRETURN     SET *ZRETURN*
 
 .1       IF     DEF,SYSFDBG  IF -SYSFILE- DEBUG ON 
          SA7    RJSAVE      SAVE MSG ADDRESS 
 DEBUG8   SA1    TRETURN
          SB6    A5          SAVE A5
          CALL   S=OTOA 
          SA5    B6          RESTORE A5 
          SA6    ZRETURNM+1 
          SA7    ZRETURNM+2 
          SA1    TERROR 
          SB6    A5          SAVE A5
          CALL   S=OTOA 
          SA5    B6          RESTORE A5 
          SA6    ERRORM+1 
          SA7    ERRORM+2 
* /---   BLOCK      SYSFILE    00 000   80/12/02  03.44 
          CALL   S=MSG,ZRETURNM 
          CALL   S=MSG,ERRORM 
          CALL   S=MSG,FIPMSG 
          EQ     DEBUG9 
 ZRETURNM DATA   10HZRETURN - 
          DATA   0,0,0
 ERRORM   DATA   10HERROR   - 
          DATA   0,0,0
 FIPMSG   DIS    ,* FIP CONTENTS --*
 DEBUG9   SA1    FIPSAVE
          ZR     X1,* 
          CALL   OCTDUMP,X1,FIPLTH
          SA1    TRETURN     RESTORE (X6) 
          SX6    X1+
          SA1    RJSAVE      RESTORE (X7) 
          SX7    X1+
 .1       ENDIF 
 
          NG     X6,=XCKPROC  IF NO ERROR OCCURRED
          SA1    MSGADDR     (X1) = ADDRESS OF MSG BUFFER 
          ZR     X1,=XCKPROC  IF NO MESSAGE DESIRED 
          SB1    1           (B1) = 1 
          SB2    4           (B2) = COUNTER FOR LOOP
          SX6    0
 SYSFEX1  SA6    A1+B2       PRE-CLEAR MESSAGE BUFFER 
          SB2    B2-B1
          PL     B2,SYSFEX1 
          MX0    -12         (X0) = MASK FOR LAST MSG WORD
          SB2    0           (B2) = CURRENT WORD OF MSG.
          SB3    4           (B3) = MAX. MSG. WORDS - 1 
 SYSFEX2  SA2    X7+B2       (X2) = NEXT WORD OF MESSAGE
          BX6    X2 
          SA6    X1+B2       STORE NEXT WORD OF MESSAGE 
          BX2    -X0*X2      TEST FOR WORD ENDING IN 0000B
          ZR     X2,=XCKPROC  IF REACHED END OF MESSAGE 
          EQ     B2,B3,=XCKPROC  IF MAX. WORDS REACHED
          SB2    B2+B1       INCREMENT COUNT OF WORDS 
          EQ     SYSFEX2     GO DO NEXT WORD
 
 
 SYSFE0   SX6    0           0 = FILE NOT FOUND 
          SX7    MSG0 
          EQ     SYSFEX 
 
 SYSFE3   SX6    3           3 = PACK NOT LOADED
          SX7    MSG3 
          EQ     SYSFEX 
 
 SYSFE4   SX6    4           4 = BAD FILE NAME
          SX7    MSG4 
          EQ     SYSFEX 
 
 SYSFE5   SX6    5           5 = BAD STARTING BLOCK 
          SX7    MSG5 
          EQ     SYSFEX 
 
 SYSFE6   SX6    6           6 = BAD NUMBER OF BLOCKS 
          SX7    MSG6 
          EQ     SYSFEX 
 
 SYSFE7   SX6    7           7 = TRANSFER LENGTH TOO LONG 
          SX7    MSG7 
          EQ     SYSFEX 
 
 SYSFE8   SX6    8           8 = BAD STORAGE INDEX
          SX7    MSG8 
          EQ     SYSFEX 
 
 SYSFE11  SX6    11          11 = DUPLICATE FILE NAME 
          SX7    MSG11
          EQ     SYSFEX 
 
 SYSFE12  SX6    12          12 = BAD FILE TYPE 
          SX7    MSG12
          EQ     SYSFEX 
 
 SYSFE13  SX6    13          13 = BAD DIRECTORY INFO
          SX7    MSG13
          EQ     SYSFEX 
 
 SYSFE14  SX6    14          14 = BAD FILE LENGTH 
          SX7    MSG14
          EQ     SYSFEX 
 
 SYSFE98  BX6    X1          98 = WEIRD RETURN VALUE
          SA6    TERROR      RETURN *ERROR* = ACTUAL VALUE
* /---   BLOCK      SYSFILE    00 000   80/12/02  03.44 
          SX6    98 
          SX7    MSG98
          EQ     SYSFEX 
 
 SYSFE99  SX6    99          99 = UNSUPPORTED OPTION
          SX7    MSG99
          EQ     SYSFEX 
 
 MSG0     DIS    ,*FILE NOT FOUND*
 MSG3     DIS    ,*PACK NOT LOADED* 
 MSG4     DIS    ,*BAD FILE NAME* 
 MSG5     DIS    ,*BAD STARTING BLOCK*
 MSG6     DIS    ,*BAD NUMBER OF BLOCKS*
 MSG7     DIS    ,*TRANSFER LENGTH TOO LONG*
 MSG8     DIS    ,*BAD STORAGE INDEX* 
 MSG11    DIS    ,*DUPLICATE FILE NAME* 
 MSG12    DIS    ,*BAD FILE TYPE* 
 MSG13    DIS    ,*BAD DIRECTORY PARAMETERS*
 MSG14    DIS    ,*BAD FILE LENGTH* 
 MSG98    DIS    ,/WEIRD *MS.FILE* RETURN/
 MSG99    DIS    ,*UNSUPPORTED OPTION*
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
 .MDS     IFEQ   *F,1 
 
          EJECT 
 
 
*         THE FOLLOWING ARE USED TO SPECIFY ATTRIBUTES AND
*         REQUIREMENTS OF VARIOUS SYSFILE OPTIONS.  THERE IS
*         ONE WORD FOR EACH OPTION.  IF AN OPTION IS NOT
*         AVAILABLE IN THE MASTOR DISK SYSTEM, SET THE
*         FUNCTION CODE TO 0. 
* 
*         THE CONTENTS OF AN ENTRY ARE -- 
* 
*                1/SET IF ATTACH FIP REQUIRED 
*                1/SET IF ATTACH MODE TO BE SPECIFIED 
*                1/SET IF NEW FILE TYPE TO BE SPECIFIED 
*                1/SET IF NEW FILE LENGTH TO BE SPECIFIED 
*                1/SET IF NEW FILE NAME TO BE SPECIFIED 
*                1/SET IF NEW DIRECTORY SIZE TO BE SPECIFIED
*                1/SET IF NEW RMT SIZE TO BE SPECIFIED
*                1/SET IF AFT POINTER CAN BE SPECIFIED
*                1/SET IF OK TO READ WITHOUT ATTACH 
*               15/0
*               18/READ/WRITE CODE
*               18/FUNCTION CODE
 
*         DEFINE SHIFTS FOR USING THE ATTRIBUTE TABLE.
 
 R.AFIP   EQU    0           ATTACH FIP REQUIRED (LX) 
 R.MODE   EQU    1           ATTACH MODE REQUIRED (LX)
 R.TYP    EQU    2           FILE TYPE REQUIRED 
 R.LTH    EQU    3           FILE LENGTH REQUIRED 
 R.NAME   EQU    4           NEW ACCOUNT';NAME REQUIRED 
 R.DIR    EQU    5           DIRECTORY SIZE REQUIRED
 R.RMT    EQU    6           RMT SIZE REQUIRED
 R.AFT    EQU    7           SET IF AFT POINTER SPECIFIED 
 R.NOATT  EQU    8           SET IF OK TO READ W/O ATTACH 
 
*         DEFINE TABLE OF PRIMARY OPTION ATTRIBUTES.
 
 ATTRTAB  BSS    0
 
          VFD    1/0,1/1,1/0,1/0,1/0,1/0,1/0,1/1  ATTACH
          VFD    16/0,18/0,18/MF.ATT
 
          VFD    1/0,1/0,1/0,1/0,1/0,1/0,1/0,1/1  DETACH
          VFD    16/0,18/0,18/MF.DET
 
          VFD    1/0,1/0,1/0,1/0,1/0,1/0,1/0,1/1  CHECK 
          VFD    16/0,18/0,18/MF.ATT
 
          VFD    1/1,1/0,1/0,1/0,1/0,1/0,1/0,1/1  READ
          VFD    1/1,15/0,18/1,18/MF.READ 
 
          VFD    1/1,1/0,1/0,1/0,1/0,1/0,1/0,1/1  WRITE 
          VFD    16/0,18/2,18/MF.WRITE
 
          VFD    1/0,1/0,1/1,1/1,1/0,1/1,1/1,1/0  CREATE
          VFD    16/0,18/0,18/MF.CREAT
 
          VFD    1/0,1/0,1/0,1/0,1/0,1/0,1/0,1/1  DESTROY 
          VFD    16/0,18/0,18/MF.DESTR
 
          VFD    1/0,1/0,1/0,1/0,1/1,1/0,1/0,1/0  RENAME
          VFD    16/0,18/0,18/MF.RENAM
 
          VFD    1/0,1/0,1/1,1/0,1/0,1/0,1/0,1/1  RETYPE
          VFD    16/0,18/0,18/MF.CHANG
 
          VFD    1/0,1/0,1/0,1/0,1/0,1/0,1/0,1/0  FBIT
          VFD    16/0,18/0,18/0 
 
          VFD    1/0,1/0,1/1,1/1,1/0,1/1,1/1,1/1  RECREATE
          VFD    16/0,18/0,18/MF.RECRE
 .MDS     ENDIF 
 
*         FUNCTION CODES FOR THE VARIOUS -SYSFILE- OPTIONS. 
 
 F.ATTACH EQU    0           ATTACH FILE
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
 F.DETACH EQU    1           DETACH FILE
 F.CHECK  EQU    2           SEE IF FILE EXISTS 
 F.READ   EQU    3           READ FILE
 F.WRITE  EQU    4           WRITE FILE 
 F.CREATE EQU    5           CREATE FILE
 F.DEST   EQU    6           DESTROY FILE 
 F.RENAME EQU    7           CHANGE FILE NAME 
 F.RETYPE EQU    8           CHANGE FILE TYPE 
 F.FBIT   EQU    9           SET/CLEAR BACKUP BIT 
 .MDS     IFEQ   *F,1 
 F.RECRE  EQU    10          RECREATE FILE
 
 
*         DEFINE TABLE USED TO CONVERT *MS.FILE* ERROR
*         CODES TO -SYSFILE- *ZRETURN* CODES. 
 
 CONVTAB  BSS    0
 CONV     HERE
          DATA   0           MARK END OF TABLE
 .MDS     ENDIF 
 
*         DATA DEFINITIONS
 
 NUMARGS  OVDATA             TOTAL NUMBER OF ARGUMENTS
 ARGSDONE OVDATA             NUMBER OF ARGUMENTS PROCESSED
 
*         THE FOLLOWING FIELDS REQUIRE 60 BITS EACH WHEN
*         THEY ARE SAVED OVER INTERRUPTS. 
 
 SAVE60   OVDATA 0           START OF 60-BIT FIELDS 
 
 FILE     OVDATA             FILE NAME
 ACCT     OVDATA             ACCOUNT NAME 
 NFILE    OVDATA             NEW FILE NAME
 NACCT    OVDATA             NEW ACCOUNT NAME 
 PACK     OVDATA             PACK NAME
 DIRECT   OVDATA             DIRECTORY NAME 
 SUBACCT  OVDATA             SUB-ACCOUNT IDENTIFIER 
 ACCTRES  OVDATA             ACCOUNT OF RESIDENCE IDENT.
 
*         THE FOLLOWING FIELDS REQUIRE 18 BITS EACH WHEN
*         THEY ARE SAVED OVER INTERRUPTS. 
 
 SAVE18   OVDATA 0           START OF 18-BIT FIELDS 
 
 FIPSAVE  OVDATA             ADDRESS OF FIP 
 TYPSAVE  OVDATA             PRIMARY KEYWORD OPTION 
 OLDPACK  OVDATA             -1 IF PACK FOR OLD DISK SYSTEM 
 PINNED   OVDATA             -1 IF STORAGE PINNED, 0 IF NOT 
 SMCODE   OVDATA             STATION/MASTER DETACH FLAG 
 F.TYP    OVDATA             FILE TYPE
 F.LTH    OVDATA             FILE LENGTH
 F.DIR    OVDATA             SIZE OF DIRECTORY (SECTORS)
 F.RMT    OVDATA             SIZE/16 OF RMT (WORDS) 
 NPDWRIT  OVDATA             ZERO TO CHECKPT PACK DIRECTORY 
 START    OVDATA             STARTING SECTOR
 STORAGE  OVDATA             STORAGE INDEX
 NUMBER   OVDATA             NUMBER OF SECTORS
 MSGADDR  OVDATA             ADDRESS OF USER MESSAGE BUFFER 
 NEWFBIT  OVDATA             NEW BACKUP BIT 
 RJSAVE   OVDATA             -RJ- ADDRESS FOR *NEWSRCH* 
 RJSAVE1  OVDATA             -RJ- ADDRESS FOR *SEARCHED*
 ATTRIBS  OVDATA             ATTRIBUTE BITS 
 
 SAVEND   OVDATA 0           END OF FIELDS TO BE SAVED
 
 OVD      RMT                MUST BE ASSEMBLED W/OVDATA DEFS
 
*         THE OVERFLOW CHECK BELOW USES *TINTSVL-1* AS THE
*         MAXIMUM LENGTH AVAILABLE BECAUSE *TBINTSV+15* IS
*         USED BY *REQCHK*. 
 
 SAVE60L  EQU    SAVE18-SAVE60  60-BIT FIELDS TO SAVE 
 TSAV18L  SET    SAVEND-SAVE18+2
* /---   BLOCK      SYSFILE    00 000   79/10/28  01.18 
 TSAV18L  SET    TSAV18L/3   WORDS NEEDED FOR 18-BIT FIELDS 
          ERRNG  TINTSVL-1-SAVE60L-TSAV18L  OVERFLOW CHECK
          ERRNZ  TINTSVL-1-15  *TBINTSV+15* MUST BE LAST
 TSAV18L  SET    SAVEND-SAVE18  RESET TO NO OF 18-BIT FIELDS
* 
*         THE FOLLOWING -EQU- IS NEEDED BECAUSE COMPASS NO
*         LONGER RETAINS THE LAST VALUE OF THE -SET- PSEUDO 
*         BETWEEN PASSES 1 AND 2.  THIS WOULD THEN CAUSE
*         SYMBOL *SAVE18L* TO BE UNDEFINED AS IT IS 
*         REFERENCED BEFORE IT IS -SET- TO A VALUE. 
* 
*         KUBAT      82/02/17 
* 
 SAVE18L  EQU    TSAV18L
 
          RMT 
 
*         PARAMETERS EXPECTED BY -CREATE- 
 
          QUAL   CREATE 
 
 FILE     EQU    TBINTSV     FILE NAME
 INFO     EQU    TBINTSV+1   SPACE ALLOCATION REQUEST 
 CHECKPT  EQU    TBINTSV+2   NEG. IF NOT TO RETURN PACK DIR.
 FIPADDR  EQU    TBINTSV+3   ADDRESS OF FIP 
 
          QUAL   *
 
*         PARAMETERS EXPECTED BY -DESTROY-
 
          QUAL   DESTROY
 
 FILE     EQU    TBINTSV     NAME OF FILE TO DESTROY
 FIPADDR  EQU    TBINTSV+3   ADDRESS OF FIP 
 
          QUAL   *
 
*         PARAMETERS EXPECTED BY -RENAMEF-
 
          QUAL   RENAME 
 
 FILE     EQU    TBINTSV     FILE NAME
 NFILE    EQU    TBINTSV+1   DESIRED NEW FILE NAME
 FLAG     EQU    TBINTSV+2   0 FOR -RENAMEF-
 FIPADDR  EQU    TBINTSV+3   ADDRESS OF FIP 
 
          QUAL   *
 
*         PARAMETERS EXPECTED BY -RETYPEF-
 
          QUAL   RETYPE 
 
 FILE     EQU    TBINTSV     FILE NAME
 TYPE     EQU    TBINTSV+1   NEW FILE TYPE
 FLAG     EQU    TBINTSV+2   -1 FOR -RETYPEF- 
 FIPADDR  EQU    TBINTSV+3   ADDRESS OF FIP 
 
          QUAL   *
 
*         PARAMETERS EXPECTED BY -FBIT- 
 
          QUAL   FBIT 
 
 FILE     EQU    TBINTSV
 NEWFBIT  EQU    TBINTSV+1
 FIPADDR  EQU    TBINTSV+3
 
          QUAL   *
 
          ENDOV 
* /---   BLOCK      FIPS       00 000   80/11/26  15.00 
          EJECT 
 
          TITLE  FIP CONVERSIONS
 
 
**        FIELD - MOVE BIT FIELD BETWEEN REGISTERS
* 
*         FIELD  OW,OAS,OR,NLS,NR 
* 
*         ENTRY  (OW)  = WIDTH OF OLD FIELD 
*                (OAS) = SHIFT TO RIGHT-JUSTIFY OLD FIELD 
*                (OR)  = X-REGISTER CONTAINING OLD FIELD
*                        (NOT 0 OR 4) 
*                (NLS) = LEFT SHIFT TO POSITION NEW FIELD 
*                (NR)  = X-REGISTER TO CONTAIN NEW FIELD
*                        (NOT 0 OR 4) 
* 
*         USES   A - NONE.
*                B - 4. 
*                X - 0, 4.
* 
 
          PURGMAC FIELD 
 
          MACREF FIELD$ 
 FIELD    MACRO  OW,OAS,OR,NLS,NR 
 .0       IFNE   OAS,0
          SB4    OAS         (B4) = SHIFT TO RIGHT-JUSTIFY
 .0       ELSE
          SB4    B0 
 .0       ENDIF 
          AX4    OR,B4       RIGHT-JUSTFY FIELD IN X4 
          MX0    -OW
          BX4    -X0*X4      (X4) = DESIRED FIELD 
 .1       IFNE   NLS,0
          LX4    NLS         SHIFT TO NEW POSITION
 .1       ENDIF 
          B_NR   X4+NR       MERGE
          ENDM
 
 
* /---   BLOCK      FIPS       00 000   80/11/26  15.00 
          EJECT 
 
**        NEWFIPV - CONVERT OLD FORMAT FIP TO NEW FORMAT
* 
*         ENTRY  (OVARG1) = ADDRESS OF OLD FIP
*                (OVARG2) = ADDRESS OF NEW FIP
* 
 
 NEWFIPV  OVRLAY
 
          SA1    OVARG1 
          SA2    OVARG2 
          SB1    X1          (B1) = ADDR. OF OLD FIP
          SB2    X2          (B2) = ADDR. OF NEW FIP
 
          SA1    B1+0        (X1) = FILE NAME 
          SA2    B1+1        (X2) = PACK NAME 
          BX6    X1 
          BX7    X2 
          SA6    B2+/FIP/FILE 
          SA7    B2+/FIP/DIR
 
          SA1    B1+2 
          SA2    B1+3 
 
          SX6    MA.READ     PRESET TO R/O ACCESS 
          PL     X1,NEWFIP1  --- IF R/O ACCESS
          SX6    MA.RW       RESET TO R/W ACCESS
 NEWFIP1  LX6    /MFF/S.ATTACH
 
          SX4    1           SET OLD DISK SYSTEM FLAG 
          LX4    /MFF/S.OLD 
          BX6    X4+X6
 
          FIELD  11,48,X2,/MFF/S.STATN,X6 
          FIELD  1,59,X2,/MFF/S.FBIT,X6 
          FIELD  1,58,X1,/MFF/S.FILEF,X6
          FIELD  18,0,X1,/MFF/S.AFT,X6
 
          SA6    B2+/FIP/MFF  STORE MISC. FIP FIELDS
 
          MX6    0
 
          FIELD  6,30,X2,/FAW/S.FTYPE,X6
 
          SA6    B2+/FIP/FAW  STORE FILE ATTRIBUTE WORD 
 
          MX6    0
 
          FIELD  6,36,X2,/FIW/S.NDIR,X6 
          FIELD  6,42,X2,/FIW/S.RMTS,X6 
          FIELD  6,24,X2,/FIW/S.SIZE,X6 
          FIELD  9,18,X1,/FIW/S.PACK,X6 
          FIELD  18,0,X2,/FIW/S.ALLOC,X6
 
          SA6    B2+/FIP/FIW  STORE FILE INFORMATION WORD 
 
          RETURN
 
          ENDOV 
 
* /---   BLOCK      FIPS       00 000   80/11/26  15.13 
          EJECT 
 
**        OLDFIPV - CONVERT NEW FORMAT FIP TO OLD FORMAT
* 
*         ENTRY  (OVARG1) = ADDRESS OF NEW FIP
*                (OVARG2) = ADDRESS OF OLD FIP
* 
 
 OLDFIPV  OVRLAY
 
          SA1    OVARG1 
          SA2    OVARG2 
          SB1    X1          (B1) = ADDRESS OF NEW FIP
          SB2    X2          (B2) = ADDRESS OF OLD FIP
 
          SA1    B1+/FIP/FILE  (X1) = FILE NAME 
          SA2    B1+/FIP/DIR   (X2) = PACK NAME 
          BX6    X1 
          BX7    X2 
          SA6    B2+0 
          SA7    B2+1 
 
          SX6    0           CLEAR UNUSED WORD
          SA6    B2+4 
 
          RJ     =XZFILACC   (X1) = -1 IF R/W, 0 IF R/O 
          MX6    1           (X6) = MASK FOR ACCESS MODE
          BX6    X6*X1       (X6) = 1/ACCESS MODE, 59/0 
 
          SA1    B1+/FIP/MFF  (X1) = MISC. FIP FIELDS 
          SA2    B1+/FIP/FIW  (X2) = FILE INFORMATION WORD
          SA3    B1+/FIP/FAW  (X3) = FILE ATTRIBUTE WORD
 
          FIELD  1,/MFF/S.FILEF,X1,58,X6
          FIELD  9,/FIW/S.PACK,X2,18,X6 
          FIELD  18,/MFF/S.AFT,X1,0,X6
 
          SA6    B2+2        STORE MISC. GARBAGE
 
          MX6    0
 
          FIELD  1,/MFF/S.FBIT,X1,59,X6 
          FIELD  11,/MFF/S.STATN,X1,48,X6 
          FIELD  6,/FIW/S.RMTS,X2,42,X6 
          FIELD  6,/FIW/S.NDIR,X2,36,X6 
          FIELD  6,/FAW/S.FTYPE,X3,30,X6
          FIELD  6,/FIW/S.SIZE,X2,24,X6 
          FIELD  18,/FIW/S.ALLOC,X2,0,X6
 
          SA6    B2+3        STORE FIW
 
          RETURN
 
          ENDOV 
 
* /---   BLOCK      SYSLOC     00 000   80/11/26  15.13 
          TITLE  -SYSLOC- COMMAND EXECUTION OVERLAY 
*         -SYSLOC-  (CODE=182)
* 
*         RETURNS ADDRESS OF SYSTEM NAME
* 
* 
 
 SYSLOCV  OVRLAY
 
          NGETVAR            (X1) = SYSTEM NAME TO FIND 
          CALL   LJUST,(1R ),0
          MX6    -1          MARK INFO BUFFER USED
          SA6    JJSTORE
          SA2    ASYSLST     ADDRESS OF SYSTEM NAME TABLE 
          BX0    X2 
          SA4    NSYSNAM     LENGTH OF TABLE
 SNREAD   SB1    X4          SET LENGTH TO READ 
          SA0    INFO        READ TABLE TO INFO BUFFER
          SB2    INFOLTH     LENGTH OF INFO BUFFER
          LE     B1,B2,SYSLOX1  --- IF EVERYTHING FITS
          SB1    B2          DON'7T READ MORE THAN FITS 
 SYSLOX1  RE     B1 
          RJ     ECSPRTY
          MX7    42          MASK FOR NAME PORTION
          SA2    A0          GET FIRST ENTRY
          EQ     SNL1 
* 
 SNLOOK   SA2    A2+1        LOAD NEXT NAME 
          SB2    INFO+INFOLTH  END OF BUFFER
          SB2    A2-B2       TEST FOR END OF BUFFER 
          GE     B2,SNNEXT   PAST END - READ NEXT BUFFER
          ZR     X2,SYSNOT   EXIT IF NAME NOT FOUND 
 SNL1     BX3    X7*X2       GET NAME ONLY
          BX3    X1-X3       ...AND CHECK IF ITS THE ONE
          NZ     X3,SNLOOK   KEEP LOOKING 
          SX6    X2          MASK OFF ADDRESS 
          SA6    SSLOC       SAVE ADDRESS OF VARIABLE 
          SA5    A5 
          LX5    XCODEL 
          NGETVAR            GET SECOND VARIABLE
          SA2    SSLOC
          BX6    X2          STORE ADDRESS IN 2ND VAR 
          SA6    A1 
          SX6    0           *ERROR* = 0 IF ALL OK
          SX7    -1          *ZRETURN* = -1 
 SYSLEX   SA6    TERROR 
          SA7    TRETURN
          EQ     PROCESS     --- EXIT TO NEXT COMMAND 
 
 SYSNOT   MX6    -1          *ERROR* = -1 IF ERROR
          MX7    0           *ZRETURN* = 0 IF ERROR 
          EQ     SYSLEX 
* 
 SNNEXT   SX3    INFOLTH     BUFFER LENGTH
          IX4    X4-X3       TOTAL AMOUNT LEFT
          ZR     X4,SYSNOT   --- IF NOTHING LEFT
          NG     X4,SYSNOT   --- IF LESS THAN NOTHING LEFT
          IX0    X0+X3       ADVANCE ECS ADDRESS
          EQ     SNREAD      READ NEXT BUFFER 
 
 SSLOC    OVDATA             ADDRESS OF VARIABLE
 
          ENDOV 
* /---   BLOCK      DSKCOV     00 000   80/12/02  03.45 
          TITLE  DISK COMMANDS
* 
* 
* 
 DSKCOV   OVRLAY
          SA1    OVARG1 
          SB1    X1          GET JUMP TABLE INDEX 
          JP     B1+*+1 
* 
+         EQ     *           0 = UNUSED 
+         EQ     RENAMFX     1 = -RENAMEF- COMMAND
+         EQ     RETYPFX     2 = -RETYPEF- COMMAND
+         EQ     RENAME1     3 = -SYSFILE- COMMAND RENAME 
* 
* 
* /---   BLOCK      RENAMEF    00 000   80/12/02  03.31 
          TITLE  -RENAMEF-  AND  -RETYPEF-  TUTOR COMMANDS
* 
* 
*         RENAMEF 
* 
*         THE 1ST ARGUMENT SPECIFIES THE CURRENT NAME 
*         OF THE FILE AND THE 2ND ARGUMENT SPECIFIES THE
*         NEW NAME FOR THE FILE.  THE DISK UNIT AND PACK
*         NAME ARE ASSUMED TO BE IN *TDISKU* AND *TPNAME*.
*         THE ECS FILE NAME AND INFO TABLES ARE CHANGED 
*         AND THE PACK DIRECTORY IS THEN WRITTEN BACK ON
*         THE DISK. 
* 
*         ON EXIT, *TERROR* IS SET AS FOLLOWS-- 
*            -1 = FILE RENAMED SUCCESSFULLY 
*             0 = ERROR--PACK NAME (NO LONGER LOADED) 
*             1 = ERROR--OLD FILE NAME (NOT ON PACK)
*             2 = ERROR--NEW FILE NAME (ALREADY EXISTS) 
*             3 = ERROR--NEW FILE NAME (IMPROPER NAME)
* 
* 
*       RETYPEF 
* 
*       FIRST ARGUMENT IS FILE NAME TO BE RETYPED.
*       SECOND ARGUMENT IS NEW FILE TYPE.  MOST CODE
*       SHARED WITH RENAMEF, ERROR RETURNS THE SAME 
*       EXCEPT   ERROR = 2    MEANS BAD FILE TYPE 
* 
* 
* 
 RETYPFX  MX6    -1          SET FLAG FOR -RETYPEF- 
          EQ     RENATYP     JUMP TO COMMON ROUTINES
* 
 RENAMFX  MX6    0           SET FLAG FOR -RENAMEF- 
 RENATYP  SA6    TBINTSV+2   STORE FLAG 
          NGETVAR            X1 = OLD FILE NAME 
          BX6    X1 
          SA6    TBINTSV
          SA5    A5          RETRIEVE ORIGINAL COMMAND WORD 
          LX5    XCODEL 
          NGETVAR            X1 = NEW FILE NAME OR FILE TYPE
          BX6    X1 
          SA6    TBINTSV+1
* 
 RENAME1  BSS    0
          SA1    TDISKU 
          NG     X1,RERR0    NO SETPACK IN EFFECT 
          SA2    PTYPES+X1   PACK TYPE
          SA3    PDTYPES+3   BINARY 
          BX3    X2-X3
          ZR     X3,RERR0    ERROR EXIT IF BINARY PACK
          CALL   SAVLES      SAVE COMMON, STORAGE, ETC. 
          CALL   SAVKEY 
* 
          QUEUE  ADCTQUE,DACT     WAIT IN *DACT* QUEUE
* 
* /---   BLOCK      RENAMEF    00 000   80/12/02  03.30 
* 
*         INFORM *MASTOR* OF PENDING PACK DIRECTORY CHANGE
* 
          INTLOK X,I.DDIR,W  INTERLOCK DISK DIRECTORIES 
          CALL   S=UDSKR     READ DISK SYSTEM PARAMETERS
          SA1    TDISKU 
          MX6    1
          SA1    X1+PKSTS    SET BIT IN PACK STATUS TABLE TO
          BX6    X1+X6       MARK DIRECTORY CHANGE PENDING
          SA6    A1 
          CALL   S=UDSKW     WRITE DISK SYSTEM PARAMETERS 
          INTCLR X,I.DDIR 
          CALL   S=UDSK,STATION   UPDATE DISK STATUS TABLES 
* 
 REN120   TUTIM  -1,,IOKEY   WAIT REQUEST COMPLETE
          SA1    KEY
          SX1    X1-IOKEY    CHECK *KEY* = *IOKEY*
          NZ     X1,REN120
* 
          CALL   MXDSKW      FORCE OTHER EXECUTOR TO RECALL 
* 
*         EXECUTE DISK FILE RENAME OVERLAY. 
* 
          SA1    TBINTSV     SET UP OVERLAY ARGUMENTS 
          SA2    TBINTSV+1
          BX6    X1 
          BX7    X2 
          SA6    OVARG1 
          SA7    OVARG2 
          CALL   S=UDSKR     READ DISK SYSTEM PARAMETERS
* 
          SA1    TBINTSV+2   GET RENAMEF/RETYPEF FLAG 
          NG     X1,RETYP2   EXEC DIFF OVERLAYS DEP. ON FLAG
* 
          X      RENAMOV     -RENAMEF-
          SA1    TBINTSV+1   (X1) = NEW FILE NAME 
          BX6    X1 
          SA6    TBINTSV     OVERWRITE ORIGINAL NAME
          EQ     RENATY2
* 
 RETYP2   X      RETYPOV     -RETYPEF-
* 
 RENATY2  SA1    TDISKU      GET DISK UNIT NUMBER 
          MX6    1
          SA1    X1+PKSTS    CLEAR DIRECTORY CHANGE BIT 
          BX6    -X6*X1 
          SA6    A1 
          CALL   S=UDSKW     WRITE DISK SYSTEM PARAMETERS 
          CALL   MXDSKC      RELEASE OTHER EXECUTOR 
          CALL   S=UDSK,0    INFORM *MASTOR*
          SA1    TERROR 
          NG     X1,PDWRITE  OK -- WRITE PACK DIRECTORY 
          MX6    0           CLEAR *DACT* 
          SA6    DACT 
          REPLAX DACT 
          CALL   RESTKEY
          EQ     RETPROC     TO PROCESS IF ERROR
* 
 RERR0    SX6    0           BAD PACK 
          SA6    TERROR 
          SX6    3
          SA6    TRETURN     ALSO SET *ZRETURN* 
          EQ     PROCESS     ERROR RETURN 
* 
          ENDOV 
* 
* 
* /---   BLOCK      NETIO      00 000   78/08/11  21.56 
          TITLE  PLATO NETWORK REQUEST PROCESSING 
* 
*         NETIOV
* 
*         NETIO  REQUEST,RESPONSE  (CODE = 107) 
* 
*         REQUEST - 2 WORD REQUEST PACKED FOR -PLF- 
*         RESPONSE - 2 WORD RESPONSE AREA FOR -PLF- RESPONSE
* 
* 
*         REQUEST PACKET FROM LESSON (E.G. LINKCTL) 
*         WORD 1 - 04/UNUSED
*                  01/NETWORK TYPE(0=DOELZ, 1=3266) 
*                  01/UNUSED
*                  02/EOM(0=EOD, 1=EOB, 2=EOF)
*                  04/UNUSED
*                  12/UNUSED
*                  12/UNUSED
*                  12/NET ADDRESS (IF APPLICABLE) 
*                  12/REQUEST CODE
*         WORD 2 - ESTABLISH LINK REQUEST 
*                  4/NUMBER OF CALL PARAMETERS
*                  56/UP TO EIGHT 7 BIT CALL PARAMETERS 
*         WORD 2 - STORAGE ASSOCIATED REQUESTS
*                  12/LENGTH OF STORAGE 
*                  12/NUMBER OF WORDS OF STORAGE USED 
*                  12/UNUSED
*                  24/RELATIVE STORAGE ADDRESS
* 
*         REQUEST PACKET SENT TO -PLF-
*         WORD 1 - 04/UNUSED
*                  01/NETWORK TYPE(0=DOELZ, 1=3266) 
*                  01/UNUSED
*                  02/EOM (EOF, EOB, EOD) 
*                  04/EXECUTOR NUMBER 
*                  12/LESSON STATION NUMBER 
*                  12/NUMBER OF CM WORDS IN REQUEST 
*                  12/NET ADDRESS (IF APPLICABLE) 
*                  12/REQUEST CODE
*         WORD 2 - ESTABLISH LINK REQUEST 
*                  4/NUMBER OF CALL PARAMETERS
*                  56/UP TO EIGHT 7 BIT CALL PARAMETERS 
*         WORD 2 - STORAGE ASSOCIATED REQUESTS
*                  12/LENGTH OF STORAGE 
*                  12/NUMBER OF WORDS OF STORAGE USED 
*                  12/UNUSED
*                  24/ABSOLUTE STORAGE ADDRESS
* 
* /---   BLOCK      NETIO      00 000   78/08/06  22.40 
* 
*         TWO WORD RESPONSE PACKET RETURNED BY -PLF-, THEN
*         RETURNED IN -RESPONSE- TO LESSON. 
*         WORD 1 - 04/UNUSED
*                  01/NETWORK TYPE(0=DOELZ, 1=3266) 
*                  01/UNUSED
*                  02/EOM (0=EOD, 1=EOB, 2=EOF) 
*                  04/EXECUTOR NUMBER 
*                  12/LESSON STATION NUMBER 
*                  12/NUMBER OF CM WORDS IN RESPONSE
*                  12/NET ADDRESS (IF APPLICABLE) 
*                  12/RESPONSE CODE 
*         WORD 2 - ERROR RESPONSE 
*                  60/ERROR TYPE
*         WORD 2 - STORAGE ASSOCIATED RESPONSE
*                  12/LENGTH OF STORAGE 
*                  12/LENGTH OF MESSAGE 
*                  12/UNUSED
*                  24/ABSOLUTE STORAGE ADDRESS
* 
* 
 REQC     EQU    TBINTSV+9   REQUEST CODE 
 BORDSV   EQU    TBINTSV+10  FIXED BUFFER ORDINAL 
 LSTORSV  EQU    TBINTSV+11  LESSON STORAGE FWA 
 NETSTOP  EQU    TBINTSV+12  1 IF DROP LINK SENT TO PLF 
*                            BECAUSE TIMEOUT OCCURRED OR
*                            STOP1 WAS PRESSED, OTHERWISE 
*                            SET TO ZERO
 RPSAV    EQU    TBINTSV+13  SAVE -RESPONSE- ADDRESS
 STORSAV  EQU    TBINTSV+14  STORAGE ASSOCIATED FLAG
 PLFTIM   EQU    TBINTSV+15  -PLF- ALIVE TIMER
* /---   BLOCK      NETIO      00 000   78/07/13  22.31 
 NETIOV   OVRLAY
* 
* * *     INITIALIZE STORAGE FLAG TO NO STORAGE 
          MX6    0
          SA6    STORSAV
* 
* * *     SET TO NO -STOP1- RECEIVED
          SA6    NETSTOP
* 
* * *     SAVE THE CURRENT KEY
          SA1    KEY
          BX6    X1 
          SA6    TOKEY
* 
* * *     GET ADDRESS OF REQUEST
          NGETVAR 
* 
* * *     MAKE SURE ALL WORDS ARE IN BOUNDS 
          SA0    A1 
          SX1    PTSIZE      LENGTH OF NETWORK REQUEST
          RJ     =XBOUNDS 
* 
* * *     MOVE REQUEST PACKET TO WORK VARIABLES 
          SA1    A1 
          BX6    X1 
          SA6    NETRQ       WORD 1 
          SA1    A1+1 
          BX6    X1 
          SA6    NETRQ+1     WORD 2 
* 
* * *     GET -RESPONSE- ADDRESS
          SA5    A5 
          LX5    XCODEL 
          NGETVAR 
* 
* * *     MAKE SURE -RESPONSE- IS IN BOUNDS 
          SA0    A1 
          SX1    PFSIZE      LENGTH OF NETWORK RESPONSE 
          RJ     =XBOUNDS 
* 
* * *     SAVE -RESPONSE- ADDRESS IN STUDENT BANK 
          SX6    A1 
          SA6    RPSAV
* /---   BLOCK      NETIO      00 000   79/01/30  14.57 
 
*         SAVE COMMON AND STORAGE INFO. 
 
          CALL   SAVLES 
 
*         TEST IF DOELZ NETWORK SUPPORTED.
 
          SX0    =XPLF
          ZR     X0,NIOE8    IF NOT SUPPORTED 
* 
* * *     ISOLATE REQUEST CODE
          MX0    -RRCM
          SA1    NETRQ
          BX7    -X0*X1 
* 
* * *     MAKE SURE REQUEST IS IN RANGE 
          SX1    X7-MAXRQ1-1
          PL     X1,NIOE1    JUMP IF BAD REQUEST NUMBER 
* 
* * *     PROCESS WORD 2 OF REQUEST IF NECESSARY
          SB2    X7 
          SA7    REQC        SAVE REQUEST CODE
          JP     B2+NETTB 
* 
* * *     JUMP DEPENDING ON WHETHER REQUEST HAS 
* * *     ASSOCIATED STORAGE.  THE -JPTAB- MACRO
* * *     IS DEFINED IN -NETTEXT-.
* 
 NETTB    JPTAB              JUMP TABLE 
          JPTAB  0,NIOE1     NEVER USED 
          JPTAB  IATSIM,NIOS  INTERACTIVE TRUNK SIMULATION
          JPTAB  ESTSIM,NIONS  ESTABLISH SIMULATION LINK
          JPTAB  SWRITE,NIOS  SELECTIVE WRITE 
          JPTAB  DLDL,NIONS 
          JPTAB  CBST,NIOS   CIRCULAR BUFFER STATISTICS 
          JPTAB  ENDP,NIONS  END -PLF-
          JPTAB  DIAG,NIOS   DIAGNOSTIC REQUEST 
          JPTAB  DISP,NIONS  SET DISPLAY WINDOW 
          JPTAB  ESTT,NIONS  ESTABLISH TERMINAL LINK
          JPTAB  RNWA,NIONS  RESERVE NETWORK ADDRESS
          JPTAB  LDSIM,NIONS  LOCAL DISTRIBUTION SIMULATOR
          JPTAB  PLFSTS,NIOS  PLF STATISTICS
          JPTAB  HHLBA,NIOS  HOST TO HOST LOOPBACK
          JPTAB  ESTI,NIONS  ESTABLISH LINK (IA)
          JPTAB  ESTLB,NIONS  ESTABLISH LINK (LOOP) 
          JPTAB  IAP,NIONS   INTERACTIVE LINK PAUSE 
          JPTAB  APTS,NIOS   PERMISSION TO SEND 
          JPTAB  ADRPL,NIONS  DROP LINK 
          JPTAB  ESTR,NIONS  ESTABLISH RUNNER STATION 
          JPTAB  DRR,NIONS   DROP RUNNER STATION
          JPTAB  SREAD,NIOS  SELECTIVE READ 
          JPTAB  ESTD,NIONS  ESTABLISH DATA LINK
          JPTAB  SENDD,NIOS  SEND DATA
          JPTAB  SNAME,NIOS  GET SYSTEM NAME
          JPTAB  ESTNAM,NIOS NODE AVAILABLE MESSAGES
          JPTAB  TPLFS,NIOS  TEST - STORAGE 
          JPTAB  TPLFNS,NIONS  TEST - NO STORAGE
          JPTAB  MAXRQ1      END OF JUMP TABLE
* /---   BLOCK      NETIO      00 000   79/03/08  00.15 
* 
* * *     GET STORAGE INFO FOR THIS STATION 
 NIOS     SA1    TBXSTOR
          RJ     =XSETSTOR   SET UP *STORWRD* 
* 
* * *     GET STORAGE LENGTH FROM REQUEST 
          MX0    ECLM 
          SA1    NETRQ+1
          BX3    X0*X1
          LX3    ECLS 
          ZR     X3,NIOE2    JUMP IF BAD STORAGE LENGTH 
* 
* * *     GET STORAGE ADDRESS FROM REQUEST
          MX0    -ECAM
          BX2    -X0*X1 
          BX6    X0*X1       CLEAR OLD ECS ADDR. AND SAVE 
          SX4    1
          IX2    X2-X4
          NG     X2,NIOE3    JUMP IF BAD STORAGE ADDRESS
* 
* * *     GET LENGTH OF STORAGE FOR THIS STATION
          SA4    STORWRD
          AX4    18          POSITION LENGTH TO BOTTOM
          SX1    X4 
* 
* * *     CHECK STORAGE BOUNDS
          IX1    X1-X3       SUBTRACT STORAGE LENGTH
          IX1    X1-X2       SUBTRACT STORAGE START 
          NG     X1,NIOE4    JUMP IF OUT OF RANGE 
* 
* * *     CALCULATE ABSOLUTE STORAGE ADDRESS
          AX4    18          STARTING ADDR. FROM -STORWRD-
          IX4    X4+X2
* 
* * *     MERGE WITH STORAGE LENGTH AND DATA LENGTH 
          BX6    X4+X6
          SA6    NETRQ+1
* 
* * *     SET FLAG TO INDICATE STORAGE ASSOCIATED REQUEST 
          MX6    -1 
          SA6    STORSAV
* 
* * *     LOCK THE STORAGE
          CALL   IOLESSN,TBXSTOR,4000B
          RJ     NETIOF      MOVE TO FIXED BUFFER 
          PL     X6,NETIOX   IF ERRORS
 
*         SAVE PLF TIMER, FOR TIME OUT. 
 
 NIONS    SA0    PLFTIM 
          SA1    APLFCLK
          BX0    X1 
          RE     1
          RJ     ECSPRTY
* 
* * *     PUT NEW REQUEST INTO -TO PLF- BUFFER
          SX6    NETRQ       SET -PUTPLF- ARGUMENTS 
          SX7    PTSIZE 
          SA6    OVARG1 
          SA7    OVARG2 
          X      PUTPLF      CALL PUTPLF
          SA1    OVRET1      PICK UP RETURN ARGUMENT
          NG     X1,NIOE5    JUMP IF NO ROOM
* /---   BLOCK      NETIO      00 000   80/07/21  21.54 
          EQ     NETIO3     WAIT FOR RESPONSE FROM PLF
 
*         CHECK FOR PLF NOT RUNNING.
 
 NETIO1   SA3    PLFTIM      (X3) = LAST PLF TIME 
          SA0    A3 
          SA2    APLFCLK     ECS ADDRESS OF PLF CLOCK 
          BX0    X2 
          RE     1           READ CURRENT VALUE OF CLOCK
          RJ     ECSPRTY
* 
* * *     COMPARE OLD AND NEW CLOCK VALUES. 
          SA2    A0 
          IX2    X2-X3
          ZR     X2,NIOE6    JUMP IF PLF IS NOT RUNNING.
 
*         WAIT FOR RESPONSE FROM PLF. 
 
 NETIO3   TUTIM  PLFPTL,,ANYKEY 
          CALL   DETUTIM     DELETE TUTIM TIMING REQUEST
* 
          SA1    KEY
          SX2    X1-TUTUP 
          ZR     X2,NETIO1   IF -TUTUP- TIMING KEY
          SX2    X1-NETKEY   CHECK FOR -NETKEY- 
          ZR     X2,NIONK    JUMP IF -NETKEY- 
* 
* * *     CHECK FOR -STOP1- KEY.
*         (X1) = CURRENT KEY. 
          SX2    X1-STOP1 
          NZ     X2,NETIO3   IF NOT -STOP1- KEY 
* 
* * *     HAS -STOP1- BEEN PRESSED BEFORE.
          SA1    NETSTOP
          NZ     X1,NETIO3   IF -STOP1- ALREADY PRESSED 
* 
* * *     SEND DROP LINK TO PLF.
          SX6    NIODRPL     SET -PUTPLF- ARGUMENTS 
          SX7    PTSIZE 
          SA6    OVARG1 
          SA7    OVARG2 
          X      PUTPLF      CALL PUTPLF
          SA1    OVRET1      PICK UP RETURN ARGUMENT
          NG     X1,NETIO3   LOOP IF BUFFER FULL
* 
* * *     SET THE -STOP1- FLAG. 
          SX6    1
          SA6    NETSTOP
          EQ     NETIO3      WAIT FOR RESPONSE FROM PLF 
 
*         MOVE RESPONSE TO LESSON RESPONSE WORDS. 
 
 NIONK    SA1    RPSAV       ADDRESS OF -RESPONSE-
          SA2    NETRP       FIRST WORD OF RESPONSE 
          BX7    X2 
          SA7    X1          STORE FIRST WORD 
          SA2    NETRP+1     SECOND WORD OF RESPONSE
          BX6    X2 
          SA6    X1+1        STORE SECOND WORD
 
*         TEST FOR -PLF- ERROR RESPONSE.
 
          MX0    -RRCM
          BX0    -X0*X7 
          SX0    X0-ERMC
          ZR     X0,NIOE7    IF -PLF- ERROR RESPONSE
* 
* * *     SET ERROR RETURN IF DROP LINK SENT
          SA1    NETSTOP
          NZ     X1,NIOE6 
* 
* * *     SET FOR NORMAL RETURN 
          MX6    -1 
          EQ     NETIOX 
* /---   BLOCK      NETIO      00 000   78/10/27  13.48 
* 
* * *     ERROR --REQUEST NUMBER OUT OF RANGE 
 NIOE1    BSS    0
          SX6    1
          EQ     NETIOX 
* 
* * *     ERROR -- STORAGE LENGTH IS ZERO 
 NIOE2    BSS    0
          SX6    2
          EQ     NETIOX 
* 
* * *     ERROR -- STORAGE ADDRESS IS ZERO
 NIOE3    BSS    0
          SX6    3
          EQ     NETIOX 
* 
* * *     ERROR -- STORAGE OUT OF BOUNDS
 NIOE4    BSS    0
          SX6    4
          EQ     NETIOX 
* 
* * *     ERROR -- PLF REQUEST BUFFER IS FULL 
 NIOE5    BSS    0
          SX6    5
          EQ     NETIOX 
* 
* * *     ERROR -- NO PLF RESPONSE
 NIOE6    BSS    0
          SX6    6
          EQ     NETIOX 
 
*         ERROR RESPONSE RECEIVED FROM -PLF-. 
 
 NIOE7    SX6    7
          EQ     NETIOX 
 
*         ERROR - DOELZ NETWORK NOT SUPPORTED.
 
 NIOE8    SX6    8
          EQ     NETIOX 
* 
* * *     SET RETURN CODE 
 NETIOX   SA6    TRETURN
* 
* * *     STORAGE ASSOCIATED WITH THIS REQUEST/RESPONSE 
          SA1    STORSAV
          ZR     X1,NETIO2   JUMP IF NOT
          PL     X6,NETIOX1  IF ERROR ALREADY DETECTED
          SA1    REQC        CHECK REQUEST CODE 
          SX1    X1-DIAG     CHECK FOR *DIAG* REQUEST 
          ZR     X1,NETIOX1  IF *DIAG* DO NOT WRITE STORAGE 
          RJ     NETIOT      MOVE FROM FIXED BUFFER 
          SA6    TRETURN     SET ERROR RETURN 
 NETIOX1  RJ     NETIOR      RELEASE FIXED BUFFER 
* 
* * *     UNLOCK STORAGE BUFFER 
          CALL   IOLESSN,TBXSTOR,-4000B 
 
*         RESTORE LESSON AND COMMON/STORAGE POINTERS. 
 
 NETIO2   CALL   RESTLES
 
*         RESTORE *KEY*.
 
          SA1    TOKEY
          BX6    X1 
          SA6    KEY
          EQ     CKPROC 
* 
 
 NIODRPL  VFD    60/ADRPL    NETWORK DROP LINK REQUEST
          VFD    60/0 
* /---   BLOCK      NETIOF     00 000   78/09/15  01.19 
          SPACE  4,10 
**        NETIOF - TEMPORARY NETIO ROUTINE. 
* 
*         MOVE DATA FROM LESSON STORAGE TO A FIXED -NETIO-
*         ECS BUFFER AND ALTER PLF REQUEST TO USE THIS FIXED
*         ECS STORAGE BUFFER.  THIS PROTECTS PLATO FROM PLF 
*         ERRORS DURING DEBUGGING, BECAUSE PLFS FLX CONTAINS
*         THESE FIXED BUFFERS.
* 
*         ENTRY  (NETRQ+1) = LESSON STORAGE FWA AND LENGTH. 
* 
*         EXIT   (X6) = -1, IF NO ERRORS. 
*                (X6) = 96, IF DATA LENGTH TOO LONG.
*                (X6) = 99, IF FIXED BUFFER NOT AVAILABLE.
*                (X6) = 100, IF LESSON STORAGE TOO LONG.
*                (NETRQ+1) = FIXED BUFFER FWA AND LENGTH. 
*                (BORDSV) = FIXED BUFFER ORDINAL. 
* 
*         USES   X - 0,1,2,3,4,6,7. 
*                A - 0,1,4,7. 
*                B - 1,2,3. 
* 
*         CALLS  INTLOKW,INTCLR 
 
 
 NETIOF   PS                 ENTRY/EXIT 
 
*         SET TO NO BUFFER ALLOCATED. 
 
          MX6    -1 
          SA6    BORDSV 
 
*         TEST STORAGE LENGTH.
 
          SA4    NETRQ+1
          MX3    ECLM 
          BX1    X4*X3
          LX1    ECLS 
          SX3    X1-NETIOBL-1 
          SX6    100         SET LENGTH ERROR 
          PL     X3,NETIOF   RETURN IF STORAGE TOO LONG 
          SB2    X1          SAVE THE LENGTH
 
*         TEST DATA LENGTH
 
          MX3    EDLM 
          LX3    60-EDLS+EDLM 
          BX2    X4*X3
          LX2    EDLS 
          IX3    X1-X2       STORAGE LTH - DATA LTH 
          SX6    96          SET DATA LENGTH ERROR
          NG     X3,NETIOF   RETURN IF DATA LTH .GT. STORAGE
 
*         ALLOCATE A FIXED BUFFER.
 
          INTLOK X,I.PLFT,W  INTERLOCK THE BUFFER BITS
          SA1    ANETBB      GET BUFFER BITS ECS ADDRESS
          RX3    X1          READ BUFFER BITS FROM ECS
          NX2    X3 
          ZR     X2,NETIOF1  RETURN, IF NO BUFFERS
          UX2,B1 X2          GET BUFFER ORDINAL IN *B1* 
          SX7    B1          SAVE BUFFER ORDINAL
          SA7    BORDSV 
          MX6    -1          CLEAR BUFFER BIT 
          SB3    =XNNIOB-48 
          SB1    B1-B3
          LX6    B1 
          BX6    X3*X6
          WX6    X1          REPLACE BUFFER BITS
          INTCLR X,I.PLFT    UNLOCK BUFFER BITS 
* /---   BLOCK      NETIOF     00 000   78/10/27  16.49 
 
*         COMPUTE FIXED BUFFER FWA. 
 
          SX2    NETIOBL     BUFFER LENGTH
          IX7    X7*X2       OFFSET TO NEXT BUFFER
          SA1    ANETBF      ECS FWA OF BUFFERS 
          IX2    X1+X7       FWA OF THIS BUFFER 
 
*         SAVE LESSON STORAGE FWA.
 
          MX6    -ECAM
          BX7    -X6*X4      LESSON STORAGE ECS FWA 
          SA7    LSTORSV
 
*         MOVE LESSON STORAGE TO FIXED BUFFER.
 
          BX0    X7 
          SA0    WORK 
+         RE     B2 
          RJ     =XECSPRTY   ANALYZE ECS ERROR
          BX0    X2 
+         WE     B2 
          RJ     =XECSPRTY   ANALYZE ECS ERROR
 
*         REPLACE LESSON STORAGE FWA WITH FIXED BUFFER
*         FWA IN THE REQUEST. 
 
          BX6    X4*X6       CLEAR ECS FWA
          BX6    X0+X6       INSERT FIXED BUFFER FWA
          SA6    NETRQ+1
 
*         SET TO NO ERRORS AND RETURN.
 
          SX6    -1 
          EQ     NETIOF      RETURN 
 
 NETIOF1  INTCLR X,I.PLFT    UNLOCK BUFFER BITS 
          SX6    99          SET NO BUFFER ERROR
          EQ     NETIOF      RETURN 
* /---   BLOCK      NETIOT     00 000   78/08/11  01.27 
          SPACE  4,10 
**        NETIOT - TEMPORARY NETIO ROUTINE. 
* 
*         MOVE DATA FROM A FIXED -NETIO- BUFFER TO LESSON 
*         STORAGE BUFFER AND ALTER PLF RESPONSE TO USE THE
*         LESSON BUFFER ADDRESS.  THIS PROTECTS PLATO FROM
*         PLF ERRORS DURING DEBUGGING, BECAUSE PLFS FLX 
*         CONTAINS THESE FIXED BUFFERS. 
* 
*         ENTRY  (RPSAV) = FWA OF RESPONSE. 
* 
*         EXIT   (X6) = -1, IF NO ERRORS. 
*                (X6) = 98, IF STORAGE BUFFER ERROR.
*                (X6) = 97, IF PLF MESSAGE TOO LONG.
*                ((RPSAV)+1) = STORAGE LENGTH, MESSAGE
*                              LENGTH, LESSON STORAGE FWA.
* 
*         USES   X - 0,1,2,3,4,6,7. 
*                A - 0,1,4,6. 
*                B - 1,2. 
* 
*         CALLS  INTLOKW,INTCLR,SETSTOR.
 
 
 NETIOT   PS                 ENTRY/EXIT 
 
*         CHECK THAT LESSON STORAGE FWA IS .LE. THE SAVED 
*         STORAGE FWA.
 
          SA1    TBXSTOR
          RJ     =XSETSTOR   GET LESSON STORAGE INFORMATION 
          SA1    STORWRD
          AX1    18 
          SX4    X1          SAVE LESSON STORAGE LENGTH 
          AX1    18          GET LESSON STORAGE FWA 
          SA2    LSTORSV     SAVED STORAGE FWA
* /---   BLOCK      NETIOT     00 000   78/08/11  02.47 
          IX3    X2-X1
          SX6    98          SET STORAGE BUFFER ERROR 
          NG     X3,NETIOT   RETURN IF STORAGE BUFFER ERROR 
 
*         CHECK THAT MESSAGE WILL NOT OVERFLOW LESSON 
*         STORAGE.
 
          IX1    X1+X4       LESSON STORAGE LWA 
          SA3    RPSAV       GET PLF MESSAGE LENGTH 
          SA3    X3+1 
          MX6    -EDLM
          LX3    EDLS 
          BX7    -X6*X3      ISOLATE MESSAGE LENGTH 
          SB1    X7          SAVE MESSAGE LENGTH
          IX1    X1-X7       LWA - MESSAGE LENGTH 
          IX1    X1-X2
          SX6    97          SET MESSAGE LENGTH ERROR 
          NG     X1,NETIOT   RETURN IF MESSAGE TOO LONG 
 
*         MOVE MESSAGE FROM FIXED -NETIO- BUFFER TO 
*         LESSON STORAGE. 
 
          LX3    60-EDLS     ISOLATE PLF STORAGE FWA
          MX6    -ECAM
          BX4    -X6*X3 
          BX0    X4 
          SA0    WORK 
+         RE     B1 
          RJ     =XECSPRTY   ANALYZE ECS ERROR
          BX0    X2 
+         WE     B1 
          RJ     =XECSPRTY   ANALYZE ECS ERROR
 
*         REPLACE PLF ECS FWA WITH LESSON STORAGE FWA IN
*         RESPONSE. 
 
          BX3    X3*X6       CLEAR ECS FWA FILED
          BX6    X3+X0       INSERT LESSON STORAGE FWA
          SA6    A3 
* /---   BLOCK      NETIOT     00 000   78/09/15  01.20 
          MX6    -1          SET NO ERRORS
          EQ     NETIOT      RETURN 
 
          SPACE  4,10 
**        NETIOR - RELEASE FIXED -NETIO- BUFFER.
* 
*         ENTRY  (BORDSV) = FIXED BUFFER ORDINAL. 
* 
*         EXIT   NONE.
* 
*         USES   X - 0,1,2,6. 
*                A - 0,1,2,6. 
*                B - 2,3. 
* 
*         CALLS  INTLOKW,INTCLR.
 
 
 NETIOR   PS                 ENTRY/EXIT 
          SA1    BORDSV 
          NG     X1,NETIOR   RETURN IF NO BUFFER ALLOCATED
          SB2    X1          BUFFER ORDINAL 
          INTLOK X,I.PLFT,W  INTERLOCK BUFFER BITS
          SA1    ANETBB 
          RX2    X1          READ BUFFER BITS 
          MX6    -1 
          SB3    =XNNIOB-48 
          SB2    B2-B3
          LX6    B2 
          BX6    -X6+X2      SET BUFFER BIT 
          WX6    X1          WRITE BUFFER BITS
          INTCLR X,I.PLFT    REMOVE INTERLOCK 
          EQ     NETIOR      RETURN 
* /---   BLOCK      END NETIO  00 000   78/08/11  21.56 
          ENDOV 
* /---   BLOCK      PUTPLF     00 000   79/03/08  00.47 
          TITLE  PUT PLF REQUEST
* 
* * * PUTPLF
* 
*         ENTRY  (OVARG1) = ADDRESS OF REQUEST
*                (OVARG2) = LENGTH OF REQUEST 
* 
*         EXIT   (OVRET1) = -(REQUEST LENGTH) IF NO ROOM
* 
*         FORMAT OF REQUEST HEADER- 
*         06/UNUSED 
*         02/EOM TYPE 
*         04/UNUSED 
*         12/STATION
*         12/NUMBER OF CM WORDS IN REQUEST
*         12/SEQUENCE NUMBER
*         12/REQUEST TYPE 
* 
 PUTPLF   OVRLAY
 
*         TEST IF DOELZ NETWORK SUPPORTED.
 
          SX6    =XPLF
          ZR     X6,PPLF7    IF NOT SUPPORTED 
 
*         UPDATE SEQUENCE NUMBER. 
 
          SA1    NETSEQ 
          SX6    X1+1 
          MX0    -12
          BX6    -X0*X6 
          SA6    A1+
 
*         INSERT STATION, LENGTH AND SEQUENCE IN REQUEST. 
 
          SA1    STATION
          SA2    OVARG1 
          SB2    X2          (B2) = REQUEST FWA 
          SA2    B2          (X2) = REQUEST WORD 0
          SA4    OVARG2      (X4) = REQUEST LENGTH
          SB3    X4          (B3) = REQUEST LENGTH
          MX0    36 
          LX1    36          POSTION STATION
          LX4    24          POSITION LENGTH
          LX6    12          POSITION SEQUENCE
          LX0    47-59       POSITION MASK
          BX2    -X0*X2      CLEAR FIELDS 
          BX6    X2+X6       MERGE SEQUENCE 
          BX6    X1+X6       MERGE STATION
          BX6    X4+X6       MERGE LENGTH 
          SA6    B2+
* 
* * *     INTERLOCK -TO PLF- BUFFER 
          INTLOK X,I.PLFT,W 
* 
* * *     GET BUFFER ADDRESS. SAVE IN X4. 
          SA1    APLFTO      GET BUFFER LENGTH / FWA WORD 
          MX0    -ECAM       ISOLATE FWA IN X4
          BX4    -X0*X1      ** X4 = BUFFER FWA **
* 
* * *     GET BUFFER LENGTH. SAVE IN B4 
          MX0    -BFLM       ISOLATE LENGTH IN X1 
          LX1    BFLS 
          BX1    -X0*X1 
          SB4    X1          ** B4 = BUFFER LENGTH ** 
* 
* * *     GET BUFFER IN AND OUT POINTERS FROM ECS.
          SA2    APTIN       ECS ADDRESS OF POINTERS
          BX0    X2 
          SA0    NETPTRS
+         RE     2
          RJ     =XECSPRTY   ANALYZE ECS ERROR
* 
* * *     COMPUTE FREE SPACE IN BUFFER. 
* 
*         IF (IN < OUT) 
*                FREE SPACE = OUT - IN - 1
*         ELSE
*                FREE SPACE = (BUFFER LENGTH - IN) + (OUT - 1)
*         ENDIF 
 
* /---   BLOCK      PUTPLF     00 000   79/03/08  00.47 
          SA2    A0          ** X2 = IN **
          SA3    A0+1        GET OUT POINTER
          IX0    X2-X3       (IN - OUT) 
          BX1    -X0         (OUT - IN) 
          SB6    X1-1        FREE SPACE IF IN &lt; OUT 
          NG     X0,PPLF2    IF IN &lt; OUT
          SB6    B6+B4       FREE SPACE IF IN .GE. OUT
 PPLF2    BSS    0
          LT     B6,B3,PPLF5 IF NOT ENOUGH FREE SPACE 
* /---   BLOCK      PUTPLF     00 000   79/04/18  00.07 
* 
* * *     COMPUTE THE NEW IN POINTER VALUE.  SAVE IN B6.
* 
*         T = IN + MESSAGE LENGTH 
*         IF (T < BUFFER LENGTH)
*                NEW IN = T 
*         ELSE
*                NEW IN = T - BUFFER LENGTH 
*         ENDIF 
 
          SB6    X2+B3       NEW IN IF NO WRAP AROUND 
          LT     B6,B4,PPLF3 JUMP IF NO WRAP AROUND 
          SB6    B4-B6       NEW IN IF WRAP AROUND
* 
* * *     WRAP AROUND, SO MESSAGE MUST BE WRITTEN IN
*         TWO PARTS.
          SA0    B2          (MESSAGE FWA)
          SB1    X2          IN 
          SB1    B4-B1       BUFFER LTH - IN
          IX0    X4+X2       (BUFFER FWA + IN)
+         WE     B1 
          RJ     =XECSPRTY   ANALYZE ECS ERROR
* 
* * *     SECOND PART.
          SA0    B2+B1       (MESSAGE FWA + 1ST PART LENGTH)
          BX0    X4          (BUFFER FWA) 
+         WE     B6 
          RJ     =XECSPRTY   ANAYZE ECS ERROR 
          EQ     PPLF4       UPDATE IN POINTER
* 
* * *     WRITE MESSAGE IN ONE PART.
 PPLF3    BSS    0
          SA0    B2          MESSAGE FWA
          IX0    X2+X4       (IN + BUFFER FWA)
+         WE     B3 
          RJ     =XECSPRTY   ANALYZE ECS ERROR
* 
* * *     UPDATE IN POINTER.
 PPLF4    SX6    B6          PLACE POINTER IN CM
          SA1    APTIN       GET IN POINTER ECS ADDRESS 
          WX6    X1 
          EQ     PPLF6
* 
* * *     ERROR -- NO ROOM IN BUFFER
 PPLF5    BSS    0
          SB3    -B3
* 
* * *     CLEAR -PLF- BUFFER INTERLOCK
 PPLF6    BSS    0
          INTCLR X,I.PLFT 
          SX6    B3          SET RETURN WITH ERROR
          SA6    OVRET1 
 PPLF7    RETURN             RETURN FROM THIS OVERLAY 
* /---   BLOCK      END PUTPLF 00 000   79/03/07  19.15 
          ENDOV 
* /---   BLOCK      DRPLINK    00 000   79/04/18  00.02 
          TITLE  DROP LINK
* 
* * * DRPLINK 
* 
*  THIS ROUTINE IS CALLED TO CHECK TO SEE IF A STATION
*  IS ON THE DOELZ NETWORK LINK, AND IF SO, SEND A DROP 
*  LINK REQUEST TO PLF. 
* 
* 
 DRPLINK  OVRLAY
* 
*  CHECK TO SEE IF THIS SYSTEM HAS A DOELZ NETWORK
* 
          SX1    =XPLF
          ZR     X1,DLEXIT   IF DOELZ NOT SUPPORTED 
* 
*  CHECK TO SEE IF THE STATION IS A REMOTE DOELZ STATION
* 
          SA1    STATION     GET THE STATION NUMBER 
          SX2    RNETSF      GET FIRST REMOTE DOELZ STATION 
          IX3    X1-X2
          NG     X3,LDLZ     BRANCH IF NOT A REMOTE STATION 
* 
          SX2    RNETSN      GET NUMBER OF REMOTE STATIONS
          IX3    X3-X2
          PL     X3,LDLZ     IF NOT A REMOTE STATION
          SX6    ADRPL       REMOTE DROP LINK REQUEST CODE
          EQ     DROPL       SEND REQUEST TO PLF
* 
*  CHECK TO SEE IF THE STATION IS A LOCAL DOELZ STATION 
* 
 LDLZ     BSS    0
          SX2    LNETSF      GET FIRST LOCAL DOELZ STATION
          IX3    X1-X2
          NG     X3,DLEXIT   EXIT IF NOT A LOCAL STATION
* 
          SX2    LNETSF      GET NUMBER OF LOCAL STATIONS 
          IX3    X3-X2
          PL     X3,DLEXIT   IF NOT A LOCAL STATION 
          SX6    DLDL        LOCAL DROP LINK REQUEST CODE 
* 
*  SEND A DROP LINK REQUEST TO PLF   (X6) = REQUEST CODE. 
* 
 DROPL    BSS    0
          SA6    NIODROP     SET PLF REQUEST CODE 
          SX6    NIODROP     SET -PUTPLF- ARGUMENTS 
          SX7    PTSIZE 
          SA6    OVARG1 
          SA7    OVARG2 
          X      PUTPLF      CALL PUTPLF
* 
 DLEXIT   RETURN             EXIT DRPLINK 
* 
 NIODROP  BSSZ   2           DROP LINK REQUEST
* 
          ENDOV 
* /---   BLOCK      END        00 000   76/07/21  20.27 
* 
* 
          OVTABLE 
* 
* 
          END    EXEC4$