Retro1.org codex

          IDENT  INSTALL,FETS
          ABS
          SST
          ENTRY  INSTALL
          ENTRY  RFL=
          ENTRY  SSJ=
          SYSCOM B1          DEFINE (B1) = 1
          TITLE  INSTALL - INSTALL DEADSTART FILE.
*COMMENT  INSTALL - INSTALL DEADSTART FILE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
*****     INSTALL - INSTALL DEADSTART FILE.
*
*         P. D. HAAS.        78/02/28.
*         D. R. HILGREN.     78/08/18.
          SPACE  4,10
***              *INSTALL* COPIES A FILE TO A MASS STORAGE DEVICE AND
*         UPDATES THE DEADSTART SECTOR SO THAT THE RESULTING FILE CAN BE
*         DEADSTARTED.  THE DEVICE SPECIFIED MUST BE A SINGLE UNIT
*         *LDAM* TYPE DEVICE WHICH IS *ON*, AVAILABLE, AND HAS HAD *CTI*
*         INSTALLED ON IT.
          SPACE  4,10
***       CONTROL CARD CALL.
*
*         INSTALL,LFN,EQXXX.
*
*         LFN =  MASS STORAGE FILE (ASSIGNED TO THE CONTROL POINT)
*                WHICH IS TO BE INSTALLED AS A SYSTEM DEADSTART
*                FILE.  IF *LFN* IS OMITTED, DEFAULT IS FILE
*                *SYSTEM* (WHICH MUST BE ASSIGNED TO THE CONTROL
*                POINT).  *SDF* IS A RESERVED FILE NAME AND CANNOT
*                BE USED AS *LFN*.
*
*         XXX =  EST ORDINAL ON WHICH *LFN* IS TO BE WRITTEN.
*
*         CALLING JOB MUST BE SYSTEM ORIGIN OR MUST BE VALIDATED
*         FOR SYSTEM ORIGIN PRIVILEGES.  IF THE DEADSTART FILE
*         TO BE INSTALLED IS ON TAPE, IT MUST FIRST BE COPIED TO
*         MASS STORAGE.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*         * DEADSTART FILE FORMAT ERROR.* - AN ERROR WAS DETECTED IN
*         THE DIRECTORY OF THE DEADSTART FILE.
*
*         * INSTALL - ARGUMENT ERROR.* - AN ERROR WAS DETECTED IN THE
*         PARAMETERS ASSOCIATED WITH THE *INSTALL* CONTROL STATEMENT.
*
*         * SDF INSTALLATION COMPLETE.* - SYSTEM DEADSTART FILE
*         INSTALLATION IS COMPLETED.
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSPRD
*CALL     COMSSSD
*CALL     COMSSSJ
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 CBUFL    EQU    22000B      BUFFER LENGTH
 
*         CODE REQUIRES CBUFL DIVISIBLE BY 3
 
          ERRNZ  CBUFL/3*3-CBUFL
****
****
 FETS     SPACE  4,10
**        FETS.
 
 
          ORG    104B
 FETS     BSS    0
 
 
 I        BSS    0           INSTALL FILE
 SYSTEM   RFILEB TBUF,TBUFL,FET=7
 
 
 O        BSS    0           *SDF* FILE
 SDF      RFILEB CBUF,CBUFL,FET=6,EPR
          TITLE  DATA STORAGE.
**        DATA STORAGE.
 
 
 EORF     CON    1           CURRENT BLOCK EOR FLAG
          SPACE  4,10
*         SPECIAL ENTRY POINTS.
 
 
 SSJ=     BSS    0
          VFD    12/0,24/-0,12/SYCS,12/IRSI
          BSSZ   SSJ=+SSJL-*
          SPACE  4,10
*         *1IS* FUNCTION REQUESTS.
 
 
 VIFF     VFD    18/0L1IS,6/0,12/1,12/0,12/I
 IDFF     VFD    18/0L1IS,6/0,12/2,12/O,12/I
 CFIF     VFD    18/0L1IS,6/0,12/3,12/O,12/I
 PMEF     VFD    18/0L1IS,6/0,12/4,12/O,12/0
          TITLE  MAIN PROGRAM.
 INSTALL  SPACE  4,10
