/* REXX ASMMAP Setup and submit JCL to assemble a cics map from the current member. For optimum operation there should be a command in the command table whose action is SELECT CMD(%ASMMAP {&ZDSN {&ZMEM {&ZMEMB {&ZPARM ) This allows you to issue the command "ASMMAP" while in edit causing a background job to be submitted to assemble the instant source. Use '(routine name) ?' for HELP-text. |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| | | | WARNING: EMBEDDED COMPONENTS. | | See text following TOOLKIT_INIT | | | |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| Written by Jane Doughty 20050324 Impact Analysis . SYSEXEC COMPARM . SYSEXEC FCCMDUPD . SYSEXEC JOBCARDS . SYSEXEC POST . SYSEXEC SYSUMON . SYSEXEC TRAPOUT Modification History 20080129 fxc added long helpmsg for the 'no command table entry' situation; 20090528 fxc MAP name shortened to 7 characters; 20230401 fxc SYSUMON only if not testing 20230726 fxc adjust HELP; 20230808 fxc fix non-printable characters in panels; 20230911 fxc use ZUP/ZCONT in HELP panels; 20240229 fxc remove imbeds from I/A; 20240305 fxc align panel names; 20240308 fxc chg dollar-sign to @ everywhere; 20240404 fxc changed tutorial to scrollable area; 20240414 fxc DUMP_QUEUE quiet; */ arg argline address ISPEXEC /* REXXSKEL ver.20010524 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace(tv) info = parms /* to enable parsing */ "CONTROL ERRORS RETURN" /* I'll handle my own */ address TSO "POST" exec_name argline if tv = 'N' then, /* only if not testing */ "SYSUMON USER" Userid() "TOOL" exec_name call A_INIT /* -*/ call B_TAILOR /* -*/ if \sw.nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ ASMMAP */ /* Initialization. Setup JOB1L as the first job statement. . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address ISPEXEC parse var parms "{" srcds . "{" src "{" memb "{" info if srcds = "" then do helpmsg = "The input parameter is faulty. This could be", "caused by several things. (1) Your command table", "may not be loaded. ASMMAP can only be run from", "an active command table. (2) There may not be an", "ASMMAP command in your command table. Issue 'tso", "asmmap (( install' to put the proper command into", "your table, then reload your active command", "table. (3) You may not have a command table at", "all in which case you must allocate an", "ISPTLIB/ISPTABL dataset and populate it." call HELP /* -*/ end if SWITCH("?") then call HELP /* a lone q-mark in info */ parse value src memb with src . parse value "" with , cpcics cpclass cplib cplist cproot cptype cpmlib parse value 'EF'x with , xef . parse var src 3 tag 5 "VGET JOB1L ASIS" /* jobcard */ if job1l = "" then do "VGET JOB1 ASIS" /* get standard jobcard */ if rc > 0 then do /* not found? */ address TSO "JOBCARDS" /* setup initial set */ "VGET JOB1 ASIS" end /* JOB1 not found */ job1l = job1 end /* JOB1H not found */ parse var job1l w1 rest /* //jobname ... */ job1l = "//"Userid()tag rest /* reconstruct */ "VPUT JOB1L PROFILE" /* save it */ return /*@ A_INIT */ /* Customize the JCL . ----------------------------------------------------------------- */ B_TAILOR: /*@ */ if branch then call BRANCH address ISPEXEC call BA_SETUP_LIBDEFS /* -*/ call BJ_BUILD_JCL /* -*/ call BZ_DROP_LIBDEFS /* -*/ return /*@ B_TAILOR */ /* Deimbed and attach the ISPF material . ----------------------------------------------------------------- */ BA_SETUP_LIBDEFS: /*@ */ if branch then call BRANCH address ISPEXEC call DEIMBED /* extract ISPF elements -*/ dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist @ddn = @ddn.dd /* PLIB322 <- PLIB */ "LIBDEF ISP"dd "LIBRARY ID("@ddn") STACK" end ddnlist = ddnlist dd return /*@ BA_SETUP_LIBDEFS */ /* File-tailor the skeleton to compile and link the source and store the listings in a library. Submit the JCL. . ----------------------------------------------------------------- */ BJ_BUILD_JCL: /*@ */ if branch then call BRANCH address ISPEXEC mbr. = "?" /* PROCESS statements to be prefaced to the source */ call BJA_OUTPUT_WHERE /* what load and list locns? -*/ if sw.0error_found then return /* Oops... */ "FTOPEN TEMP" "FTINCL ASMMAP" /* customize JCL */ if rc > 0 then do "SETMSG MSG(ISRZ002)" sw.0error_found = "1" end /* FTINCL error */ "FTCLOSE" if rc > 0 then do "SETMSG MSG(ISRZ002)" sw.0error_found = "1" end /* FTCLOSE error */ if sw.0error_found then return /* Oops... */ "VGET (ZTEMPF ZTEMPN)" if modify then do "LMINIT DATAID(DDNID) DDNAME("ztempn")" zerrsm = "Submit-it-yourself" zerrlm = "This JCL will -NOT- be automatically submitted when", "EDIT completes. If you want the JOB to run", "you must issue the SUBMIT command before leaving", "this edit session." "SETMSG MSG(ISRZ002)" "EDIT DATAID("ddnid") PROFILE(DEFAULT)" end else, address TSO "SUBMIT '"ZTEMPF"'" return /*@ BJ_BUILD_JCL */ /* Where to put the load module? Where to put the listings? . ----------------------------------------------------------------- */ BJA_OUTPUT_WHERE: /*@ */ bja_tv = trace() /* what setting at entry ? */ if branch then call BRANCH address ISPEXEC listsrc = src /* listing membername */ loadsrc = src /* load module */ mnsrc = Left( src,7 ) /* maplib module */ call BJAA_COMPARM_FETCH /* -*/ call BJAB_GET_PARMS /* -*/ if sw.0error_found then return rc = Trace("O"); rc = trace(bja_tv) call BJAJ_RESET_CLASS /* change job class -*/ call BJAZ_COMPARM_STORE /* -*/ return /*@ BJA_OUTPUT_WHERE */ /* call COMPARM with mbrname FETCH; load values for panel FROMTO: lodds <- cplib ; mapds <- cpmlib; listds <- cplist . . ----------------------------------------------------------------- */ BJAA_COMPARM_FETCH: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" parse value src "none" with src . "COMPARM FETCH" src "((" opts parse pull cp_rc (xef) cp_sm (xef) cp_lm (xef) info "DELSTACK" address ISPEXEC "VGET (PRGRP,LODDS,LISTDS MAPDS) PROFILE" cpcics = KEYWD("CPCICS") cptype = KEYWD("CPTYPE") cplib = KEYWD("CPLIB") cplist = KEYWD("CPLIST") cpclass = KEYWD("CPCLASS") cpmlib = KEYWD("CPMLIB") /*"VGET (CPLIB CPLIST CPCLASS) SHARED"*/ parse value cplib lodds with , lodds . parse value cplist listds with , listds . parse value cpmlib mapds with , mapds . parse value cpclass "X" with , cpclass . parse value prgrp "NTI" with , prgrp . parse value cpcics "Y" with , cpcics . parse value cptype "E" with , cptype . swcics = cpcics compid = cptype /* cpclass has to go on the jobcard */ if loadsrc <> "" then loadsrc = Left(loadsrc,5)"00" /* CICS version always 00 */ return /*@ BJAA_COMPARM_FETCH */ /* Pop a panel to get the compile instructions: CICS or not; LINK or not; dataset names and member names; etc... . ----------------------------------------------------------------- */ BJAB_GET_PARMS: /*@ */ if branch then call BRANCH address ISPEXEC "VGET ZPFCTL"; save_zpf = zpfctl /* save current setting */ do forever if listds <> "" then list = listsrc /* seed */ else list = "" if lodds <> "" then lmod = loadsrc /* seed */ else lmod = "" if mapds <> "" then mname= mnsrc /* seed */ else mname= src if mapds = "" then do /* seed */ parse value reverse(srcds), with .'.' remdsn mapds = reverse(remdsn)".maplib" end zwinttl = "Assemble" srcds"("src")" zpfctl = "OFF"; "VPUT ZPFCTL" /* PFSHOW OFF */ "ADDPOP ROW(8) COLUMN(5)" "DISPLAY PANEL(FROMTO)" disp_rc = rc "REMPOP ALL" zpfctl = save_zpf; "VPUT ZPFCTL" /* restore */ if disp_rc > 0 then do sw.0error_found = "1" /* Halt */ leave end if lodds <> "" then do if Sysdsn("'"lodds"'") <> "OK" then do zerrsm = "LOADLIB?" zerrlm = "Named library not available" "SETMSG MSG(ISRZ002)" iterate end end if mapds <> "" then do if Sysdsn("'"mapds"'") <> "OK" then do zerrsm = "MAPLIB?" zerrlm = "Named library not available" "SETMSG MSG(ISRZ002)" iterate end end saveprt = "0" if listds <> "" then do if Sysdsn("'"listds"'") <> "OK" then do zerrsm = "LISTING?" zerrlm = "Named library not available" "SETMSG MSG(ISRZ002)" iterate end @RC = Listdsi("'"listds"' DIRECTORY") if sysdsorg = "PO" then, if list = "" then do zerrsm = "What List mbr?" zerrlm = "Specify a member name for the listing." "SETMSG MSG(ISRZ002)" iterate end ; else nop else list = "" /* not PO, zap membername */ saveprt = "1" end /* listds */ leave /* all data is correct */ end /* forever */ return /*@ BJAB_GET_PARMS */ /* Pull all the JOBcards. Find "CLASS=" and replace that value with CPCLASS if different. . ----------------------------------------------------------------- */ BJAJ_RESET_CLASS: /*@ */ if branch then call BRANCH address ISPEXEC cls = "CLASS=" if Pos(cls,JOB1L) > 0 then do pt = Pos(cls,JOB1L) + 6 /* point to jobclass */ if Substr(JOB1L,pt,1) = cpclass then return JOB1L = Overlay(cpclass,JOB1L,pt,1) "VPUT JOB1L PROFILE" return end "VGET (JOB2 JOB3 JOB4) ASIS" /* jobcards */ if Pos(cls,JOB2) > 0 then do pt = Pos(cls,JOB2) + 6 /* point to jobclass */ if Substr(JOB2,pt,1) = cpclass then return JOB2 = Overlay(cpclass,JOB2,pt,1) "VPUT JOB2 PROFILE" return end if Pos(cls,JOB3) > 0 then do pt = Pos(cls,JOB3) + 6 /* point to jobclass */ if Substr(JOB3,pt,1) = cpclass then return JOB3 = Overlay(cpclass,JOB3,pt,1) "VPUT JOB3 PROFILE" return end if Pos(cls,JOB4) > 0 then do pt = Pos(cls,JOB4) + 6 /* point to jobclass */ if Substr(JOB4,pt,1) = cpclass then return JOB4 = Overlay(cpclass,JOB4,pt,1) "VPUT JOB4 PROFILE" return end return /*@ BJAJ_RESET_CLASS */ /* call COMPARM with mbrname STORE; load values from panel FROMTO: swcics -> cpcics; compid -> cptype; lodds -> cplib; listds -> cplist. . ----------------------------------------------------------------- */ BJAZ_COMPARM_STORE: /*@ */ if branch then call BRANCH address ISPEXEC cpcics = swcics cptype = compid cplib = lodds cplist = listds cpmlib = mapds info = "CPCICS" cpcics "CPTYPE" cptype, "CPLIB" cplib "CPLIST" cplist "CPMLIB" cpmlib, "CPCLASS" cpclass "VPUT (PRGRP) PROFILE" /* programming group */ address TSO "NEWSTACK" "COMPARM STORE" src info "((" opts parse pull cp_rc (xef) cp_sm (xef) cplm (xef) . "DELSTACK" return /*@ BJAZ_COMPARM_STORE */ /* . ----------------------------------------------------------------- */ BZ_DROP_LIBDEFS: /*@ */ if branch then call BRANCH address ISPEXEC dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist @ddn = @ddn.dd /* PLIB322 <- PLIB */ "LIBDEF ISP"dd address TSO "FREE FI("@ddn")" end ddnlist = ddnlist dd return /*@ BZ_DROP_LIBDEFS */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO if SWITCH("INSTALL") then do queue "ASMMAP" queue 0 queue "SELECT CMD(%ASMMAP {&ZDSN {&ZMEM {&ZMEMB {&ZPARM )" queue "Assemble a CICS Map module" "FCCMDUPD" exit end /* INSTALL */ modify = SWITCH("EDIT") return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* Parse out the embedded components at the back of the source code. . ----------------------------------------------------------------- */ DEIMBED: Procedure expose, /*@ */ (tk_globalvars) ddnlist @ddn. daid. address TSO fb80po.0 = "NEW UNIT(VIO) SPACE(5 5) TRACKS DIR(40)", "RECFM(F B) LRECL(80) BLKSIZE(0)" parse value "" with ddnlist @ddn. daid. lastln = sourceline() currln = lastln /* */ if Left(sourceline(currln),2) <> "*/" then return currln = currln - 1 /* previous line */ "NEWSTACK" address ISPEXEC do while sourceline(currln) <> "/*" text = sourceline(currln) /* save with a short name ! */ if Left(text,3) = ")))" then do /* package the queue */ parse var text ")))" ddn mbr . /* PLIB PANL001 maybe */ if Pos(ddn,ddnlist) = 0 then do /* doesn't exist */ ddnlist = ddnlist ddn /* keep track */ @ddn = ddn || Random(999) @ddn.ddn = @ddn address TSO "ALLOC FI("@ddn")" fb80po.0 "LMINIT DATAID(DAID) DDNAME("@ddn")" daid.ddn = daid end daid = daid.ddn "LMOPEN DATAID("daid") OPTION(OUTPUT)" do queued() parse pull line "LMPUT DATAID("daid") MODE(INVAR) DATALOC(LINE) DATALEN(80)" end "LMMADD DATAID("daid") MEMBER("mbr")" "LMCLOSE DATAID("daid")" end /* package the queue */ else push text /* onto the top of the stack */ currln = currln - 1 /* previous line */ end /* while */ address TSO "DELSTACK" return /*@ DEIMBED */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" submits a background job to assemble a CICS map from the " say " source program. You should be in Edit, Browse, or View on" say " the source to be assembled. " say " " say " Syntax: "ex_nam" no parms " say " (( EDIT " say " INSTALL " say " " say " EDIT causes the composed JCL to be presented in EDIT for " say " last-minute changes. " say " " say " INSTALL writes a shortcut command for this routine onto the " say " user's command table. If INSTALL is specified, no " say " other processing is done. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK " say " Debugging tools provided include: " say " " say " BRANCH: show all paragraph entries. " say " " say " TRACE tv: will use value following TRACE to place the " say " execution in REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO "ex_nam" parameters (( debug-options " say " " say " For example: " say " " say " TSO "ex_nam" (( MONITOR TRACE ?R " if sysvar("SYSISPF") = "ACTIVE" then, address ISPEXEC "CONTROL DISPLAY REFRESH" exit /*@ HELP */ /* . ----------------------------------------------------------------- */ BRANCH: Procedure expose, /*@ */ sigl exec_name rc = trace("O") /* we do not want to see this */ arg brparm . origin = sigl /* where was I called from ? */ do currln = origin to 1 by -1 /* inch backward to label */ if Right(Word(Sourceline(currln),1),1) = ":" then do parse value sourceline(currln) with pgfname ":" . /* Label */ leave ; end /* name */ end /* currln */ select when brparm = "NAME" then return(pgfname) /* Return full name */ when brparm = "ID" then do /* wants the prefix */ parse var pgfname pgfpref "_" . /* get the prefix */ return(pgfpref) end /* brparm = "ID" */ otherwise say left(sigl,6) left(pgfname,40) exec_name "Time:" time("L") end /* select */ return /*@ BRANCH */ /* . ----------------------------------------------------------------- */ DUMP_QUEUE: /*@ Take whatever is in stack */ rc = trace("O") /* and write to the screen */ address TSO arg mode . "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return if mode <> "QUIET" then, say "Total Stacks" rc , /* rc = #of stacks */ " Begin Stacks" tk_init_stacks , /* Stacks present at start */ " Excess Stacks to dump" stk2dump do dd = rc to tk_init_stacks by -1 /* empty each one. */ if mode <> "QUIET" then, say "Processing Stack #" dd " Total Lines:" queued() do queued();parse pull line;say line;end /* pump to the screen */ "DELSTACK" /* remove stack */ end /* dd = 1 to rc */ return /*@ DUMP_QUEUE */ /* . ----------------------------------------------------------------- */ KEYWD: Procedure expose info /*@ hide all vars, except info*/ arg kw kw_pos = wordpos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ kw_val = word(info,kw_pos+1) /* get the next word */ info = Delword(info,kw_pos,2) /* remove both */ return kw_val /*@ KEYWD */ /* . ----------------------------------------------------------------- */ KEYPHRS: Procedure expose, /*@ */ info helpmsg exec_name /* except these three */ arg kp wp = wordpos(kp,info) /* where is it? */ if wp = 0 then return "" /* not found */ front = subword(info,1,wp-1) /* everything before kp */ back = subword(info,wp+1) /* everything after kp */ parse var back dlm back /* 1st token must be 2 bytes */ if length(dlm) <> 2 then /* Must be two bytes */ helpmsg = helpmsg, "Invalid length for delimiter("dlm") with KEYPHRS("kp")" if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter("dlm") with KEYPHRS("kp")" if helpmsg <> "" then call HELP /* Something is wrong */ parse var back kpval (dlm) back /* get everything b/w delim */ info = front back /* restore remainder */ return Strip(kpval) /*@ KEYPHRS */ /* . ----------------------------------------------------------------- */ NOVALUE: /*@ */ say exec_name "raised NOVALUE at line" sigl say " " say "The referenced variable is" condition("D") say " " zsigl = sigl signal SHOW_SOURCE /*@ NOVALUE */ /* . ----------------------------------------------------------------- */ SHOW_SOURCE: /*@ */ call DUMP_QUEUE /* Spill contents of stacks -*/ if sourceline() <> "0" then /* to screen */ say sourceline(zsigl) rc = trace("?R") nop exit /*@ SHOW_SOURCE */ /* . ----------------------------------------------------------------- */ SS: Procedure /*@ Show Source */ arg ssbeg ssend . if ssend = "" then ssend = 10 if \datatype(ssbeg,"W") | \datatype(ssend,"W") then return ssend = ssbeg + ssend do ssii = ssbeg to ssend ; say sourceline(ssii) ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw sw_val = Wordpos(kw,info) > 0 /* exists = 1; not found = 0 */ if sw_val then /* exists */ info = Delword(info,Wordpos(kw,info),1) /* remove it */ return sw_val /*@ SWITCH */ /* . ----------------------------------------------------------------- */ SYNTAX: /*@ */ errormsg = exec_name "encountered REXX error" rc "in line" sigl":", errortext(rc) say errormsg zsigl = sigl signal SHOW_SOURCE /*@ SYNTAX */ /* Can call TRAPOUT. . ----------------------------------------------------------------- */ TOOLKIT_INIT: /*@ */ address TSO info = Strip(opts,"T",")") /* clip trailing paren */ parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn parse value "" with tv helpmsg . parse value 0 "ISR00000 YES" "Error-Press PF1" with, sw. zerrhm zerralrm zerrsm if SWITCH("TRAPOUT") then do "TRAPOUT" exec_name parms "(( TRACE R" info exit end /* trapout */ if Word(parms,1) = "?" then call HELP /* I won't be back */ "QSTACK" ; tk_init_stacks = rc /* How many stacks? */ parse value SWITCH("BRANCH") SWITCH("MONITOR") SWITCH("NOUPDT") with, branch monitor noupdt . parse value mvsvar("SYSNAME") sysvar("SYSNODE") with, #tk_cpu node . sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" parse value KEYWD("TRACE") "N" with tv . tk_globalvars = "exec_name tv helpmsg sw. zerrhm zerralrm ", "zerrsm zerrlm tk_init_stacks branch monitor ", "noupdt" call LOCAL_PREINIT /* for more opts -*/ return /*@ TOOLKIT_INIT */ /* ))) SLIB ASMMAP .. &JOB1L &JOB2 &JOB3 &JOB4 //* -- ESTABLISH PRIMARY INPUT */ //ORIGIN EXEC PGM=IEFBR14 //SOURCE DD DISP=SHR,DSN=&SRCDS(&SRC) )SET LSTEP = ORIGIN )SET LDDN = SOURCE //BLD EXEC PGM=IEBGENER //PLDIGN DD DUMMY //SYSIN DD DUMMY //SYSPRINT DD SYSOUT=* //SYSUT2 DD UNIT=VIO,SPACE=(CYL,(5,2),RLSE),DISP=(,PASS) //SYSUT1 DD DSN=*.&LSTEP..&LDDN,DISP=SHR //* */ //* ---ASSEMBLE THE MAP */ //* */ //MAP EXEC PGM=ASMA90,REGION=1024K, // PARM='SYSPARM(MAP),DECK,NOOBJECT' //PLDIGN DD DUMMY //SYSLIB DD DSN=CICS.SDFHMAC,DISP=SHR // DD DSN=&PRGRP.???.PLILIB,DISP=SHR // DD DSN=SYS1.MACLIB,DISP=SHR //SYSUT1 DD UNIT=VIO,SPACE=(CYL,(1,1)) //SYSUT2 DD UNIT=VIO,SPACE=(CYL,(1,1)) //SYSUT3 DD UNIT=VIO,SPACE=(CYL,(1,1)) //SYSPUNCH DD UNIT=VIO,SPACE=(CYL,(1,1)),DISP=(,PASS), // DCB=(RECFM=FB,LRECL=80,BLKSIZE=400) //SYSPRINT DD UNIT=VIO,SPACE=(CYL,(1,1)),DISP=(,PASS) //SYSIN DD DSN=*.BLD.SYSUT2,DISP=(OLD,PASS) //* */ //* ---LINK THE MAP */ //* */ //LNK EXEC PGM=IEWL,PARM='LIST,LET,XREF' //STEPLIB DD DSN=CEE.SCEELKED,DISP=SHR //SYSLIB DD DSN=CICS.SDFHLOAD,DISP=SHR // DD DSN=CEE.SCEELKED,DISP=SHR // DD DSN=???.SLINKLIB,DISP=SHR //PLDIGN DD DUMMY //SYSUT1 DD UNIT=VIO,SPACE=(CYL,(1,1)) //SYSLMOD DD DSN=&LODDS(&LMOD),DISP=SHR //SYSPRINT DD UNIT=VIO,SPACE=(CYL,(1,1)),DISP=(,PASS) //SYSLIN DD DSN=*.MAP.SYSPUNCH,DISP=(OLD,DELETE) //* */ //* ---CREATE THE MAPLIB INCLUDE MEMBER */ //* */ //DSECT EXEC PGM=ASMA90,REGION=1024K, // PARM='SYSPARM(DSECT),DECK,NOOBJECT' //PLDIGN DD DUMMY //SYSLIB DD DSN=CICS.SDFHMAC,DISP=SHR // DD DSN=&PRGRP.???.PLILIB,DISP=SHR // DD DSN=SYS1.MACLIB,DISP=SHR //SYSUT1 DD UNIT=VIO,SPACE=(CYL,(1,1)) //SYSUT2 DD UNIT=VIO,SPACE=(CYL,(1,1)) //SYSUT3 DD UNIT=VIO,SPACE=(CYL,(1,1)) //SYSPUNCH DD DSN=&MAPDS(&MNAME),DISP=SHR //SYSPRINT DD UNIT=VIO,SPACE=(CYL,(1,1)),DISP=(,PASS) //SYSIN DD DSN=*.BLD.SYSUT2,DISP=(OLD,DELETE) //* --- */ //* ---SEND LISTINGS TO SYSOUT */ //* --- */ //PRINT1 EXEC PGM=IEBGENER //SYSUT1 DD DISP=(SHR,PASS),DSN=*.MAP.SYSPRINT //SYSUT2 DD SYSOUT=* //SYSIN DD DUMMY //SYSPRINT DD DUMMY // IF (MAP.RC << 8 ) THEN //* */ //PRINT2 EXEC PGM=IEBGENER //SYSUT1 DD DISP=(SHR,PASS),DSN=*.LNK.SYSPRINT //SYSUT2 DD SYSOUT=* //SYSIN DD DUMMY //SYSPRINT DD DUMMY // IF (LNK.RC << 8 ) THEN //* -- */ //PRINT3 EXEC PGM=IEBGENER //SYSUT1 DD DISP=(SHR,PASS),DSN=*.DSECT.SYSPRINT //SYSUT2 DD SYSOUT=* //SYSIN DD DUMMY //SYSPRINT DD DUMMY )SEL &SAVEPRT = 1 //* -- */ //* -------- COMBINE MAP, LNK, DSECT LISTINGS ---------------------*/ //* */ //COMBINE EXEC PGM=IKJEFT01,DYNAMNBR=300, // PARM='COMBINE @MAP @LNK @DSECT (( RACE R' //SYSTSIN DD DUMMY //SYSTSPRT DD SYSOUT=* //SYSPROC DD DISP=SHR,DSN=???.EXEC //@MAP DD DISP=(SHR,PASS),DSN=*.MAP.SYSPRINT //@LNK DD DISP=(SHR,PASS),DSN=*.LNK.SYSPRINT //@DSECT DD DISP=(SHR,PASS),DSN=*.DSECT.SYSPRINT )SEL &LIST = &Z //@PRINT DD DISP=SHR,DSN=&LISTDS )ENDSEL &LIST = &Z )SEL &LIST ^= &Z //@PRINT DD DISP=SHR,DSN=&LISTDS(&LIST) )ENDSEL &LIST ^= &Z )SET LSTEP = COMBINE )SET LDDN = @PRINT //* */ )ENDSEL &SAVEPRT = 1 // ELSE )SEL &SAVEPRT = 1 //* -- */ //* -------- FAILURE ON LINK STEP, COMBINE MAP AND LINK SYSPRINT---*/ //* */ //LINKFAIL EXEC PGM=IKJEFT01,DYNAMNBR=300, // PARM='COMBINE @MAP @LNK @DSECT (( RACE R' //SYSTSIN DD DUMMY //SYSTSPRT DD SYSOUT=* //SYSPROC DD DISP=SHR,DSN=NTIN.TS.D822.LIB.EXEC //@MAP DD DISP=(SHR,PASS),DSN=*.MAP.SYSPRINT //@LNK DD DISP=(SHR,PASS),DSN=*.LNK.SYSPRINT //@DSECT DD DUMMY //@PRINT DD DISP=(SHR,PASS),DSN=*.COMBINE.@PRINT //* */ )ENDSEL &SAVEPRT = 1 // ENDIF // ELSE /* MAP.RC << 8) */ )SEL &SAVEPRT = 1 //* -- */ //* -------- FAILURE ON MAP STEP, ONLY SAVE MAP.SYSPRINT-----------*/ //* */ //MAPFAIL EXEC PGM=IKJEFT01,DYNAMNBR=300, // PARM='COMBINE @MAP @LNK @DSECT (( RACE R' //SYSTSIN DD DUMMY //SYSTSPRT DD SYSOUT=* //SYSPROC DD DISP=SHR,DSN=???.EXEC //@MAP DD DISP=(SHR,PASS),DSN=*.MAP.SYSPRINT //@LNK DD DUMMY //@DSECT DD DUMMY //@PRINT DD DISP=(SHR,PASS),DSN=*.COMBINE.@PRINT //* */ )ENDSEL &SAVEPRT = 1 // ENDIF )SEL &LIST ^= &Z //* --------------- Add stats to listing member ---------------- */ //PLIXREF EXEC PGM=IKJEFT01,DYNAMNBR=300 //SYSTSPRT DD SYSOUT=* //SYSTSIN DD * ISPSTART CMD(ADDXREF &LISTDS(&LIST) ) //SYSEXEC DD DISP=SHR,DSN=???.EXEC //ISPLOG DD DISP=NEW,UNIT=VIO, // SPACE=(TRK,(1,1)), // DCB=(LRECL=121,RECFM=FB,BLKSIZE=0) //ISPPROF DD DISP=NEW,UNIT=VIO,SPACE=(CYL,(1,1,15)), // DCB=(LRECL=80,RECFM=FB,BLKSIZE=0) //ISPPLIB DD DISP=SHR,DSN=ISP.SISPPENU //ISPMLIB DD DISP=SHR,DSN=ISP.SISPMENU //ISPSLIB DD DISP=SHR,DSN=ISP.SISPSENU //ISPTLIB DD DISP=SHR,DSN=ISP.SISPTENU //* ---------- */ )ENDSEL &LIST ^= &Z ))) PLIB FROMTO .. )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) PAD('_') } TYPE( OUTPUT ) INTENS( HIGH ) CAPS( OFF ) JUST( LEFT ) { TYPE( OUTPUT ) COLOR( PINK ) CAPS( OFF ) HILITE( BLINK ) @ TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) JUST( LEFT ) )BODY WINDOW(68,13) + Source DSN%==>}srcds + + MEM%==>}SRC + {namemsg + Maplib DSN%==>@MAPDS + + MEM%==>@MNAME + + + Load DSN%==>@lodds + + MEM%==>@LMOD + + +Listing DSN%==>@listds + + Mem%==>@list + JOB class ==>@Z+ + + MY GROUP IS%==>@PRGRP+ )INIT .HELP = FROMTOH .ZVARS = '(CPCLASS)' .CURSOR = SRCDS )PROC VER (&LODDS,DSNAME) VER (&LMOD,NAME) VER (&MAPDS,DSNAME) VER (&MNAME,NAME) VER (&LISTDS,DSNAME) VER (&LIST,NAME) )END ))) PLIB FROMTOH .. )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) } AREA( SCRL ) EXTEND( ON ) )BODY EXPAND(||) %TUTORIAL |-| ASMMAP -- Specify Target |-| TUTORIAL %Next Selection ===>_ZCMD + }hlptxt } )AREA HLPTXT + + The%FROMDSN+and%FROMMBR+have been determined by your current location. + Other fields are populated based on what you entered the last time you + compiled this program. + + Please specify a datasetname and member for the%load+module. The + default suffix for all map loads is %00+. + + Please specify a datasetname and member for the%maplib+module. The + maplib dataset must exist and must be a partitioned dataset type. + + Please specify a datasetname and member for the%output listing dataset. + If the datasetname is left%blank,+the listing will%not+be saved. If the + datasetname is for a%sequential dataset,+the membername is ignored. + )PROC &ZCONT = FROMTOH &ZUP = FROMTOH )END */