FILES 
          IDENT  FILES,FILES
          ABS 
          SST 
          SYSCOM B1 
          ENTRY  BKSP 
          ENTRY  BKSPRU 
          ENTRY  COMMON 
          ENTRY  EVICT
          ENTRY  LOCK 
          ENTRY  PRIMARY
          ENTRY  RENAME 
          ENTRY  SKIPEI 
          ENTRY  SKIPF
          ENTRY  SKIPFB 
          ENTRY  SKIPR
          ENTRY  UNLOCK 
          ENTRY  WRITEF 
          ENTRY  WRITER 
          ENTRY  NPC= 
          ENTRY  RFL= 
*COMMENT  FILES - LOCAL FILE MANIPULATOR. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  FILES - LOCAL FILE MANIPULATOR.
          SPACE  4
***       FILES - LOCAL FILE MANIPULATOR. 
*         G. R. MANSFIELD.  70/11/25. 
          SPACE  4
***              FILES PROCESSES LOCAL FILE FUNCTIONS FOR A JOB AS
*         LISTED BELOW.  NUMERIC ARGUMENTS, EXCEPT SKIPR EOR LEVEL AND
*         SETID ID CODE, ARE ASSUMED DECIMAL, BUT A TRAILING RADIX OF 
*         *D* OR *B* MAY BE USED. 
          SPACE  4
***       DAYFILE MESSAGES. 
* 
* 
*         * ERROR IN FILE ARGUMENTS.* = AN ARGUMENT TO A FILE 
*                FUNCTON WAS ILLEGAL. 
          SPACE  4
*CALL     COMCCMD 
*CALL     COMCMAC 
*CALL     COMSDSP 
*CALL     COMSJIO 
          SPACE  4,10 
*         SPECIAL ENTRY POINT.
  
 NPC=     EQU    0           FORCE OPERATING SYSTEM PARAMETER FORMAT
          TITLE  MULTI FILE PROCESSOR.
 FILES    SPACE  4
**        FILES - MULTI FILE PROCESSOR. 
*         ENTRY  (B5) = PROCESSOR ADDRESS.
  
  
          ORG    150B 
 FILES    SA5    2+B6        SET FILE NAME
          BX6    X5 
          SB6    B6+B1
          SA6    F
          JP     B5          PROCESS OPERATION
  
 FIL1     NE     B6,B7,FILES LOOP FOR ALL FILES 
 FIL2     SA1    JOPR        CHECK FOR *DIS* CALL 
          LX1    59-19
          NG     X1,FIL4     IF *DIS* CALL
          CONTROL CCDR,RSS
          SA1    PGNR 
          ZR     X1,FIL4     IF NO CONTROL CARD 
          SA2    FILES-1     FIRST ENTRY NAME 
          MX0    42 
          BX1    X0*X1
 FIL3     NG     X2,FIL4     IF END OF ENTRY NAMES
          BX3    X0*X2
          BX6    X3-X1
          SB2    X2 
          SA2    A2-B1
          NZ     X6,FIL3     IF NO MATCH
          CONTROL CCDR       ADVANCE CONTROL CARD 
          SA3    PGNR 
          SA1    F+1         CLEAR FET STATUS 
          ZR     X3,ERR1     IF CONTROL STATEMENT LIMIT 
          MX2    -24
          BX6    -X2*X1 
          SA6    A1 
          JP     B2          PROCESS CALL 
 FIL4     ENDRUN
          TITLE  FUNCTION PROCESSORS. 
 ASSIGN   SPACE  4
 BKSP     SPACE  4
***       BKSP   (F,N,M)
*         BACKSPACE N RECORDS ON FILE F 
*         WITH FILE MODE *M*. 
  
  
 BKSP     SB2    -1          PROCESS F,X,M ARGUMENTS
          RJ     ARG
          OPEN   F,READNR,R 
          SKIPB  F,X0,R 
          EQ     SKF2        RESET FILE MODE
 BKSPRU   SPACE  4,5
***       BKSPRU (F,N,M)
* 
*         BACKSPACE N PHYSICAL RECORD UNITS ON FILE *F* 
*         WITH FILE MODE *M*. 
  
  
 BKSPRU   SB2    -1          PROCESS F,N,M ARGUMENTS
          RJ     ARG
          OPEN   F,READNR,R 
          BKSPRU F,X0,R 
          EQ     SKF2        RESET FILE MODE
 COMMON   SPACE  4
