/* REXX - command to edit a load module - requires assembler program */ /* listed in comments below. This is rough! Be careful. */ /* */ /* Syntax: (assuming you name the exec EDITMOD) */ /* from an ISPF command line, */ /* TSO EDITMOD dataset(member) */ /* */ /* Doug Nadel - version 1.00 - June 8, 2000 */ /* */ /* */ Parse Upper Arg indataset . Parse Var indataset dataset '('member ')' . If substr(dataset,1,1)="'" Then dataset=dataset"'" If indataset='' Then Call msgexit 'No data set name was supplied.' If member ='' Then Call msgexit 'No member name was supplied.' If sysdsn(dataset) <> 'OK' Then Call msgexit dataset' can not be allocated.' If member <> '' & sysdsn(indataset) <> 'OK' Then Call msgexit member 'is not a member in 'dataset'.' Call listdsi dataset If sysdssms='PDSE' Then Call msgexit dataset 'is a PDSE data set.' If sysrecfm <> 'U' Then Call msgexit dataset 'is not RECFM=U.' Parse Value 0 0 0 With lineno maxlen linelen. line. trb. preserve Parse Value 0 0 0 With newlineno newmaxlen newlinelen. newline. newtrb. 'ALLOC F(A1) DA('dataset') SHR REU' Address ispexec 'VGET (ZENVIR) SHARED' 'LMINIT DATAID(DID) DDNAME(A1) ENQ(SHRW)' 'LMOPEN DATAID('did') OPTION(INPUT)' 'LMMFIND DATAID('did') MEMBER('member')' getrc=rc Do While(getrc=0) 'LMGET DATAID('did') MODE(INVAR) DATALOC(LINE) DATALEN(LEN)', ' MAXLEN(32760)' getrc=rc If getrc=0 Then Do lineno=lineno+1 trb.lineno=verify(reverse(line),' ') maxlen=max(maxlen,len) linelen.lineno=len line.lineno=line End End 'LMFREE DATAID('did')' totallines=lineno Address tso 'FREE F(A1)' If lineno=0 | maxlen>32756 Then call msgexit , 'At least one line is longer than 32756 bytes or the member is', 'empty.' Address tso 'ALLOC NEW DEL UNIT(VIO) DSO(PS) RECFM(V B) ', 'LRECL('maxlen+4') F(A2) REU SP(1,1) CYLINDER' Address tso 'EXECIO * DISKW A2 (FINIS STEM LINE.' Drop line. 'LMINIT DATAID(DID) DDNAME(A2) ENQ(SHRW)' If substr(zenvir,5,4)>' 4.5' Then preserve='PRESERVE' Else Do Say 'You are running an older version of ISPF.' Say 'As a result, this program can not verify that the', 'lengths of lines have not changed during the edit session.', 'Trailing blanks may cause errors also.' Say 'Be extra careful making changes.' End Call msg center('*** WARNING ***',75,'-'), 'Do not change the number of lines or the length of any lines.', 'Doing so may destroy your load module member and result in', 'I/O errors!!.' 'EDIT DATAID('did') 'preserve editrc=rc 'LMFREE DATAID('did')' If editrc=4 Then Do Call msg 'No changes were made. The data was not saved.' Signal out End If editrc>4 Then Do 'SETMSG MSG(ISRZ002)' Signal out End Address tso 'EXECIO * DISKR A2 (FINIS STEM NEWLINE.' getrc=rc If getrc=0 Then Do a=1 to newline.0 newtrb.a=verify(reverse(newline.a),' ') newmaxlen=max(newmaxlen,length(newline.a)) newlinelen.a=length(newline.a) End newtotallines=newline.0 Drop line. If newtotallines <> totallines Then Do Call msg, 'The number of lines changed! There were 'totallines' lines,', 'but now there are 'newtotallines' lines.' Signal out End If substr(zenvir,5,4)>' 4.5' Then Do a= 1 to newtotallines If newlinelen.a <> linelen.a Then Do Call msg ' The length of line number 'a' has changed (was', linelen.a', is now 'newlinelen.a').' Signal out End If newtrb.a <> trb.a Then Do Call msg 'The number of trailing blanks changed on line 'a, '(was' trb.a', is now 'newtrb.a').' Signal out End End Address tso 'ALLOC F(A1) DA('indataset') REU SHR' 'SELECT PGM(TC)' Call msg, 'Changes were saved. The current browse session shows the results.' 'BROWSE DATASET('indataset')' Address tso 'FREE F(A1)' out: Address tso 'FREE F(A2)' Exit msg: Parse Arg zerrlm Parse Value 'YES *' With zerralrm zerrhm zerrsm Address ispexec 'SETMSG MSG(ISRZ002)' Return msgexit: Call msg Arg(1) Exit /* * TEST COPY - COPY FROM A VB DATA SET TO A U DATA SET. * SOURCE IS DDNAME A2 (VB) * TARGET IS DDNAME A1 (U) - UPDATES ARE DONE UPDATE-IN-PLACE!!! ******************************************************************* * THIS ROUTINE HAS NO ERROR CHECKING AT ALL. IT ASSUMES THE * INPUT DATA SET EXACTLY MATCHES THE EXISTING OUTPUT MEMBER * IN THE NUMBER OF LINES AND THE LENGTH OF EACH LINE. * IT ALSO ASSUMES THE DATA SETS CAN BE READ OR WRITTEN TO. * IF EITHER IF THESE ARE NOT TRUE, RUN FOR THE HILLS BECAUSE THERE * IS GONNA BE A LOUD *BOOM* ******************************************************************* TC CSECT TC AMODE 31 TC RMODE ANY STM 14,12,12(13) LR 12,15 USING TC,12 LA 0,DYNSIZE GETMAIN RU,LV=(0),SP=0,LOC=BELOW ST 1,8(13) SAVE SAVEAREA ADDR IN CALLERS AREA ST 13,4(0,1) SAVE CALLERS ADDR IN OWN SAVEAREA LR 13,1 SET UP OWN SAVEAREA *---- MOVE DCBS BELOW THE LINE ------- LA VDCBP,VDCB-SAVEAREA(13) LA UDCBP,UDCB-SAVEAREA(13) LR 2,VDCBP GET ADDRESS TO STORE DCBS/DCBES LA 3,ENDDCBS-VDCB GET LENGTH OF DCBS AND DCBES LA 4,VDCB GET ADDRESS OF STATIC DCBS/DCBES LA 5,ENDDCBS-VDCB MVCL 2,4 MOVE DCBS/DCBES BELOW 16M LINE LA 1,DCBLNGPS(VDCBP) GET ADDRESS OF INPUT DCBE ST 1,0(VDCBP) STORE INTO INPUT DCB LA 1,DCBLNGPS(UDCBP) GET ADDRESS OF OUTPUT DCBE ST 1,0(UDCBP) STORE INTO OUTPUT DCB *---- COPY INPUT FILE TO OUTPUT -------- LA 10,OPENLST-SAVEAREA(13) OPEN ((VDCBP),INPUT,(UDCBP),UPDAT),MODE=31,MF=(E,(10)) READLOOP GET (VDCBP) READ INPUT (VB) FILE LA READBUF,4(0,1) GET ADDRESS OF DATA JUST READ IN LH READLEN,0(1) GET LENGTH OF DATA JUST READ IN SH READLEN,=H'4' SUBTRACT RDW LENGTH GET (UDCBP) READ OUTPUT FILE TO START UPDATE LR WRITEBUF,1 GET BUFFER ADDRESS FOR WRITE USING IHADCB,UDCBP LH WRITELEN,DCBLRECL GET LENGTH FOR WRITE MVCL WRITEBUF,READBUF COPY READ LINE TO WRITE BUFFER PUTX (UDCBP) REWRITE OUTPUT LINE B READLOOP GO BACK FOR MORE *---- END OF READ LOOP ------------------ SYNAD DS 0H EODAD DS 0H LA 10,CLOSLST-SAVEAREA(13) CLOSE ((UDCBP),,(VDCBP)),MODE=31,MF=(E,(10)) LA 0,DYNSIZE SETUP FOR EXIT LR 1,13 L 13,4(13) FREEMAIN RU,LV=(0),A=(1),SP=0 FREE DYNAMIC STORAGE LM 14,12,12(13) GET OLD REGISTERS XR 15,15 ALWAYS RETURN ZERO IN R15 BR 14 RETURN TO CALLER *---- STORAGE DEFINITIONS AND EQUATES --- WRITEBUF EQU 2 REGISTER 2 POINTS TO WRITE BUFFER WRITELEN EQU 3 REGISTER 3 IS WRITE BUFFER LENGTH READBUF EQU 4 REGISTER 4 POINTS TO READ BUFFER READLEN EQU 5 REGISTER 5 IS READ BUFFER LENGTH UDCBP EQU 8 REGISTER 8 POINTS TO WRITE DCB VDCBP EQU 9 REGISTER 9 POINTS TO READ DCB **** DCBS AND DCBES THAT WILL BE COPIED BELOW THE LINE **** SAVEAREA DS 9D VDCB DCB DSORG=PS,MACRF=(GL),DDNAME=A2,DCBE=VDCBE VDCBE DCBE RMODE31=BUFF,SYNAD=SYNAD,EODAD=EODAD UDCB DCB DSORG=PS,MACRF=(GL,PL),DDNAME=A1,DCBE=UDCBE UDCBE DCBE RMODE31=BUFF,SYNAD=SYNAD,EODAD=EODAD OPENLST OPEN (,,,),MODE=31,MF=L CLOSLST CLOSE (,,),MODE=31,MF=L ENDDCBS DS 0D DYNSIZE EQU *-SAVEAREA LTORG DCBD DSORG=PS TC CSECT END TC */