LDI 
          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 
