Providing software solutions since 1976
|
SAS/C 6.50C CMS LCDEFS EXEC
/* TS-590: SAS/C 6.50C CMS LCDEFS EXEC */
/*------------------------------------------------------------------*/
/* Copyright (c) 1998 by SAS Institute Inc., */
/* Cary, NC 27513-2414, USA. All rights reserved. */
/*------------------------------------------------------------------*/
/*------------------------------------------------------------------*/
/* */
/* Product: SAS/C */
/* Type: Utility, Installation */
/* Function: */
/* 1. ZAP the SAS/C compiler, library, debugger, and utility */
/* programs with non-default segment names. */
/* 2. ASSEMBLE, LKED alternate translate table. */
/*------------------------------------------------------------------*/
address command
arg parms "(" options ")" .
if parms = "?" then do
call usage
exit 4
end
/*-------------------------------------------------------------------+
| Process alternate character translate table
+-------------------------------------------------------------------*/
trans_tbl = ""
if (word(parms,1) = "-TRANS") then do
/* get input file name */
parse var parms word1 trans_tbl rest
if trans_tbl = "" then do /* if no input file name */
say "LCDEFS ERROR: Translate table file name must be specified."
call usage
exit 4
end
if (rest ^= "") then do /* other parameters not allowed */
say "LCDEFS ERROR: Only filename parameter accepted with -TRANS"
call usage
exit 4
end
if (options ^= "") then
say 'LCDEFS WARNING: Option(s) "'options'" ignored for -TRANS'
exit trans(trans_tbl) /* process translate table */
end
/*-------------------------------------------------------------------+
| Process and set segment names
+-------------------------------------------------------------------*/
newname = ""
parse var parms newname oldname newname2 oldname2 extra1
/*-------------------------------------------------------------------+
| Initilaize and process options
+-------------------------------------------------------------------*/
zapopts = ""
comp_opt = 0
cxx_opt = 0
force_opt = 0
fssl_opt = 0
let_opt = 0
lib_opt = 0
prt_opt = 0
cxx_installed = 0
numopts = words(options)
do i=1 to numopts
opt = word(options,i)
select
when (opt = "LET") then do
let_opt = 1
end
when (opt = "PRINT") then do
prt_opt = 1
end
when abbrev("FORCE_NODCSS",opt,5) then do
force_opt = 1
end
when abbrev("CCOMPILER",opt,2) then do
comp_opt = 1
end
when abbrev("CXX",opt,2) then do
cxx_opt = 1
end
when abbrev("LIBRARY",opt,3) then do
lib_opt = 1
end
when abbrev("FSSL",opt,2) then do
fssl_opt = 1
end
otherwise do
say 'LCDEFS ERROR: invalid option "'opt'".'
call usage
exit 4
end
end /*select*/
end /*do 1 to numopts*/
if (^(comp_opt | cxx_opt | lib_opt | fssl_opt)) then do
say "LCDEFS ERROR: no target option specified."
call usage
exit 4
end
/*-------------------------------------------------------------------+
| Initilaize and process segment names
+-------------------------------------------------------------------*/
if ( ^force_opt & newname = "" ) then do
say "LCDEFS ERROR: New segment name must be specified."
call usage
exit 4
end
if (extra1 ^= "")then do
say 'LCDEFS ERROR: Invalid parameter(s) "'extra1'".'
call usage
exit 4
end
if ( force_opt) then do/* force names to be nodcss */
newname = "-NODCSS"
newname2 = "-NODCSS"
end
else do
/* check if newname2 useful */
if (newname2 ^= "" & ^lib_opt) then do
say "LCDEFS WARNING: second segment name only used with LIBrary",
"option."
say""
end
end
/* Make NOPRINT the default option to ZAP */
if (prt_opt) then
zapopts = zapopts || "PRINT"
else
zapopts = zapopts || "NOPRINT"
/*-------------------------------------------------------------------+
| check primary segment names and convert to hex |
+-------------------------------------------------------------------*/
if length(newname) > 8 then do /* process primary newname */
say "LCDEFS ERROR: New segment name too long:" newname
exit 4
end
if newname = "-NODCSS" then
hexnew = "0000000000000000"
else do
hexnew = c2x(left(newname,8))
end
if length(oldname) > 8 then do /* process primary oldname */
say "LCDEFS ERROR: Existing segment name too long:" oldname
exit 4
end
if oldname = "" then
oldname = "-NODCSS" /* set primary oldname default*/
if oldname = "-NODCSS" then
hexold = "0000000000000000"
else
hexold = c2x(left(oldname,8))
if (newname2 ^= "") then do /* if specified */
/*----------------------------------------------------------------+
| check secondary segment names and convert to hex |
+----------------------------------------------------------------*/
if (length(newname2) > 8) then do /* process secondary newname */
say "LCDEFS ERROR: New segment name too long:" newname2
exit 4
end
if (newname2 = "-NODCSS") then
hexnew2 = "0000000000000000"
else do
hexnew2 = c2x(left(newname2,8))
end
if (length(oldname2) > 8) then do /* process secondary oldname */
say "LCDEFS ERROR: Existing segment name too long:" oldname2
exit 4
end
if oldname2 = "" then
oldname2 = "-NODCSS" /* set secondary oldname default*/
if oldname2 = "-NODCSS" then
hexold2 = "0000000000000000"
else
hexold2 = c2x(left(oldname2,8))
end
/*-------------------------------------------------------------------+
| Check for correct access to all necessary files. |
+-------------------------------------------------------------------*/
ckrc = 0
if (comp_opt | lib_opt) then do
ckrc = ckrc + ckwr("LC1370S MODULE")
ckrc = ckrc + ckwr("LC2370S MODULE")
ckrc = ckrc + ckwr("LCGOS MODULE")
ckrc = ckrc + ckwr("CLINKS MODULE")
ckrc = ckrc + ckwr("COOLS MODULE")
end
if (cxx_opt) then do
ckrc = ckrc + ckcxx(cxx_opt)
ckrc = ckrc + ckwr("SHELLER MODULE")
end
if (lib_opt) then do
ckrc = ckrc + ckwr("LC370STD TXTLIB")
ckrc = ckrc + ckwr("L$DEBUG LOADLIB")
ckrc = ckrc + ckwr("OMD370 MODULE")
ckrc = ckrc + ckwr("DSECT2C MODULE")
ckrc = ckrc + ckwr("L$DBRMT MODULE")
ckrc = ckrc + ckwr("LCCCP0 MODULE")
ckrc = ckrc + ckwr("AR370 MODULE")
ckrc = ckrc + ckwr("UPDTE2AR MODULE")
ckrc = ckrc + ckwr("AR2UPDTE MODULE")
ckrc = ckrc + ckwr("XLTHDR MODULE")
ckrc = ckrc + ckilc("ILCLINK")
end
if (fssl_opt) then do
ckrc = ckrc + ckwr("L$FSSL TXTLIB")
ckrc = ckrc + ckwr("HC MODULE")
ckrc = ckrc + ckwr("HYPVIEW MODULE")
end
if ((ckrc > 0) & ^(let_opt)) then
exit 4
signal on error
queue,
"* NAME: LCDEFS PRODUCT: SASC CATEGORY: SEGNAME SYSTEM: CMS "
if (comp_opt) then do
/*----------------------------------------------------------------+
| Set name of LC370 LOADLIB segment in the loader modules
+----------------------------------------------------------------*/
queue "* "
queue "NAME LC1370S LC1370S$ MODULE "
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set compiler segment "'newname'" in LC1370S'
queue "* "
queue "NAME LC2370S LC2370S$ MODULE "
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set compiler segment "'newname'" in LC2370S'
queue "* "
queue "NAME LCGOS LCGOS@$ MODULE "
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set compiler segment "'newname'" in LCGOS'
queue "* "
queue "NAME CLINKS CLINKS@$ MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set compiler segment "'newname'" in CLINKS'
queue "* "
queue "NAME COOLS COOLS@$ MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set compiler segment "'newname'" in COOLS '
end
if (cxx_opt) then do
/*----------------------------------------------------------------+
| Set name of LCXX LOADLIB segment in the loader module
+----------------------------------------------------------------*/
queue "* "
queue "NAME LCXX LCXX@$ MODULE "
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set CXX segment "'newname'" in LCXX'
zap_rc = lczap(MODULE)
queue "* "
queue "NAME SHELLER SHELL@$ MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set compiler segment "'newname'" in SHELLER'
zap_rc = lczap(MODULE)
end
if (lib_opt) then do
/*----------------------------------------------------------------+
| Set transient library segment name into all shipped modules
+----------------------------------------------------------------*/
queue "* "
queue "NAME LCCCP0 L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in LCCCP0'
queue "* "
queue "NAME LC1370S L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in LC1370S'
queue "* "
queue "NAME LC2370S L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in LC2370S'
queue "* "
queue "NAME LCGOS L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in LCGOS'
queue "* "
queue "NAME CLINKS L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in CLINKS'
queue "* "
queue "NAME COOLS L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in COOLS '
queue "* "
queue "NAME OMD370 L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in OMD370_1'
queue "* "
queue "NAME OMD370 O370LNO$ MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in OMD370_2'
queue "* "
queue "NAME AR370 L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in AR370'
/*----------------------------------------------------------------+
| Assumes fssl not installed if the modules that come with it are
| not writeable.
+----------------------------------------------------------------*/
if ( mod_w( HC ) ) then do /* if fssl module is writeable */
queue "* "
queue "NAME HC L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in HC'
end
if ( mod_w(HYPVIEW) ) then do /* if fssl module is writeable */
queue "* "
queue "NAME HYPVIEW L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in HYPVIEW'
end
if (cxx_installed) then do
queue "* "
queue "NAME LCXX L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in LCXX'
end
if ilcmod then do
queue "* "
queue "NAME ILCLINK L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in ILCLINK'
end
queue "* "
queue "NAME DSECT2C L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in DSECT2C'
queue "* "
queue "NAME L$DBRMT L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in L$DBRMT'
queue "* "
queue "NAME UPDTE2AR L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in UPDTE2AR'
queue "* "
queue "NAME AR2UPDTE L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in AR2UPDTE'
queue "* "
queue "NAME XLTHDR L$C$SEGC MODULE"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg "'newname'" in XLTHDR'
/*----------------------------------------------------------------+
| Set transient library segment name in the shipped modules
+----------------------------------------------------------------*/
zap_rc = lczap(MODULE)
/*----------------------------------------------------------------+
| Set transient library segment name in the C resident library
+----------------------------------------------------------------*/
queue "* "
queue "NAME L$C$SEGC L$C$SEGC STDOBJ"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg name "'newname'" in C res'
if (newname2 ^= "") then do
/*----------------------------------------------------------------+
| Set the segment name for the part of the C run time library
| that must reside below the 16 MB line.
+----------------------------------------------------------------*/
queue "* "
queue "NAME L$C$ICMC L$C$ICMC STDOBJ"
if (^force_opt) then
queue "VER 0009" hexold2 oldname2
queue "REP 0009" hexnew2 newname2
queue 'LOG LCDEFS ZAPLOG Set C trans seg2 "'newname2'" in C res'
queue "* "
queue "NAME L$C$SEGC L$C$SEGC STDOBJ"
if (^force_opt) then
queue "VER 0040" hexold2 oldname2
queue "REP 0040" hexnew2 newname2
queue 'LOG LCDEFS ZAPLOG Set C trans seg2 "'newname2'" in C res'
end
zap_rc = lczap(TXTLIB LC370STD)
/*----------------------------------------------------------------+
| Set transient library segment name in the C transient library so
| pre 5.50 modules run with this library ATL can find the BTL part
+----------------------------------------------------------------*/
if (newname2 ^= "") then do
queue "* "
queue "NAME LSCWIO L$C$ICMC LINKLIB"
if (^force_opt) then
queue "VER 0009" hexold2 oldname2
queue "REP 0009" hexnew2 newname2
queue 'LOG LCDEFS ZAPLOG Set C trans seg2 "'newname2'" in C RTL(WIO).'
queue "* "
queue "NAME LSCSIO L$C$ICMC LINKLIB"
if (^force_opt) then
queue "VER 0009" hexold2 oldname2
queue "REP 0009" hexnew2 newname2
queue 'LOG LCDEFS ZAPLOG Set C trans seg2 "'newname2'" in C RTL(SIO).'
zap_rc = lczap(LOADLIB LSCRTL)
end
if (ilcldlb) then do
/*-------------------------------------------------------------+
| Set transient library segment name in ilclink loadlib
+-------------------------------------------------------------*/
queue "* "
queue "NAME ILCLINK L$C$SEGC ILCLINK"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg name "'newname'" in ILC'
zap_rc = lczap(LOADLIB ILCLINK)
end /* if ilcldlb*/
/*----------------------------------------------------------------+
| Set transient library segment name in the debugger.
+----------------------------------------------------------------*/
queue "* "
queue "NAME L$DEBUG L$C$SEGC DEBUG"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg name "'newname'" in Debug'
queue "* "
queue "NAME L$DEBUGM L$FDCSS DEBUG"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set FSSL trans seg name "'newname'" in Debug'
queue "* "
queue "NAME L$DSTG L$C$SEGC DEBUG"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set C trans seg name "'newname'" in Stor CMD'
zap_rc = lczap(LOADLIB L$DEBUG)
end /* if lib */
if (fssl_opt) then do
/*----------------------------------------------------------------+
| set the segment name of the Full Screen transient library in the
| Full Screen resident library: L$FSSL TXTLIB
+----------------------------------------------------------------*/
queue "* "
queue "NAME L$FDCSS L$FDCSS FSSLOBJ"
if (^force_opt) then
queue "VER 0000" hexold oldname
queue "REP 0000" hexnew newname
queue 'LOG LCDEFS ZAPLOG Set FSSL segment name "'newname'" in FS Res Lib'
zap_rc = lczap(TXTLIB L$FSSL)
end /* if fssl */
/*-------------------------------------------------------------------+
| Issue success message
+-------------------------------------------------------------------*/
say ""
if (newname2 ^= "" & lib_opt) then
say 'LCDEFS NOTE: Segment names changed to "'newname'" and "'newname2'".'
else
say 'LCDEFS NOTE: Segment name changed to "'newname'".'
say ""
return 0;
/*********************************************************************
* error - handles errors while stack is loaded.
*********************************************************************/
error:
signal off error
say "LCDEFS ERROR: Unexpected error on line "sigl". Unable to continue."
"DESBUF"
exit 16
/*********************************************************************
* Check R/W status of a file to be zapped.
*********************************************************************/
ckwr: procedure
arg fileid, fmode
if fmode = "" then do
fmode = "*"
default_fmode = 1;
end
else
default_fmode = 0;
"SET CMSTYPE HT"
"ESTATEW" fileid fmode /* Is it writable? */
strc = rc
"SET CMSTYPE RT"
if strc ^= 0 then do
if (default_fmode) then
say "LCDEFS ERROR: "left(fileid, 17)" not on write accessed disk."
else
say 'LCDEFS ERROR: "'fileid'" not the disk accessed as',
'"'fmode'" or is not writable.'
return 1
end
return 0
/*********************************************************************
* Check access to file.
*********************************************************************/
ckac: procedure
arg fileid
"SET CMSTYPE HT"
"ESTATE "fileid" *" /* Is it accessed ? */
strc = rc
"SET CMSTYPE RT"
if strc ^= 0 then do
say "LCDEFS ERROR: "left(fileid, 17)" not on an accessed disk."
return 1
end
return 0
/*********************************************************************
* Check status of C++ module
*********************************************************************/
ckcxx: procedure expose cxx_installed
arg cxx_required
"SET CMSTYPE HT"
"ESTATE LCXX MODULE *" /* does it exist */
exist_rc = rc
if ((exist_rc = 0) | (cxx_required)) then do
cxx_installed = 1
"ESTATEW LCXX MODULE *" /* is it write accessed */
wac_rc = rc
"SET CMSTYPE RT"
if (wac_rc ^= 0) then do
say "LCDEFS ERROR: SAS/C C++ Development System not",
"on write accessed disk."
return 1
end
else
return 0
end
else do
"SET CMSTYPE RT"
say "LCDEFS NOTE: SAS/C C++ Development System not installed."
return 0
end
/*********************************************************************
* Check R/W status of a module.
*********************************************************************/
mod_w: procedure
arg fname
"SET CMSTYPE HT"
signal off error
"ESTATEW "fname" MODULE *" /* Is it writable? */
strc = rc
signal on error
"SET CMSTYPE RT"
if strc ^= 0 then /* if not return failure */
return 0
else
return 1 /* if writable return true */
/*********************************************************************
* Check R/W status of ILCLINK code.
*********************************************************************/
ckilc: procedure expose ilcmod ilcldlb
arg fname
ilcldlb = 0
ilcmod = 0
"SET CMSTYPE HT"
"ESTATEW ILCLINK MODULE *" /* Is it writable? */
strc = rc
if strc ^= 0 then do
"ESTATEW ILCLINK LOADLIB *" /* Is it writable? */
strc = rc
"SET CMSTYPE RT"
if strc ^= 0 then do
say "LCDEFS ERROR: ILCLINK utility not on write accessed disk."
return 1
end
else do
"SET CMSTYPE RT"
ilcldlb = 1
end
end
else
ilcmod = 1
return 0
/*********************************************************************
* Write zap input file and run the ZAP command.
*********************************************************************/
lczap: procedure expose zapopts
trace o
libname = ""
arg target_type libname
queue ""
signal off error
"SET CMSTYPE HT"
"ERASE LCDEFS ZAP A1" /* Remove any old ZAP input file */
"SET CMSTYPE RT"
/* write stack tp ZAP input file */
"EXECIO * DISKW LCDEFS ZAP A1 1 F 80 (FINIS"
io_rc = rc
if io_rc ^= 0 then do
say "LCDEFS ERROR: Unable to write file "LCDEFS ZAP A1" rc="io_rc
"DESBUF"
exit io_rc
end
/* libname blank unless needed */
"ZAP "target_type" "libname" (INPUT LCDEFS " zapopts
zap_rc = rc
if zap_rc ^= 0 then do
say ""
say "LCDEFS ERROR: ZAP command returned rc="rc
"DESBUF"
exit zap_rc
end
say "zap rc = "zap_rc
"ERASE LCDEFS ZAP A1"
signal on error
return zap_rc
/*********************************************************************
* Re-assemble and re-link translate table.
*********************************************************************/
trans: procedure
arg name
if ( ckwr("LSCRTL LOADLIB","A")) then
exit 4
if ( ckwr("LCARES TXTLIB")) then
exit 4
if ( ckwr("CICSARES TXTLIB")) then
exit 4
"MAKEBUF"
buf = rc
oldstack = queued()
"SET CMSTYPE HT"
"LISTFILE" name "ASSEMBLE * (STACK FIFO"
src = rc
"SET CMSTYPE RT"
if src ^= 0 then do
say "LCDEFS ERROR: File "name" ASSEMBLE * not found."
return src
end
parse pull . . fm
fm = substr(strip(fm),1,1)
do while queued() > oldstack
pull .
end
usermacs = "";
"QUERY MACLIB (STACK LIFO"
do while queued() > oldstack
parse pull . '=' umacs
usermacs = usermacs strip(umacs)
end
"GLOBAL MACLIB LCUSER"
"ASSEMBLE" name
src = rc
say "LCDEFS NOTE: ASSEMBLE command returned RC="rc "for" name
if strip(usermacs) = "NONE" then
"GLOBAL MACLIB" /* Cancel current maclibs. */
else
"GLOBAL MACLIB" usermacs /* Restore the user maclibs. */
"DROPBUF" buf
if src = 0 then do /* if new table assembled */
if ( ckwr(name" TEXT")) then /* assembler out must be writeable */
exit 4
/*-------------------------------------------------------------------+
| replace translate table in the transient (run-time) library |
+-------------------------------------------------------------------*/
"LKED" name "(NAME L$DCST LIBE LSCRTL XREF MAP LIST NOTERM NCAL"
src = rc
say "LCDEFS NOTE: LKED command returned RC="rc "for" name
if src ^= 0 then do
emsg = "LCDEFS ERROR: translate table not replaced in "
emsg = emsg"LSCRTL LOADLIB by "name" ASSEMBLE."
say emsg
end
else do
say "Compress? (Y/N)"; parse pull resp; upper resp
if abbrev("YES",resp,1) then do
"LOADLIB COMPRESS LSCRTL LOADLIB A"
say "LCDEFS NOTE: LOADLIB COMPRESS command returned RC="rc
end
end
say""
say "LCDEFS NOTE: L$DCST replaced in LSCRTL LOADLIB by "name" ASSEMBLE."
/*-------------------------------------------------------------------+
| replace translate table in the All-resident library |
+-------------------------------------------------------------------*/
"EXECIO 1 DISKW "name" TEXT * (STRING NAME L$DCST"
n_rc = rc
if n_rc ^= 0 then do
say "LCDEFS ERROR: Unable to insert name card in "name" TEXT A."
exit n_rc
end
"TXTLIB DEL LCARES L$DCST"
d_rc = rc
if d_rc ^= 0 then do
say "LCDEFS ERROR: Unable to delete L$DCST from LCARES TXTLIB."
exit d_rc
end
"TXTLIB ADD LCARES "name
a_rc = rc
if a_rc ^= 0 then do
say "LCDEFS ERROR: Unable to add "name" to LCARES TXTLIB."
exit a_rc
end
say""
say "LCDEFS NOTE: L$DCST replaced in LCARES TXTLIB by "name" ASSEMBLE."
/*-------------------------------------------------------------------+
| replace translate table in the CICS all-resident library |
+-------------------------------------------------------------------*/
"TXTLIB DEL CICSARES L$DCST"
d_rc = rc
if d_rc ^= 0 then do
say "LCDEFS ERROR: Unable to delete L$DCST from CICSARES TXTLIB."
exit d_rc
end
"TXTLIB ADD CICSARES "name
a_rc = rc
if a_rc ^= 0 then do
say "LCDEFS ERROR: Unable to add "name" to CICSARES TXTLIB."
exit a_rc
end
say""
say "LCDEFS NOTE: L$DCST replaced in CICSARES TXTLIB by "name" ASSEMBLE."
say""
"ERASE" name "TEXT A"
"ERASE" name "LISTING A"
end
return 0
/*********************************************************************
* Usage describe syntax for LCDEFS EXEC
*********************************************************************/
usage:
trace o;
if parms = "" | parms = "?" then do
say "LCDEFS Exec usage:"
say ""
say " The LCDEFS utility provides two services. It changes the "
say " segment search target or reassembles and link-edits the"
say " character set translation table macro."
say ""
end
say "LCDEFS Exec syntax:"
say ""
say" +--------+-------------------------------------------------------------+"
say" | | + + |"
say" | LCDEFS | | newname (oldname (newname2 (oldname2))) | |"
say" | | | | |"
say" | | | -NODCSS (oldname (-NODCSS (oldname2))) | ( (options ()) |"
say" | | | | |"
say" | | | -TRANS filename | |"
say" | | + + |"
say" | | |"
say" | | Options: CCompiler |"
say" | | CXx |"
say" | | LIBrary |"
say" | | FSsl |"
say" | | LET |"
say" | | PRINT |"
say" | | FORCE-nodcss |"
say" | | |"
say" | | |"
say" +--------+-------------------------------------------------------------+"
return
|
