Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/t20sys.bli
There are 10 other files named t20sys.bli in the archive. Click here to see a list.
%TITLE 'T20SYS - TOPS20 system specific storage'
MODULE T20SYS ( ! TOPS20 system specific storage
IDENT = '1-007' ! File: T20SYS.B36 Edit: GB1007
) =
BEGIN
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1988. ALL RIGHTS RESERVED.
!
!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 THAT IS NOT SUPPLIED BY DIGITAL.
!
!
!++
! FACILITY: EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
! This module contains system specific code for the TOPS20
! environment.
!
! ENVIRONMENT: TOPS20 only
!
! AUTHOR: Graham Beech, CREATION DATE: January 12, 1982
!
! MODIFIED BY:
!
! 1-001 - Add EDT$$GET_LOGDIR so that login directory is also searched
! for startup command files. CJG 7-Oct-1983
! 1-002 - Add call to EDT$$DEA_ALLMEM to deallocate all memory. CJG 11-Oct-1983
! 1-003 - Make EDT$$SYS_EXI return a status to the superior fork. CJG 8-Nov-1983
! 1-004 - Move interrupt code to this module (from IOMOD) and fix up the
! timer interrupt for the working message. CJG 24-Nov-1983
! 1-005 - Fix up control-C handling so it works in line mode. CJG 5-Jan-1984
! 1-006 - Trap over quota in an AST and give appropriate message etc. GB 30-Jul-1984
! 1-007 - Fix over quota handling in line mode. GB 15-Oct-1984
!--
%SBTTL 'Declarations'
!
! AST LINKAGE
!
LINKAGE
AST_LINKAGE = PUSHJ : LINKAGE_REGS (15, 14, 4)
PRESERVE (0, 1, 2, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13);
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
LIBRARY 'EDTSRC:KEYPADDEF';
LIBRARY 'EDTSRC:SUPPORTS';
FORWARD ROUTINE
EDT$$GET_LOGDIR : NOVALUE,
EDT$$INTER_ERR : NOVALUE,
EDT$$SYS_EXI : NOVALUE,
EDT$$GET_DATE : NOVALUE,
EDT$$DEA_ALLHEAP : NOVALUE,
EDT$$START_WKINGMSG : NOVALUE,
EDT$$STOP_WKINGMSG : NOVALUE,
EDT$$INT_CONTROL,
CC_ISR : NOVALUE,
CC_AST : AST_LINKAGE NOVALUE,
OVRQTA_ISR : NOVALUE,
OVRQTA_AST : AST_LINKAGE NOVALUE,
TIMER_ISR : NOVALUE,
TIMER_AST : AST_LINKAGE NOVALUE;
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
REQUIRE 'SYS:JSYS';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
! NONE
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
EDT$$CAN_KDEF,
EDT$$TI_WRSTR,
EDT$$FMT_STR,
EDT$$FMT_CRLF,
EDT$$OUT_FMTBUF,
EDT$$SC_ERATOEOL,
EDT$$SC_POSCSIF,
EDT$$SC_INIT,
EDT$$SC_RESET,
EDT$$TI_WRLN : NOVALUE,
EDT$$TI_RES,
EDT$$TI_OPN,
EDT$$DEA_HEAP : NOVALUE,
DEAMEM : NOVALUE,
EDT$$MSG_TOSTR : NOVALUE;
EXTERNAL
EDIT_MOD,
FST_AVLN,
FST_SCRPTR,
TRN_TBL : VECTOR,
US_TXT : VECTOR,
US_ENT : VECTOR,
MESSAGE_LINE,
FMT_WRRUT,
WORKCOUNT,
SCR_CHGD,
SECOND : VOLATILE,
BUF_LST,
TI_RESET,
TT_OPEN,
TXT_ONSCR,
CC_WAIT,
CC : VOLATILE;
LITERAL
CHUNK_SIZE = 16,
MAP_SIZE = 256*512/CHUNK_SIZE;
MESSAGES ((COMFILNOP, NOJNLFIL, CTRC__IGN, INPFILCLO, JOUFILCLO, COMFILCLO,
EDITORABO, WRKFILOVF))
GLOBAL
HDEF_NAM : BLOCK [1] PRESET ([DSC$W_LENGTH] = 15,
[DSC$A_POINTER] = UPLIT (%ASCIZ 'HLP:EDTHELP.HLB')),
HELP_DFLT : VECTOR [DSC$K_SIZE] INITIAL (
0,
0,
CH$PTR (UPLIT (%ASCIZ 'HLP')),
0,
CH$PTR (UPLIT (%ASCIZ 'EDTHELP')),
CH$PTR (UPLIT (%ASCIZ 'HLB'))),
CMD_NAM_DEF1 : BLOCK [1] PRESET ([DSC$W_LENGTH] = 14,
[DSC$A_POINTER] = UPLIT (%ASCIZ 'SYS:EDTSYS.EDT')),
CMD_NAM_DEF2 : BLOCK [1] PRESET ([DSC$W_LENGTH] = 10,
[DSC$A_POINTER] = UPLIT (%ASCIZ 'EDTINI.EDT')),
CMD_DFLT : VECTOR [DSC$K_SIZE] INITIAL (
0,
0,
0,
0,
CH$PTR (UPLIT (%ASCIZ 'EDTINI')),
CH$PTR (UPLIT (%ASCIZ 'EDT')));
OWN
MAP_BUILT,
FIRST_FREE,
MEM_USE : INITIAL (0),
MEMORY_MAP : BITVECTOR [MAP_SIZE];
%SBTTL 'EDT$$GET_LOGDIR - Get login directory and device'
GLOBAL ROUTINE EDT$$GET_LOGDIR ( ! Get login directory and device
SOURCE : REF BLOCK, ! Address of source block
DEST : REF BLOCK ) : NOVALUE = ! Destination block address
!++
! FUNCTIONAL SPECIFICATION:
!
! This routine takes the file name and type from the source
! block, and places these together with the login device
! and directory into the destination block. This is used
! in searching for the startup command file.
!
! FORMAL PARAMETERS:
!
! SOURCE Source block address
! DEST Destination block address
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MESSAGES ((INSMEM));
EXTERNAL ROUTINE
EDT$$FMT_MSG,
EDT$$ALO_HEAP; ! Allocate memory for the string
LOCAL
TEMP_PTR,
TEMP_LEN,
DIR_NO,
DIR_ADR;
!
! Get the login directory number and convert it to a string.
!
_GETJI (-1, FLD (-1,FLD_LHS) + FLD (DIR_NO,FLD_RHS), $JILNO);
IF NOT EDT$$ALO_HEAP (%REF (80), DIR_ADR)
THEN
BEGIN
EDT$$FMT_MSG (EDT$_INSMEM);
RETURN;
END;
DIR_ADR = CH$PTR (.DIR_ADR);
_DIRST (.DIR_ADR, .DIR_NO; TEMP_PTR);
!
! Now copy the filespec defaults from the source and fill in the rest
!
TEMP_LEN = CH$DIFF (.TEMP_PTR, .DIR_ADR);
DEST [DSC$L_DESC] = 0;
DEST [DSC$A_FNAME] = .SOURCE [DSC$A_FNAME];
DEST [DSC$A_FEXTN] = .SOURCE [DSC$A_FEXTN];
DEST [DSC$A_DEVICE] = .DIR_ADR;
TEMP_PTR = CH$FIND_CH (.TEMP_LEN, .DIR_ADR, %C':');
CH$WCHAR_A (0, TEMP_PTR);
DEST [DSC$A_DIRECT] = CH$PLUS (.TEMP_PTR, 1);
TEMP_PTR = CH$FIND_CH (.TEMP_LEN, .DIR_ADR, %C'>');
CH$WCHAR_A (0, TEMP_PTR);
END;
%SBTTL 'EDT$$INTER_ERR - internal error'
GLOBAL ROUTINE EDT$$INTER_ERR ( ! Internal error
CODE ! Error number
) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! If an internal error is detected in EDT, come here to
! print a cryptic error code and bail out.
!
! FORMAL PARAMETERS:
!
! CODE The error code number
!
! IMPLICIT INPUTS:
!
! MESSAGE
!
! IMPLICIT OUTPUTS:
!
! MESSAGE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! Never returns to its caller.
!
!--
BEGIN
!+
! Output the code and address. This is done directly with JSYS's because
! we have no octal output routine, nor can we trust the output routines.
!-
_PSOUT (CH$PTR (UPLIT (%ASCIZ 'Internal error detected - code : ')));
_NOUT ($PRIOU, .CODE, 10);
_PSOUT (CH$PTR (UPLIT (%ASCIZ ' at address : ')));
_NOUT ($PRIOU, (.(CODE + 1) - 1) AND %O'777777', 8);
_PSOUT (CH$PTR (UPLIT (%CHAR (ASC_K_CR, ASC_K_LF, 0))));
EDT$$SYS_EXI (EDT$_EDITORABO);
END;
%SBTTL 'EDT$$SYS_EXI - exit back to the operating system'
GLOBAL ROUTINE EDT$$SYS_EXI ( ! Exit back to the operating system
STATUS ! Exit status code
) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Final clean-up
!
! FORMAL PARAMETERS:
!
! STATUS Exit status code.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! Deallocates all heap memory and returns the status to the
! superior fork.
!
!--
BEGIN
OWN
PRARG_BLK : VECTOR [3] INITIAL (1, %O'400740000002', 0);
EXTERNAL
EXE_CURCMD : REF NODE_BLOCK; ! Current command pointer
LOCAL
CMD : REF NODE_BLOCK; ! A local pointer
EDT$$DEA_ALLHEAP ();
!+
! If the status is non-zero then don't look for EXIT/GO
!-
IF (.STATUS EQL 0)
THEN
BEGIN
!+
! If the command was EXIT/GO, then tell EXEC about it.
!-
IF ((.EXE_CURCMD [NODE_TYPE] EQL COM_NODE)
AND (.EXE_CURCMD [COM_NUM] EQL COM_EXIT)) THEN
BEGIN
CMD = .EXE_CURCMD [SWITS];
WHILE 1 DO
BEGIN
!+
! Search the command nodes for /GO.
!-
IF (.CMD NEQ 0)
THEN
IF ((.CMD [SW_BITS] AND OPT_GO) NEQ 0)
THEN
EXITLOOP
ELSE
CMD = .CMD [SWITS]
ELSE
EXITLOOP;
END;
IF (.CMD NEQ 0) THEN
_PRARG (FLD ($PRAST,FLD_LHS) + $FHSLF, PRARG_BLK, 3);
END;
END;
!+
! Get a status code to return to the superior fork.
!-
CMD = (SELECTONE .STATUS OF
SET
[0] : 0; ! Good return
[EDT$_EDITORABO] : 2; ! Internal abort
[EDT$_COMFILNOP] : 3; ! No command file
[EDT$_NOJNLFIL] : 4; ! Journal file not open
[-1] : 5; ! /NOCREATE and file not found
[EDT$_INPFILCLO] : 6; ! Input file not closed
[EDT$_COMFILCLO] : 7; ! Command file not closed
[EDT$_JOUFILCLO] : 8; ! Journal file not closed
[EDT$_WRKFILOVF] : 9; ! Work file overflowed
[EDT$_CTRC__IGN] : 10; ! Recovery aborted
TES);
!+
! Watch out for user typing continue
!-
WHILE 1 DO _HALTF (.CMD);
END;
%SBTTL 'EDT$$GET_DATE - return the date as an ASCII string'
GLOBAL ROUTINE EDT$$GET_DATE ( ! Return the date as an ASCII string
LEN, ! Length of the buffer to return the date in
BUFFER ! Address of the buffer
) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Return the date and time as an ASCII string.
!
! FORMAL PARAMETERS:
!
! LEN Length of the buffer in which the date is returned
!
! BUFFER Address of that buffer.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
LOCAL
STRING_PTR;
!
! Get Date & time from system
!
STRING_PTR = CH$PTR (.BUFFER,, BYTE_SIZE);
CH$WCHAR_A (%C' ', STRING_PTR); ! begin with a space
_ODTIM (.STRING_PTR, -1, 0; STRING_PTR);
CH$WCHAR_A (%C' ', STRING_PTR); ! and end with a space
IF CH$RCHAR (CH$PTR (.BUFFER, 1, BYTE_SIZE)) EQL %C' '
THEN
BEGIN
CH$MOVE (18, CH$PTR (.BUFFER, 2, BYTE_SIZE),
CH$PTR (.BUFFER, 1, BYTE_SIZE)); ! shift left one space
.LEN = 19;
END
ELSE
.LEN = 20;
END;
%SBTTL 'EDT$$DEA_ALLHEAP - Deallocate all memory'
GLOBAL ROUTINE EDT$$DEA_ALLHEAP ! Deallocate all memory
: NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Deallocate all memory which was allocated for the screen database,
! buffer headers, entities, and key definitions.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! Frees up memory.
!--
BEGIN
!
!EXTERNAL REFERENCES
!
LOCAL
NEW_PTR : REF SCREEN_LINE,
NEW_BUF : REF TBCB_BLOCK,
LEN;
!+
! Deallocate all buffer headers
!-
NEW_BUF = .BUF_LST;
WHILE .NEW_BUF NEQ 0 DO
BEGIN
LEN = .NEW_BUF [TBCB_NAME_LEN] + TBCB_SIZE;
BUF_LST = .NEW_BUF [TBCB_NEXT_BUF];
EDT$$DEA_HEAP (LEN, NEW_BUF);
NEW_BUF = .BUF_LST;
END;
!+
! Deallocate memory used for screen data structure.
!-
NEW_PTR = .FST_SCRPTR;
WHILE (.NEW_PTR NEQA 0) DO
BEGIN
FST_SCRPTR = .NEW_PTR [SCR_NXT_LINE];
EDT$$DEA_HEAP (%REF (SCR_SIZE), NEW_PTR);
NEW_PTR = .FST_SCRPTR;
END;
NEW_PTR = .FST_AVLN;
WHILE (.NEW_PTR NEQA 0) DO
BEGIN
FST_AVLN = .NEW_PTR [SCR_NXT_LINE];
EDT$$DEA_HEAP (%REF (SCR_SIZE), NEW_PTR);
NEW_PTR = .FST_AVLN;
END;
!+
! Deallocate virtual storage allocated for entities
!-
INCR ENT_NUM FROM 0 TO 3 DO
BEGIN
LEN = ..US_ENT [.ENT_NUM];
EDT$$DEA_HEAP (%REF (.LEN + 1), US_ENT [.ENT_NUM] + 1);
END;
INCR TEXT_NUM FROM 0 TO 1 DO
BEGIN
LEN = ..US_TXT [.TEXT_NUM];
EDT$$DEA_HEAP (%REF (.LEN + 1), US_TXT [.TEXT_NUM] + 1);
END;
!+
! Deallocate virtual storage reserved for the key definitions
!-
INCR TBL_PTR FROM 0 TO K_KPAD_HASHSIZ - 1 DO
BEGIN
WHILE (.TRN_TBL [.TBL_PTR] NEQA 0) DO
BEGIN
LOCAL
KEY_PTR : REF BLOCK [] FIELD (KEY_DEF_FIELD);
KEY_PTR = .TRN_TBL [.TBL_PTR];
EDT$$CAN_KDEF (.KEY_PTR [KEY_DEF_KEY]);
END;
END;
DEAMEM ();
END;
%SBTTL 'EDT$$START_WKINGMSG - initiate the "working" timer'
GLOBAL ROUTINE EDT$$START_WKINGMSG ! Initiate the "working" timer
: NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Start the timer which will cause the "working" message
! to print occasionally until it is cancelled.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! WORKING set to zero
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! Starts a one second timer which will cause an interrupt on channel 2.
!-
BEGIN
_TIMER (FLD ($FHSLF, FLD_LHS) + $TIMEL, 1000, 2);
SECOND = 0;
WORKCOUNT = 0;
END;
%SBTTL 'EDT$$STOP_WKINGMSG - cancel the "working" timer'
GLOBAL ROUTINE EDT$$STOP_WKINGMSG ! Cancel the "working" timer
: NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Cancel the "working" timer. The "working" message will not print
! until it is initiated again. Also, erase the working message.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! WORKCOUNT set to -1
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! The timer is stopped.
!--
BEGIN
LOCAL
TEMP,
FORMAT_ROUTINE;
!+
! If the "working" message is not running, then do nothing.
!-
IF (.WORKCOUNT LSS 0) THEN RETURN;
!+
! Stop all timer interrupts up to 2 seconds from now.
!-
_GTAD (;TEMP);
_TIMER (FLD ($FHSLF, FLD_LHS) + $TIMBF, .TEMP + 6, 0);
!+
! Erase the working message when it is stopped if not already done.
!-
FORMAT_ROUTINE = .FMT_WRRUT;
FMT_WRRUT = EDT$$TI_WRSTR;
IF .WORKCOUNT
THEN
BEGIN
EDT$$SC_POSCSIF (.MESSAGE_LINE + 1, 0);
EDT$$SC_ERATOEOL ();
EDT$$OUT_FMTBUF ();
END;
!+
! If "working" was printed, then reposition the cursor to the leftmost
! position of the prompt.
!-
IF (.WORKCOUNT NEQ 0)
THEN
BEGIN
EDT$$SC_POSCSIF (.MESSAGE_LINE + 1, 0);
EDT$$OUT_FMTBUF ();
END;
FMT_WRRUT = .FORMAT_ROUTINE;
WORKCOUNT = -1;
END;
%SBTTL 'EDT$$INT_CONTROL - enable for control C/T traps'
GLOBAL ROUTINE EDT$$INT_CONTROL ( ! Enable for control C/T traps
MODE ) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Enable for control-C or control-T traps. When a control-C is
! intercepted, CC_ISR is called.
!
! FORMAL PARAMETERS:
!
! MODE - one of the following:
! 1 - enable control-C interrupts
! 2 - disable control-C interrupts
! 3 - enable control-T interrupts (stop EXEC seeing it)
! 4 - disable control-T interrupts (let EXEC see it again)
!
! IMPLICIT INPUTS:
!
! FMT_WRRUT
! CTRL_T
!
! IMPLICIT OUTPUTS:
!
! CT
!
! ROUTINE VALUE:
!
! Success = 1, Failure = 0.
!
! SIDE EFFECTS:
!
! Enables or disables interrupts
!
!--
BEGIN
OWN
CHAN2_ADDR, ! Channel 2 interrupt address
LEVEL_TAB : VECTOR [3] ! Interrupt level table
INITIAL (CC, ! Control-C
CHAN2_ADDR, ! Timer and over quota
0),
CHAN_TAB : VECTOR [36] ! Channel table
INITIAL (FLD (1, FLD_LHS) + FLD (CC_ISR, FLD_RHS),
0,
FLD (2, FLD_LHS) + FLD (TIMER_ISR, FLD_RHS),
REP 9 OF (0),
FLD (2, FLD_LHS) + FLD (OVRQTA_ISR, FLD_RHS),
REP 23 OF (0));
LOCAL
TEMP_1,
TEMP_2;
EXTERNAL
FMT_WRRUT, ! Address of terminal O/P
EDT$$TI_WRSTR, ! Possible value of FMT_WRRUT
TXT_ONSCR, ! Text on screen flag
TT_OPEN, ! Terminal opened flag
CTRL_T; ! SET [NO]CONTROL-T flag
LITERAL
CC_CHAN = %O'400000000000', ! ^C channel = 0
TIM_CHAN= %O'100000000000', ! Timer channel = 2
OVRQTA_CHAN= %O'40000000'; ! Over quota channel
CASE .MODE FROM 1 TO 4 OF
SET
[1]: ! Enable ^C interrupt
BEGIN
!+
! Set the interrupt table addresses and enable the system.
! Also activate the timer and over quota interrupt channels.
!-
_SIR ($FHSLF, FLD (LEVEL_TAB, FLD_LHS) + FLD (CHAN_TAB, FLD_RHS));
_EIR ();
_AIC ($FHSLF, TIM_CHAN);
_AIC ($FHSLF, OVRQTA_CHAN);
%IF SUPPORT_CTLC
%THEN
!+
! If we can trap control-C, then assign channel 0 to it, else return 0.
!-
_RPCAP ($FHSLF; TEMP_1, TEMP_2);
IF ((.TEMP_1 AND SC_CTC) EQL 0) THEN RETURN (0);
_EPCAP ($FHSLF, .TEMP_1, .TEMP_2 OR SC_CTC);
_ATI (FLD ($TICCC, FLD_LHS) + 0);
_AIC ($FHSLF, CC_CHAN);
%FI
CC = 0;
END;
[2]: ! Disable ^C interrupt
BEGIN
_DIC ($FHSLF, CC_CHAN);
_DTI ($TICCC);
END;
[3]: ! Enable ^T catcher
!+
! If we are in change mode then either enable interrupts for ^T or just
! stop EXEC seeing it as defined by CTRL_T.
!-
IF (.FMT_WRRUT EQL EDT$$TI_WRSTR)
THEN
IF (.CTRL_T NEQ 0)
THEN
BEGIN ! Stop EXEC seeing ^T
_RTIW ($FHJOB; TEMP_1);
_STIW ($FHJOB, .TEMP_1 AND NOT %O'100000');
END;
[4]: ! Disable ^T interrupts
!+
! If we are in change mode, then stop ^T interrupting or let it be seen
! by EXEC as appropriate.
!-
IF (.FMT_WRRUT EQL EDT$$TI_WRSTR)
THEN
IF (.CTRL_T NEQ 0)
THEN
BEGIN ! Let EXEC see ^T
_RTIW ($FHJOB; TEMP_1);
_STIW ($FHJOB, .TEMP_1 OR %O'100000');
END;
TES;
RETURN (1);
END;
%SBTTL 'CC_ISR - deal with a control-C interrupt'
ROUTINE CC_ISR : NOVALUE = ! Deal with an interrupt
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine simply DEBRK's out of an interrupt. CC has
! already been set by the interrupt mechanism.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
CC_AST ();
_DEBRK ();
END;
%SBTTL 'CC_AST - Process control-c interrupt'
ROUTINE CC_AST: AST_LINKAGE NOVALUE = ! Process interrupt
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called to check if the interrupt occurred in
! user code or in monitor code. If in monitor and EDT was waiting
! for terminal input (CC_WAIT set) then the PC is incremented to
! cause the monitor call to complete.
!
! It must be done this way so that AC's can be saved.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! May abort outstanding terminal I/O.
!
!--
BEGIN
LOCAL
TEMP_1,
TEMP_2;
_RWM ($FHSLF; TEMP_1, TEMP_2);
IF (((.TEMP_2 AND %O'200000') NEQ 0) AND (.CC_WAIT NEQ 0))
THEN
CC = .CC + 1;
END;
%SBTTL 'OVRQTA_ISR - handle over quota interrupt'
ROUTINE OVRQTA_ISR : NOVALUE = ! Deal with an interrupt
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine simply DEBRK's out of an interrupt after calling
! OVRQTA_AST to exit and allow the user to delete some files
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
OVRQTA_AST ();
_DEBRK ();
END;
%SBTTL 'OVRQTA_AST - Process over quota interrupt'
ROUTINE OVRQTA_AST: AST_LINKAGE NOVALUE = ! Process interrupt
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called to handle over quota interrupts.
! It exits to EXEC after printing a message and allows
! the user to delete some files to make space, then
! type continue to return. It then DEBRKs from the
! interrupt after resetting the terminal mode.
!
! It must be done this way so that AC's can be saved.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
LOCAL
FORMAT_ROUTINE;
OWN
CUR_MODE;
!+
! First reset the terminal to its original state
!-
IF (.EDIT_MOD EQL CHANGE_MODE)
THEN
CUR_MODE = CHANGE_MODE
ELSE
CUR_MODE = LINE_MODE;
IF .TI_RESET THEN EDT$$SC_RESET ();
!+
! Output a suitable message
!-
EDT$$TI_RES ();
_PSOUT (CH$PTR (UPLIT (%ASCIZ '?Over quota or disk full -')));
_PSOUT (CH$PTR (UPLIT (%CHAR (ASC_K_CR, ASC_K_LF, 0))));
_PSOUT (CH$PTR (UPLIT (%ASCIZ ' If you wish to continue with this edit')));
_PSOUT (CH$PTR (UPLIT (%CHAR (ASC_K_CR, ASC_K_LF, 0))));
_PSOUT (CH$PTR (UPLIT (%ASCIZ ' EXPUNGE some files and type CONTINUE')));
!+
! Wait for him to CONTINUE
!-
_HALTF ();
!+
! Now we must reopen the terminal and repaint the screen we were in change mode
!-
TT_OPEN = 0;
EDT$$TI_OPN ();
IF (.CUR_MODE EQL CHANGE_MODE)
THEN
BEGIN
EDT$$SC_INIT ();
SCR_CHGD = 2;
END;
END;
%SBTTL 'TIMER_ISR - deal with a timer interrupt'
ROUTINE TIMER_ISR : NOVALUE = ! Deal with a timer interrupt
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine calls TIMER_AST to reset the timer and set a flag.
! This has to be done since this routine cannot use any AC's.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!--
BEGIN
TIMER_AST ();
_DEBRK ();
END;
%SBTTL 'TIMER_AST - Reset the timer'
ROUTINE TIMER_AST : AST_LINKAGE NOVALUE = ! Reset the timer
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called to reset the timer and set a flag. It must
! be done this way so that AC's can be saved.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! Restarts the timer.
!
!--
BEGIN
IF (.WORKCOUNT GEQ 0) THEN
BEGIN
SECOND = -1;
_TIMER (FLD ($FHSLF, FLD_LHS) + $TIMEL, 1000, 2);
END;
END;
END
ELUDOM