IDENT NOTE,FET ABS SST SYSCOM B1 ENTRY BLOCK ENTRY ENTER ENTRY NOTE ENTRY RFL= *COMMENT NOTE - ENTER DELIMITED LINES INTO FILE. COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. TITLE NOTE - ENTER DELIMITED LINES INTO FILE. SPACE 4 *** NOTE - ENTER DELIMITED LINES INTO FILE. * J.C.BOHNHOFF. 75/05/04. * W.F.ANSLEY. 77/02/03. * R.K.MYERS. 84/01/04. SPACE 4 *** NOTE TAKES DELIMITED LINES FROM THE CALL COMMAND * AND WRITES THEM INDIVIDUALLY TO A FILE. THIS FILE MAY BE USED * AS A PROCEDURE. NOTE SPACE 4,45 *** THE COMMAND - * * BLOCK(LFN,P1,P2)/BLINE 1/BLINE 2/BLINE N * OR * ENTER./COMMAND 1/COMMAND 2/COMMAND N * OR * NOTE(LFN,NR)/LINE 1/LINE 2/LINE N * * ASSUMED PARAMETERS. * LFN = *OUTPUT*. * NR OMITTED = AUTOMATIC REWIND BEFORE AND AFTER (*NOTE*). * P1 OMITTED = NO REWIND BEFORE (*BLOCK*). * * WHERE ) MAY BE PERIOD OR RIGHT PARENTHESIS. * LFN IS A FILE NAME TO RECEIVE THE LINES. IF ABSENT, * *OUTPUT* IS ASSUMED. * NR CAN EITHER BE *NR* OR *R*, DENOTING WHETHER THE * FILE SHOULD BE REWOUND BEFORE AND AFTER PROCESSING. * P1 CAN EITHER BE *R* OR *NR*, DENOTING WHETHER * THE FILE SHOULD BE REWOUND BEFORE PROCESSING. * P2 CAN BE ANY USER SPECIFIED CARRIAGE CONTROL * CHARACTER (ONLY THE FIRST CHARACTER IS USED), BUT * NO VALIDITY CHECKING IS PERFORMED. LITERALS ($-$) * OR THE WORD *SPACE* WILL ALSO BE ACCEPTED. * / MAY BE ANY CHARACTER TO DELIMIT THE INDIVIDUAL * COMMANDS. IT MUST IMMEDIATELY FOLLOW THE PERIOD * OR RIGHT PARENTHESIS. A RIGHT BLANK WILL BE * GENERATED FOR EACH OCCURRENCE OF CONSECUTIVE * DELIMITERS. * COMMAND I IS ANY VALID COMMAND. A * PERIOD IS APPENDED TO ANY COMMAND THAT DOES NOT * ALREADY HAVE A TERMINATOR (A *.* OR A *)*). * LINE I IS ANY TEXT. IT IS TREATED THE SAME AS A * COMMAND EXCEPT THAT A BLANK IS APPENDED TO * EACH LINE INSTEAD OF A PERIOD. * BLINE I IS ANY TEXT STRING OF UP TO 9 * CHARACTERS IN LENGTH, WHICH IS TO BE PRINTED * IN EXPANDED FORMAT TO FILE LFN. THERE ARE * SPECIAL TEXT STRINGS FOR WHICH CURRENT DATA * ABOUT THE JOB WILL BE SUBSTITUTED. THESE ARE - * * STRING SUBSTITUTED DATA * ------ ----------- ---- * DATE CURRENT DATE * JSN JOB SEQUENCE NAME * TIME CURRENT TIME * UJN USER JOB NAME * USER USER NAME * * * *ENTER* WRITES THE COMMANDS TO AN INTERNAL FILE * *ZZZZZG0* AND THEN EXECUTES A *ZZZZZG0.* COMMAND * TO PROCESS THE COMMANDS. * * FOR EXAMPLE - * ENTER./LDSET(LIB=ULIB)/LOAD(A)/LOAD(LGO)/NOGO. * RESULTS IN - * LDSET(LIB=ULIB) * LOAD(A) * LOAD(LGO) * NOGO. * * *NOTE* WRITES THE LINES TO A FILE. * * FOR EXAMPLE - * NOTE(MESSAGE)/ CANT GET THE FILE * RESULTS IN FILE MESSAGE CONTAINING - * CANT GET THE FILE SPACE 4 *** DAYFILE MESSAGES ISSUED. * * * TOO MANY PARAMETERS.* * MORE THAN TWO PARAMETERS WERE SPECIFIED ON THE CALL * COMMAND. * * * NO TERMINATOR IN COMMAND CALL.* * NO TERMINATOR WAS FOUND BEFORE THE LEADING DELIMITER * OF THE CALL COMMAND. * * * INCORRECT -NR- PARAMETER.* * A PARAMETER OTHER THAN *NR*, *R* OR NULL WAS PASSED * TO *NOTE* AS THE SECOND PARAMETER. * * * INCORRECT -R/NR- PARAMETER.* * A PARAMETER OTHER THAN *R*, *NR* OR NULL WAS PASSED * TO *BLOCK* AS THE SECOND PARAMETER. TITLE SYMBOLS AND DATA. * COMMON DECKS. *CALL COMCMAC *CALL COMSQAC SPACE 4 * SYMBOL DEFINITIONS. PBUFL EQU 3 *QAC*/*PEEK* BUFFER LENGTH SBUFL EQU 3001B SCRATCH/OUTPUT BUFFER LENGTH SPACE 4 * FET. ORG 110B FET BSS 0 S BSS 0 SCRATCH ZZZZZG0 FILEB SBUF,SBUFL SPACE 4 * DATA LOCATIONS. BLKF CON 0 *BLOCK* FLAG CCCH DATA 1L1 CARRIAGE CONTROL CHARACTER DATE CON 0 CURRENT DATE JSNM CON 0 JOB SEQUENCE NAME NLIP CON 0 NUMBER OF LINES IN PAGE NR CON 0 NO REWIND FLAG TIME CON 0 CURRENT TIME UJNM CON 0 USER JOB NAME USER CON 0 USER NAME QACB SPACE 4,10 * *QAC* PARAMETER BLOCK. QACB VFD 50/0,9/PKFC,1/0 REQUEST PREFIX PORTION VFD 36/0,6/11,18/PBUF VFD 42/0,18/PBUF VFD 42/0,18/PBUF VFD 42/0,18/PBUF+PBUFL QBSC VFD 60/0 SELECTION CRITERIA PORTION VFD 60/0 VFD 60/100B VFD 12/2B,48/0 VFD 60/0 VFD 60/0 VFD 60/0 QBPF VFD 60/-0 PEEK FUNCTION PORTION VFD 12/-0,48/0 VFD 48/0,12/UJPB+JSPB JSN AND USER JOBNAME VFD 60/0 * *QAC*/*PEEK* BUFFER. PBUF BSSZ PBUFL TITLE COMMAND PROCESSORS. BLOCK SPACE 4,10 ** BLOCK - WRITE BLOCK LETTERS TO FILE. BLOCK BSS 0 ENTRY SB1 1 SX6 B1+ SA6 BLKF SET *BLOCK* FLAG RJ ICP INITIALIZE COMMAND PARAMETERS ZR B6,BLO0 IF NO PARAMETERS RJ POP READ FILE NAME PARAMETER NZ X6,BLO1 IF PARAMETER PRESENT BLO0 SA1 =0LOUTPUT SET DEFAULT FILE NAME BX6 X1 BLO1 SX7 B1 SET STATUS BX6 X7+X6 SA6 S SET FILE NAME ZR B6,BLO3 IF NO MORE PARAMETERS RJ POP READ *R/NR* PARAMETER ZR X6,BLO2 IF NULL PARAMETER SX3 2RNR SX2 1RR LX3 -12 LX2 -6 BX3 X6-X3 BX2 X6-X2 CHECK IF *R* ZR X3,BLO2 IF *NR* SPECIFIED NZ X2,BLO4 IF NOT *R* REWIND S,R BLO2 ZR B6,BLO3 IF NO MORE PARAMETERS RJ POP READ CARRIAGE CONTROL PARAMETER ZR X6,BLO3 IF NULL PARAMETER SPECIFIED MX1 6 BX6 X6*X1 ISOLATE TO 1 CHARACTER SA6 CCCH SET USER SPECIFIED CARRIAGE CONTROL BLO3 GETPAGE BLOA GET PAGE SIZE PARAMETERS SA1 BLOA MX6 -8 LX1 -20 BX6 -X6*X1 NUMBER OF LINES ON PAGE SA6 NLIP WRITEW S,CCCH,1 WRITE CARRIAGE CONTROL CHARACTER SX7 1R SET TERMINATOR RJ WDL WRITE DELIMITED LINES ENDRUN * PROCESS INCORRECT PARAMETERS. BLO4 MESSAGE (=C* INCORRECT -R/NR- PARAMETER.*),,R ABORT BLOA BSS 2 *GETPAGE* PARAMETER BLOCK ENTER SPACE 4,10 ** ENTER - PLACE COMMANDS FROM CALL COMMAND INTO * FILE *ZZZZZG0*, AND THEN CALL FILE *ZZZZZG0*. ENTER BSS 0 ENTRY SB1 1 RJ ICP INITIALIZE COMMAND PARAMETERS REWIND S,R REWIND SCRATCH FILE WRITEW S,ENTA,ENTAL WRITE PROCEDURE HEADER SX7 1R. SET TERMINATOR RJ WDL WRITE DELIMITED LINES EXCST (=C*ZZZZZG0.*) ENTER CALL COMMAND ENTA DATA C*.PROC,ZZZZZG0.* DATA C*$RETURN,ZZZZZG0.* ENTAL EQU *-ENTA NOTE SPACE 4 ** NOTE - PLACE LINES FROM CALL COMMAND INTO SPECIFIED FILE. NOTE BSS 0 ENTRY SB1 1 RJ ICP INITIALIZE COMMAND PARAMETERS ZR B6,NOT1 IF NO PARAMETERS RJ POP READ FILE NAME PARAMETER NZ X6,NOT2 IF FILE NAME PRESENT NOT1 SA1 =0LOUTPUT SET DEFAULT FILE NAME BX6 X1 NOT2 SA2 S SET NAME MX0 42 BX7 -X0*X2 FILE STATUS BX6 X6+X7 SA6 A2 ZR B6,NOT3 IF NO MORE PARAMETERS RJ POP READ *NR* PARAMETER NZ B6,NOT6 IF TOO MANY PARAMETERS ZR X6,NOT3 IF NULL PARAMETER SX3 1RR SX2 2RNR LX3 -6 LX2 -12 BX3 X6-X3 CHECK IF *R* BX2 X6-X2 CHECK IF *NR* ZR X3,NOT3 IF *R* NZ X2,NOT7 IF NOT *NR* SX7 1R SET TERMINATOR SA7 NR INDICATE NO REWIND IN EFFECT EQ NOT4 * NOT3 REWIND S,R SX7 1R NOT4 RJ WDL WRITE DELIMITED LINES SA1 NR NZ X1,NOT5 IF NO REWIND SELECTED REWIND S NOT5 ENDRUN * PROCESS TOO MANY PARAMETERS. NOT6 MESSAGE (=C* TOO MANY PARAMETERS.*),,R ABORT * PROCESS INCORRECT PARAMETERS NOT7 MESSAGE (=C* INCORRECT -NR- PARAMETER.*),,R ABORT TITLE SUBROUTINES. CNW SPACE 4,10 ** CNW - CENTER NAME IN WORD. * * ENTRY (X1) = NAME (LEFT JUSTIFIED, ZERO FILLED). * * EXIT (X6) = CENTERED NAME. * * USES X - 1, 7. * B - 2. * * CALLS SFN. CNW SUBR ENTRY/EXIT RJ SFN SPACE FILL NAME ZR X7,CNWX IF 10-CHARACTER NAME CX7 X7 NUMBER OF BITS IN NAME SX1 6 IX7 X7/X1 NUMBER OF CHARACTERS IN NAME SX1 10 NUMBER OF CHARACTERS IN WORD IX7 X1-X7 AX7 1 NUMBER OF CHARACTERS TO RIGHT SHIFT LX7 1 SB2 X7 LX7 1 SB2 X7+B2 NUMBER OF BITS TO RIGHT SHIFT SB2 B2-60 AX6 B2 CENTER NAME (CIRCULAR LEFT SHIFT) EQ CNWX RETURN CSP SPACE 4,15 ** CSP - CHECK FOR SUBSTITUTIBLE PARAMETERS. * * ENTRY (B6) = FWA OF DELIMITED STRING TO TEST. * (B7) = COUNT OF CHARACTERS IN STRING. * * EXIT (X4) = PACKED WORD TO BE PRINTED. * * USES X - 1, 2, 3, 4, 5, 6. * A - 1, 2, 4, 6. * B - 2, 3, 4, 5. * * CALLS CNW, GJS. * * MACROS CLOCK, DATE, SYSTEM, USERNUM. CSP SUBR ENTRY/EXIT SB4 B6 SB5 60 BX1 X1-X1 SB2 10 MAXIMUM CHARACTERS SB3 B7-2 LT B3,B2,CSP1 IF CORRECT NUMBER OF CHARACTERS SB3 9 RESET CHARACTER COUNT CSP1 SA2 B4 GET NEXT CHARACTER LX1 6 BX1 X1+X2 PACK CHARACTER SB4 B4+B1 SB5 B5-6 DECREMENT SHIFT COUNT SB3 B3-B1 DECREMENT CHARACTER COUNT PL B3,CSP1 IF MORE CHARACTERS LX1 B5 LEFT JUSTIFY STRING SA2 CSPA MX3 42 CSP2 BX6 X3*X2 CHECK FOR SUBSTITUTIBLE PARAMETER BX6 X1-X6 ZR X6,CSP3 IF SUBSTITUTIBLE PARAMETER FOUND SA2 A2+B1 NZ X2,CSP2 IF NOT AT END OF MATCH TABLE * SPECIFIED STRING NOT FOUND IN TABLE. RJ CNW CENTER STRING ON LINE BX4 X6 EQ CSPX RETURN * CALL SUBSTITUTION PROCESSOR. CSP3 SB2 X2 GET PROCESSOR ADDRESS JP B2 PROCESS SUBSTITUTION * GET CURRENT DATE. CSP4 SA4 DATE NZ X4,CSPX IF DATE ALREADY AVAILABLE DATE DATE SA1 DATE SX6 1R &1R. CHANGE LAST CHARACTER TO SPACE BX6 X1-X6 SA6 A1 EQ CSP4 RETURN DATE * GET CURRENT TIME. CSP5 SA4 TIME NZ X4,CSPX IF TIME ALREADY AVAILABLE CLOCK TIME SA1 TIME SX6 1R &1R. CHANGE LAST CHARACTER TO SPACE BX6 X1-X6 SA6 A1 EQ CSP5 RETURN TIME * GET USER NAME. CSP6 SA4 USER NZ X4,CSPX IF USER NAME ALREADY AVAILABLE USERNUM USER SA1 USER RJ CNW CENTER USER NAME IN WORD SA6 A1 EQ CSP6 RETURN USER NAME * GET JSN. CSP7 SA4 JSNM NZ X4,CSPX IF JSN ALREADY AVAILABLE RJ GJS GET JSN EQ CSP7 RETURN JSN * GET UJN. CSP9 SA4 UJNM NZ X4,CSPX IF UJN ALREADY AVAILABLE SA1 JSNM NZ X1,CSP10 IF JSN ALREADY AVAILABLE RJ GJS GET JSN FOR *QAC* CALL CSP10 SYSTEM QAC,R,QACB CALL *QAC* FOR UJN SA1 PBUF+1 MX3 42 BX1 X3*X1 ISOLATE UJN RJ CNW CENTER UJN IN WORD SA6 UJNM EQ CSP9 RETURN UJN CSPA BSS 0 TABLE OF SUBSTITUTION PROCESSORS VFD 42/0LDATE,18/CSP4 VFD 42/0LTIME,18/CSP5 VFD 42/0LUSER,18/CSP6 VFD 42/0LJSN,18/CSP7 VFD 42/0LUJN,18/CSP9 CON 0 EXP SPACE 4,20 ** EXP - EXPAND CHARACTERS. * * EXPAND EACH CHARACTER OF A TEN CHARACTER STRING INTO A * PATTERN OF CHARACTERS IN A 10X10 MATRIX, AND WRITE THE * EXPANSION ONTO FILE *S*. CERTAIN SPECIAL STRINGS WILL * HAVE VALUES SUBSTITUTED BEFORE EXPANSION (SEE *CSP*). * A PAGE EJECT WILL BE WRITTEN IF THE PAGE IS FULL. * * ENTRY (B6) = FWA OF DELIMITED STRING TO EXPAND. * (B7) = COUNT OF CHARACTERS IN STRING. * * EXIT EXPANDED BLOCK LETTERS WRITTEN TO FILE. * * USES X - 1, 2, 3, 4, 5, 6. * A - 1, 2, 6. * * CALLS BAN, CSP. * * MACROS WRITEW. EXP SUBR ENTRY/EXIT RJ CSP CHECK FOR SUBSTITUTIBLE PARAMETERS SA2 LBUF EXPAND LINE TO *LBUF* RJ BAN SX5 A2-LBUF LENGTH OF BUFFER SA1 EXPA UPDATE LINE COUNT SX6 X1+/COMCBAN/LNCH+2 SA2 NLIP SA6 A1 ZR X1,EXP2 IF TOP OF FIRST PAGE IX2 X2-X6 PL X2,EXP1 IF ROOM ON CURRENT PAGE SX6 /COMCBAN/LNCH+2 RESET LINE COUNT FOR NEW PAGE SA6 A1 WRITEW S,(=2L1 ),1 ISSUE PAGE EJECT EQ EXP2 WRITE EXPANDED LINE TO FILE EXP1 WRITEW S,(=2L0 ),1 ISSUE DOUBLE SPACE EXP2 WRITEW S,LBUF,X5 WRITE EXPANDED LINE TO FILE EQ EXPX RETURN EXPA CON 0 NUMBER OF LINES ALREADY ON CURRENT PAGE ICP SPACE 4,15 ** ICP - INITIALIZE COMMAND PARAMETERS. * * ICP INITIALIZES THE COMMAND STRING BUFFER FOR SUBSEQUENT * EXTRACTION OF PARAMETERS VIA *POP*. * * EXIT (B6) .EQ. 0 IF TERMINATOR ENCOUNTERED. * .NE. 0 = INDEX TO NEXT CHARACTER IN BUFFER. * (USCB) = EXPANDED COMMAND, 1 CHARACTER PER WORD. * * USES X - 1. * A - 1. * B - 2, 6. * * CALLS POP, USB. ICP2 RJ POP SKIP PAST COMMAND NAME ICP SUBR ENTRY/EXIT SB2 CCDR COMMAND RJ USB UNPACK DATA BLOCK TO STRING BUFFER ICP1 SA1 B6+ SKIP PREFIX $, /, SPACE SX1 X1-1R9-1 NG X1,ICP2 IF ALPHANUMERIC CHARACTER SB6 B6+1 EQ ICP1 CHECK NEXT CHARACTER GJS SPACE 4,15 ** GJS - GET JOB SEQUENCE NAME. * * EXIT (QBSC+2) SET WITH JSN FOR *QAC* CALL. * (JSNM) = CENTERED JSN. * * USES X - 1, 6. * A - 1, 6. * * CALLS CNW. * * MACROS GETJN. GJS SUBR ENTRY/EXIT GETJN QBSC+2 GET JSN SA1 QBSC+2 SET JSN FOR POSSIBLE *QAC* CALL SX6 100B SET JSN FLAG BX6 X1+X6 SA6 A1 RJ CNW CENTER JSN SA6 JSNM SET CENTERED JSN EQ GJSX RETURN WDL SPACE 4,20 ** WDL - WRITE DELIMITED LINES. * * ENTRY (X7) = TERMINATOR TO BE APPENDED TO EACH LINE. * (S) SET WITH PROPER FILE NAME. * * EXIT FILE WRITTEN WITH EOR. * * USES X - ALL. * A - 0, 1, 2, 5, 6, 7. * B - 2, 5, 6, 7. * * CALLS EXP. * * MACROS ABORT, MESSAGE, WRITER, WRITES, WRITEW. WDL SUBR ENTRY/EXIT SA7 WDLA SAVE TERMINATOR SA2 USBC LWA OF COMMAND IN STRING BUFFER MX6 -1 ASSURE STRING TERMINATION SA0 B0 CLEAR LINE COUNT * REMOVE TRAILING BLANKS FROM COMMAND. WDL0.1 SA1 X2+ SX2 X2-1 SX1 X1-1R ZR X1,WDL0.1 IF BLANK CHARACTER * FIND BEGINNING OF LINES TO BE WRITTEN. SA5 USBB FIND DELIMITER SA6 X2+2 SA6 X2+3 WDL1 NG X5,WDL11 IF NO TERMINATION SX6 X5-1R. SX7 X5-1R) SA5 A5+1 ZR X6,WDL2 IF TERMINATOR NZ X7,WDL1 IF NOT TERMINATOR WDL2 BX0 X5 DELIMITER SA5 A5+B1 FIRST CHARACTER OF FIRST LINE BX6 X0 SB6 A5 SET FWA OF LINE SA6 WDLB SAVE DELIMITER SB5 B0 INITIALIZE LINE TERMINATOR FLAG * WRITE DELIMITED LINES. WDL3 NG X5,WDL8 IF END OF STRING BX6 X5-X0 CHECK DELIMITER SX4 X5-1R. SX3 X5-1R) ZR X4,WDL4 IF TERMINATOR NZ X3,WDL5 IF NOT TERMINATOR WDL4 SB5 1 INDICATE TERMINATOR IN THIS LINE WDL5 SA5 A5+1 NZ X6,WDL3 IF NOT DELIMITER SA1 WDLA TERMINATE LINE SB7 A5 WRITE LINE BX7 X1 SB7 B7-B6 LENGTH OF LINE SA7 A5-B1 SA1 BLKF NZ X1,WDL7 IF *BLOCK* CALL ZR B5,WDL6 IF LINE TERMINATOR NOT FOUND SB7 B7-1 DO NOT ADD TERMINATOR WDL6 WRITES S,B6,B7 SB6 A5 SET FWA OF LINE SB5 B0 INITIALIZE LINE TERMINATOR FLAG EQ WDL3 LOOP TO STRING TERMINATOR WDL7 RJ EXP EXPAND CHARACTERS SA5 A5 RESTORE (X5) SA2 WDLB RESTORE DELIMITER SB6 A5 SET FWA OF LINE BX0 X2 EQ WDL3 LOOP TO STRING TERMINATOR * WRITE LAST LINE. WDL8 SB7 A5+B1 WRITE LAST LINE SA1 WDLA TERMINATE LINE SB7 B7-B6 LENGTH OF LINE BX7 X1 SA7 A5 SA1 BLKF NZ X1,WDL10 IF *BLOCK* CALL ZR B5,WDL9 IF LINE TERMINATOR NOT FOUND SB7 B7-1 DO NOT ADD LINE TERMINATOR WDL9 WRITES S,B6,B7 WRITER S,R END FILE EQ WDLX RETURN WDL10 RJ EXP EXPAND CHARACTERS WRITEW S,(=2L0 ),1 ISSUE DOUBLE SPACE WRITER S,R END FILE EQ WDLX RETURN WDL11 MESSAGE (=C* NO TERMINATOR IN COMMAND CALL.*) ABORT WDLA CON 0 HOLDS LINE TERMINATOR WDLB CON 0 STRING DELIMITER SPACE 4 * COMMON DECKS. LIST X SMCH$ EQU 1 ENCODE SMALL CHARACTERS *CALL COMCBAN LIST * *CALL COMCCIO *CALL COMCCPM *CALL COMCSFN *CALL COMCSYS *CALL COMCUSB LIT EQ 1 ALLOW LITERAL PARAMETERS *CALL COMCPOP *CALL COMCWTS *CALL COMCWTW LIST X *CALL COMTBAN LIST * SPACE 4 USE BUFFER SPACE 4 * BUFFER. SBUF EQU * SCRATCH BUFFER LBUF EQU SBUF+SBUFL LINE BUFFER RFL= EQU LBUF+134D END