Retro1.org codex

          IDENT  LDI,FETS
          ABS
          ENTRY  LDI
          ENTRY  RFL=
          SST
          SYSCOM B1
*COMMENT  LDI - LOAD JOBS TO INPUT QUEUE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  LDI - LOAD JOBS TO INPUT QUEUE.
          SPACE  4
***       LDI - LOAD JOBS TO INPUT QUEUE.
*         G. R. MANSFIELD.  70/10/25.
*         R. M. DESSEL.      81/10/26.
          SPACE  4
***       *LDI* COPIES A SPECIFIED FILE TO THE INPUT QUEUE.
          SPACE  4,10
***       *LDI* COMMAND.
*
*         LDI(LFN,ID,OP,DC,UN,FM)
*
*         LDI(FN=LFN,ID=ID,OP=OP,DC=DC,UN=UN,FM=FM)
*
*         *LDI* COMMAND PARAMETERS ARE DEFINED
*         AS THE FOLLOWING.
*
*         LFN    NAME OF FILE TO BE COPIED.
*
*         ID     *ID* CODE (NUMERIC).  TWO FORMS ARE PERMITTED -
*                ID = NN       SELECT LOCAL DEVICE.
*                ID            IMPLICIT CENTRAL SITE ROUTING.
*
*         OP     IF OP IS SPECIFIED, JOBNAME OF EACH JOB LOADED
*                WILL BE ISSUED TO THE CONTROL POINT DAYFILE.
*
*         DC     DISPOSITION CODE.  VALID CODES INCLUDE -
*                IN - INPUT QUEUE TYPE.
*                NO - INPUT QUEUE TYPE - NO OUTPUT.
*                TO - INPUT QUEUE TYPE - TERMINAL OUTPUT.
*
*         UN     USER NAME.  TWO FORMS ARE PERMITTED -
*                UN = XXXXXXX    USER NAME.
*                UN              IMPLICIT REMOTE ROUTING.
*
*         FM     FAMILY NAME.  TWO FORMS ARE PERMITTED -
*                FM = XXXXXX     FAMILY NAME.
*                FM              IMPLICIT REMOTE ROUTING.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*         * ARGUMENT ERROR.*
*                ARGUMENT ERROR DETECTED ON COMMAND.
*
*         * INCORRECT ID CODE.*
*                *ID* CODE SPECIFIED ON THE COMMAND IS AN
*                INCORRECT VALUE FOR A BATCH *ID* CODE.
*
*         * INCORRECT DC CODE.*
*                DISPOSITION CODE SPECIFIED ON COMMAND
*                IS AN INCORRECT VALUE.
*
*         * LDI ID AND FM/UN CONFLICT.*
*                BOTH *ID* AND *FM*/*UN* WERE SPECIFIED ON THE CONTROL
*                COMMAND.  *ID* MAY NOT BE SPECIFIED WITH EITHER
*                *FM* OR *UN*.
          SPACE  4
****      ASSEMBLY CONSTANTS.
 
 
 BUFL     EQU    100B
 IBUFL    EQU    2001B
 OBUFL    EQU    2001B
****
          SPACE  4
*CALL     COMCMAC
*CALL     COMSDSP
*CALL     COMSIOQ
*CALL     COMSSSJ
          TITLE  FETS AND COMMON DATA.
 FETS     SPACE  4
 
 
          ORG    110B
 FETS     BSS    0
 
 I        BSS    0
 LOAD     FILEB  IBUF,IBUFL
 
 O        BSS    0
 SCR      FILEB  OBUF,OBUFL,(FET=8)
 TDSP     SPACE  4,10
**        TDSP - *DSP* PARAMETER BLOCK.
*
*T  W0    42/ FILE NAME,18/
*T, W1    24/ ,12/ DC,6/ ,18/ FLAGS
*T, W2    36/ ,24/ DA
*T, W3    60/
*T, W4    60/
*T, W5    60/
*T, W6    60/
*
*         DC - DISPOSITION CODE.
*         DA - *TID* OR POINTER TO *FM*/*UN*.
 
 
 
 TDSP     BSS    0
          VFD    42/0LSCR,18/0
          VFD    12/,12/,12/0LIN,6/,18/FRDC+FRCS
          VFD    36/0,24/-0
          BSSZ   4
 TFUN     SPACE  4,10
**        TFUN - FAMILY NAME, USER NAME TABLE.
*
*T W0     42/ FAMILY NAME,18/
*T,W1     42/ USER NAME,18/
 
 
 TFUN     BSSZ   2           FAMILY NAME - USER NAME
          SPACE  4,10
