0000 TITLE 'COPYED - MULTIPLE COPY AND EDIT UTILITY PROGRAM' 00002000 PRINT NOGEN 00004000 COPYED CSECT 00006000 **--> CSECT: COPYED MULTIPLE COPY AND EDIT PROGRAM . . . . . . . . 00008000 *. ENTRY CONDITIONS . 00010000 *. R1 = @ @ PARM FIELD, IF ANY, WITH FOLLOWING CONTROL OPTIONS: . 00012000 *. NCOPY=# NUMBER OF COPIES. 1 ASSUMED IF NONE SUPPLIED.. 00014000 *. CNTRL=CHARACTERS UP TO 10 CHARACTERS. WHENVER THIS CHAR . 00016000 *. STRING APPEARS, SKIP NEXT RECORD TO NEW PAGE. . 00018000 *. IF NOT CODED, ASSUMES ASA CARRIAGE CONTROL EXISTS . 00020000 *. IN FIRST BYTE OF EACH RECORD. . 00022000 *. TRANS=YES TRANSLATE LOWER CASE TO UPPER<. . 00024000 *. LMARG=# NUMBER OF COLUMS BETWEEN OUTPUT CARRIAGE CTRL . 00026000 *. CHARACTER AND 1ST BYTE OF PRINTABLE RECORD. . 00028000 *. ASSUMES 0 IF NOT SUPPLIED. . 00030000 *. SEQNO=PRT ASSUME 80-CHAR CARDS, W/O ASA CARRIAGE CTRL. . 00032000 *. MOVE SEQNO FIELD OVER 5 BYTES AND PRINT IT THERE. . 00034000 *. FT08F001 : INPUT DDNAME. RECFM=F OR FB. TAPE OR DISK. . 00036000 *. FT09F001: OUTPUT DDNAME. RECFM=F OR FB. ANY DEVICE. . 00038000 *. EXIT CONDITIONS 00040000 *. RC = 0 SUCCESSFUL RUN . 00042000 *. RC = 9 COULD NOT OPEN FT08F001 DCB . 00044000 *. RC = 10 COULD NOT OPEN FT09F001 DCB. . 00046000 *. RC = 11 COULD NOT OPEN EITHER FT08F001 OR FT09F001 DCBS. . 00048000 *. USES MACROS: CLOSE,DCB,GET,OPEN,PUT,RETURN,SAVE . 00050000 *.. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 00052000 SPACE 1 00054000 $ EQU 0 FOR ANY FIELD MODIFIED DURING EXEC 00056000 SPACE 1 00058000 * REGISTER EQUATES AND USAGE. 00060000 R0 EQU 0 WORK, LIMIT @ PARM FIELD DURING SCN 00062000 R1 EQU 1 SCAN PTR DURING PARM SCAN. WORK. 00064000 R2 EQU 2 WORK REG 00066000 R8 EQU 8 LENGTH-1 OF INPUT RECORD 00068000 R10 EQU 10 @ WHERE INPUT RECORD MOVED 00070000 R11 EQU 11 CONSTANT 1 FOR BXHING 00072000 R13 EQU 13 SAVE AREA PTR, BASE REGSISTER 00074000 R14 EQU 14 INTERNAL LINK, WORK REGISTER 00076000 R15 EQU 15 WORK REGISTER 00078000 SPACE 1 00080000 USING COPYED,R15 NOTE ENTRY PT USING 00082000 SAVE (14,12),T,* SAVE REGS 00084000 LR R14,R13 MOVE SA @ OVER 00086000 CNOP 0,4 ALIGN 00088000 BAL R13,*+76 SET R13, SKIP OVER 00090000 USING *,R13 NEW USING 00092000 DROP R15 KILL OLD ONE 00094000 DS 18F SAVE AREA 00096000 ST R14,4(R13) BACK LINK 00098000 ST R13,8(R14) FORWARD LINK 00100000 SPACE 1 00102000 LA R11,1 SRT UP USEFUL CONSTQNT IN ODD REG 00104000 L R1,0(R1) GET @ LENGTH/PARM FILED 00106000 LH R2,0(R1) LENGTH OF PARM FIELD 00108000 LTR R2,R2 WAS IT 0, I.E. NO PARM FILED 00110000 BZ COPARMDN NO PARM. SKIP PARM SCAN 00112000 EJECT 00114000 * INITIALIZE FOR PARM FIELD ANALYSIS. 00116000 STC R2,*+5 STORE LENGTH FOR BLANKING 00118000 MVC COPARM($),COBLANK BLANK FIELD 00120000 BCTR R2,0 GET LENGTH-1 OF PARM FILED 00122000 STC R2,*+5 STRE LENGTH-1 FOR MOVE 00124000 MVC COPARM($),2(R1) MOVE PARM FIELD OVER 00126000 SPACE 1 00128000 LA R0,COPARM(R2) GET @ LAST BYTE OF PARM FIELD 00130000 LA R1,COPARM SCAN PTR INIT 00132000 SPACE 2 00134000 * SCAN PARM FIELD, ONE OPERAND AT A TIME. 00136000 COPSEARA CR R1,R0 HAVE WE REACHED END OF PARM FIELD 00138000 BNL COPARMDN YES, QUIT SCANNING 00140000 LA R2,COPRMLST @ PARM OPERAND LIST 00142000 LA R14,COPRMNUM GET # DIFFERENT PARM OPERANDS 00144000 SR R15,R15 SET UP FOR IND%XED BRANCH 00146000 SPACE 1 00148000 COPSEARB CLC 0(COPL,R1),0(R2) COMPARE TO PARM OPERAND 00150000 BE COPARMFD THIS WAS IT, BRANCH 00152000 LA R2,COPL(R2) INCREMENT OEPRAND PTR 00154000 LA R15,4(R15) INCREMRNT FOR BRANCH INDEX 00156000 BCT R14,COPSEARB LOOP , SEATCH FOR OPERAND 00158000 BXH R1,R11,COPSEARA BUMP SCANNER 1 CHAR AND TRY AGAIN 00160000 SPACE 1 00162000 * PARM OPERAND FOUND. BRANCH TO RIGHT SECTION. 00164000 COPARMFD LA R1,COPL+1(R1) INDEX BEYOND = SIGN AFTER PARM 00166000 B *+4(R15) BRANCH TO ROUTINE 00168000 B COPNCOPY NCOPY= 00170000 B COPCNTRL CNTRL=CHARACTERS 00172000 B COPTRANS TRANS=YES 00174000 B COPLMARG LMARG=# 00176000 B COPSEQNO SEQNO=PRT 00178000 EJECT 00180000 * INDIVIDUAL PARM OPTION SECTIONS. 00182000 SPACE 1 00184000 COPNCOPY BAL R14,COPDECIN CONVERT DECIMAL # 00186000 STH R2,CONCOPY SAV E THIS VALUE, OVERRIDE 1 00188000 BXH R1,R11,COPSEARA BUMP BEYOND ,. BACK FOR NEXT 00190000 SPACE 2 00192000 COPCNTRL SR R2,R2 ZERO FOR LENGTH COUNTER 00194000 LA R14,COCNTCHR @ FOR CHARACTER STRING 00196000 OI COFLAGS,COFCNT SHOW CONTROL CHARACTER STRING EXIST 00198000 SPACE 1 00200000 COPCNTRM MVC 0(1,R14),0(R1) MOVE 1 CHARACTER OVER 00202000 STC R2,COCNTCLC+1 SAVE 6-1 INT INSTR NOW 00204000 AR R1,R11 INCREMENT SCAN PTR 00206000 CLI 0(R1),C',' WAS COMMA AFTERWARD 00208000 BE COPCNTRN YES, SKIP, THEN GET NEXT 00210000 AR R14,R11 INCREMRNT PTR 00212000 AR R2,R11 INCREMRNT LENGTH-1 00214000 CR R1,R0 COMPARE OT @ LAST CHAR 00216000 BNH COPCNTRM IF MORE, CONTINUE 00218000 COPCNTRN BXH R1,R11,COPSEARA BUMP SCAN PTR, CONTRINUE 00220000 SPACE 2 00222000 COPTRANS CLC 0(3,R1),=C'YES' WAS IT RIGHT OPERAND 00224000 BNE COPSEARA NO, IGNORE IT THEN 00226000 OI COFLAGS,COFTRA SHOW TRANSLATE MUST BE DONE 00228000 LA R1,3(R1) BUMP SCANNER BEYOND YES 00230000 SPACE 1 00232000 * BUILD TRANSLATE TABLE 00234000 MVI COTRTAB,0 ZERO FIRST BYTE 00236000 LA R2,255 FOR BCT LIMIT 00238000 STC R2,COTRTAB(R2) STORE VALUE IN RIGHT PLACE 00240000 BCT R2,*-4 LOOP AND DECREMTNP 00242000 OC COTRTAB+X'81'(9),COBLANK CONVERT LOWER TO UPPER 00244000 OC COTRTAB+X'91'(9),COBLANK CONVERT LOWER TO UPPER 00246000 OC COTRTAB+X'A2'(9),COBLANK CONVERT LOWER TO UPPER 00248000 BXH R1,R11,COPSEARA BUMP BEYOND ,. BACK FOR NEXT 00250000 SPACE 2 00252000 COPLMARG BAL R14,COPDECIN GET DECIMAL # 00254000 STH R2,COLMARG SAVE FOR LEFT MARGING 00256000 BXH R1,R11,COPSEARA BUMP BEYOND ,. BACK FOR NEXT 00258000 SPACE 2 00260000 COPSEQNO CLC 0(3,R1),=C'PRT' WAS IT SEQNO=PRT 00262000 BNE COPSEARA NO, IGNORE IT 00264000 LA R1,3(R1) SKIP BEYOND PRT 00266000 OI COFLAGS,COFPRT SHOW THIS OPTION 00268000 BXH R1,R11,COPSEARA BUMP BEYOND ,. BACK FOR NEXT 00270000 EJECT 00272000 **--> INSUB: COPDECIN CONVERT DECIMAL NUMBER TO BINARY + + + + + + + 00274000 *+ ENTRY CONDITIONS + 00276000 *+ R14= RETURN @ TO CALLING SECTION + 00278000 *+ R1 = SCAN PTR TO 1ST DECIMAL DIGIT (MUST BE RIGHT) + 00280000 *+ EXIT CONDTIONS + 00282000 *+ R1 = SCAN PTR TO 1ST NON DECIMAL DIGIT + 00284000 *+ R2 = BINARY RESULT OF CONVERSION + 00286000 *+ R15 IS MODIFIED BY THIS INSUB. + 00288000 *+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 00290000 SPACE 1 00292000 COPDECIN SR R2,R2 CLEAR FOR COUNTER 00294000 LR R15,R1 SAVE @ FIRST DEIGIT 00296000 SPACE 1 00298000 CLI 1(R1),C'0' COMPARE TO DIGIT 00300000 BL *+10 BRANCH OUT IF NO MORE 00302000 AR R2,R11 INCREMRNT LENGTH-1 00304000 BXH R1,R11,*-10 LOOP, BUMP SCAN PTR 00306000 SPACE 1 00308000 EX R2,COPDECPK PACK VALUE 00310000 CVB R2,CODWORK CONVERT IT 00312000 BXH R1,R11,0(R14) BUMP SCAN PTR TO COMMAR, RTURN 00314000 COPDECPK PACK CODWORK,0($,R15) FOR EX 00316000 EJECT 00318000 * PARM SCAN DONE. OPEN DCB'S AND TEST THEM. 00320000 COPARMDN EQU * 00322000 OPEN (CODCB08,(INPUT),CODCB09,(OUTPUT)) 00324000 LA R15,8 INIT FOR ERROR 00326000 TM CODCB08+48,X'10' DID IT OPEN 00328000 BO *+8 YES, SKIP 00330000 LA R15,1(R15) INCRE,NT 00332000 TM CODCB09+48,X'10' TEST THIS ONE 00334000 BO *+8 OK,SKIP 00336000 LA R15,2(R15) SHOW DID NOT OPEN 00338000 CH R15,=H'8' DID BITH OPEN 00340000 BNE CORETN NO, ERROR 00342000 SPACE 1 00344000 * DCBS OPENED OK. INITIALIZE FPR COPYING. 00346000 LH R8,CODCB08+82 GET DCBLRECL 00348000 BCTR R8,0 GET LENGTH-1 FO INPUT RECRD 00350000 TM COFLAGS,COFCNT WAS CARRIAGE CONTROL SPEC CHARAS 00352000 BO *+6 YES, SO NO ASA CC, SKIP. 00354000 BCTR R8,0 ASA, SO MAKE LENGTH-1 INTO L-2 00356000 STC R8,COTRANSL+1 STORE ACTUAL L-1 FOR TRANSLATE 00358000 STC R8,COMOVE+1 STORE L-1 FOR MVOING OVER 00360000 LA R10,COCARD @ OF BUFFER 00362000 AH R10,COLMARG = @ WHERE ACTUAL RECORD STARTS 00364000 USING COCARDIM,R10 NOTE DUMMY SECTION. MAY BE NEEDED 00366000 EJECT 00368000 * MAIN LOOP - GET A CARD, PROCESS IT, WRITE IT OUT. 00370000 COGET GET CODCB08 GET NEXT RECORD 00372000 SPACE 1 00374000 * CARRIAGE CONTROL PROCESSING 00376000 TM COFLAGS,COFCNT WAS THERE SPEC CNTRL CHARAC 00378000 BZ COASCON NO, ASA ONES ARE THERE 00380000 COCNTCLC CLC 0($,R1),COCNTCHR WAS THIS CNTRL CHAR CARD 00382000 BNE CONOCON NO, SKIP 00384000 MVI COCC,C'1' MAKE NEXT ONE NEW PAGE 00386000 B COGET GO GET NEXT ONE 00388000 COASCON MVC COCC,0(R1) MOVE CC OVER 00390000 AR R1,R11 BUMP PTR BEYOND CC IN INPT RECORD 00392000 SPACE 1 00394000 * TRANSLATION PROCESSING. 00396000 CONOCON TM COFLAGS,COFTRA SHOULD WE TRANSLATE LOWERS UP 00398000 BZ *+10 NO, SKIP 00400000 COTRANSL TR 0($,R1),COTRTAB TRANSLATE 00402000 SPACE 1 00404000 * SEQUENCE NUMBER PROCESSING. 00406000 COMOVE MVC 0($,R10),0(R1) MOVE RECORD OVER 00408000 TM COFLAGS,COFPRT WAS SEQNO=PRT OPTION USED 00410000 BZ CONOSEQ SKIP IF NOT 00412000 MVC CODWORK,COSEQ1 MOVE DEQNO OVER 00414000 MVC COSEQ2,CODWORK MOVE IT NEW PLACE 00416000 MVC COSPACE,COBLANK BLMK SPACE IN BETWEEN 00418000 CONOSEQ EQU * 00420000 SPACE 1 00422000 * OUTPUT NEW RECORD. RESET CARRIAGE CONTROL. 00424000 PUT CODCB09,COCC OUTPUT 00426000 MVI COCC,C' ' REBLANK CC 00428000 B COGET GO FOR NEXT 00430000 SPACE 1 00432000 * END-O-FILE PROCESSING. 00434000 COEOF EQU * 00436000 LH R0,CONCOPY GET COUNT REMAINING 00438000 SR R0,R11 SUBTRACT 1 00440000 STH R0,CONCOPY STORE BACK 00442000 BNP COFINISH NO MORE, QUIT 00444000 CLOSE (CODCB08,REREAD) CLOSE, REWIND IT 00446000 OPEN (CODCB08,(INPUT)) OPEN, GO FOR NEXT COPU 00448000 MVI COCC,C'1' MAKE SURE STARTS ON NEW PAGE 00450000 B COGET GO BACK AND DO NEXT COPY 00452000 SPACE 1 00454000 * FINISH - WRITE 1 MORE NEW PAGE. 00456000 COFINISH MVI COCC,C'1' CC FOR NEW PAGE 00458000 MVC COCARD,COBLANK BLNAK REST OF IT 00460000 PUT CODCB09,COCC NEW PAGE 00462000 CLOSE (CODCB08,,CODCB09) CLOSE BOTH DCB'S 00464000 SPACE 1 00466000 * SET RETURN CODE AND EXIT. 00468000 SR R15,R15 SUCCESS 00470000 CORETN L R13,4(R13) RELOAD PREVIOUS SA @ 00472000 RETURN (14,12),T,RC=(15) RETURN, WITH RETCODE 00474000 EJECT 00476000 * PARM OPTION LIST, EQUS. 00478000 COPRMLST DC C'NCOPY',C'CNTRL',C'TRANS',C'LMARG',C'SEQNO' 00480000 COPL EQU L'COPRMLST LENGTH OF SINGLE PARM 00482000 COPRMNUM EQU 5 # DIFFERENT OPERANDS IN PARM FIELD 00484000 SPACE 1 00486000 * PARM VALUES AND FLAGS 00488000 COPARM DS CL100' ' FOR PARM FIELD 00490000 CONCOPY DC H'1' # COPIES, INIT = 1 00492000 COLMARG DC H'0' LEFT MARGIN, DEFAULT=0 00494000 COCNTCHR DC CL10' ' SPACE FOR BUILTUP CARRIAGE CHARS 00496000 COFLAGS DC B'0' FLAG BYTE 00498000 COFCNT EQU B'00000001' (COFLAGS)- SPECIAL CC CHARACTERS 00500000 COFTRA EQU B'00000010' (COFLAGS)- TRANSLATE MODE 00502000 COFPRT EQU B'00000100' (COFLAGS)- SEQNO=PRT 00504000 SPACE 1 00506000 * OUTPUT BUFFER, CARRIAGE CONTROL. 00508000 DS 0D ALIGNMENT 00510000 COCC DC C'1' CARRIAGE CONTROL 00512000 COCARD DC CL255' ' SPACE FOR OUTPUT 00514000 SPACE 1 00516000 * MISC WORKAREAAS AND AREAS. 00518000 CODWORK DS D WORKAREA 00520000 COTRTAB DS 256B TRANSLATE TABLE 00522000 COBLANK DC CL256' ' BLANKS 00524000 SPACE 1 00526000 * INPUT AND OUTPUT DCB'S 00528000 CODCB08 DCB DDNAME=FT08F001,DSORG=PS,MACRF=GL,EODAD=COEOF 00530000 CODCB09 DCB DDNAME=FT09F001,DSORG=PS,MACRF=PM 00532000 LTORG 00534000 SPACE 2 00536000 **--> DSECT: COCARDIM CARD IMAGE FOR PRT OPTION . . . . . . . . . . . 00538000 COCARDIM DSECT 00540000 DS CL72 TEST 00542000 COSEQ1 DS CL8 ORIG SEQNO 00544000 ORG COSEQ1 ORG BACK 00546000 COSPACE DS CL5 SPACE 00548000 COSEQ2 DS CL8 NEW PLACE FOR SEQNO 00550000 DROP R10,R13 REMV USINGS 00552000 END 00554000