***       COMMON (F1,F2,...,FN) 
*         FOR FILES FN, THE FOLLOWING OPERATION IS PERFORMED. 
*         IF FILE FN IS NOT ASSIGNED TO THE JOB, *COMMON* FILE FN 
*         IS ASSIGNED TO THE JOB. 
*         IF FILE FN IS ALREADY ASSIGNED TO THE JOB, NO ACTION IS 
*         TAKEN.
  
  
 COMMON   SB2    1           CHECK SINGLE ARGUMENTS 
          RJ     ARG
          SB5    COM         SET COMMON ENTRY 
          EQ     FILES
  
 COM      ASSIGN F
          EQ     FIL1 
 EVICT    SPACE  4
***       EVICT(F1,F2,...,FN) 
*         EVICT FILES FN. 
  
  
 EVICT    SB2    1           CHECK SINGLE ARGUMENTS 
          RJ     ARG
          SB5    EVI         SET EVICT ENTRY
          JP     FILES
  
 EVI      EVICT  A6,R 
          JP     FIL1        PROCESS NEXT FILE
 LOCK     SPACE  4
***       LOCK (F1,F2,...,FN) 
*         LOCK FILES FN.
  
  
 LOCK     SB2    1           CHECK SINGLE ARGUMENTS 
          RJ     ARG
          SB5    LCK         SET LOCK ENTRY 
          EQ     FILES
  
 LCK      LOCK   A6,R 
          EQ     FIL1        PROCESS NEXT FILE
 PRIMARY  SPACE  4,2
***       PRIMARY (F) 
*         MAKE FILE F USER S NEW PRIMARY FILE.
  
  
 PRIMARY  SB2    1           CHECK SINGLE ARGUMENT
          RJ     ARG
          NE     B1,B7,ERR   IF MORE THAN 1 ARGUMENT SPECIFIED
          SB5    PRI
          EQ     FILES
  
 PRI      PRIMARY F 
          EQ     FIL1 
 RENAME   SPACE  4
***       RENAME (N1=F1,N2=F2,...,NI=FI)
*         RENAME FILES FN TO NN.
*         IF FILE NN WAS PREVIOUSLY DEFINED, THAT FILE WILL BE DROPPED
*         FROM THE JOB. 
  
  
 RENAME   SB2    2           CHECK EQUIVALENCED ARGUMENTS 
          RJ     ARG
          SB6    B1          BEGIN WITH SECOND NAME 
          SB7    B7+B1
          SB5    REN         SET RENAME ENTRY 
          EQ     FILES
  
 REN      SA4    A6          SAVE OLD NAME
          SA1    A5-B1       SET NEW NAME 
          BX7    X1 
          SA7    A6 
          SA1    F           SET NEW NAME 
          BX6    X4          SET OLD NAME 
          LX7    X1 
          SA6    A1 
          SA7    F+6
          RENAME A6,,R
          SB6    B6+B1
          EQ     FIL1        PROCESS NEXT FILE
 SKIPEI   SPACE  4
***       SKIPEI (F)
*         SKIP TO END OF INFORMATION ON FILE F (MASS STORAGE ONLY). 
  
  
 SKIPEI   SB2    B0          PROCESS F,X ARGUMENTS
          RJ     ARG
          NZ     B7,ERR      ERROR IF MORE THAN 1 ARGUMENT
          OPEN   F,READNR,R 
          SKIPEI F,R
          EQ     FIL2 
 SKIPF    SPACE  4
***       SKIPF  (F,N,M)
*         SKIP N FILES FORWARD ON FILE F. 
*         WITH FILE MODE *M*. 
  
  
 SKIPF    SB2    -1          PROCESS F,X,M ARGUMENTS
          RJ     ARG
          OPEN   F,READNR,R 
 SKF1     SKIPFF F,X0,R 
 SKF2     SA1    F           RESET FILE MODE
          SX4    3
          MX0    42 
          BX6    X0*X1
          BX6    X6+X4
          SA6    A1 
          EQ     FIL2 
 SKIPFB   SPACE  4
***       SKIPFB (F,N,M)
*         SKIP N FILES BACKWARD ON FILE F.
*         WITH FILE MODE *M*. 
  
  
 SKIPFB   SB2    -1          PROCESS F,X,M ARGUMENTS
          RJ     ARG
          OPEN   F,READNR,R 
 SKB1     SKIPFB F,X0,R 
          EQ     SKF2 
 SKIPR    SPACE  4