*         INTERNAL FLAGS.
 
 PDID     CON    0           DEVICE CODE PROCESSED
 PFUN     CON    0           FM - UN PROCESSED
 LDI      TITLE  MAIN PROGRAM.
 
 
 LDI      SB1    1           (B1) = 1
          RJ     PRS         PRESET PROGRAM
 LDI1     READ   I
          READW  I,BUF,BUFL
          NG     X1,LDI2     IF EOF
          SX7    X1-BUF
          ZR     X7,LDI2     IF EMPTY RECORD
          BX5    X1          SAVE (X1)
          SA1    O+1         ASSIGN FILE TO INPUT DEVICE
          MX0    12
          BX6    -X0*X1
          SX1    2RIN
          LX1    59-11
          BX7    X6+X1
          SA7    A1
          REQUEST  O,U,N     REQUEST EQUIPMENT WITH NO DAYFILE MESSAGE
          BX1    X5          RESTORE (X1)
          RJ     CPY         COPY FILE
          RECALL O
          ROUTE  TDSP,RECALL
          SA1    O           RESTORE FILE NAME IN *DSP* BLOCK
          MX0    42
          BX6    X0*X1
          SA1    TDSP
          SA2    LDIB
          SA6    A1
          NZ     X2,LDI1     IF JOBNAME OPTION NOT SELECTED
          BX7    X0*X1
          SX2    2RS
          BX6    X7+X2
          LX6    48
          SA6    LDIA+1
          MESSAGE  LDIA,3,R
          EQ     LDI1        LOOP
 LDI2     ENDRUN
 
 LDIA     DATA   C* JOBNAME IS*
 LDIB     CON    1
          TITLE  SUBROUTINES.
 CPY      SPACE  4
**        CPY - COPY FILE.
*
*         ENTRY  (X1) = FILE STATUS.
*
*         MACROS READ, RECALL, WRITE, WRITEF, WRITER.
 
 
 CPY      SUBR               ENTRY/EXIT
          EQ     CPY3
 
 CPY1     READ   I
          RECALL O
 CPY2     READW  I,BUF,BUFL
 CPY3     NG     X1,CPY5     IF EOF
          NZ     X1,CPY4     IF EOR
          WRITEW O,BUF,BUFL
          EQ     CPY2
 
 CPY4     WRITEW O,BUF,X1-BUF
          WRITER O           END RECORD
          EQ     CPY1
 
 CPY5     WRITEF O           END FILE
          EQ     CPY         RETURN
          SPACE  4
*         COMMON DECKS.
 
 
*CALL     COMCCIO
*CALL     COMCLFM
*CALL     COMCRDW
*CALL     COMCSYS
*CALL     COMCWTW
 BUFFERS  SPACE  4
*         BUFFER ASSIGNMENTS.
 
 
          USE    BUFFERS
 BUF      EQU    *
 IBUF     EQU    BUF+BUFL
 OBUF     EQU    IBUF+IBUFL
 RFL=     EQU    OBUF+OBUFL
          TITLE  PRESET PROCESSING.
 PRS      SPACE  4
**        PRS - PRESET PROGRAM.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*
*         CALLS  ARM, CPA, DXB, FNB, USB.
*
*         MACROS LABEL, RETURN.
 
 
          ORG    BUF
 PRS      SUBR               ENTRY/EXIT
          RETURN O
          SB2    CCDR        UNPACK COMMAND
          RJ     USB
          SA1    A6          ASSURE TERMINATOR CHARACTER
          SX6    1R.
          SA6    X1+B1
          SA2    PRSA        SET SEPARATOR MASK
          SB2    60
          SB7    ERR         SET EXIT FOR TERMINATOR CHARACTER
          RJ     FNB         FIND NON-BLANK CHARACTER
 
*         SKIP PROGRAM NAME.
 
          SB7    PRS4        SET EXIT FOR TERMINATOR CHARACTER
 PRS1     RJ     FNB         FIND NON-BLANK CHARACTER
          SB4    B5-B2
          LX4    X2,B5
          PL     B4,PRS2     IF SEPARATOR CHARACTER
          PL     X4,PRS1     IF NOT SEPARATOR CHARACTER
 PRS2     SB3    TARG        FWA OF ARGUMENT TABLE
          SB2    TARGL       LENGTH OF ARGUMENT TABLE
          SB4    PRSK        ADDRESS TO PLACE DATA
          RJ     CPA         CONVERT POSITIONAL ARGUMENTS
          NG     B5,ERR      IF ARGUMENT ERROR
          PL     X1,PRS4     IF NO ARGUMENTS PROCESSED
          SX6    B5          SET LWA OF ARGUMENTS
          SA6    USBC
          SB6    PRSK        FWA OF ARGUMENTS
          RJ     ARM         PROCESS ARGUMENTS
          NZ     X1,ERR      IF ERROR
 
