From:	MERC::"uunet!WKUVX1.BITNET!DSJ-Mgr" 21-DEC-1992 09:30:13.62
To:	galaxy::gleeve
CC:	
Subj:	DECEMBER92.HANDLE

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 8.1
$!   On  1-DEC-1992 07:46:45.14   By user GOATHUNTER   (@WKUVX1.BITNET)
$!
$! The VMS_SHARE software that created this archive
$!    was written by  Andy Harper, Kings College London UK
$!    -- September 1992
$!
$! Credit is due to these people for their original ideas:
$!    James Gray, Michael Bednarek
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. BUILD_CH_DEMO.COM;1
$!       2. CH_DEMO.FOR;1
$!       3. CH_MAKE_SHARED_IMAGE.COM;1
$!       4. CH_TRANSFER_VECTORS.MAR;1
$!       5. FCH_CONDITION_HANDLER.FOR;1
$!       6. SCH_EXIT_HANDLER.FOR;1
$!       7. SCH_SET_EXITHANDLER.FOR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$unpack: subroutine ! P1=filename, P2=checksum, P3=attributes
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'"
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-UNPACK, Unpacking file ''P1'"
$ n=P1
$ if P3 .nes. "" then $ n=f
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='n'
PROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,
ERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
PROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;
ENDLOOP;ENDPROCEDURE;
PROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["`"]
:ERASE_CHARACTER(1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[
OUTRANGE,INRANGE]:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE;
PROCEDURE ProcessLine s:=ERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH(
CURRENT_LINE);ExpandChar;ENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE;
PROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);
ENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=
END_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;
ELSE ProcessLine;AdvanceLine;ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,
"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=
GET_INFO(COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,
GET_INFO(COMMAND_LINE,"output_file"));QUIT;
$ if p3 .eqs. "" then $ goto dl
$ open/write fdl &f
$ write fdl "RECORD"
$ write fdl P3
$ close fdl
$ w "-I-CONVRFM, Converting record format to ", P3
$ convert/fdl=&f &f-1 &P1
$dl: delete 'f'*
$ if P2 .eqs. "" then $ goto ckskip
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ckskip: e "-W-CHKSUMSKIP, checksum validation unavailable for ''P1'"
$ endsubroutine
$start:
$!
$ create 'f'
X$!
X$!`20---`09This`20command`20procedure`20compiles`20the`20condition`20handler
V`20test
X$!`20---`09demonstration`20program.`20`20The`20/LIST`20command`20modifier`20on
V`20the
X$!`20---`09FORTRAN`20command`20is`20required`20to`20generate`20a`20compiler
V`20listing
X$!`20---`09(CH_DEMO.LIS)`20File.`20`20The`20source`20code`20line`20numbers`20i
Vn`20this
X$!`20---`09listing`20file`20are`20what`20are`20referenced`20in`20the`20traceba
Vck.
X$!
X$!`20---`09When`20you`20link`20this`20image,`20you`20should`20receive`20a`20wa
Vrning`20message
X$!`20---`09that`20procedure`20'XYZ'`20cannot`20be`20found.`20`20This`20is`20no
Vrmal,`20and`20is
X$!`20---`09necessary`20for`20the`20demonstration`20to`20work`20correctly.
X$!
X$`20fortran/list`20ch_demo
X$`20link`20ch_demo,sys$input/opt
Xch_shared_image/share
X$`20delete`20ch_demo.obj;*
X$`20exit
$ call unpack BUILD_CH_DEMO.COM;1 1031153848 ""
$!
$ create 'f'
X!
X!`20---`09This`20is`20the`20condition`20handler`20test`20demonstration`20progr
Vam.
X!`20---`09This`20program`20contains`20three`20errors;`20two`20warnings`20and
V`20one
X!`20---`09fatal.`20`20Run`20this`20program`20with`20the`20condition`20handler
V`20shared
X!`20---`09image`20linked`20in,`20to`20receive`20exception`20traceback`20VAXmai
Vl.
X!
X`09program`20ch_demo
X!
X!`20---`09Make`20the`20Condition`20Handler`20and`20the`20Exit`20Handler`20know
Vn
X!`20---`09to`20the`20system.`20`20Change`20the`20argument`20"'ROSENSTEIN'"`20t
Vo
X!`20---`09your`20own`20VMS`20account`20name,`20to`20receive`20mail`20correctly
V.
X!
X`09external`20fch_condition_handler
X`09call`20lib$establish(fch_condition_handler)
X`09call`20sch_set_exithandler('Rosenstein')
X!
X!`20---`09Induce`20two`20warnings,`20by`20trying`20to`20print`20out`20five`20d
Vigit
X!`20---`09numbers`20in`20four`20digit`20fields.`20`20After`20each`20exception
V`20is
X!`20---`09signaled,`20execution`20will`20continue.
X!
X`09i=10000
X`09type`20100,`20i
X100`09format('`20i=',i4)
X`09k=10000
X`20`09type`20200,`20k
X200`09format('`20k=',i4)
X!
X!`20---`09Induce`20a`20fatal`20exception,`20by`20trying`20to`20call`20a`20non-
Vexistant
X!`20---`09subroutine.`20`20Execution`20will`20stop`20at`20this`20point,`20and
V`20image
X!`20---`09rundown`20begin.`20`20We`20should`20have`20received`20a`20message
V`20from`20the
X!`20---`09linker`20indicating`20that`20it`20could`20not`20find`20a`20subroutin
Ve`20XYZ.
X!
X`09call`20xyz
X!
X!`20---`09We`20should`20never`20see`20the`20following`20message`20on`20our`20t
Verminal
X!
X`09type`20300
X300`09format('`20The`20program`20has`20completed`20normally')
X`09call`20exit
X`09end
$ call unpack CH_DEMO.FOR;1 1884844272 ""
$!
$ create 'f'
X$!`09CH_MAKE_SHARED_IMAGE.COM
X$!++
X$!`09Author:`20`20Steve`20Rosenstein
X$!
X$!`09Creation`20Date:`20`2001-OCT-1988
X$!
X$!`09Modification`20History:
X$!
X$!`09Functional`20Description:
X$!
X$!`09`09This`20command`20procedure`20compiles`20the`20three`20FORTRAN`20proced
Vures
X$!`09`09used`20in`20the`20combination`20condition/exit`20handler`20technique
V`20to
X$!`09`09log`20and`20report`20runtime`20exception`20conditions.`20`20It`20assem
Vbles
X$!`09`09the`20macro`20procedure`20used`20to`20create`20the`20transfer`20vector
Vs`20for
X$!`09`09the`20resulting`20shared`20image,`20and`20then`20it`20links`20everythi
Vng
X$!`09`09together`20into`20a`20shared`20image.`20`20If`20shared`20image`20insta
Vllation
X$!`09`09is`20desired,`20the`20last`20line`20should`20be`20uncommented.
X$!
X$!`09`09An`20assumption`20which`20is`20made`20is`20that`20the`20logical
X$!`09`09CH_SHARED_IMAGE`20has`20been`20created`20as`20a`20system-wide`20logica
Vl
X$!`09`09name.`20`20It`20is`20equivalenced`20to`20the`20full`20filespec`20of
V`20the
X$!`09`09condition`20handler`20executable.`20`20For`20this`20example,`20this
X$!`09`09definition`20is`20as`20follows:
X$!`09`09`09$`20DEFINE/SYSTEM`20-
X$!`09`09`09`09CH_SHARED_IMAGE`20-
X$!`09`09`09`09SSW_DISK:`5BROSENSTEIN.CH.CODE`5DCH.EXE
X$!`09`09If`20this`20logical`20cannot`20been`20defined,`20you`20will`20have`20t
Vo`20
X$!`09`09replace`20every`20instance`20of`20CH_SHARED_IMAGE`20with`20the`20full
V`20path
X$!`09`09to`20the`20condition`20handler`20shared`20image.`20`20This`20logical
V`20*MUST*
X$!`09`09be`20defined`20at`20runtime`20so`20that`20the`20applications`20can`20f
Vind`20the
X$!`09`09shared`20image,`20so`20it`20is`20best`20to`20have`20it`20defined`20on
V`20a
X$!`09`09system-wide`20basis.
X$!
X$!`09Calling`20Format:
X$!
X$!`09`09@CH_MAKE_SHARED_IMAGE
X$!
X$!`09Formal`20Argument(s):`20NONE
X$!
X$!`09Implicit`20Inputs:`20`20`20`20NONE
X$!`09Implicit`20Outputs:`20`20`20NONE
X$!`09Side`20Effects:`20`20`20`20`20`20`20NONE
X$!
X$!----------------------------------------------------------------------------
V--
X$!
X$`20fortran`20fch_condition_handler,sch_set_exithandler,sch_exit_handler
X$`20macro`20ch_transfer_vectors
X$`20link/notraceback/share=ch_shared_image`20-
X`09ch_transfer_vectors,-
X`09fch_condition_handler,sch_set_exithandler,sch_exit_handler,-
X`09sys$input/options
X`09gsmatch=always,0,0
X$`20delete`20*.obj;*
X$!
X$!`20---`09To`20install`20the`20condition`20handler,`20uncomment`20the`20follo
Vwing
X$!`20---`09statements.`20`20The`20condition`20handler`20uses`203`20global`20se
Vctions,
X$!`20---`094`20global`20pages,`20and`20requires`20CMKRNL`20privilege.
X$!
X$!install`20create/open/shared/header`20ch_shared_image
X$`20exit
$ call unpack CH_MAKE_SHARED_IMAGE.COM;1 1013854912 ""
$!
$ create 'f'
X;`09CH_TRANSFER_VECTORS.MAR
X;++
X;`09Author:`20`20Steve`20Rosenstein
X;
X;`09Creation`20Date:`20`2001-OCT-1988
X;
X;`09Modification`20History:
X;
X;`09Functional`20Description:
X;
X;`09`09This`20procedure`20creates`20the`20transfer`20vectors`20that`20allow
V`20the
X;`09`09condition`20handler`20shared`20image`20to`20be`20linker`20independent.
X;
X;`09Calling`20Format:`20`20`20`20`20NONE
X;
X;`09Formal`20Argument(s):`20NONE
X;
X;`09Implicit`20Inputs:`20`20`20`20NONE
X;`09Implicit`20Outputs:`20`20`20NONE
X;`09Side`20Effects:`20`20`20`20`20`20`20NONE
X;
X;-----------------------------------------------------------------------------
V--
X;
X`09.macro`09`09xfer`09`09module
X`09.transfer`09module
X`09.mask`09`09module
X`09jmp`09`09l`5Emodule+2
X`09.endm
X;
X`09.psect`09`09condition_handler_xfr,nowrt,exe
X`09xfer`09`09FCH_CONDITION_HANDLER
X`09xfer`09`09SCH_SET_EXITHANDLER
X`09.end
$ call unpack CH_TRANSFER_VECTORS.MAR;1 1598982969 ""
$!
$ create 'f'
X`09integer*4`20function`20fch_condition_handler(j_sigargs,j_mechargs)
X!++
X!`09Author:`20`20Steve`20Rosenstein
X!
X!`09Creation`20Date:`20`2001-OCT-1988
X!
X!`09Modification`20History:
X!
X!`09Functional`20Description:
X!
X!`09`09This`20procedure`20is`20made`20known`20to`20the`20user's`20process`20as
V`20a`20VMS
X!`09`09Condition`20Handler`20via`20a`20call`20to`20the`20VMS`20Runtime`20Libra
Vry
X!`09`09procedure`20LIB$ESTABLISH.`20`20Control`20is`20passed`20to`20it`20by
V`20the`20VMS
X!`09`09Condition`20Handling`20Facility`20whenever`20an`20exception`20condition
V
X!`09`09is`20signaled.`20`20It`20is`20not`20called`20directly`20by`20any`20appl
Vication
X!`09`09program.
X!
X!`09Calling`20Format:
X!
X!`09`09EXTERNAL`20FCH_CONDITION_HANDLER
X!`09`09CALL`20LIB$ESTABLISH(FCH_CONDITION_HANDLER)
X!
X!`09Formal`20Argument(s):
X!
X!`09`09J_SIGARGS
X!`09`09Type:`20`20`20`20`20`20`20Longword`20array
X!`09`09Access:`20`20`20`20`20Read`20Only
X!`09`09Mechanism:`20`20By`20reference
X!`09`09VMS`20Usage:`20`20Describes`20the`20nature`20of`20the`20exception`20con
Vdition
X!`09`09`09`20`20`20`20to`20the`20Condition`20Handler
X!
X!`09`09J_MECHARGS
X!`09`09Type:`20`20`20`20`20`20`20Longword`20array
X!`09`09Access:`20`20`20`20`20Read/Write
X!`09`09Mechanism:`20`20By`20reference
X!`09`09VMS`20Usage:`20`20Describes`20the`20state`20of`20the`20process`20at`20t
Vhe`20time
X!`09`09`09`20`20`20`20the`20condition`20was`20signaled
X!
X!`09`09FCH_CONDITION_HANDLER
X!`09`09Type:`20`20`20`20`20`20`20Longword`20function`20return`20value
X!`09`09Access:`20`20`20`20`20Write`20Only
X!`09`09Mechanism:`20`20By`20reference
X!`09`09VMS`20Usage:`20`20Passes`20a`20value`20representing`20the`20current`20C
Vondition
X!`09`09`09`20`20`20`20Value`20back`20to`20the`20Condition`20Handling`20Facilit
Vy.
X!
X!`09Implicit`20Inputs:`20`20`20`20NONE
X!
X!`09Implicit`20Outputs:`20`20`20NONE
X!
X!`09Side`20Effects:
X!
X!`09`09Modifies`20the`20way`20the`20Condition`20Handling`20Facility`20continue
Vs
X!`09`09to`20process`20the`20exception`20condition,`20based`20on`20the`20value
X!`09`09returned`20via`20the`20function`20call`20return`20value.`20`20Can`20als
Vo
X!`09`09modify`20the`20value`20returned`20via`20a`20function`20procedure`20call
V.
X!
X!-----------------------------------------------------------------------------
V--
X!
X`09include`09`09'fortran_types.inc/nolist'
X`09include`09`09'($jpidef)/nolist'
X`09include`09`09'($lnmdef)/nolist'
X`09integer*4`09j_sigargs(*)
X`09integer*4`09j_mechargs(*)
X`09character*128`09c_exception_logfile/'`20'/
X`09character*128`09c_imagename
X`09parameter`09(j_unit=99)
X`09character*(*)`09c_null_device
X`09parameter`09(c_null_device='NLA0:')
X`09record/itmlst/getjpi(2)
X`09record/itmlst/crelnm(2)
X!
X!`20---`09Test`20if`20the`20current`20exception`20is`20the`20first`20one`20to
V`20be`20trapped`20(via`20the
X!`20---`09character`20variable`20C_EXCEPTION_LOGFILE`20being`20a`20blank`20str
Vint),`20and`20if
X!`20---`09so,`20do`20all`20exception`20reporting`20initialization`20and`20file
V`20creation.
X!
X`09if`20(c_exception_logfile.eq.'`20')`20then
X`09`09open`20(
X`091`09`09unit=j_unit,
X`091`09`09file='sys$scratch:exception_report.log',
X`091`09`09carriagecontrol='list',
X`091`09`09status='new')
X`09`09inquire`20(unit=j_unit,name=c_exception_logfile)
X`09`09j_exception_logfile_lth=index(c_exception_logfile,'`20')-1
X!
X!`20---`09Create`20the`20logical`20name`20"EXCEPTION_LOGFILE"`20the`20first
V`20time`20an
X!`20---`09exception`20is`20trapped`20by`20the`20condition`20handler.`20`20This
V`20serves`20two
X!`20---`09purposes:`201)`20it's`20existance`20signals`20the`20exit`20handler
V`20that`20an`20exception
X!`20---`09log`20file`20exists`20and`20has`20to`20be`20mailed,`20and`202)`20it
V`20passes`20the`20full`20file
X!`20---`09specification`20of`20the`20exception`20log`20file`20to`20the`20exit
V`20handler.
X!
X`09`09crelnm(1).i_buflen=j_exception_logfile_lth
X`09`09crelnm(1).i_itmcod=lnm$_string
X`09`09crelnm(1).j_bufadr=%loc(c_exception_logfile)
X`09`09crelnm(2).j_endlst=0
X`09`09call`20sys$crelnm(,
X`091`09`09'LNM$PROCESS',
X`091`09`09'EXCEPTION_LOGFILE',,
X`091`09`09crelnm)
X!
X!`20---`09During`20normal`20VMS`20condition`20handling,`20the`20traceback`20in
Vformation`20is
X!`20---`09provided`20to`20SYS$OUTPUT`20and`20SYS$ERROR`20after`20the`20image
V`20exits.`20`20In`20order
X!`20---`09to`20be`20able`20to`20save`20traceback`20information,`20the`20logica
Vl`20name`20SYS$OUTPUT
X!`20---`09is`20re-defined`20to`20be`20the`20exception`20textfile.`20`20The`20l
Vogical`20name`20SYS$ERROR
X!`20---`09is`20re-defined`20to`20be`20the`20null`20device`20(NLA0:)`20to`20inh
Vibit`20output`20to
X!`20---`09the`20screen.
X!
X`09`09crelnm(1).i_buflen=j_exception_logfile_lth
X`09`09crelnm(1).i_itmcod=lnm$_string
X`09`09crelnm(1).j_bufadr=%loc(c_exception_logfile)
X`09`09crelnm(2).j_endlst=0
X`09`09call`20sys$crelnm(,'LNM$PROCESS','SYS$OUTPUT',,crelnm)
X`09`09crelnm(1).i_buflen=len(c_null_device)
X`09`09crelnm(1).i_itmcod=lnm$_string
X`09`09crelnm(1).j_bufadr=%loc(c_null_device)
X`09`09crelnm(2).j_endlst=0
X`09`09call`20sys$crelnm(,'LNM$PROCESS','SYS$ERROR',,crelnm)
X!
X!`20---`09Use`20GETJPI`20to`20obtain`20the`20name`20of`20the`20image`20current
Vly`20signaling`20the
X!`20---`09exception.`20`20Other`20image`20and`20process`20dependent`20informat
Vion`20can`20be
X!`20---`09returned`20and`20made`20a`20part`20of`20the`20exception`20reporting
V`20file`20if`20required.
X!
X`09`09getjpi(1).i_buflen=len(c_imagename)
X`09`09getjpi(1).i_itmcod=jpi$_imagname
X`09`09getjpi(1).j_bufadr=%loc(c_imagename)
X`09`09getjpi(1).j_retlen=%loc(j_imagename_lth)
X`09`09getjpi(2).j_endlst=0
X`09`09call`20sys$getjpiw(,,,getjpi,,,)
X`09`09write`20(j_unit,10100)`20c_imagename(1:j_imagename_lth)
X10100`09`09format(`20'Signaling`20Image:`20',A,/)
X`09`09close`20(unit=j_unit)
X`09endif
X!
X!`20---`09At`20this`20point`20we`20are`20finished`20looking`20at`20the`20condi
Vtion`20value.`20`20We`20want
X!`20---`09to`20re-signal`20the`20condition`20to`20allow`20VMS`20to`20proceed
V`20according`20to`20the
X!`20---`09severity`20of`20the`20exception.
X!
X`09fch_condition_handler=j_sigargs(2)
X`09return
X`09end
$ call unpack FCH_CONDITION_HANDLER.FOR;1 1127768611 ""
$!
$ create 'f'
X`09subroutine`20sch_exit_handler(
X`091`09j_exit_status,
X`091`09b_exception_mailist,
X`091`09j_mailist_len)
X!++
X!`09Author:`20`20Steve`20Rosenstein
X!
X!`09Creation`20Date:`20`2001-OCT-1991
X!
X!`09Modification`20History:
X!
X!`09Functional`20Description:
X!
X!`09`09This`20procedure`20is`20made`20known`20to`20the`20user's`20process`20as
V`20a`20VMS
X!`09`09exit`20handler`20via`20the`20exit`20handler`20control`20block`20created
V`20in
X!`09`09SCH_SET_EXITHANDLER.`20`20If`20any`20exception`20conditions`20are
X!`09`09signaled,`20this`20procedure`20will`20submit`20a`20batch`20job`20that
V`20will
X!`09`09send`20a`20mailgram`20continaing`20exception`20condition`20traceback
X!`09`09information`20to`20the`20accounts`20of`20those`20users`20on`20the`20VAX
Vmail
X!`09`09distribution`20list.
X!
X!`09Calling`20Format:
X!
X!`09`09(Not`20called`20directly`20by`20an`20application,`20but`20made`20known
V`20to
X!`09`09the`20system`20via`20a`20call`20to`20the`20$DCLEXH`20system`20service
V`20in
X!`09`09SCH_SET_EXITHANDLER.)
X!
X!`09Formal`20Argument(s):
X!
X!`09`09J_EXIT_STATUS
X!`09`09Type:`20`20`20`20`20`20`20Longword
X!`09`09Access:`20`20`20`20`20Read`20Only
X!`09`09Mechanism:`20`20By`20reference
X!`20`20`20`20`09`09VMS`20Usage:`20`20Contains`20the`20final`20Condition`20Valu
Ve`20of`20image
X!`09`09`09`20`20`20`20execution`20at`20the`20start`20of`20image`20rundown
X!
X!`09`09B_EXCEPTION_MAILIST
X!`09`09Type:`20`20`20`20`20`20`20Byte`20array
X!`09`09Access:`20`20`20`20`20Read`20Only
X!`09`09Mechanism:`20`20By`20reference
X!`09`09VMS`20Usage:`20`20Contains`20the`20VAXmail`20mail`20distribution`20list
V
X!`09`09`09`20`20`20`20text`20string
X!
X!`09`09J_MAILIST_LEN
X!`09`09Type:`20`20`20`20`20`20`20Longword
X!`09`09Access:`20`20`20`20`20Read`20Only
X!`09`09Mechanism:`20`20By`20reference
X!`09`09VMS`20Usage:`20`20Contains`20the`20length`20(in`20bytes)`20of`20the`20V
VAXmail
X!`09`09`09`20`20`20`20mail`20distribution`20list`20text`20string
X!
X!`09Implicit`20Inputs:`20`20`20`20NONE
X!
X!`09Implicit`20Outputs:`20`20`20NONE
X!
X!`09Side`20Effects:
X!
X!`09`09Modifies`20the`20normal`20functioning`20of`20process`20image`20rundown
X!`09`09by`20receiving`20control`20and`20performing`20additional`20image`20rund
Vown
X!`09`09tasks.
X!
X!-----------------------------------------------------------------------------
V--
X!
X`09include`09`09'fortran_types.inc/nolist'
X`20`09include`09`09'($ssdef)/nolist'
X`09include`09`09'($lnmdef)/nolist'
X`09include`09`09'($sjcdef)/nolist'
X`09byte`09`09b_exception_mailist(j_mailist_len)
X`09record/itmlst/trnlnm(2)
X`09record/itmlst/sndjbc(5)
X`09character*128`09c_exception_logfile
X`09character*128`09c_exception_comfile
X`09character*064`09c_exception_message
X`09character*(*)`09c_queue
X`09parameter`09(c_queue='sys$batch')
X`09parameter`09(j_unit=99)
X!
X!`20---`09The`20exit`20handler`20is`20invoked`20upon`20image`20termination.
V`20`20If`20any`20exceptions
X!`20---`09have`20been`20trapped`20by`20the`20condition`20handler,`20the`20logi
Vcal`20name
X!`20---`09EXCEPTION_LOGFILE`20has`20been`20created`20in`20the`20process`20tabl
Ve.
X!`20---`09If`20the`20logical`20name`20does`20not`20exist,`20it`20is`20assumed
V`20there`20is`20no`20traceback
X!`20---`09information`20to`20be`20mailed.
X!
X`09trnlnm(1).i_buflen=len(c_exception_logfile)
X`09trnlnm(1).i_itmcod=lnm$_string
X`09trnlnm(1).j_bufadr=%loc(c_exception_logfile)
X`09trnlnm(1).j_retlen=%loc(j_txtfile_len)
X`09trnlnm(2).j_endlst=0
X`09j_status=sys$trnlnm(,'LNM$PROCESS','EXCEPTION_LOGFILE',,trnlnm)
X`09if`20(j_status.and.j_status.ne.ss$_nolognam)`20then
X!
X!`20---`09The`20subject`20of`20the`20mail`20message`20will`20be`20the`20Facili
Vty-Severity-Ident`20of
X!`20---`09the`20condition`20value`20at`20image`20termination.`20`20These`20are
V`20obtained`20via`20the
X!`20---`09call`20to`20SYS$GETMSG.
X!
X`09`09call`20sys$getmsg(
X`091`09`09%val(j_exit_status.and.'0fffffff'x),
X`091`09`09i_message_len,
X`091`09`09c_exception_message,
X`091`09`09%val(14),)
X!
X!`20---`09The`20exit`20handler`20creates`20a`20small`20.COM`20file`20containin
Vg`20all`20of`20the
X!`20---`09commands`20necessary`20to`20send`20the`20traceback`20logging`20file
V`20to`20the`20people
X!`20---`09on`20the`20VAXmail`20distribution`20list.`20`20This`20is`20done`20he
Vre.
X!
X`09`09open`20(
X`091`09`09unit=j_unit,
X`091`09`09file='sys$scratch:exception_report.com',
X`091`09`09status='new')
X`09`09inquire`20(unit=j_unit,name=c_exception_comfile)
X`09`09write`20(j_unit,10100)
X`091`09`09c_exception_logfile(1:j_txtfile_len),
X`091`09`09b_exception_mailist,
X`091`09`09c_exception_message(1:i_message_len),
X`091`09`09c_exception_logfile(1:j_txtfile_len)
X10100`09`09format(`09'$`20mail`20',a,'`20-',/,
X`091`09`09'`20`20',<j_mailist_len>a1,'/sub="',a,'"',/,
X`091`09`09'$`20delete`20',a,/,
X`091`09`09'$`20exit')
X`09`09close`20(unit=j_unit)
X!
X!`20---`09Submit`20the`20command`20procedure`20created`20above`20to`20the`20ba
Vtch`20queue`20named
X!`20---`09in`20C_QUEUE`20(in`20our`20case,`20SYS$BATCH).
X!
X`09`09sndjbc(1).i_buflen=len(c_queue)
X`09`09sndjbc(1).i_itmcod=sjc$_queue
X`09`09sndjbc(1).j_bufadr=%loc(c_queue)
X`09`09sndjbc(2).i_buflen=len(c_exception_comfile)
X`09`09sndjbc(2).i_itmcod=sjc$_file_specification
X`09`09sndjbc(2).j_bufadr=%loc(c_exception_comfile)
X`09`09sndjbc(3).i_itmcod=sjc$_no_log_specification
X`09`09sndjbc(4).i_itmcod=sjc$_delete_file
X`09`09sndjbc(5).j_endlst=0
X`09`09j_status=sys$sndjbcw(,%val(sjc$_enter_file),,sndjbc,,,)
X`09endif
X`09return
X`09end
$ call unpack SCH_EXIT_HANDLER.FOR;1 863721149 ""
$!
$ create 'f'
X`09subroutine`20sch_set_exithandler(c_exception_mailist)
X!++
X!`09Author:`20`20Steve`20Rosenstein
X!
X!`09Creation`20Date:`20`2001-OCT-1988
X!
X!`09Modification`20History:
X!
X!`09Functional`20Description:
X!
X!`09`09This`20procedure`20sets`20up`20the`20control`20block`20for`20the`20fina
Vl`20exit
X!`09`09handler.`20`20It`20also`20accepts`20the`20mail`20distribution`20list
V`20from
X!`09`09the`20main`20program.`20`20This`20list`20can`20be`20in`20any`20form`20v
Valid`20to`20the
X!`09`09VMS`20MAIL`20facility.`20`20It`20can`20either`20be`20the`20actual`20nam
Ve(s)`20of
X!`09`09the`20users,`20a`20VAXmail`20distribution`20list`20(@xxxx.DIS),`20or
V`20a
X!`09`09logical`20name`20containing`20any`20of`20the`20above.`20`20An`20example
V`20of`20a
X!`09`09system-wide`20logical`20containing`20the`20names`20of`20the`20programme
Vrs
X!`09`09responsible`20for`20maintaining`20the`20application`20programs`20is:
X!
X!`09`09`20`20`20`20DEFINE/SYSTEM`20CH_MAIL_DIST`20"ROSENSTEIN,AHDERS,FLICKER"
X!
X!`09`09"CH_MAIL_DIST"`20would`20be`20used`20as`20the`20input`20argument`20into
V
X!`09`09CH_SET_EXITHANDLER.`20`20The`20quotes`20around`20the`20list`20of`20name
Vs`20is
X!`09`09required`20so`20that`20they`20are`20not`20taken`20to`20be`20elements
V`20of`20the
X!`09`09logical.`20`20It`20is`20suggested`20that`20logicals`20be`20used,`20so
V`20the`20mail
X!`09`09distribution`20scheme`20can`20be`20changed`20without`20requiring`20any
X!`09`09modifications`20to`20the`20actual`20application`20program.`20`20This
X!`09`09subroutine`20must`20be`20called`20before`20any`20additional`20exit
X!`09`09handlers`20are`20declared.
X!
X!`09Calling`20Format:
X!
X!`09`09CALL`20SCH_SET_EXITHANDLER(C_EXCEPTION_MAILLIST)
X!
X!`09Formal`20Argument(s):
X!
X!`09`09C_EXCEPTION_MAILLIST
X!`09`09Type:`20`20`20`20`20`20`20Character`20string
X!`09`09Access:`20`20`20`20`20Read`20Only
X!`09`09Mechanism:`20`20By`20descriptor
X!`09`09VMS`20Usage:`20`20Passes`20the`20VAXmail`20distribution`20list`20into
V`20the
X!`09`09`09`20`20`20`20exit`20handler
X!
X!`09Implicit`20Inputs:`20`20`20`20NONE
X!
X!`09Implicit`20Outputs:`20`20`20NONE
X!
X!`09Side`20Effects:
X!
X!`09`09Modifies`20the`20normal`20functioning`20of`20process`20image`20rundown
X!`09`09by`20making`20an`20exit`20handler`20known`20to`20the`20system.
X!
X!-----------------------------------------------------------------------------
V--
X!
X`09include`09`09'fortran_types.inc/nolist'
X`20`20`09character*(*)`09c_exception_mailist
X`09external`09sch_exit_handler
X!
X!`20---`09Set`20up`20the`20exit`20handler`20control`20block
X!
X`09integer*4`20j_exit_ctrlblk(6)/
X`091`090,`09!`20Forward`20link`20(used`20by`20VMS)
X`091`090,`09!`20Exit`20handler`20address`20(set`20by`20%LOC(SCH_EXIT_HANDLER))
V
X`091`093,`09!`20Number`20of`20exit`20handler`20arguments
X`091`090,`09!`20Status`20longword`20address`20(set`20by`20%LOC(J_EXIT_STATUS))
V
X`091`090,`09!`20Mail`20distribution`20list`20character`20string`20array
X`091`090/`09!`20Mail`20distribution`20list`20character`20string`20length
X!
X!`20---`09Establish`20the`20exit`20handler
X!
X`09j_len=index(c_exception_mailist//'`20','`20')-1
X`09j_exit_ctrlblk(2)=%loc(sch_exit_handler)
X`09j_exit_ctrlblk(4)=%loc(j_exit_status)
X`09j_exit_ctrlblk(5)=%loc(c_exception_mailist)
X`09j_exit_ctrlblk(6)=%loc(j_len)
X`09call`20sys$dclexh(j_exit_ctrlblk)
X`09return
X`09end
$ call unpack SCH_SET_EXITHANDLER.FOR;1 40509138 ""
$ v=f$verify(v)
$ exit