***       SKIPR  (F,N,L,M)
*         SKIP N RECORDS FORWARD ON FILE F. 
*         WITH EOR LEVEL *L*, ASSUMED OCTAL, AND/OR FILE MODE *M*.
  
  
 SKIPR    SB2    -2          PROCESS F,X,L,M ARGUMENTS
          RJ     ARG
          BX4    X7          SAVE LEVEL NUMBER
          OPEN   F,READNR,R 
          BX7    X4          RESTORE LEVEL NUMBER 
 SKR1     SX2    F
          LX0    18 
          BX2    X2+X0
          LX7    14 
          SX6    240B 
          BX7    X7+X6
          MX6    60 
          BX7    X7-X6
          RJ     =XCIO= 
          EQ     SKF2 
 UNLOCK   SPACE  4
***       UNLOCK (F1,F2,...,FN) 
*         UNLOCK FILES FN.
  
  
 UNLOCK   SB2    1           CHECK SINGLE ARGUMENTS 
          RJ     ARG
          SB5    ULK         SET LOCK ENTRY 
          EQ     FILES
  
 ULK      UNLOCK A6,R 
          EQ     FIL1        PROCESS NEXT FILE
 WRITEF   SPACE  4
***       WRITEF(F,N) 
*         WRITE N FILE MARKS ON FILE F. 
  
  
 WRITEF   SB2    B0          PROCESS F,X ARGUMENTS
          RJ     ARG
 WRF1     WRITEF F,R
          SX0    X0-1 
          NZ     X0,WRF1     LOOP FOR ALL FILES 
          EQ     FIL2 
 WRITER   SPACE  4
***       WRITER (F,N)
*         WRITE N EMPTY RECORDS ON FILE F.
  
  
 WRITER   SB2    B0          PROCESS F,X ARGUMENTS
          RJ     ARG
 WRR1     WRITER F,R
          SX0    X0-1 
          NZ     X0,WRR1     LOOP FOR ALL RECORDS 
          EQ     FIL2 
          TITLE  SUBROUTINES. 
 AMO      SPACE  4
 ARG      SPACE  4
**        ARG - PROCESS ARGUMENTS.
* 
*         ENTRY  (B2) = -2 IF F,X,L,M FORM. 
*                (B2) = -1 IF F,X,M FORM. 
*                (B2) = 0 IF F,X FORM.
*                (B2) = 1 IF SINGLE VALUE ARGUMENT. 
*                (B2) = 2 IF EQUIVALENCED ARGUMENT. 
* 
*         EXIT   (B1) = 1.
*                (B6) = 0.
*                (B7) = ARGUMENT COUNT. 
*                (X0) = COUNT OF FILES OR RECORDS.
*                (X7) = LEVEL NUMBER. 
* 
*         CALLS  DXB. 
  
  
 ARG      PS     0           ENTRY/EXIT 
          SB1    1           (B1) = CONSTANT 1
          SA1    ACTR        CHECK ARGUMENT COUNT 
          SB3    X1 
          ZR     B3,ERR      IF NO ARGUMENTS
          SB7    X1 
          MX0    42 
          SA5    ARGR        GET FIRST ARGUMENT 
          SB6    B0 
          SX2    1
          SX6    B2+
          ZR     B2,ARG1     IF F,X FORM
          PL     B2,ARG8     IF SINGLE VALUE OR EQUIVALENCED ARGUMENT 
  
