Retro1.org codex

          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