*         PROCESS FILE NAME.
 
 PRS3     SA1    FN
          SX4    -B1
          BX2    X4-X1
          ZR     X2,PRS4     IF NULL ARGUMENT
          MX0    42          SET FILE NAME IN FET
          BX1    X0*X1
          SX2    3
          IX6    X1+X2
          SA6    I
          EQ     PRS5        PROCESS *ID* CODE
 
 PRS4     LABEL  I           REQUEST LOCAL FILE
 
*         PROCESS *ID* CODE.
 
 PRS5     SA5    ID
          SX4    -B1
          BX2    X4-X5
          ZR     X2,PRS7     IF *ID* CODE NOT SET
          SX7    B1+         SET *ID* FLAG
          SA7    PDID
          SA2    PRSG
          MX0    42          GET *ID* CODE
          BX5    X0*X5
          BX2    X5-X2
          ZR     X2,PRS6     IF CENTRAL SITE SPECIFIED
          SB7    0           SET OCTAL CONVERSION
          RJ     DXB         CONVERT TO DISPLAY CODE
          SB7    PRSC        * INCORRECT ID CODE.*
          NZ     X4,ERR1     IF CONVERSION ERROR
          SX2    X6-IDLM
          PL     X2,ERR1     IF ID .GE. IDLM
          SA6    TDSP+2      SET *ID* CODE IN *DSP* BLOCK
          SX2    FRTI
 PRS6     SA1    TDSP+1
          SX6    FRCS
          BX6    X1+X6       SET CENTRAL SITE ROUTING FLAG
          BX6    X2+X6       OPTIONALLY SET *ID* FLAG
          SA6    A1+
 
*         PROCESS *OP* OPTION.
 
 PRS7     SA1    OP
          SX4    -B1
          BX2    X4-X1
          ZR     X2,PRS8     IF JOBNAME MESSAGE NOT SELECTED
          SX3    FRFN        FLAG JOB NAME OPTION
          MX0    -18
          BX2    -X0*X3
          SA1    TDSP+1
          BX7    X1+X2
          SA7    A1
          SX6    B0+         ZERO LAST WORD OF MESSAGE BUFFER
          SA6    LDIB
 
*         PROCESS *DC* OPTION.
 
 PRS8     SA1    DC
          BX2    X4-X1
          ZR     X2,PRS10    IF *DC* OPTION NOT SELECTED
          SB7    PRSD        * INCORRECT DC CODE.*
          MX0    12
          BX5    X0*X1
          LX0    -12         CHECK IF CODE .GT. TWO CHARACTERS
          BX2    X0*X1
          NZ     X2,ERR1     IF INCORRECT *ID* CODE
          LX5    12
          SX2    X5-2RIN
          SX3    X5-2RNO
          SX1    X5-2RTO
          ZR     X2,PRS9     IF VALID CODE
          ZR     X3,PRS9     IF VALID CODE
          NZ     X1,ERR1     IF INCORRECT *DC* CODE
 PRS9     SA2    TDSP+1
          SX7    FRDC
          LX0    -12         POSITION MASK
          LX5    24          POSITION PARAMETER
          BX3    -X0*X2
          BX3    X3+X5       ENTER *DC* PARAMETER
          BX7    X3+X7       ENTER FLAG BIT
          SA7    TDSP+1
 
*         PROCESS *UN* PARAMETER.
 
 PRS10    SA1    UN
          BX2    X4-X1
          ZR     X2,PRS11    IF *UN* OPTION NOT SPECIFIED
          SA2    PDID
          SB7    PRSE        * LDI ID AND FM/UN CONFLICT.*
          NZ     X2,ERR1     IF CONFLICT
          SX7    FRTI        SET *FM*/*UN* FLAG
          SA7    PFUN
          MX0    42          GET USER NAME
          BX6    X0*X1
          SA2    PRSI        CHECK IF CENTRAL SITE SPECIFIED
          BX2    X6-X2
          ZR     X2,PRS11    IF IMPLICIT REMOTE ROUTING
          SA6    TFUN+1      SET USER NAME
 
*         PROCESS *FM* PARAMETER.
 
 PRS11    SA1    FM
          BX2    X4-X1
          ZR     X2,PRS12    IF *FM* OPTION NOT SPECIFIED
          SA2    PDID
          SB7    PRSE        * LDI ID AND FM/UN CONFLICT.*
          NZ     X2,ERR1     IF CONFLICT
          SX7    FRTI        SET *FM*/*UN* FLAG
          SA7    PFUN
          MX0    42
          BX7    X0*X1
          SA2    PRSJ        CHECK IF CENTRAL SITE SPECIFIED
          BX2    X7-X2
          ZR     X2,PRS12    IF IMPLICIT REMOTE ROUTING
          SA7    TFUN        SET FAMILY NAME
 
