IDENT ROUTE,ROU,ROUTE ABS SST SYSCOM B1 ENTRY ROUTE ENTRY NPC= ENTRY RFL= *COMMENT ROUTE - ROUTE FILE TO I/O QUEUE. COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. TITLE ROUTE COMMAND PROCESSOR. SPACE 4,10 *** ROUTE - PROCESS ROUTE COMMAND. * R.N. LAGERSTROM 76/01/30. * * ROUTE IS USED TO PLACE FILES INTO THE INPUT AND * OUTPUT QUEUES. SPACE 4,20 *** CALL. * * ROUTE(LFN,P1,P2,...,PN) * * LFN - FILE NAME TO ROUTE. * * THE REMAINING PARAMETERS ARE ORDER INDEPENDENT. * * DC=AA - TWO-CHARACTER DISPOSITION CODE (ALPHA CODE). * DEF - INDICATES DEFERRED (END-OF-JOB) ROUTING. * DO=XXX - DEFAULT OUTPUT MAINFRAME LOGICAL ID. * EC=XX - EXTERNAL CHARACTERISTICS. * FC=XX - FORMS CODE (TWO-CHARACTER ALPHA-NUMERIC). * FID=XXXXXXX - FILE ID. (NOS/BE COMPATIBILITY) * FM=XXXXXXX - FAMILY NAME. * FM - IMPLICIT REMOTE ROUTING. * IC=XX - INTERNAL CHARACTERISTICS. * ID=NN - SELECT LOCAL DEVICE (0-67 OCTAL DEFAULT). * ID - IMPLICIT CENTRAL SITE ROUTING. * JSN=XXX - FORCE A UNIQUE THREE CHARACTER JSN ON A JOB. * OT=XXXX - SET THE ORIGIN TYPE OF THE FILE. * PI=N - PRINT IMAGE ORDINAL ( 0 - 7 ) * PI=XXXXXXX - PRINT IMAGE NAME ( 1 TO 7 CHARACTER NAME ) * PRI=NNNN - FILE PRIORITY. IGNORED WITH MESSAGE. * REP=NN - REPEAT COUNT (0-63 DECIMAL DEFAULT). * SC=XX - SPACING CODE (FOR 580-PFC SUPPORT). * SCL=XX - SELECT SERVICE CLASS FOR OUTPUT FILES (TWO-CHARACTER * ALPHA-NUMERIC). * ST=XXX - LOGICAL ID (LID) OF SYSTEM TO WHICH FILE IS TO * BE ROUTED. * TID=XX - PROCESSED AS UN=XXXXXXX (FOR NOS/BE COMPATIBILITY). * TID=C - IMPLICIT CENTRAL SITE ROUTING. * TID - IMPLICIT REMOTE ROUTING. * UJN=XXXXXXX - USER JOB NAME. * UN=XXXXXXX - USER NAME. * UN - IMPLICIT REMOTE ROUTING. * * NOTE- * * 1. CENTRAL SITE ROUTING WILL BE SELECTED BY DEFAULT FOR ALL * ORIGIN TYPES EXCEPT *RBOT* UNLESS TID (EXCEPT TID=C), FM, * OR UN IS INCLUDED. * * 2. FOR *RBOT* ORIGIN JOBS, ROUTING WILL BE TO THE TERMINAL * OF ORIGIN UNLESS TID, FM, OR UN ARE SPECIFIED WITH A * PARAMETER. *TID=C* OR *TID* WILL ROUTE TO CENTRAL SITE. * * 3. IMPLICIT REMOTE ROUTING MEANS THAT ROUTING WILL BE TO A * REMOTE TERMINAL IDENTIFIED BY THE FM-UN OF THE JOB MAKING * THE REQUEST. * * 4. IMPLICIT CENTRAL SITE ROUTING WILL SUPPLY THE DEFAULT * LOCAL DEVICE ID AND OVER-RIDE DEFAULT REMOTE ROUTING FOR * *RBOT* ORIGIN JOBS. SPACE 4,10 ** PROGRAMS CALLED. * * DSP - ROUTE FILE. SPACE 4,10 ** COMMON DECKS CALLED. * * COMCDXB * COMCMAC * COMCSYS * COMSBIO * COMSDSP * COMSJIO * COMSSCD * COMSSSJ SPACE 4,20 *** MESSAGES ISSUED. * * ROUTE COMMAND ERROR. * ROUTE COMPLETE. * ROUTE COMPLETE. JSN IS XXXX. * ROUTE *DC* INCOMPATIBLE WITH *EC*. * ROUTE INCORRECT *DO* PARAMETER. * ROUTE INCORRECT *EC* PARAMETER. * ROUTE INCORRECT *FC* PARAMETER. * ROUTE INCORRECT *IC* PARAMETER. * ROUTE INCORRECT *JSN* PARAMETER. * ROUTE INCORRECT KEYWORD. * ROUTE INCORRECT *OT* PARAMETER. * ROUTE INCORRECT SPACING CODE. * ROUTE INCORRECT *ST* PARAMETER. * ROUTE *JSN* NOT ALLOWED. * ROUTE *OT* NOT ALLOWED. * ROUTE *PRI* IGNORED. * ROUTE *REP* .GT. 63. DEFAULT USED. * ROUTE *TID* AND *FM/UN* CONFLICT. * ROUTE *TID/FM/UN* AND *ID* CONFLICT. * ROUTE UNDEFINED SERVICE CLASS. * ROUTE UNKNOWN *PI* PARAMETER. SPACE 4,10 ** DEFINE. * EXTERNAL CHARACTERISTICS (EC), AND * INTERNAL CHARACTERISTICS (IC). SPACE 4,10 * SPECIAL ENTRY POINT. NPC= EQU 0 FORCE OPERATING SYSTEM PARAMETER FORMAT QUAL BIO *CALL COMSBIO QUAL * *CALL COMSDSP *CALL COMCMAC *CALL COMSSSJ LIST X *CALL COMSJIO LIST * TITLE TABLE DEFINITIONS. ORG 103B ROU BSS 0 TDSP SPACE 4,30 ** TDSP - DSP PARAMETER BLOCK. * *T W0 42/ FILE NAME,6/ ,1/F,4/ ,6/ OT,1/C *T, W1 12/ ,12/ FC,12/ DC,3/ EC,3/ IC,18/ FLAGS *T, W2 18/ SLID,18/ DLID,24/ DA *T, W3 42/ UJN,18/ *T, W4 2/ 0,1/ P,3/ PI,6/ SC,12/ SCL,12/ FA,6/ ,6/ RC,12/ *T, W5 60/ *T, W6 60/ * * F - FORCE ORIGIN TYPE FLAG. * OT - DESIRED ORIGIN TYPE. * C - COMPLETE BIT. * FC - FORMS CODE * DC - DISPOSITION CODE * EC - EXTERNAL CHARACTERISTICS * IC - INTERNAL CHARACTERISTICS * SLID - LOGICAL ID (LID) TO RECEIVE OUTPUT FROM INPUT FILES. * DLID - DESTINATION LOGICAL ID OF MAINFRAME TO RECEIVE FILES. * DA - TID OR POINTER TO FM/UN * P - PRINT IMAGE FLAG (INDICATES PRINT IMAGE CODE PRESENT). * PI - PRINT IMAGE CODE (0-7) IF PRINT IMAGE FLAG SET. * SC - SPACING CODE * SCL - SERVICE CLASS * FA - ABORT CODE * RC - REPEAT COUNT * UJN - USER JOB NAME TDSP BSS 0 CON 0 VFD 42/0,18/FRFN VFD 36/0,24/-0 CON 0 CON 0 CON 0 CON 0 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. PTID CON 0 TID PROCESSED PFUN CON 0 FM-UN PROCESSED PDID CON 0 DEVICE ID PROCESSED PDEF CON 0 DEF PROCESSED PJSN CON 0 JSN PROCESSED PUJN CON 0 UJN PROCESSED PDCT CON 0 DISPOSITION TYPE - SEE *TDCC* PECT CON 0 EXTERNAL CHARACTERISTICS TYPE - SEE *TECC* PJOT CON 0 ORIGIN OF JOB LIST X *CALL COMTDSP LIST -X ROUTE TITLE MAIN PROGRAM ** ROUTE - PROCESS COMMAND. ROUTE BSS 0 ENTRY SB1 1 SA1 ACTR R= A0,ARGR FIRST ARGUMENT ADDRESS SB6 X1 SET ARGUMENT COUNT MX0 -18 SA1 A0 ZR B6,ABT IF NOT AT LEAST ONE ARGUMENT * GET FILE NAME. BX6 -X0*X1 AX6 1 NZ X6,ABT IF FILE NAME NOT FIRST PARAMETER BX7 X0*X1 SA7 TDSP STORE FILE NAME * PROCESS NEXT PARAMETER. EPRX BSS 0 END-OF-PROCESSING PARAMETER EXIT SB6 B6-B1 REDUCE REMAINING PARAMETER COUNT SA0 A0+B1 LE B6,B0,DSP IF END OF PARAMETERS SA2 A0 GET NEXT ARGUMENT MX3 0 ZERO PARAMETER SX7 X2-1R= ZR X7,ROU1 IF *=* SEPARATOR SX7 X2-2 NZ X7,ROU3 IF NOT *=* SEPARATOR (NOS/BE FORMAT) * PROCESS EQUIVALENCED PARAMETER, IF PRESENT. ROU1 SA0 A0+B1 SB6 B6-B1 SA3 A0 GET NEXT PARAMETER SB2 X3 LE B2,B1,ROU2 IF 0 OR 1 TERMINATOR SB2 B2-17B ZR B2,ROU2 IF 17B TERMINATOR EQ ABT ABORT ROU2 MX0 42 CHECK FOR NULL PARAMETER BX3 X0*X3 NZ X3,ROU3 IF NOT NULL PARAMETER SX3 -1 SET NULL PARAMETER FLAG * SEARCH FOR KEYWORD. ROU3 SA1 TKEY-1 MX0 36 ROU4 SA1 A1+B1 BX7 X1-X2 COMPARE KEYWORD BX7 X0*X7 SB2 X1 SET PROCESSOR ADDRESS ZR X1,ROU6 IF KEYWORD NOT FOUND IN TABLE NZ X7,ROU4 IF NOT THIS KEYWORD SX7 -B1 DELETE KEYWORD FROM TABLE SA7 A1 MX0 42 BX7 X3-X7 ZR X7,EPRX IF NULL PARAMETER, IGNORE BX3 X0*X3 LX1 59-18 NG X1,ROU5 IF NONEQUIVALENCED PARAMETER ALLOWED ZR X3,ABT IF NONEQUIVALENCED PARAMETER ROU5 JP B2 EXECUTE KEYWORD PROCESSOR ROU6 MESSAGE (=C* ROUTE INCORRECT KEYWORD.*),0,RECALL EQ ABT1 ABORT ABT MESSAGE (=C* ROUTE COMMAND ERROR.*),0,RECALL ABT1 ABORT * MAKE *DSP* CALL. DSP SA1 TDSP+1 MX0 -12 EXTRACT DISPOSITION CODE BX2 X1 AX1 24 BX7 -X0*X1 SB3 B0 INITIALIZE POINTER AX1 12 BX1 -X0*X1 SX3 X7-2RSC NZ X3,DSP0 IF NOT *DC=SC* SA0 B1 SET * ROUTE COMPLETE.* MESSAGE EQ DSP1 CONTINUE DSP0 SA3 DSPB+B3 GET INPUT MNEMONIC ZR X3,DSP0.2 IF END OF TABLE IX3 X7-X3 ZR X3,DSP0.1 IF MATCH SB3 B3+B1 GET NEXT MNEMONIC EQ DSP0 CONTINUE DSP0.1 NZ X1,ABT IF *FC=XX* ON INPUT DISPOSITION SA1 PDEF CHECK FOR *DEF* PARAMETER NZ X1,ABT IF DEFERRED INPUT FILE DSP0.2 SA0 0 SET *ROUTE COMPLETE. JSN IS XXXX.* DSP1 SA1 PFUN SA3 PTID SX4 FRTI BX6 X3+X1 BX7 X4+X2 ZR X6,DSP2 IF NOT REMOTE ROUTING SA7 TDSP+1 SET *TID* FLAG BIT SA1 TFUN SA2 A1+B1 BX2 X2+X1 ZR X2,DSP2 IF IMPLICIT REMOTE ROUTING SA2 TDSP+2 SX3 A1 SET ADDRESS OF FAMILY/USERNUMBER BLOCK MX0 36 BX3 -X3 BX6 -X0*X3 BX2 X0*X2 BX6 X2+X6 SA6 TDSP+2 DSP2 MX0 -3 SA1 PDCT LX0 3 SA2 PECT BX1 -X0*X1 GET *DC* TYPE BX2 -X0*X2 GET *EC* TYPE ZR X1,DSP3 IF NO *DC* TYPE ZR X2,DSP3 IF NO *EC* TYPE BX1 X1-X2 ZR X1,DSP3 IF TYPES COMPARE MESSAGE (=C/ ROUTE *DC* INCOMPATIBLE WITH *EC*./),3,RECALL EQ ABT1 ABORT DSP3 ROUTE TDSP,RECALL SX1 A0 SA2 TDSP MX0 -1 SA3 A2+B1 GET FLAGS FIELD BX3 -X0*X3 NZ X3,DSP5 IF THIS WAS A DEFERRED ROUTE NZ X1,DSP5 IF JSN NOT TO BE RETURNED SA3 DSPA+2 POSITION JSN MX0 24 BX6 X0*X2 ZR X6,DSP5 IF NO JSN RETURNED LX0 30 BX3 -X0*X3 LX6 30 BX6 X3+X6 SA6 DSPA+2 STORE JSN IN MESSAGE MESSAGE DSPA,3,RECALL DSP4 ENDRUN DSP5 MESSAGE (=C* ROUTE COMPLETE.*),3,RECALL EQ DSP4 DSPA DATA H/ ROUTE COMPLETE. JSN IS XXXX./ DSPB DATA 2RIN *DC=IN* DATA 2RNO *DC=NO* DATA 2RTO *DC=TO* DATA 0 TITLE KEYWORD PROCESSORS. ** ALL OF THE FOLLOWING ROUTINES HAVE COMMON ENTRY AND EXIT * CONDITIONS- * * ENTRY X3 = PARAMETER WHEN *KW=PP* IS THE FORMAT. * X3 = ZERO IF NO PARAMETER WITH KEYWORD. * * EXIT CORRECT ENTRIES MADE IN *TDSP*. * RETURN IN ALL NORMAL CASES TO *EPRX* * * USES ALL REGISTERS EXCEPT A0, B6. KDC SPACE 4,10 ** KDC - PROCESS DC=XX. DISPOSITION CODE. * * EXIT *DC* FIELD SET IN *TDSP+1* * *FLAGS* ENTERED WITH *FRDC* IN *TDSP+1*. KDC BSS 0 ENTRY SA1 TDCC-1 MX0 12 * FIND CODE IN TABLE. KDC1 SA1 A1+1 BX7 X1-X3 COMPARE CODES BX7 X0*X7 ZR X1,KDC2 IF END OF TABLE NZ X7,KDC1 IF NO MATCH KDC2 BX7 X1 SA7 PDCT SET TYPE PROCESSED LX3 -24 POSITION PARAMETER SA1 TDSP+1 SX7 FRDC LX0 -24 POSITION MASK BX3 X0*X3 BX1 -X0*X1 BX3 X1+X3 ENTER *DC* PARAMETER BX7 X3+X7 ENTER FLAG BIT SA7 A1 EQ EPRX RETURN KDE SPACE 4,10 ** KDE - PROCESS *DEF*. DEFERRED ROUTE * * EXIT *FLAGS* IN *TDSP+1* ENTERED WITH *FRDR*. KDE BSS 0 ENTRY NZ X3,ABT IF EQUIVALENCED PARAMETER SA1 TDSP+1 SX7 FRDR SA7 PDEF SET *DEF* PARAMETER ENTERED FLAG BX7 X1+X7 ENTER FLAG SA7 A1 EQ EPRX RETURN KDO SPACE 4,10 ** KDO - PROCESS *DO=XXX*. DEFAULT OUTPUT MAINFRAME. * * EXIT SOURCE LOGICAL ID IS PLACED IN *TDSP+2*. * * ERROR IF INCORRECT *DO* PARAMETER OR *LID* IS * GREATER THAN THREE CHARACTERS. KDO BSS 0 ENTRY MX0 18 BX2 -X0*X3 AX2 18 NZ X2,KDO2 IF *LID* GREATER THAN THREE CHARACTERS BX6 X0*X3 EXTRACT OUTPUT MAINFRAME *LID* SA5 =1L* CHECK FOR ASTERISK R= X4,LCPD SET SLID TO PID LX6 18 IX3 X4-X6 PL X3,KDO2 IF .LE. SPECIAL SLID VALUES LX5 18 BX5 X5-X6 NZ X5,KDO1 IF NOT ASTERISK BX6 X4 SET SLID=PID KDO1 SA2 TDSP+2 SET SLID IN TDSP BX2 -X0*X2 LX6 42 BX6 X2+X6 SA6 A2 SX6 FRLD SA1 A2-B1 SET SLID/DLID FLAG BX6 X1+X6 SA6 A1+ STORE FLAG EQ EPRX RETURN KDO2 MESSAGE (=C+ ROUTE INCORRECT *DO* PARAMETER.+),3,RECALL EQ ABT1 ABORT KEC SPACE 4,10 ** KEC - PROCESS *EC=XX*. EXTERNAL CHARACTERISTICS. * * EXIT *EC* FIELD SET IN *TDSP+1*. * *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FREC*. KEC BSS 0 ENTRY SA1 TECC-1 MX0 36 SA2 TDSP+1 MX7 -3 KEC1 SA1 A1+B1 ZR X1,KEC2 IF *EC* NOT FOUND BX6 X3-X1 BX6 X0*X6 NZ X6,KEC1 IF NOT CORRECT *EC* BX6 X1 SA6 PECT SET TYPE PROCESSED LX7 23-2 POSITION MASK LX1 23-2 POSITION ENTRY FROM *EC* TABLE SX6 FREC BX2 X7*X2 BX1 -X7*X1 BX6 X2+X6 ENTER FLAG BIT BX6 X1+X6 ENTER *EC* CODE SA6 A2+ EQ EPRX RETURN KEC2 MESSAGE (=C+ ROUTE INCORRECT *EC* PARAMETER.+),3,RECALL EQ ABT1 ABORT KFC SPACE 4,10 ** KFC - PROCESS *FC=XX. FORMS CODE. * * EXIT *FC* FIELD SET IN *TDSP+1*. * *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FRFC*. * * ERROR TO *ABT1*. * * MACROS MESSAGE. KFC BSS 0 ENTRY SA1 TDSP+1 MX0 -48 SX6 FRFC BX2 -X0*X3 LX3 -12 NZ X2,KFC1 IF FORMS CODE GREATER THAN TWO CHARACTERS LX0 -12 BX1 X1+X6 ENTER FLAG BIT BX3 X0*X3 BX6 X1+X3 ENTER FORMS CODE SA6 A1 EQ EPRX RETURN KFC1 MESSAGE (=C+ ROUTE INCORRECT *FC* PARAMETER.+),0,RECALL EQ ABT1 ABORT KFM SPACE 4,10 ** KFM - PROCESS *FM=XXXXXXX* PARAMETER. * * EXIT FAMILY NAME ENTERED IN *TFUN*. * FLAG SET IN *PFUN* IF *PTID* AND *PDID* ARE ZERO. KFM BSS 0 ENTRY SA1 PDID NZ X1,KFM2 IF *FM* AND *ID* CONFLICT SA1 PTID SX7 FRTI NZ X1,KFM1 IF *TID* PROCESSED SA7 PFUN SET *FM-UN* FLAG ZR X3,EPRX IF IMPLICIT REMOTE ROUTING MX0 42 BX7 X0*X3 SA7 TFUN STORE FAMILY NAME IN *TFUN* EQ EPRX RETURN KFM1 MESSAGE (=C+ ROUTE *TID* AND *FM/UN* CONFLICT.+),3,RECALL EQ ABT1 ABORT KFM2 MESSAGE (=C+ ROUTE *TID/FM/UN* AND *ID* CONFLICT.+),3,RECALL EQ ABT1 ABORT KIC SPACE 4,10 ** KIC - PROCESS *IC=XX* (INTERNAL CHARACTERISTICS) * * EXIT *IC* FIELD SET IN *TDSP+1*. * *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FRIC*. KIC BSS 0 ENTRY SA1 TDSP+1 SA2 TICC-1 SX6 FRIC MX7 -2 MX0 36 LX7 19-1 POSITION MASK BX6 X1+X6 ENTER FLAG BIT KIC1 SA2 A2+B1 ZR X2,KIC2 IF UNKNOWN *IC* CODE BX1 X3-X2 BX1 X0*X1 NZ X1,KIC1 IF NOT FOUND LX2 19-1 BX6 X7*X6 BX2 -X7*X2 BX6 X6+X2 ENTER IC CODE SA6 A1 EQ EPRX RETURN KIC2 MESSAGE (=C+ ROUTE INCORRECT *IC* PARAMETER.+),3,RECALL EQ ABT1 ABORT KID SPACE 4,10 ** KID - PROCESS *ID=NN* (LOCAL DEVICE ID). * * EXIT DEVICE ID STORED IN *TDSP+2* (TID FIELD). * *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FRTI*. * *PDID* SET IF *PTID* AND *PFUN* ARE ZERO. KID BSS 0 ENTRY SA1 PTID SA2 PFUN SX7 B1 BX1 X1+X2 NZ X1,KFM2 IF *ID* - *TID*/*FM*/*UN* CONFLICT SA7 PDID ZR X3,KID1 IF NONEQUIVALENCED PARAMETER SB7 B0 SET OCTAL CONVERSION DEFAULT BX5 X3 RJ =XDXB NZ X4,ABT IF CONVERSION ERROR SA1 TDSP+2 MX0 36 SX2 X6-IDLM BX7 X0*X1 PL X2,ABT IF ID .GE. IDLM BX7 X7+X6 SA7 A1 SX3 FRTI KID1 SA2 TDSP+1 SX6 FRCS BX6 X2+X6 SET CENTRAL SITE ROUTING FLAG BX6 X3+X6 OPTIONALLY SET *TID* FLAG SA6 A2+ EQ EPRX RETURN KJS SPACE 4,10 ** KJS - PROCESS *JSN=XXX* (UNIQUE JSN). * * EXIT FORCED JSN FIELD SET IN *TDSP+6*. * *FLAGS* FIELD IN *TDSP+1* ENTERED WITH *FRFJ*. KJS BSS 0 ENTRY ZR X3,ABT IF NULL PARAMETER SX6 B1+ SA6 PJSN SA1 JOPR CHECK JOB ORIGIN TYPE MX0 -12 LX1 0-24 BX1 -X0*X1 MX0 42 IFNE SYOT,0,1 SX1 X1-SYOT ZR X1,KJS1 IF SYSTEM ORIGIN JOB MESSAGE (=C+ ROUTE *JSN* NOT ALLOWED.+),3 EQ ABT1 ABORT KJS1 LX3 18 BX1 X0*X3 NZ X1,KJS2 IF JSN TOO LONG MX7 -6 BX1 -X7*X3 ZR X1,KJS2 IF JSN TOO SHORT SA1 TDSP+6 SA2 TDSP+1 BX6 X0*X1 BX6 X6+X3 SET JSN IN FORCED JSN FIELD SX7 FRFJ BX7 X2+X7 SET FORCED JSN FLAG SA6 A1 SA7 A2+ EQ EPRX RETURN KJS2 MESSAGE (=C+ ROUTE INCORRECT *JSN* PARAMETER.+),3 EQ ABT1 ABORT KOT SPACE 4,10 ** KOT - PROCESS *OT=XXXX* (ORIGIN TYPE). * * EXIT *F* AND *OT* FIELDS SET IN *TDSP*. KOT BSS 0 ENTRY SA1 JOPR CHECK JOB ORIGIN TYPE MX0 -12 LX1 11-35 BX1 -X0*X1 MX0 30 SA2 TLOT-1 SX1 X1-SYOT ZR X1,KOT1 IF *SYOT* JOB ORIGIN MESSAGE (=C/ ROUTE *OT* NOT ALLOWED./),3,RECALL EQ ABT1 ABORT KOT1 SA2 A2+1 BX6 X3-X2 BX6 X0*X6 ZR X2,KOT2 IF END OF TABLE NZ X6,KOT1 IF NOT A MATCH MX0 -7 SA1 TDSP BX2 -X0*X2 EXTRACT ORIGIN VALUE SX2 X2+4000B SET FLAG BIT BX1 X0*X1 BX7 X1+X2 ENTER ORIGIN VALUE SA7 TDSP EQ EPRX RETURN KOT2 MESSAGE (=C+ ROUTE INCORRECT *OT* PARAMETER.+),3,RECALL EQ ABT1 ABORT KPI SPACE 4,10 ** KPI - PROCESS *PI=NNNNNNN* (PRINT IMAGE). * * EXIT- *P* FLAG AND *PI* FIELD SET IN *TDSP+4* * KPI BSS 0 ENTRY ZR X3,EPRX IF NULL PARAMETER SA1 TPIN-1 MX0 1 * CHECK FOR VALID PRINT IMAGE NAME. KPI1 SA1 A1+B1 CHECK NEXT ENTRY ZR X1,KPI2 IF END OF TABLE SX6 X1 ISOLATE MASK SIZE BX7 X1-X3 AX6 6 SB4 X6 AX6 X0,B4 FORM MASK BX2 X6*X7 NZ X2,KPI1 IF NO MATCH SA2 TDSP+4B MX0 -6 ISOLATE PRINT IMAGE ORDINAL LX2 6 BX6 -X0*X1 BX7 X0*X2 SX6 X6+10B SET PRINT IMAGE FLAG BX7 X6+X7 SET PRINT IMAGE CODE INTO PARAMETER BLOCK LX7 -6 SA7 A2 EQ EPRX RETURN KPI2 MESSAGE (=C/ ROUTE UNKNOWN *PI* PARAMETER./),3,R EQ ABT1 ABORT KPR SPACE 4,10 ** KPR - PROCESS *PRI=NNNN* (PRIORITY) * * EXIT MESSAGE ISSUED, PARAMETER IGNORED. KPR BSS 0 ENTRY MESSAGE (=C/ ROUTE *PRI* IGNORED./),3,RECALL EQ EPRX RETURN KRE SPACE 4,10 ** KRE - PROCESS *REP=NN* (REPEAT COUNT) * * EXIT REPEAT COUNT SET IN *TDSP+4* - *RC* FIELD. * *FLAGS* IN *TDSP+1* ENTERED WITH *FRRC*. KRE BSS 0 ENTRY SB7 B1 SET DECIMAL CONVERSION BX5 X3 RJ =XDXB CONVERT VALUE NZ X4,ABT IF CONVERSION ERROR SA1 TDSP+1 MX0 -6 BX2 X0*X6 NZ X2,KRE1 IF VALUE .GT. 63D (77B) SA2 TDSP+4 SX7 FRRC LX0 12 POSITION MASK LX6 12 POSITION VALUE BX2 X0*X2 BX7 X1+X7 SET FLAG BIT SA7 A1 BX6 X6+X2 ENTER REPEAT COUNT SA6 A2+ EQ EPRX RETURN KRE1 MESSAGE (=C/ ROUTE *REP* GT 63. DEFAULT USED./),3,RECALL EQ EPRX RETURN KSC SPACE 4,10 ** KSC - PROCESS *SC=XX* (SPACING CODE). * * EXIT SPACING CODE ENTERED IN *TDSP+4*. KSC BSS 0 ENTRY SB7 B0 SET OCTAL CONVERSION BX5 X3 RJ =XDXB CONVERT VALUE NZ X4,ABT IF CONVERSION ERROR MX0 -6 ENTER SPACING CODE BX3 -X0*X6 BX1 X0*X6 ZR X1,KSC1 IF SC .LE. 77B MESSAGE (=C* ROUTE INCORRECT SPACING CODE.*),3,R EQ ABT1 ABORT KSC1 SA1 TDSP+4 LX0 48 BX1 X0*X1 LX3 48 BX6 X1+X3 SA6 A1+ SA1 TDSP+1 SET SPACING CODE FLAG SX6 FRSC BX6 X6+X1 SA6 A1 EQ EPRX RETURN KST SPACE 4,10 ** KST - PROCESS *ST=XXX*. DESTINATION LID. * * EXIT THE LOGICAL ID IS PLACED IN *TDSP+2*. * * ERROR IF INCORRECT *ST* PARAMETER OR *LID* IS * GREATER THAN THREE CHARACTERS. KST BSS 0 ENTRY MX0 18 BX2 -X0*X3 AX2 18 NZ X2,KST2 IF *LID* GREATER THAN THREE CHARACTERS BX6 X0*X3 SA5 =1L* CHECK FOR ASTERISK R= X4,LCPD SET DLID TO PID LX6 18 IX3 X4-X6 PL X3,KST2 IF .LE. SPECIAL DLID VALUES LX5 18 BX5 X5-X6 NZ X5,KST1 IF NOT ASTERISK BX6 X4 SET DLID=PID KST1 LX6 24 SA2 TDSP+2 SET DLID IN TDSP LX0 -18 BX2 -X0*X2 BX6 X6+X2 SX1 FRLD SET SLID/DLID FLAG SA6 A2 SA2 A2-B1 BX6 X2+X1 SA6 A2 STORE FLAG EQ EPRX RETURN KST2 MESSAGE (=C+ ROUTE INCORRECT *ST* PARAMETER.+),3,RECALL EQ ABT1 ABORT KSV SPACE 4,10 ** KSV - PROCESS *SCL=XX* (SERVICE CLASS). * * EXIT SERVICE CLASS ENTERED IN *TDSP+4*. KSV BSS 0 ENTRY SA1 TSCT-1 * CHECK FOR VALID SERVICE CLASS. KSV1 SA1 A1+B1 ZR X1,KSV2 IF END OF TABLE BX7 X1-X3 NZ X7,KSV1 IF NO MATCH SA1 TDSP+4 MX0 12 BX7 X0*X3 SET SERVICE CLASS INTO PARAMETER BLOCK LX7 -12 BX7 X7+X1 SA7 A1 SA1 TDSP+1 SET FORCED SERVICE CLASS FLAG MX0 -1 LX0 20 BX7 -X0+X1 SA7 A1+ EQ EPRX RETURN KSV2 MESSAGE (=C+ ROUTE UNDEFINED SERVICE CLASS.+),3,RECALL EQ ABT1 ABORT KTD SPACE 4,10 ** KTD - PROCESS *TID=XX* (TERMINAL ID). * * EXIT *PTID* SET NON-ZERO IF *PFUN* AND *PDID* EQUAL ZERO. * *TID=C* PROCESSED AS *ID*. * *TID=XX* PROCESSED AS *UN*. KTD BSS 0 ENTRY SX6 1RC LX6 59-5 BX6 X6-X3 ZR X6,KTD1 IF *TID=C* - ROUTE TO CENTRAL SITE SA1 PDID NZ X1,KFM2 IF *TID* - *ID* CONFLICT SA1 PFUN NZ X1,KFM1 IF TID - FM/UN CONFLICT PL X3,KUN IF *TID=XX* SX7 FRTI SA7 PTID EQ EPRX RETURN KTD1 SX3 0 EQ KID PROCESS AS *ID* KUJ SPACE 4,10 ** KUJ - PROCESS *UJN=XXXXXXX* (USER JOB NAME). * * EXIT *UJN* FIELD SET IN *TDSP+3*. * *FLAGS* IN *TDSP+1* ENTERED WITH *FRUJ*. KUJ BSS 0 ENTRY SX6 B1+ SA6 PUJN SA1 TDSP+1 ENTER FLAG BIT SX7 FRUJ BX7 X1+X7 SA7 A1 SA1 TDSP+3 ENTER *UJN* PARAMETER BX1 -X0*X1 BX6 X1+X3 SA6 A1 EQ EPRX RETURN KUN SPACE 4,10 ** KUN - PROCESS *UN=XXXXXXX* (USER NAME). * * EXIT USER NAME ENTERED IN *TFUN+1*. * FLAG SET IN *PFUN* IF *PTID* AND *PDID* ARE ZERO. KUN BSS 0 ENTRY SA1 PDID NZ X1,KFM2 IF *UN* - *ID* CONFLICT SA1 PTID SX7 FRTI NZ X1,KFM1 IF FM/UN - TID CONFLICT SA7 PFUN ZR X3,EPRX IF IMPLICIT REMOTE ROUTING MX0 42 BX6 X0*X3 SA6 TFUN+1 STORE USER NAME EQ EPRX RETURN SPACE 4,10 USE LITERALS ** COMMON DECKS. *CALL COMCDXB *CALL COMCSYS BSS 0 RFL= EQU *+8 END