<After Tom after Tony>
As the name of the source program, as referenced in the compile, can be
different than the object program. I use the following command file to
insure that the "real" name of the source code(as referenced via a disc file
name) is placed in the "VERSION" area of an object module. I use a version
of this for PASCAL as well as COBOL.
If anyone can suggest improvements I would be glad to hear them.
Eric Sand
[log in to unmask]
----------------------------------------------------------------------------
\
parm src_name="", obj_name="", lp=$null, mast="",new ="", info ="",
wksp
="", xdb =""
comment
comment @(#) COBOLII/iX 85 compile & link"
comment
if len("!obj_name") = 0
if pos(".","!src_name",1) > 0
setvar obj_name lft("!src_name",pos(".","!src_name")-1)
else
setvar obj_name, str("!src_name", 1, len("!src_name"))
endif
endif
setvar rel_no "Release 00.00"
if bound(inlxmigr_rel)
setvar rel_no inlxmigr_rel
endif
if bound(migrdevl_rel)
setvar rel_no migrdevl_rel
endif
setvar _cob_info "$VERSION
'!src_name/!rel_no/',&"+"$'!HPJOBNAME.!HPACCOUNT,!HPG
ROUP/!HPDATEF/!HPTIMEF'"
if len(_cob_info) > 0 and lft(_cob_info,1) <> "$" then
setvar _cob_info ""
endif
if "!xdb" <> "" then
if finfo("!xdb",0) then
if ups("!xdb") <> ups("!src_name") and ups("!xdb") <> ups("!mast") and
fin
fo("!xdb",14) = -72 and finfo("!xdb",9) = "EDTCT" then
purge !xdb
else
echo COBXDB file (!xdb) exists
echo COMPILE STEP FAILED, NO LINK DONE
setjcw jcw=fatal
endif
endif
file cobxdb=!xdb
setvar _cob_info _cob_info + "$CONTROL SYMDEBUG=XDB"
setvar _link_info "from=$oldpass,xdbend.lib.sys"
else
setvar _link_info ""
endif
setvar _cob_parm 0
if "!src_name" <> "" then
if ups("!src_name") = ups("!lp") then
echo COBLIST file (!lp) would overwrite COBTEXT
echo ERRORS IN COMPILE
if "!xdb" <> "" then
reset cobxdb
endif
setjcw jcw=fatal
endif
setvar _cob_parm _cob_parm+$01
file cobtext=!src_name
endif
if "!lp" <> "" then
setvar _cob_parm _cob_parm+$02
file coblist=!lp
endif
if "!mast" <> "" then
setvar _cob_parm _cob_parm+$08
file cobmast=!mast
endif
if "!new" <> "" then
setvar _cob_parm _cob_parm+$10
file cobnew=!new
endif
if "!wksp" <> "" then
setvar _cob_parm _cob_parm+$20
file cobwksp=!wksp
endif
continue
run COBOL.PUB.SYS,ANSI85;parm=!_cob_parm;info="!_cob_info"
if "!xdb" <> "" then
reset cobxdb
endif
if "!src_name" <> "" then
reset cobtext
endif
if "!lp" <> "" then
reset coblist
endif
if "!mast" <> "" then
reset cobmast
endif
if "!new" <> "" then
reset cobnew
endif
if "!wksp" <> "" then
reset cobwksp
endif
if jcw >= fatal then
echo COMPILE STEP FAILED, NO LINK DONE
setjcw jcw=fatal
endif
echo END OF COMPILE
continue
purge ![obj_name].nmprg
link !_link_info;to=![obj_name].nmprg;cap=IA,BA,PH
if jcw >= fatal then
echo ERRORS IN LINK
setjcw jcw=fatal
else
deletevar _@
endif
echo END OF LINK
----------------------------------------------------------------------------
-----Original Message-----
From: Tom Brandt [mailto:[log in to unmask]]
Sent: Tuesday, October 15, 2002 8:25 AM
To: [log in to unmask]
Subject: Re: [HP3000-L] Cobol PROGRAM-ID Query
Tony,
Try using macros:
$CONTROL LIST,POST85
$DEFINE %PROGNAME="CUSTEDI"#
$DEFINE %VERSION="(A.12)"#
IDENTIFICATION DIVISION.
PROGRAM-ID. %PROGNAME.
PROCEDURE DIVISION.
AA00-MAIN SECTION.
DISPLAY %PROGNAME, " ", %VERSION,
"; compiled ", WHEN-COMPILED
At 04:23 PM 10/15/2002 +0100, Tony Summers wrote:
>Anybody know of a way to get a cobol's program-Id "into" the procedure
>division ?
--------------------------------
Tom Brandt
Northtech Systems, Inc.
313 N. 1st Street
Ann Arbor, MI 48103
http://www.northtech.com/
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
|