*         COMPLETE BUILDING THE *DSP* PARAMETER BLOCK.
 
 PRS12    SA1    PDID
          SA3    PFUN
          BX6    X3+X1
          ZR     X6,PRSX     IF NOT REMOTE ROUTING
          SX4    FRTI
          SX3    FRCS        CLEAR CENTRAL SITE FLAG
          SA1    TDSP+1
          BX7    X4+X1
          BX7    X7-X3
          SA7    A1          SET *ID* FLAG
          SA1    TFUN
          SA2    A1+B1
          BX2    X2+X1
          ZR     X2,PRSX     IF IMPLICIT REMOTE ROUTING
          SX3    A1          SET ADDRESS OF FAMILY/USER NAME BLOCK
          MX0    36
          BX3    -X3
          BX6    -X0*X3
          SA6    TDSP+2
          EQ     PRSX        RETURN
 ERR      SPACE  4,15
**        ERR - ISSUE COMMAND ERROR MESSAGE.
*
*         ENTRY  (B7) = ERROR MESSAGE ADDRESS, IF ENTRY AT *ERR1*.
 
 
 ERR      SB7    PRSB        * ARGUMENT ERROR.*
 ERR1     MESSAGE  B7        ISSUE ERROR MESSAGE
          ABORT
 FNB      SPACE  4,10
**        FND - FIND NON-BLANK CHARACTER.
*
*         ENTRY  (B6) = NEXT CHARACTER ADDRESS.
*                (B7) = EXIT ADDRESS IF TERMINATOR ENCOUNTERED.
*
*         EXIT   (X1) = (B5) = NEXT NON BLANK CHARACTER.
*                (B6) = NEXT CHARACTER ADDRESS (UPDATED).
*                EXIT IS MADE TO B7, IF TERMINATOR ENCOUNTERED.
*
*         USES   X - 1, 4.
*                A - 1.
*                B - 5, 6.
 
 
 FNB      SUBR               ENTRY/EXIT
 FNB1     SA1    B6          GET NEXT CHARACTER
          SB6    B6+B1
          SX4    X1-1R
          ZR     X4,FNB1     IF BLANK CHARACTER
          SB5    X1+
          SX4    X1-1R.
          ZR     X4,FNB2     IF TERMINATOR CHARACTER
          SX4    X1-1R)
          NZ     X4,FNBX     IF NOT TERMINATOR CHARACTER, RETURN
 FNB2     JP     B7          TERMINATE CHARACTER
          SPACE  4,10
*         WORKING STORAGE.
 
 PRSA     CON    40000000000033127777B  SEPARATOR MASK
 PRSB     DATA   C* ARGUMENT ERROR.*
 PRSC     DATA   C* INCORRECT ID CODE.*
 PRSD     DATA   C* INCORRECT DC CODE.*
 PRSE     DATA   C* LDI ID AND FM/UN CONFLICT.*
 PRSG     DATA   2LID
 PRSI     DATA   2LUN
 PRSJ     DATA   2LFM
 PRSK     BSSZ   100
 TARG     SPACE  4,10
**        TARG - ARGUMENT EQUIVALENCE TABLE.
 
 
 TARG     BSS    0
 FN       ARG    FN,FN,0,0   FILE TO BE COPIED
 ID       ARG    ID,ID,0,0   ID CODE
 OP       ARG    OP,OP,0,0   INDICATES IF JOBNAME ISSUED TO DAYFILE
 DC       ARG    DC,DC,0,0   DEVICE CODE
 UN       ARG    ZR,UN,0,0   USER NAME
 FM       ARG    FM,FM,0,0   FAMILY
          ARG
 TARGL    EQU    *-TARG-1
 
 
 FN       CON    -1
 ID       CON    -1
 OP       CON    -1
 DC       CON    -1
 UN       CON    -1
 FM       CON    -1
 
 ZR       CON    0           DEFAULT ARGUMENT VALUE
          SPACE  4
*         COMMON DECKS.
 
 
*CALL     COMCARM
*CALL     COMCCPA
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCPOP
*CALL     COMCUSB
          SPACE  4
          END