**        INSTALL - MAIN PROGRAM.
 
 
 INSTALL  BSS    0
          SB1    1           PRESET PROGRAM
          RJ     PRS
          RJ     CDF         COPY DEADSTART FILE
 INS1     R=     X7,2
          SX1    CFIF        COMPLETE *SDF* INSTALLATION
          R=     A7,ARGR
          SYSTEM SPC,,X1     CALL *1IS*
          SA1    CFIF
          ZR     X1,INS2     IF *1IS* ASSIGNED
          RECALL
          EQ     INS1        RETRY *SYSTEM REQUEST
 
 INS2     RECALL ARGR        WAIT *1IS* COMPLETE
          MESSAGE  (=C* SDF INSTALLATION COMPLETE.*)
          ENDRUN
          TITLE  SUBROUTINES.
 CDF      SPACE  4,10
**        CDF - COPY DEADSTART FILE.
*
*         ENTRY  (B2) = 2.
*
*         USES   A - ALL.
*                B - 3, 4, 5, 6, 7.
*                X - ALL.
*
*         CALLS  *1IS*.
*
*         MACROS ABORT, MESSAGE, READCW, RECALL, SYSTEM, WRITECW.
*
*         NOTE   WHEN CHECKING FOR FET COMPLETE AND DATA IN THE BUFFER,
*                THE FET STATUS MUST BE PICKED UP BEFORE THE BUFFER
*                POINTER.
 
 
 CDF      SUBR               ENTRY/EXIT
          SB5    CBUF+CBUFL  SET LIMIT ADDRESS
          SA2    I+3
          BX0    X0-X0       INDICATE NO BLOCKS AVAILABLE OR COMPLETE
          SA0    X2          INITIALIZE INPUT PSEUDO OUT POINTER
          EQ     CDF13       INITIATE CONTROL WORD READ
 
*         CHECK FOR INPUT BLOCK AVAILABLE.
 
 CDF1     SA5    I           CHECK INPUT FILE STATUS
          SA3    I+2         CHECK INPUT IN = PSEUDO OUT POINTER
          BX0    X0-X0       INDICATE NO BLOCKS AVAILABLE OR COMPLETE
          SX1    A0
          IX1    X3-X1
          LX5    59-0
          NZ     X1,CDF3     IF INPUT BLOCK AVAILABLE
          PL     X5,CDF8     IF BUFFER BUSY
          LX5    59-11-59+0
          NG     X5,CDF15    IF PARITY ERROR STATUS IN FET
          LX5    59-3-59+11
          PL     X5,CDF8     IF NOT EOF
 
*         PROCESS EOF.
 
          RECALL O           WAIT OUTPUT FILE NOT BUSY
          SA3    O+2         CHECK DATA IN BUFFER
          SA4    A3+B1
          IX7    X3-X4
          ZR     X7,CDF2     IF BUFFER EMPTY
          WRITECW  X2,R      FLUSH BUFFER
 CDF2     SA3    CDFB
          SA1    X2+B1
          SA4    A3+B1
          BX6    X3          SET EOF CONTROL WORDS IN BUFFER
          LX7    X4
          SA6    X1
          SA7    X1+B1
          SX6    A6          OUT = FIRST
          SX7    X1+B2       IN = FIRST+2
          SA6    A1+B2
          SA7    A1+B1
          WRITECW  X2,R      WRITE EOF
          EQ     CDFX        RETURN
 
