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