*         PROCESS F,X OR F,X,M OR F,X,L,M ARGUMENT FORM.
  
 ARG1     SA6    ARGA        SAVE ARGUMENT FORM 
          SX7    X5-1R= 
          ZR     X7,ERR      IF EQUIVALENCED ARGUMENT 
          SX2    3           STORE FILE NAME
          BX7    X5+X2
          SX0    B1          PRESET COUNT = 1 
          SA7    F           SET FILE NAME IN FET 
          SB7    B7-B1
          BX7    X7-X7       SET LEVEL TO ZERO
          ZR     B7,ARG      RETURN IF 1 ARGUMENT 
          NZ     B2,ARG2     IF NOT F,X FORM
          NE     B7,B1,ERR   IF MORE THAN 2 ARGUMENTS 
 ARG2     SA5    A5+B1       GET SECOND ARGUMENT
          MX0    42          CHECK FOR DEFAULT COUNT
          SX6    B1          SET DEFAULT COUNT OF 1 
          BX2    X0*X5
          ZR     X2,ARG3     IF COUNT NOT SPECIFIED 
          SB7    1           ASSUME DECIMAL BASE
          RJ     DXB
          NZ     X4,ERR      IF CONVERSION ERROR
          ZR     X6,ERR      IF ZERO COUNT
 ARG3     BX0    X6          SET COUNT
          SA6    ARGB 
          BX7    X7-X7       SET LEVEL TO ZERO
          MX2    42 
          BX3    X2*X6
          NZ     X3,ERR      IF TOO LARGE 
          SA3    ARGA 
          ZR     X3,ARG      IF F,X FORM
          SA1    ACTR 
          SX3    X3+1 
          NG     X3,ARG4     IF F,X,L,M FORM
          SX2    X1-4 
          PL     X2,ERR      IF MORE THAN 3 ARGUMENTS 
          EQ     ARG5        CONTINUE TO PROCESS
  
 ARG4     SX2    X1-5 
          PL     X2,ERR      IF MORE THAN 4 ARGUMENTS 
 ARG5     SX2    X1-2 
          ZR     X2,ARG      IF ONLY 2 ARGUMENTS
          SA5    A5+B1       GET THIRD ARGUMENT 
          SB7    B0          SET OCTAL MODE 
          RJ     DXB
          SA2    ARGB        RESET COUNT
          SX0    X2+
          NZ     X4,ARG6     IF CONVERSION ERROR
          MX4    -4 
          BX7    -X4*X6 
          SA1    ACTR 
          SX1    X1-4 
          NG     X1,ARG      IF ONLY THREE ARGUMENTS
          SA5    A5+1        GET FOURTH ARGUMENT
 ARG6     SA5    A5+
          SX4    1LC
          LX4    42 
          IX4    X5-X4
          ZR     X4,ARG7     IF CODED 
          SX4    1LB
          LX4    42 
          IX4    X5-X4
          NZ     X4,ERR      IF NOT BINARY
          SX4    B1+         BINARY 
 ARG7     LX4    1           SET MODE BIT IN FET
          SA1    F
          SX2    B1+B1
          BX6    -X2*X1 
          BX6    X6+X4
          SA6    A1+
          EQ     ARG
  
*         PROCESS MULTI FILE FORM.
  
 ARG8     EQ     B2,B1,ARG9  IF SINGLE ARGUMENT REQUESTED 
          SX7    X5-1R= 
          NZ     X7,ERR      ERROR IF NO EQUIVALENCE
          BX6    X0*X5
          IX7    X6+X2       ADD COMPLETE BIT 
          ZR     X6,ERR      ERROR IF BLANK NAME
          SA7    A5+
          SB3    B3-1        NEXT ARGUMENT
          SA5    A5+B1
          BX5    X0*X5
 ARG9     ZR     X5,ERR      IF BLANK NAME
          BX7    X5+X2       ADD COMPLETE BIT 
          SA7    A5 
          SB3    B3-B1       DECREMENT ARGUMENT COUNT 
          SA5    A5+B1       NEXT ARGUMENT
          NZ     B3,ARG8     IF MORE ARGUMENTS TO PROCESS 
          EQ     ARG         RETURN 
  
  
 ARGA     CON    0           FORM OF ARGUMENTS FLAG 
 ARGB     CON    0           COUNT HOLD 
 ERR      SPACE  4
**        ERR - PROCESS ARGUMENT ERROR. 
  
  
 ERR      BSS    0
          MESSAGE (=C* ERROR IN FILE ARGUMENTS.*) 
 ERR1     ABORT 
 FET      SPACE  4
 ODEBL    EQU    20B         OPTICAL DISK EXTENSION BUFFER LENGTH 
 F        BSS    0
FILE      FILEB  BUF,BUFL,(FET=10)
          ORG    F+11B
          VFD    36/,6/ODEBL,18/FODEB POINTER TO *OD* EXT. BUFFER 
          ORG    F+10 
  
*         OPTICAL DISK EXTENSION BUFFER.
  
 FODEB    BSSZ   ODEBL
  
 BUF      BSS    0
 BUFL     EQU    1
          SPACE  4
*CALL     COMCCIO 
*CALL     COMCDXB 
*CALL     COMCLFM 
*CALL     COMCSYS 
          USE    // 
 RFL=     BSS    0
          SPACE  4
          END 