*         PROCESS INPUT BLOCK.
 
 CDF3     SX0    B1          INDICATE INPUT BLOCK TRANSFERRED
          SA4    A0          CRACK CONTROL WORD HEADER
          SX2    5
          SX7    X4+4
          IX7    X7/X2       CALCULATE WORD COUNT
          AX4    36
          SB6    X7
          SA2    EORF        CHECK FOR PREVIOUS EOR
          SB7    X4          PRU SIZE
          ZR     X2,CDF6     IF PREVIOUS BLOCK NOT EOR
          SB4    A0+B1
          NE     B4,B5,CDF4  IF NO WRAP AROUND
          SB4    CBUF        SET FIRST
 CDF4     ZR     B6,CDF6     IF ZERO LENGTH RECORD
          MX6    12
          SA1    B4          GET RECORD NAME
          BX6    X6*X1
          LX6    12
          SX6    X6-7700B
          NZ     X6,CDF5     IF NOT 77 TABLE
          SB3    B4+B1
          SA1    B4+B1
          NE     B3,B5,CDF5  IF NO WRAP AROUND
          SA1    CBUF
 CDF5     MX7    42
          BX7    X7*X1
          SA7    CDFA+1      ENTER NAME IN MESSAGE
          MESSAGE  A7-B1,1   DISPLAY RECORD NAME
 CDF6     SB4    A0+B6       ADVANCE POINTER
          SX7    B6-B7       NO EOR IF FULL BLOCK
          SB4    B4+B2       SKIP CONTROL WORDS
          SB3    B4-B5
          LT     B4,B5,CDF7  IF NO WRAP AROUND
          SB4    B3+CBUF
 CDF7     SX6    B4
          SA7    EORF        SAVE EOR FLAG
          SA1    A0          GET CONTROL WORD HEADER
          NG     X1,CDF15    IF ERROR OCCURRED ON THIS BLOCK
 
*         TRANSFER BLOCK TO OUTPUT.
 
          SA6    O+2         ADVANCE OUTPUT IN POINTER
          SB0    0
          SA0    B4+         ADVANCE INPUT PSEUDO OUT POINTER
 
*         CHECK FOR REINITIATE CONTROL WORD WRITE.
 
 CDF8     SA2    O           CHECK OUTPUT FILE STATUS
          LX2    59-0
          SA1    A2+B2
          PL     X2,CDF10    IF BUFFER BUSY
          SA2    A1+1        CHECK BUFFER THRESHOLD
          SX3    CBUFL/3
          IX1    X1-X2       (IN-OUT)
          IX2    X1-X3       (IN-OUT) - 1/3(BUFFER SIZE)
          ZR     X1,CDF10    IF BUFFER EMPTY
          PL     X1,CDF9     IF IN .GT. OUT
          LX3    1
          SB0    0
          IX2    X3+X1       2/3(BUFFER SIZE) - (OUT-IN)
 CDF9     NG     X2,CDF10    IF BUFFER THRESHOLD NOT REACHED
          WRITECW  O         REINITIATE CONTROL WORD WRITE
 
*         CHECK FOR OUTPUT BLOCK WRITTEN.
 
 CDF10    SA1    O+3         CHECK OUTPUT OUT = INPUT OUT
          SA2    I+3
          IX3    X1-X2
          ZR     X3,CDF11    IF BLOCK NOT WRITTEN
          BX6    X1
          SX0    1           INDICATE OUTPUT BLOCK COMPLETE
          SA6    I+3         UPDATE INPUT OUT = OUTPUT OUT
 
*         CHECK FOR REINITIATE CONTROL WORD READ.
 
 CDF11    SA4    I           CHECK INPUT FILE STATUS
          LX4    59-0
          SA1    A4+B2
          PL     X4,CDF14    IF BUFFER BUSY
          LX4    59-3-59+0
          SA2    A1+B1
          NG     X4,CDF14    IF EOF/EOI ENCOUNTERED
          SX3    CBUFL/3     CHECK BUFFER THRESHOLD
          IX1    X1-X2       (IN-OUT)
          IX2    X3+X1       1/3(BUFFER SIZE) + (IN-OUT)
          ZR     X1,CDF13    IF BUFFER EMPTY
          NG     X1,CDF12    IF OUT .GT. IN
          LX3    1
          IX2    X1-X3       (IN-OUT) - 2/3(BUFFER SIZE)
 CDF12    PL     X2,CDF14    IF BUFFER THRESHOLD NOT REACHED
 
 CDF13    READCW I,17B       INITIATE CONTROL WORD READ TO EOF
 
*         CHECK FOR RECALL.
 
 CDF14    NZ     X0,CDF1     IF INPUT AND/OR OUTPUT BLOCKS TRANSFERRED
          RECALL             WAIT FOR DATA TRANSFER
          EQ     CDF1        CHECK FOR INPUT BLOCKS
 
