Thanks again for everyone's help. If anyone cares, here is the assembler
program that reads the spanned file and creates a fixed length 136 byte file
padded with blanks where necessary. I don't claim to be the best assembler
programmer. I hope that worked in my favor in keeping it simple. But I am
definitely up for constructive criticism.
I am including the JCL and 2 more programs (a cobol and a rexx). This is the
reason I took so long to get back with this. Sorry if this is too much
information.
=======================================================================================
TITLE 'XP1000'
*
* 02/25/11 B HUNT CHANGED A SPANNED FILE TO A FIXED FILE
*
XP1000 AMODE 24
XP1000 RMODE 24
XP1000 START
COPY EQUATES
SAVE (14,12) SAVE REGISTERS 14 THRU 12
BASR BASE1,0 ESTABLISH ADDRESSABILITY
USING *,BASE1 PROVIDE BASE ID
ST RD,SAVEAREA+4 STORE PREV REG 13 IN SAVEAREA +4
LA RD,SAVEAREA LOAD SAVEREA IN REG 13
B BEGIN
SPACE 1
DS 0D
DC CL8'XP1000'
DC CL8'&SYSDATE'
DC CL8'&SYSTIME'
SPACE 1
BEGIN DS 0H
USING DATA,R8 ASSOCIATE DATA WITH REG 8
OPEN (INFILE,(INPUT),OUTFILE,(OUTPUT)) OPEN FILES
LTR RF,RF CHECK FOR GOOD OPEN
BNZ BADOPEN IF BAD OPEN BRANCH TO BADOPEN
LOOP DS 0H PROCESS LOOP
GET INFILE READ INPUT FILE
LR R8,R1 LOAD INPUT ADDRESS IN REG 8
XC FWLEN,FWLEN SET FULL WORD LENGTH TO ZERO
MVC HWLEN,DATA GET THE RECORD LENGTH FROM DATA
MVI FWLEN,C' ' USE A BLANK TO PAD OUTREC-MVCL
L R9,FWLEN LOAD THE INPUT LENGTH IN REG 9
LA R6,BATA LOAD THE OUTPUT ADDRESS IN REG 6
LA R7,136 LOAD THE OUT LENGTH IN REG 7
MVCL R6,R8 MOVE DATA TO BATA W/ BLANK PAD
WRITE DS 0H
PUT OUTFILE,OUTREC WRITE OUTREC
B LOOP
FINAL DS 0H
CLOSE (INFILE,,OUTFILE)
B C100
BADOPEN WTO ' UABLE TO OPEN FILE',ROUTCDE=(2),DESC=(7)
B C100
BADREAD WTO ' READ UNSUCCESSFUL ',ROUTCDE=(2),DESC=(7)
B C100
BADSEG WTO ' SEGMENTS NOT SEQUENTIAL ',ROUTCDE=(2),DESC=(7)
B C100
BADWRITE WTO ' WRITE UNSUCCESSFUL ',ROUTCDE=(2),DESC=(7)
B C100
C100 DS 0H
L RD,SAVEAREA+4
RETURN (14,12) RESTORE REGISTERS AND RETURN
INFILE DCB DSORG=PS,RECFM=VBS,MACRF=GL, +
DDNAME=INDD,EODAD=FINAL
OUTFILE DCB DSORG=PS,RECFM=FB,LRECL=136,MACRF=PM, +
DDNAME=OUTDD
OUTREC DS 0CL136
BATA DS CL136
SAVEAREA DS 18F
FWLEN DS 0F
DS H
HWLEN DS H
LTORG
INREC DSECT
DATA DS CL136
DS CL32000
DS CL32000
DS CL32000
END XP1000
================================================================================================
//FIXSPAND JOB (DP,6010),'XXXXXX - XXXX ',CLASS=A,MSGCLASS=X,
// MSGLEVEL=(1,1),NOTIFY=&SYSUID
//*
//RMS EXEC CA11RMS,TYPRUN='F'
//*
//* CHANGED SPANNED RECORDS TO FIXED
//ASMEXEC EXEC PGM=XP1000,REGION=0M
//STEPLIB DD DISP=SHR,DSN=TEST.LOADLIB
//INDD DD DISP=SHR,DSN=TEST.BACKUP
//OUTDD DD DSN=TEST.BACKUP.FIXED,
// DISP=(,CATLG,CATLG),
// SPACE=(TRK,(1950,100),RLSE),
// DCB=(LRECL=136,BLKSIZE=0,RECFM=FB)
//SYSOUT DD SYSOUT=*
//SYSDBOUT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//*
//* PUT MULTI SEGMENTS BACK TOGETHER AS 1 RECORD
//COBEXEC EXEC BATCOB,PROG=XP1001,ENV=DEVL,REGION=0M
//STEPLIB DD DISP=SHR,DSN=TEST.LOADLIB
//FONTIN DD DISP=SHR,DSN=TEST.BACKUP.FIXED
//FONTOUT DD DSN=TEST.BACKUP.JOINED,
// DISP=(,CATLG,CATLG),
// SPACE=(TRK,(1950,100),RLSE),
// DCB=(LRECL=136,BLKSIZE=0,RECFM=FB)
//SYSOUT DD SYSOUT=*
//SYSDBOUT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//*
//* READ HEADER RECORD AND GET FONT NAME & DISCARD RECORD
//* (IF THE NAME BEGINS WITH A NUMBER ADD AN 'F' ON FRONT)
//* READ DATA RECORDS AND SAVE IN A TABLE
//* READ TRAILER RECORD & DISCARD, WRITE FONT DATA TO PDS MEMBER
//* MAKE SURE THE HEADER AND TRAILER MATCH
//* REPEAT FOR NEXT FONT
//REXXBAT1 EXEC PGM=IKJEFT01,DYNAMNBR=90,
// PARM=('FONTPDS')
//SYSPROC DD DSN=TEST.EXEC,DISP=SHR
//FONTIN DD DISP=SHR,DSN=TEST.BACKUP.JOINED
//SYSTSPRT DD SYSOUT=*
//SYSTSIN DD DUMMY
//SYSPRINT DD SYSOUT=*
//SYSABEND DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//
=========================================================================
IDENTIFICATION DIVISION.
PROGRAM-ID. XP1001.
AUTHOR. BRUCE HUNT.
INSTALLATION. XXXXXXX XXXXXXXXX.
DATE-WRITTEN. MAR 11, 2011.
DATE-COMPILED.
*REMARKS. *************************************************
* * THIS PROGRAM READS SPLIT RECORDS AND WRITES *
* * THEM AS A ONE RECORD. *
* * *
* *************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
OBJECT-COMPUTER. Z2098.
SOURCE-COMPUTER. Z2098.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FONT-SPLIT-FILE ASSIGN TO FONTIN.
SELECT FONT-FILE ASSIGN TO FONTOUT.
DATA DIVISION.
FILE SECTION.
FD FONT-SPLIT-FILE
LABEL RECORDS ARE OMITTED
BLOCK CONTAINS 0.
01 FONT-SPLIT-RCD.
05 FONT-SP-LGTH PIC 9(04) USAGE BINARY.
05 FONT-SP-SEGNUM PIC 9(01).
05 FILLER PIC X(01).
05 FONT-SP-TYPE PIC 9(04).
05 FONT-SP-NAME PIC X(08).
05 FONT-SP-TRLR-END PIC X(12).
05 FONT-SP-HEDR-END PIC X(48).
05 FONT-SP-DATA-END PIC X(60).
FD FONT-FILE
LABEL RECORDS ARE OMITTED
BLOCK CONTAINS 0.
01 FONT-RECORD.
05 FONT-LGTH PIC 9(04) USAGE BINARY.
05 FONT-SEGNUM PIC X(01).
05 FILLER PIC X(01).
05 FONT-TYPE PIC 9(04).
05 FONT-NAME PIC X(08).
05 FONT-TRLR-END PIC X(12).
05 FONT-HEDR-END PIC X(48).
05 FONT-DATA-END PIC X(60).
WORKING-STORAGE SECTION.
*================================================================*
* RECORD SEGMENT FLAG USES 88 LEVELS TO REFER TO HEX VALUE *
* SEGMENT NUMBERS: *
* 1) BASE-ONLY-HEX00 HAS A HEX VALUE OF X'00' DISPLAYS AS ' ' *
* 2) BASE-SEGMENT-HEX01 HAS A HEX VALUE OF X'01' DISPLAYS AS ' ' *
* 3) BASE-SEGMENT-HEX02 HAS A HEX VALUE OF X'02' DISPLAYS AS ' ' *
*================================================================*
01 FLAGS-STATUSES-DISPLAYS.
05 END-OF-FILE-FLAG PIC X.
88 NO-MORE-RECORDS VALUE 'Y'.
05 RCD-SEGMENT-FLAG PIC X.
88 BASE-ONLY-HEX00 VALUE ' '.
88 1ST-SEGMENT-HEX01 VALUE ' '.
88 2ND-SEGMENT-HEX02 VALUE ' '.
01 ZERO-OUT PIC 9(4) USAGE BINARY VALUE 0.
01 ONE PIC 9(4) USAGE BINARY VALUE 1.
01 FOUR PIC 9(4) USAGE BINARY VALUE 4.
01 STARTPOS PIC 9(4) USAGE BINARY VALUE 0.
01 NEWLGTH PIC 9(4) USAGE BINARY VALUE 0.
01 IN-COUNT PIC 9(5) USAGE COMP-3 VALUE 0.
01 OUT-SEG00 PIC 9(5) USAGE COMP-3 VALUE 0.
01 OUT-SEG01 PIC 9(5) USAGE COMP-3 VALUE 0.
01 OUT-SEG02 PIC 9(5) USAGE COMP-3 VALUE 0.
01 OUT-OTHER PIC 9(5) USAGE COMP-3 VALUE 0.
01 OUT-RECORDS PIC 9(5) USAGE COMP-3 VALUE 0.
PROCEDURE DIVISION.
MAIN-PROCESS.
OPEN INPUT FONT-SPLIT-FILE.
OPEN OUTPUT FONT-FILE.
MOVE 'N' TO END-OF-FILE-FLAG.
MOVE 0 TO IN-COUNT.
MOVE 0 TO OUT-SEG00.
MOVE 0 TO OUT-SEG01.
MOVE 0 TO OUT-SEG02.
MOVE 0 TO OUT-OTHER.
MOVE 0 TO OUT-RECORDS.
READ FONT-SPLIT-FILE
AT END
MOVE 'Y' TO END-OF-FILE-FLAG.
PERFORM 1000-BUILD-OUTPUT
UNTIL NO-MORE-RECORDS.
DISPLAY 'RECORDS IN: ' IN-COUNT.
DISPLAY '00 SEGMENTS OUT: ' OUT-SEG00.
DISPLAY '01 SEGMENTS OUT: ' OUT-SEG01.
DISPLAY '02 SEGMENTS OUT: ' OUT-SEG02.
DISPLAY 'OTHER SEGMENTS OUT: ' OUT-OTHER.
DISPLAY 'TOTAL RECORDS OUT: ' OUT-RECORDS.
CLOSE FONT-FILE.
CLOSE FONT-SPLIT-FILE.
STOP RUN.
1000-BUILD-OUTPUT.
*================================================================*
* BUILD OUTPUT PROCESS *
* 1) ADD 1 TO THE IN RECORD COUNT *
* 2) MOVE THE INPUT SEGMENT NUMBER RECORD SEGMENT FLAG SO 88 *
* LEVELS CAN BE USED TO DISTINGUISH BETWEEN INPUT SEGMENT *
* NUMBERS OF HEX '00', '01', AND '02'. *
* 3) IF THIS RECORD HAS ONLY 1 SEGMENT ASSOCIATED WITH IT (A *
* BASE ONLY X'00' RECORD)' *
* A) ADD 1 TO THE SEGMENT 00 OUT RECORD COUNT AND THE OUT *
* RECORDS COUNT *
* B) WRITE THE RECORD AS IS TO THE OUTPUT FILE *
* 4) IF THIS RECORD HAS MULTIPLE RECORD SEGMENTS AND THIS IS THE *
* THE 1ST SEGMENT (AN X'01' RECORD) *
* A) ADD 1 TO THE SEGMENT 01 OUT RECORD COUNT *
* B) MOVE THIS 1ST SEGMENT TO BEGINNING OF THE OUTPUT RECORD *
* C) DETERMINE THE STARTING POSITION ON THE OUTPUT RECORD TO *
* MOVE THE NEXT SEGMENT TO *
* 5) IF THIS RECORD IS THE 2ND SEGMENT (AN X'02' RECORD) OF *
* MULTIPLE SEGMENT RECORDS *
* A) ADD 1 TO THE SEGMENT 02 OUT RECORD COUNT AND THE OUT *
* RECORDS COUNT *
* B) SUBTRACT 4 BYTES FROM THE SEGMENT LENGTH BECAUSE WE HAVE *
* LENGTH AND RECORD TYPE IN OUR OUTPUT RECORD ALREADY FROM *
* THE X'01' SEGMENT AND WON'T MOVE THE 1ST 4 BYTES OF THE *
* X'02 SEGMENT *
* C) MOVE THE X'02' SEGMENT MINUS THE 1ST 4 BYTES TO THE *
* OUTPUT RECORD RIGHT AFTER THE X'01' SEGMENT *
* D) MOVE X'00' TO THE OUTPUT RECORDS'S SEGMENT NUMBER SINCE *
* THIS IS NO LONGER A MULTIPLE SEGMENT RECORD *
* E) CALCULATE THE NEW LENGTH OF THE COMBINED SEGMENTS RECORD *
* E) MOVE THE NEW LENGTH TO THE LENGTH FIELD OF THE OUTPUT *
* RECORD *
* B) WRITE COMBINED SEGMENTS RECORD TO THE OUTPUT FILE *
* 6) IF THIS RECORD IS A SEGMENT NUMBER GREATER THAN X'02' FLAG *
* IT FOR NOW AND SET THE CONDITION CODE TO 9999 FOR THIS JOB *
* STEP. IN OUR APPLICATION WE ONLY HAVE X'01', X'02', AND *
* X'03' SEGMENTS *
*================================================================*
ADD 1 TO IN-COUNT.
MOVE FONT-SP-SEGNUM TO RCD-SEGMENT-FLAG.
IF BASE-ONLY-HEX00
ADD 1 TO OUT-SEG00
ADD 1 TO OUT-RECORDS
WRITE FONT-RECORD FROM FONT-SPLIT-RCD
ELSE
IF 1ST-SEGMENT-HEX01
ADD 1 TO OUT-SEG01
MOVE FONT-SPLIT-RCD(1:FONT-SP-LGTH)
TO FONT-RECORD(1:FONT-SP-LGTH)
MOVE FONT-SP-LGTH TO STARTPOS
ADD ONE TO STARTPOS
ELSE
IF 2ND-SEGMENT-HEX02
ADD 1 TO OUT-SEG02
ADD 1 TO OUT-RECORDS
SUBTRACT FOUR FROM FONT-SP-LGTH
MOVE FONT-SPLIT-RCD(5:FONT-SP-LGTH)
TO FONT-RECORD
(STARTPOS:FONT-SP-LGTH)
MOVE ' ' TO FONT-SEGNUM
MOVE STARTPOS TO NEWLGTH
SUBTRACT ONE FROM NEWLGTH
ADD FONT-SP-LGTH TO NEWLGTH
MOVE ZERO-OUT TO FONT-LGTH
ADD NEWLGTH TO FONT-LGTH
WRITE FONT-RECORD
ELSE
ADD 1 TO OUT-OTHER
MOVE 9999 TO RETURN-CODE
DISPLAY FONT-SPLIT-RCD
DISPLAY 'THIS SEGMENT IS NOT VALID AT THIS TIME!!!!'.
READ FONT-SPLIT-FILE
AT END
MOVE 'Y' TO END-OF-FILE-FLAG.
======================================================================================
/*REXX EXEC - FONTPDS - SEE JCL FOR COMMENTS */
PARSE ARG OUTFILE FILELGTH
OUTFILE="TEST.BKUP.FONTS"
/* DO WHILE OUTFILE="" */
/* SAY "PLEASE ENTER THE NAME OF THE OUTPUT FILE (CANNOT = SPACES)." */
/* SAY "EXAMPLE: TEST.BKUP.FONTS - (enter END to exit)." */
/* PARSE PULL OUTFILE */
/* IF OUTFILE = "END" THEN */
/* EXIT */
/* IF OUTFILE = "end" THEN */
/* EXIT */
/* END */
"EXECIO 1 DISKR FONTIN"
READRC = RC
FDX = 0
RCDCNT = 0
DO WHILE READRC = 0
PARSE PULL FONTREC
RECTYPE = SUBSTR(FONTREC,5,4)
IF RECTYPE = 'DATA' THEN
DO
FDX = FDX + 1
FONTMEM.FDX = SUBSTR(FONTREC,9,128)
END
ELSE
IF RECTYPE = 'HEDR' THEN
DO
MEM = SPACE(SUBSTR(FONTREC,9,8))
MEM1 = SUBSTR(MEM,1,1)
IF MEM1 == 0 THEN
MEM = 'F' || MEM
IF MEM1 == 1 THEN
MEM = 'F' || MEM
IF MEM1 == 2 THEN
MEM = 'F' || MEM
IF MEM1 == 3 THEN
MEM = 'F' || MEM
IF MEM1 == 4 THEN
MEM = 'F' || MEM
IF MEM1 == 5 THEN
MEM = 'F' || MEM
IF MEM1 == 6 THEN
MEM = 'F' || MEM
IF MEM1 == 7 THEN
MEM = 'F' || MEM
IF MEM1 == 8 THEN
MEM = 'F' || MEM
IF MEM1 == 9 THEN
MEM = 'F' || MEM
FDX = 0
DROP FONTMEM.
END
ELSE
IF RECTYPE = 'TRLR' THEN
DO
TRAILER = SPACE(SUBSTR(FONTREC,9,8))
TRAILER1 = SUBSTR(TRAILER,1,1)
IF TRAILER1 == 0 THEN
TRAILER = 'F' || TRAILER
IF TRAILER1 == 1 THEN
TRAILER = 'F' || TRAILER
IF TRAILER1 == 2 THEN
TRAILER = 'F' || TRAILER
IF TRAILER1 == 3 THEN
TRAILER = 'F' || TRAILER
IF TRAILER1 == 4 THEN
TRAILER = 'F' || TRAILER
IF TRAILER1 == 5 THEN
TRAILER = 'F' || TRAILER
IF TRAILER1 == 6 THEN
TRAILER = 'F' || TRAILER
IF TRAILER1 == 7 THEN
TRAILER = 'F' || TRAILER
IF TRAILER1 == 8 THEN
TRAILER = 'F' || TRAILER
IF TRAILER1 == 9 THEN
TRAILER = 'F' || TRAILER
IF MEM ¬= TRAILER THEN
SAY "HEDR:" MEM "DOES NOT MATCH THE TRAILER" TRAILER "!!!"
ELSE
CALL SAVEFONT
END
"EXECIO 1 DISKR FONTIN"
READRC = RC
END
"EXECIO 0 DISKR FONTIN (FINIS"
"FREE DD("FONTIN")"
EXIT
SAVEFONT:
FONTMEM.0 = FDX
FONT_OUT = "'" || OUTFILE || "(" || MEM || ")'"
"FREE DD("FONTOUT")"
"ALLOC DA("FONT_OUT") FILE(" FONTOUT ") REUSE"
"EXECIO * DISKW FONTOUT (FINIS STEM FONTMEM."
RETURN
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@bama.ua.edu with the message: GET IBM-MAIN INFO
Search the archives at http://bama.ua.edu/archives/ibm-main.html
