Trailing-Edge
-
PDP-10 Archives
-
DEC_CMS-20_V1.0_SRC
-
cms/sources/except.bli
There are no other files named except.bli in the archive.
MODULE except (
IDENT = '1',
%if
%bliss(bliss32)
%then
language(bliss32),
addressing_mode(external=long_relative,
nonexternal=long_relative)
%else
language(bliss36)
%fi
) =
BEGIN
!
! COPYRIGHT (c) 1982 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY: CMS Library Processor
!
!
! ABSTRACT:
!
! This module handles the exception and exit handling
! and processing.
!
! ENVIRONMENT: VAX/VMS, DS-20, TOPS-10
!
!
! AUTHOR: R. Wheater CREATION DATE: 19-Aug-80
!
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
batrun, ! determine if CMS in batch
cmsext, ! exception handler
%if %bliss(bliss32) %then
exit_hndlr,
%fi
%if %bliss(bliss36) %then
retctr:novalue, ! return control to user
%fi
set_exit;
!
! INCLUDE FILES:
!
%if %bliss(bliss32) %then
library 'SYS$LIBRARY:STARLET' ;
%fi
%if %bliss(bliss36) %then
require 'JSYS:';
%fi
library 'XPORT:';
require 'BLISSX:';
require 'HOSUSR:';
require 'RBUSR:';
require 'CNCUSR:';
!
! MACROS:
!
%if %bliss(bliss36) %then
macro
wrterm(s) = (
! this macro writes a message to the terminal
! the input (s) is a quoted string
bind
outstr = uplit(%string(s,%char(13,10,00))) ;
psout(outstr) ; ) % ;
%fi
%if %bliss(bliss32) %then
macro
exit_link = 0,0,32,0 %,
exit_adr = 1,0,32,0 %,
exit_arg_cnt= 2,0,32,0 %,
exit_reason_adr = 3,0,32,0 %,
ex_blk_siz = 4 %;
%fi
!
! EQUATED SYMBOLS:
!
%IF %BLISS(BLISS36) %THEN
literal
chnmsk = %o'200107000000' ; ! channel 1,11,15,16,17
%fi
!
! OWN STORAGE:
!
%if %bliss(bliss32) %then
own
exit_block : block[ex_blk_siz], ! exit handler control block
exit_reason, ! exit handler reason for entering
status; ! return status from system service
%fi
%if %bliss(bliss36) %then
! definitions for tables
field
part_wds =
set
fw = [0,36,0], ! fullword value
lhw = [18,18,0], ! left half word
rhw = [0,18,0] ! right half word
tes;
external routine
dispat, ! macro interrupt dispatcher for CTRL/C
derfil, ! error file entrypoint
illmre, ! illegal memory read entrypoint
illins, ! illegal instruction entrypoint
illmwr; ! illegal memory write entrypoint
own
! save PC area
pc1 ,
! declare level table
levtab: block[3] field(part_wds) preset( [0,lhw] = 0,
[0,rhw] = pc1, ! allow level one only
[1,fw] = 0,
[2,fw] = 0 ) ,
! declare channel table
chntab: block[36] field(part_wds) preset( [0,fw] = 0,
[1,lhw] = 1,
[1,rhw] = dispat,
[2,fw] = 0,
[3,fw] = 0,
[4,fw] = 0,
[5,fw] = 0,
[6,fw] = 0,
[7,fw] = 0,
[8,fw] = 0,
[9,fw] = 0,
[10,fw] = 0,
[11,lhw] = 1,
[11,rhw] = derfil,
[12,fw] = 0,
[13,fw] = 0,
[14,fw] = 0,
[15,lhw] = 1,
[15,rhw] = illins,
[16,lhw] = 1,
[16,rhw] = illmre,
[17,lhw] = 1,
[17,rhw] = illmwr,
[18,fw] = 0,
[19,fw] = 0,
[20,fw] = 0,
[21,fw] = 0,
[22,fw] = 0,
[23,fw] = 0,
[24,fw] = 0,
[25,fw] = 0,
[26,fw] = 0,
[27,fw] = 0,
[28,fw] = 0,
[29,fw] = 0,
[30,fw] = 0,
[31,fw] = 0,
[32,fw] = 0,
[33,fw] = 0,
[34,fw] = 0,
[35,fw] = 0);
%fi
!
! EXTERNAL REFERENCES:
!
external
f_rb_clspd, ! committed roll back pending(ROLBCK)
f_rb_in_progress, ! Roll Back in progress(ROLBCK)
f_rb_pending; ! Roll Back pending(ROLBCK)
external literal
s_Ccancldit, !command cancelled by CNTRL C
s_enablCno, !unable to enable CNTRL C AST
s_rbfail; !rollback failure
external routine
badbug, ! print bug message with no rolbck(ERRMSG)
bug, ! print bug message (ERRMSG)
err,
ers,
exits, ! exit image(SYSOPS)
librea, ! library is readable(SHARE)
%if %bliss(bliss32) %then
lib$put_output : addressing_mode(general), ! write to sys$output
%fi
nowtrn, ! in tranaction (TRANSA)
numtrn, ! number of tranactions done(TRANSA)
%if %switches(debug) %then
yes, ! **** debug *****
%fi
rbmain, ! Command Roll Back(ROLBCK)
%if %bliss(bliss32) %then
sys$cli, ! command language interface routine
sys$getjpi:addressing_mode(absolute) ,
! get job process information
%fi
sysmsg; ! output standard messages
GLOBAL ROUTINE batrun =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine determines if image in currently running in Batch.
!
! FORMAL PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = batch run.
! false = not a batch run.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
own
f_flag_valid : initial(false), ! flag to indicate if f_batch has been set yet
f_batch; ! set to true if batch job, false for interactive
!+
! This routine may be called many times during the processing of a
! single CMS command. To optimize, the batch/interactive status
! is saved after the first call and used for all subsequent calls.
!-
if .f_flag_valid then ! if BATCH/INTERACTIVE status has already
return .f_batch; ! been determined then return it
!+
! First time through, determine batch/interactive status via
! system dependent methods.
!-
%if %bliss(bliss32) %then
begin
own
term_len: initial(0), ! lenght of terminal id string
term_name: vector[7,byte] ; ! terminal id string
own
itemlist: vector[4]
initial(jpi$_terminal^16+7,term_name,term_len,0) ;
! get process info - terminal id string
status = sys$getjpi(0,0,0,itemlist,0,0,0) ;
if .status neq ss$_normal
then
bug(cat('Unable to get terminal id string for batch test')) ;
! terminal string id length = 0 means batch
f_batch = .term_len eql 0;
end;
%fi
%if %bliss(bliss36) %then
begin
local
! getji input date
jobid: block[1], ! job id
blklen: block[1], ! block len + address
offset: block[1], ! offset in table
! getji return info
jiretn: block[1] ; ! batch info
! ask for current job info
jobid = -1 ;
! set up length and address for return value from getji
blklen[lh] = -1 ;
blklen[rh] = jiretn ; ! set to -1 if batch job
! set up offset for batch entry
offset = $jibat ;
! get job information
if
not getji(.jobid,.blklen,.offset)
then
wrterm('Failure to get job information for batch test' );
f_batch = .jiretn eql -1;
end;
%fi
f_flag_valid = true; ! set flag so subsequent calls are fast
return .f_batch;
END; ! end of routine batrun
ROUTINE do_rb_checking : novalue =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! See if roll back is pending and fire it up if required. Inform
! user of roll back action.
!
!
! FORMAL PARAMETERS:
!
! none
!
! IMPLICIT INPUTS:
!
! f_rb_pending, f_rb_in_progress, f_rb_clspd - used to determine
! the current state of CMS.
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! none
!
! SIDE EFFECTS:
!
! Roll Back may be initiated, and all files closed.
!
!--
begin
local
rb_stat ;
! check for interrupt at the exact instant of the startup of rolbck
IF .f_rb_pending and .f_rb_in_progress
THEN
! force flags to correct setting
f_rb_pending = 0 ;
! find out if rolbck in progress
IF .f_rb_in_progress
THEN
badbug(lit('Fatal error occurred in Command Roll Back (CMSEXT)'))
ELSE
BEGIN ! rb not in progress
IF .f_rb_pending or .f_rb_clspd
THEN
rbmain(k_from_ctrlc)
ELSE
sysmsg(s_ccancldit,lit('Command canceled'),0) ;
END; ! rb not in progress
end; !(of do_rb_checking)
%if %bliss(bliss32) %then
GLOBAL ROUTINE cmsext(sig,mech,enabl) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This is the exception handler for CMS on VAX/VMS. It handles
! the system dependent stuff and calls do_rb_checking to do
! common stuff.
!
!
! FORMAL PARAMETERS:
!
! sig -
! mech -
! enabl -
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!
!
! SIDE EFFECTS:
!
!
!
!--
BEGIN
map
sig: ref vector;
bind
cond = sig[1] ;
! check for access violation during ROLBCK
IF .f_rb_in_progress and not (.f_rb_pending or .f_rb_clspd)
THEN
BEGIN ! fatal error
err(s_rbfail,lit('Severe error during Command Roll Back (CMSEXT)')) ;
!make sure ctrl/y is still there
enable_ctl_y ;
return ss$_resignal ;
END; ! fatal error
do_rb_checking();
! make sure ctrl/y is still there
enable_ctl_y ;
! resignal
ss$_resignal
END; ! end of routine cmsext
%fi
%if %bliss(bliss36) %then
GLOBAL ROUTINE cmsext(channel) =
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This is the exception handler for CMS on TOPS-20. It handles
! the system dependent stuff and calls do_rb_checking to do
! common stuff. It is called from module CTRLC.M36 which is needed
! to determine the channel number.
!
!
! FORMAL PARAMETERS:
!
! channel - the bit set in this word is the channel on which the
! interrupt occured.
!
! IMPLICIT INPUTS:
!
!
!
! IMPLICIT OUTPUTS:
!
!
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!
!
! SIDE EFFECTS:
!
!
!
!--
BEGIN
! force error messages to start on new line
wrterm();
! check for access violation during ROLBCK
IF .f_rb_in_progress and not (.f_rb_pending or .f_rb_clspd)
THEN
err(s_rbfail,lit('Severe error during Command Roll Back (CMSEXT)'))
ELSE
BEGIN
do_rb_checking();
END;
IF .channel NEQ M_CtrlC_Chn
THEN
BEGIN
dic($fhslf,.channel); ! deactivate channels (ignore all except panic channels)
iic($fhslf,.channel); ! initiate interrupt to get traceback
END
ELSE
retctr();
true !(for compatability)
END; ! end of routine cmsext
%fi
%if %bliss(bliss32) %then
ROUTINE exit_hndlr =
!++
! FUNCTIONAL DESCRIPTION:
!
! Exit handling comes here
!
! FORMAL PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! EXIT_REASON contains the reason for coming here
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! None.
!
! SIDE EFFECTS:
!
! None.
!
!--
begin
!if this is a forced exit, then see if rollback or special
! processing is required.
if
.exit_reason eql ss$_clifrcext
then
BEGIN
local
rb_stat;
! find out if rolbck in progress
IF .f_rb_in_progress
THEN
badbug(lit('Fatal error occurred in Command Roll Back (EXIT_HNDLR)'))
ELSE
BEGIN ! rb not in progress
IF .f_rb_pending or .f_rb_clspd
THEN
BEGIN ! rolbck required
local
ret_status;
! invoke rolbck and print status message
ret_status = rbmain(k_from_ctrlc);
! exit image
enable_ctl_y ;
exits(.ret_status) ! **** Image exit ****
END ! rolbck required
else
begin ! exit without rolbck
sysmsg(s_Ccancldit,lit('Command canceled'),0) ;
enable_ctl_y;
exits(s_ccancldit)
end ! exit without rolback
END; ! rb not in progress
true !(keep BLISS happy; suppress null-expr info message)
end
else
begin
!make sure ctrl/y is still there
enable_ctl_y ;
.exit_reason
end
end; !End of EXIT_HNDLR
%fi
GLOBAL ROUTINE set_exit =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will register the exit handling routine.
!
! FORMAL PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! true = successful completion
! false = unsuccessful
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
%if %bliss(bliss36) %then
own
sirinp: block[1] ; ! input parameter to sir call
!set up channel table and priority table address for sir call
sirinp[lh] = levtab ;
sirinp[rh] = chntab ;
! register tables with interrupt system
sir($fhslf,.sirinp) ;
! enable (user) software interrupt system
eir($fhslf) ;
! activate the interrupt system for channels 1,11,15,16,17
aic($fhslf,chnmsk) ;
! assign terminal code - CTRL/C --> channel 1 (only if interactive)
if not batrun()
then
ati(hwf($ticcc,1));
%fi
%if %bliss(bliss32) %then
own
len: word; ! length of logical device string
!set up the exit handler
exit_block[exit_link]=0;
exit_block[exit_adr]=exit_hndlr;
exit_block[exit_arg_cnt]=1;
exit_block[exit_reason_adr]=exit_reason;
$dclexh(desblk=exit_block);
exit_reason=0;
%fi
! normal completion
true
END; ! end of routine set_exit
%if %bliss(bliss36) %then
GLOBAL ROUTINE retctr : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine prints the message for continuation and returns to the
! command level.
!
! FORMAL PARAMETERS:
!
! None.
!
! IMPLICIT INPUTS:
!
! None.
!
! IMPLICIT OUTPUTS:
!
! None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
! This routine returns to command level.
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
%if %switches(tops20) %then
! return to command level
repeat ! HALT again if user types CONTINUE
haltf() ;
%else
! return to command level
UUO(0,EXIT(1));
%fi
END; ! end of routine retctr
%fi
END ! End of module
ELUDOM