*         PROCESS PARITY ERROR.
 
 CDF15    SX1    PMEF        PROCESS MASS STORAGE ERROR
          SYSTEM SPC,,X1     CALL *1IS*
          SA1    PMEF
          ZR     X1,CDF16    IF *SYSTEM* REQUEST PERFORMED
          RECALL
          EQ     CDF15       RETRY *SYSTEM* REQUEST
 
 CDF16    ABORT
 
 CDFA     DATA   10H  COPYING
          CON    0,0
 
 CDFB     VFD    24/100B,36/0  EOF CONTROL WORDS
          VFD    12/17B,48/0
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCIO
*CALL     COMCSYS
          SPACE  4,10
**        BUFFERS.
 
 
          USE    BUFFERS
 CBUF     BSS    0
 RFL=     EQU    CBUF+CBUFL+4
          TITLE  PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET PROGRAM.
*
*         ENTRY  (B1) = 1.
*
*         EXIT   (B2) = 2.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 7.
*                X - ALL.
*
*         CALLS  DXB, *1IS*.
*
*         MACROS ABORT, GETSPS, MESSAGE, READ, RECALL, REWIND, SKIPB,
*                SYSTEM.
 
 
 PRS      SUBR               ENTRY/EXIT
          GETSPS             CHECK USER ACCESS
          SA1    ACTR        GET ARGUMENT COUNT
          SA2    I
          SB7    X1
          ZR     B7,PRS2     IF NO ARGUMENTS
          SB7    B7-B1
          NE     B7,B1,PRS6  IF ILLEGAL ARGUMENT COUNT
 
*         PROCESS INPUT FILE NAME.
 
          R=     A5,ARGR     INPUT FILE NAME
          MX0    42
          SX4    3RSDF
          BX7    X0*X5
          LX4    42
          ZR     X7,PRS1     IF NULL NAME (DEFAULT TO *SYSTEM*)
          BX4    X7-X4
          SX3    X2
          ZR     X4,PRS6     IF FILE NAME CONFLICT
          BX7    X7+X3
          SA7    A2
 
*         PROCESS EST ORDINAL.
 
 PRS1     SA5    A5+B1       GET NEXT ARGUMENT
          LX5    12
          SX2    X5
          BX5    X5-X2
          SX2    X2-2REQ
          SB7    0
          NZ     X2,PRS6     IF ILLEGAL PARAMETER
          RJ     DXB         CONVERT EST ORDINAL
          NZ     X4,PRS6     IF CONVERSION ERROR
          SA6    O+5         SET EST ORDINAL IN *SDF* FET
 PRS2     R=     X7,2
          SX1    VIFF        VALIDATE INSTALL FILE
          R=     A7,ARGR
          SYSTEM SPC,,X1     CALL *1IS*
          SA1    VIFF
          ZR     X1,PRS2.1   IF *SYSTEM* REQUEST PERFORMED
          RECALL
          EQ     PRS2        RETRY *SYSTEM* REQUEST
 
 PRS2.1   SB2    B1+B1
          RECALL ARGR        WAIT *1IS* COMPLETE
          EREXIT CDF15       SET ERROR EXIT PROCESSOR ADDRESS
          SX7    B2
          SX3    B1
          LX7    29-1        POSITION RANDOM REWRITE FLAG
          BX6    X3+X7
          SA6    O+6         SET RANDOM REWRITE REQUEST
 
*         READ DIRECTORY RECORD ON INSTALL FILE.
 
          SKIPB  I,2,R       BACKSPACE ACROSS EOF AND DIRECTORY
          SA1    I+6
          BX6    X1
          AX6    30
 PRS3     SX7    TBUF        SET IN = FIRST
          SA6    I+6         SET RANDOM ADDRESS FOR READ
          SA7    X2+B2
          SA6    A6+B1
          READ   X2,R
          SA4    X2+B2       IN POINTER
          SA3    A4+B1
          SA1    X3          CHECK FIRST WORD OF RECORD
          LX1    18
          SX6    X1-770000B
          LX1    6
          SB3    X1+B1
          NZ     X6,PRS7     IF NOT 7700 (PRFX) TABLE
          SX7    X1-16B
          NZ     X7,PRS7     IF TABLE WORD COUNT INCORRECT
          SA5    X3+B3       CHECK RECORD TYPE
          LX5    18
          SX7    X5-700000B
          SA1    X2
          SA3    X3+B1
          NZ     X7,PRS7     IF NOT OPLD RECORD
          LX1    59-4        CHECK BUFFER STATUS
          MX0    42+12
          PL     X1,PRS7     IF NOT EOR (BUFFER TOO SMALL)
          SX6    10B
          LX0    12
          BX6    X3+X6       DIRECTORY NAME + RECORD TYPE OPLD
          SA5    A5-B1
          SA6    X4          STORE SEARCH PARAMETER AT (IN)
 
