Trailing-Edge
-
PDP-10 Archives
-
BB-AE97C-BM
-
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) 1981, 1985 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
! 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 WHICH 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