*DECK NMI=RTE
IDENT ROUTEM
TITLE FILE ROUTING PROCESSOR
*IF -DEF,EXCST
COMMENT ROUTEM - FILE ROUTING/ENCSF FUNCTION
*ENDIF
*IF DEF,EXCST
COMMENT ROUTEM - FILE ROUTING/EXCST FUNCTION
*ENDIF
ENTRY ROUTEM
USE /ROUTCOM/
LFN BSS 1
CODE BSS 1
TYPERT BSS 1
RTEOT BSS 1 ORIGIN TYPE (BINARY)
RTESC BSS 1 SVC CLASS (CHAR IF PRESENT)
USE *
USE /TERMCOM/
TCCNT BSS 1
LCLBFR BSS 65 BFR SPACE FOR BEGINIP / SAVE SPACE
USE *
** ROUTEM
*
* PARAMETERS PASSED THRU COMMON:
* LFN (WORD 1) = NAME OF THE FILE TO BE ROUTED
* CODE (WORD 2)= ROUTE CODE (0=INPUT, 1=OUTPUT)
*
* RETURNED PARAMS:
* FETADDR = SYSTEM ASSIGNED JOB NAME
* CODE = 0, SUCCESSFULL ROUTE OPERATION
* = 27, FNT FULL
* = 30, LOCAL FILE LIMIT
* = 33 DEFFERRED BATCH JOB LIMIT
* GENERAL COMMENTS:
* THE FILE TO BE ROUTED HAS TO RESIDE
* ON A Q-DEVICE AND HAS TO CONTAIN A JOB.
* THE USER NUMBER MUST HAVE BEEN VALIDATED
* PRIOR TO THE CALL TO THIS ROUTINE.
* AN INVALID USER NUMBER IN A ROUTED JOB, WILL FORCE AN
* UNCONDITIONAL ABORT BY THE SYSTEM.
*
* ROUTEM IS USED TO ROUTE THE NETWORK START-UP
* JOBS TO THE INPUT QUEUE AND START NIP
EJECT
PARAMS BSSZ 7 ROUTE PARAMETER LIST
BSSZ 8 EXTENDED PARAM LIST
W1 VFD 14/0,3/5 FORMS CODE
VFD 7/0,12/2CIN DISPOSITION CODE
VFD 6/0,1/1 RTRN SYS ASSIGNED JOBNAME
VFD 4/0,1/1 RETURN ERROR CODE
VFD 2/1 FORMS CODE FLAG
VFD 5/0,1/1 DISP CODE FLAG
VFD 2/0,2/2 ROUTE TO CENTRAL SITE
W2 VFD 24/0
VFD 12/2HLP LINE PRINTER
VFD 6/0
VFD 18/22B PRINT ANYWHERE
OUN VFD 42/0LSYSTEMX,18/0
SPACE 4
ROUTEM EQ *+1
MX6 0 CLEAR PARAMS AREA
SB1 1
SA6 PARAMS+1
DUP 13,1
SA6 A6+B1
SA2 LFN
RJ STRIP55
SA6 A2
ZR X2,GETJNAM FILE NAME MISSING
SA2 CODE
SX3 1000B
BX4 X2*X3
NZ X4,RSUB IF NIP
MX0 42
SA1 LFN
BX7 X1*X0 ISOLATE LFN
SX4 4000B SET
BX7 X7+X4 FORCED ORIGIN FLAG
SA7 PARAMS IN WD-0 OF DSP BLOCK
SA2 CODE GET INPUT/OUTPUT QUEUE FLAG
SX5 7B
BX2 X2*X5
SB2 X2
SA3 W1+B2 PICK UP ROUTE PARAMETERS
BX6 X3
SA2 A2 GET CODE FOR SUBSYS FLAG
LX2 3 CODE = XXXX XXXX XXXX XXXX XSXX
BX7 X4*X2 ADD SUBSYSTEM FLAG
BX6 X6+X7 (IF PRESENT IN PARAM)
SA6 A7+B1 TO DSP CALL BLOCK / FET+1
BX0 X7 SAVE SUBSYSTEM FLAG IN X0
NZ X0,RT0 IF SUBSYSTEM
SA1 RTEOT PICK UP OT
NZ X1,RT1 IF NOT SYOT
RT0 BSS 0
SX5 100B SET EXT PARAM BIT
BX6 X5+X6
SA6 A6
SA3 OUN SET OWNER USERNAME
BX7 X3
SA7 PARAMS+10B
SX7 2
SA7 A7-B1 / FET+7
ZR X0,RT1 IF NOT SUBSYSTEM
SA2 LFN PUT LFN IN SUBSYSNAME
MX0 18
BX7 X0*X2
LX7 18
SA7 A7-B1 / FET+6
EQ RT2
*
RT1 BSS 0
SA1 RTEOT PICK UP OT
LX1 1 PLACE
SA2 A7 IN
BX7 X1+X2 DSP
SA7 A7 CALL BLOCK / FET+0
NZ X1,RT2 IF NOT SYOT
SA3 RTESC WAS SC SPFD
ZR X3,RT2 NO
LX3 36 SVC CLASS
SA5 PARAMS+4 PARAMETER
BX7 X3+X5 TO DSP
SA7 A5 CALL BLOCK / FET+4
LX4 9 SET
BX6 X6+X4 FORCED SC FLAG
SA6 A6 IN DSP CALL BLOCK / FET+1
RT2 BSS 0
*
SA1 PARAMS SET STATUS MESSAGES
RJ SMS1
SA5 TYPERT IN TESTING MODE IF NON-ZERO
NZ X5,RT3
ROUTE PARAMS,R
*
RT3 BSS 0
SA1 PARAMS
SX7 77B
MX0 42
BX6 X0*X1
SA6 LFN RETURN SYSTEM ASSINGED JOB NAME
AX1 12 POSITION ERROR CODE
BX7 X7*X1
SA7 CODE ROUTE ERROR HAS BEEN ENCOUNTERED
SA1 PARAMS
RJ SMS2 SEND ROUTE MESSAGE
EQ ROUTEM
GETJNAM BSS 0
SX6 88 TEMPORARY ERROR CODE FOR PASSING A 0
* LFN
SA6 CODE
EQ ROUTEM
EJECT
STRIP55 EQ *+1S17 ENTRY/EXIT
MX0 60-6 VALUE IN X2
SX6 55B
SB1 1
SB4 10
S55A LX2 6
BX3 -X0*X2
IX3 X3-X6 SEE IF BLANK
NZ X3,S55B
BX2 X0*X2 SET TO 0 IF BLANK
S55B SB4 B4-B1
NE B4,B0,S55A
BX6 X2 MOVE TO X6 WHEN DONE
EQ STRIP55
SPACE 4,8
FILL55 EQ *+1S17 ENTRY/EXIT
MX0 60-6 VALUE IN X1
SX6 55B
SB1 1
SB4 10
F55A LX1 6
BX3 -X0*X1
NZ X3,F55B
BX1 X1+X6 ADD IN A BLANK
F55B SB4 B4-B1
NE B4,B0,F55A
BX6 X1 MOVE TO X6 WHEN DONE
EQ FILL55
MVED MACRO VAL,EDFLD,BITS
SA1 VAL
RJ =XCOD=
SA2 EDFLD
MX0 60-BITS
BX2 X0*X2
BX6 -X0*X6
BX6 X6+X2
SA6 A2
ENDM
SMS1 EQ *+1S17
MX0 60-18
SA2 A1 FET+0
BX1 X0*X1
MX0 6
+ LX1 6
BX3 X0*X1 RIGHT JUSTIFY NAME
NZ X3,*
RJ FILL55
SA6 RTMSG STARTING FILE NAME
MX0 60-18
BX6 -X0*X2
SA6 F0A
SA2 A1+B1 FET+1
MX0 60-21
BX6 -X0*X2
SA6 F1A
SA2 A2+3 FET+4
MX0 60-12
LX2 24
BX6 -X0*X2
SA6 F4A
SA2 A2+2 FET+6
MX0 60-18
BX6 -X0*X2
SA6 F6A
SA2 A2+B1 FET+7
BX6 -X0*X2
SA6 F7A
EQ SMS1
SPACE 4,8
SMS2 EQ *+1S17
MX0 60-18
SA2 A1 FET+0
BX1 X0*X1 RETURNED SYSTEM NAME
RJ FILL55
SA6 RTMSG+3
SX6 77B 12 BIT ERROR CODE
LX2 60-12
BX6 X6*X2
SA6 F0B
MVED F0B,RTMS3+2,36
MESSAGE RTMSG,0,RECALL
SA5 TYPERT
ZR X5,SMS2B TESTING IF NON-ZERO
SMS2A BSS 0
MVED F0A,RTMS2+0,36
MVED F1A,RTMS2+1,42
MVED F4A,RTMS2+2,24
MVED F6A,RTMS2+3,36
MVED F7A,RTMS2+4,36
MESSAGE RTMS2,0,RECALL
SMS2B BSS 0
SA5 F0B CHECK ERROR CODE
ZR X5,SMS2C
MESSAGE RTMS3,0,RECALL
SMS2C BSS 0
EQ SMS2
** COPYNRF
*
COPYNRF EQ *+1S17
SB1 1
OPEN NRF1,WRITE,R CREATE FILE NRF1
REWIND BEGINIP REWIND FILE NIP
SKIPF BEGINIP,1 SKIP 1 RECORD
READ BEGINIP,1 READ 1 LOGICAL RECORD
CPYNRF1 BSS 0
READW BEGINIP,WBUF,WBUFL
NG X1,COPF IF EOF OR EOI ENCOUNTERED
ZR X1,CPYNRF2 IF FULL BUFFER
WRITEW NRF1,WBUF,X1-WBUF COPY RECORD IN WBUF TO NRF1
WRITER NRF1,R WRITE END-OF-RECORD
REWIND NRF1
OPEN NRF2,WRITE,R CREATE FILE NRF2
READ BEGINIP,1 READ 1 LOGICAL RECORD
CPYNRF3 BSS 0
READW BEGINIP,WBUF,WBUFL
NG X1,COPF IF EOF OR EOI ENCOUNTERED
ZR X1,CPYNRF4 IF FULL BUFFER
WRITEW NRF2,WBUF,X1-WBUF COPY RECORD IN WBUF TO NRF2
WRITER NRF2,R WRITE END-OF-RECORD
REWIND NRF2
COPF REWIND BEGINIP
EQ COPYNRF
*
CPYNRF2 BSS 0
WRITEW NRF1,WBUF,WBUFL
EQ CPYNRF1
*
CPYNRF4 BSS 0
WRITEW NRF2,WBUF,WBUFL
EQ CPYNRF3
RTMSG DIS ,* FILNAME ROUTED, JOB NAME - XXXXXXXXXX*
RTMS2 DIS ,* 0=AAAAAA 1=BBBBBBB 4=CCCC 6=DDDDDD 7=EEEEEE*
RTMS3 DIS ,* ERROR IN ROUTE FCN. EC=XXXXXXB*
F0A VFD 60/0
F1A VFD 60/0
F7A VFD 60/0
F0B VFD 60/0
F4A BSS 1
F6A BSS 1
NBUFL EQU 65
PBUFL EQU 65
WBUFL EQU 65
BSS 0
NRF1 FILEB NBUF,NBUFL,(FET=6)
BSS 0
NRF2 FILEB PBUF,PBUFL,(FET=6)
NBUF BSS NBUFL
PBUF BSS PBUFL
WBUF BSSZ WBUFL
EJECT
*IF -DEF,EXCST
** RSUB
* WE GET HERE WHEN NIP IS TO BE EXECUTED. IN THIS
* CASE, WE HAVE WRAPPED UP ALL PROCESSING AND WILL
* TRANSFER CONTROL TO NIPS JOB CONTROL, NEVER TO
* RETURN.
*
RSUB BSS 0 ENTRY
SA1 BEGINIP
MX0 42
BX1 -X0*X1
SA2 LFN
BX6 X1+X2
SA6 A1
SA1 BEGINIP
RJ SMS1
RJ COPYNRF COPY NRF1/NRF2
SA5 TYPERT IN TESTING MODE IF NON-ZERO
NZ X5,RS2 JUST RETURN IF TESTING
ENCSF BEGINIP
PSCSF BEGINIP
ENDRUN
RS2 BSS 0
SA1 BEGINIP
RJ SMS2
EQ ROUTEM
BEGINIP FILEB LCLBFR,65,(FET=8)
RESTORE VFD 60/0
SPACE 4
*ENDIF
*IF DEF,EXCST
** RSUB
* WE GET HERE WHEN NIP IS TO BE EXECUTED. IN THIS
* CASE, WE HAVE WRAPPED UP ALL PROCESSING AND WILL
* TRANSFER CONTROL TO NIPS JOB CONTROL, NEVER TO
* RETURN.
*
RSUB BSS 0 ENTRY/NO EXIT
SA1 BEGINIP+1
MX0 6 SET CTL CARD BUFFER
BX5 X0*X1 SAVE PERIOD (.)
SA1 BEGINIP ISOLATE (BEGIN,,)
MX0 42
BX4 X0*X1
SA1 LFN GET FIRST 3 CHAR OF LFN
MX0 18
BX3 X0*X1
LX3 18 MUST BE AT LEAST 3 CHAR (NIP+++)
BX6 X3+X4
SA6 BEGINIP SAVE (BEGIN,,NIP)
BX1 -X0*X1 CLEAR OUT (NIP)
LX1 18 READJUST AND ADD IN PERIOD
SB1 1
SB4 10
MX0 6
RS1 BX2 X0*X1
ZR X2,RS3
LX1 6
SB4 B4-B1
NE B0,B4,RS1
RS3 BX6 X1+X5 PUT IN THE PERIOD (.)
RS5 LX6 6
SB4 B4-B1
NE B0,B4,RS5
SA6 A6+B1
EXCST BEGINIP
EQ ROUTEM
BEGINIP DIS ,*BEGIN,,NIP.*
SPACE 4
*ENDIF
END