*         SEARCH DIRECTORY FOR FIRST OPLD ENTRY.
 
 PRS4     BX7    X0*X3
          SA5    A5+2        GET DIRECTORY ENTRY
          BX3    X5-X6
          NZ     X7,PRS4     IF NOT DIRECTORY OPLD ENTRY
          SX3    A5-B2
          BX6    X4-X3
          ZR     X6,PRS7     IF NO OPLD ENTRY FOR DIRECTORY
          SA1    I+7         RANDOM ADDRESS FOR CURRENT DIRECTORY
          SA5    A5-1
          IX7    X5-X1
          BX6    X5          RANDOM ADDRESS OF FIRST DIRECTORY
          NZ     X7,PRS3     IF NOT FIRST DIRECTORY ON FILE
          SA2    PRSA
          SA3    A4+B1       SET UP *OSB* SEARCH
          BX6    X2
          SA1    A1-B1
          SB3    X3+B3
          AX1    30
          SX7    B2
          SA6    X4          STORE SEARCH PARAMETER AT (IN)
          SX2    B1
          IX1    X1+X7       RANDOM ADDRESS OF EOI
          SA5    B3-B1
          LX2    47          POSITION RANDOM ACCESS BIT
          BX3    X6
 
*         SEARCH DIRECTORY FOR *OSB* ENTRY.
 
 PRS5     BX7    X0*X3
          SA5    A5+2
          BX3    X5-X6
          NZ     X7,PRS5     IF NO MATCH
          SX3    A5-2
          BX6    X4-X3
          SA5    A5-B1
          ZR     X6,PRS7     IF *OSB* NOT FOUND
          LX5    36
          BX6    X5+X1
          SA6    I+5         SAVE RELATIVE SECTOR ADDRESS OF *OSB*
          MX0    42
          BX0    -X2*X0      CLEAR RANDOM ACCESS BIT IN MASK
          SA1    A4-B1
          AX2    47-44       POSITION ERROR PROCESSING FLAG
          BX1    X0*X1
          SX7    CBUF        RESET BUFFER POINTERS
          BX1    X1+X2
          BX6    X1+X7
          SA6    A1
          SA7    A1+B1
          SA7    A7+B1
 PRS5.1   R=     X6,2
          SX1    IDFF        INITIALIZE *SDF*
          R=     A6,ARGR
          SYSTEM SPC,,X1     CALL *1IS*
          SA1    IDFF
          ZR     X1,PRS5.2   IF *SYSTEM* REQUEST PERFORMED
          RECALL
          EQ     PRS5.1      RETRY *SYSTEM* REQUEST
 
 PRS5.2   REWIND I           REWIND INSTALL FILE
          RECALL ARGR        WAIT *1IS* COMPLETE
          EQ     PRSX        RETURN
 
 PRS6     MESSAGE  PRSB,0    * INSTALL - ARGUMENT ERROR.*
          ABORT
 
 PRS7     MESSAGE  PRSC,0    * DEADSTART FILE FORMAT ERROR.*
          ABORT
 
 PRSA     VFD    42/0LOSB,6/0,12/1
 
 PRSB     DATA   C* INSTALL - ARGUMENT ERROR.*
 PRSC     DATA   C* DEADSTART FILE FORMAT ERROR.*
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCPM
*CALL     COMCDXB
          SPACE  4,10
 TBUF     BSS    0
 TBUFL    EQU    CBUF+CBUFL-TBUF
          SPACE  4,10
          END