Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/lpush.bli
There are 10 other files named lpush.bli in the archive. Click here to see a list.
%TITLE 'LPUSH - Push to a new EXEC'
MODULE LPUSH ( ! Push to a new EXEC
IDENT = '3-003' ! File: LPUSH.BLI
) =
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 executes the PUSH command which transfers
! control to a new copy of EXEC.
!
! ENVIRONMENT: Runs at any access mode
!
! AUTHOR: Chris Gill CREATION DATE: September 1983
!
! MODIFIED BY:
!
! 3-001 - Creation. CJG 20-Sep-1983
! 3-002 - Keep the subfork after creating it. CJG 8-Dec-1983
! 3-003 - Add EDT$$XDDT_CMD for the XDDT command. CJG 9-Dec-1983
!--
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
FORWARD ROUTINE
EDT$$PUSH_CMD : NOVALUE, ! PUSH command
EDT$$XDDT_CMD : NOVALUE; ! XDDT command
!
! INCLUDE FILES:
!
REQUIRE 'SYS:JSYS';
REQUIRE 'EDTSRC:EDTREQ';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
! NONE
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
! In the routine
%SBTTL 'EDT$$PUSH_CMD - Push to a new EXEC'
GLOBAL ROUTINE EDT$$PUSH_CMD ! Push to a new EXEC
: NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine creates a subfork and places a copy of EXEC in it.
! It then starts the EXEC and waits for it to exit.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! Runs a copy of EXEC
!
!--
BEGIN
EXTERNAL ROUTINE
EDT$$TI_WRSTR, ! Used to see which mode we're in
EDT$$TI_RES : NOVALUE, ! Reset terminal state
EDT$$TI_OPN : NOVALUE, ! Open the terminal
EDT$$SC_RESET : NOVALUE, ! Reset the screen
EDT$$SC_SETWID : NOVALUE, ! Set terminal width
EDT$$FMT_MSG; ! Print error message
EXTERNAL
TXT_ONSCR, ! Text may be on screen
TT_OPEN, ! Terminal state
TI_WID, ! Terminal width
TI_RESET, ! Terminal reset state
PUSH_FLAG, ! Flag for PUSH command
FORK_HANDLE, ! Subfork handle
SCR_CHGD, ! Force update
SAV_TIWID, ! Terminal width on entry
FMT_WRRUT; ! Used to see which mode we're in
MESSAGES ((NOCREFORK, ABNFRKTRM, NOFNDEXEC));
LOCAL
FORK_JFN, ! JFN of EXEC
FORK_STATUS; ! Exit status of subfork
!+
! Create a fork and get SYS:EXEC.EXE into it if not already present.
!-
IF (.FORK_HANDLE EQL 0)
THEN
BEGIN
IF ( NOT _CFORK (CR_CAP; FORK_HANDLE))
THEN
BEGIN
EDT$$FMT_MSG (EDT$_NOCREFORK);
RETURN;
END;
IF ( NOT _GTJFN (GJ_OLD + GJ_SHT,
CH$PTR (UPLIT (%ASCIZ 'DEFAULT-EXEC:')); FORK_JFN))
THEN
IF ( NOT _GTJFN (GJ_OLD + GJ_SHT,
CH$PTR (UPLIT (%ASCIZ 'SYSTEM:EXEC.EXE')); FORK_JFN))
THEN
BEGIN
EDT$$FMT_MSG (EDT$_NOFNDEXEC);
RETURN;
END;
IF ( NOT _GET (FLD (.FORK_HANDLE, FLD_LHS) + FLD (.FORK_JFN, FLD_RHS), 0))
THEN
BEGIN
EDT$$FMT_MSG (EDT$_NOCREFORK);
RETURN;
END;
END;
!+
! Now reset the terminal to its orriginal state
!-
IF (.FMT_WRRUT EQL EDT$$TI_WRSTR) THEN EDT$$SC_RESET ();
IF .TI_RESET THEN EDT$$TI_RES ();
IF (.TI_WID NEQ .SAV_TIWID) THEN EDT$$SC_SETWID (.SAV_TIWID);
TT_OPEN = 0;
!+
! Start the fork and wait for it to complete. Then see what the status is
! and kill the fork.
!-
_SFRKV (.FORK_HANDLE, 0);
_WFORK (.FORK_HANDLE);
_RFSTS (.FORK_HANDLE; FORK_STATUS);
!+
! Open the terminal and mark the screen as changed
!-
EDT$$TI_OPN ();
IF (.FMT_WRRUT EQL EDT$$TI_WRSTR)
THEN
BEGIN
TXT_ONSCR = 1;
SCR_CHGD = 2;
END;
PUSH_FLAG = -1;
IF ((.FORK_STATUS AND NOT RF_FRZ) NEQ FLD ($RFHLT, RF_STS)) THEN
EDT$$FMT_MSG (EDT$_ABNFRKTRM);
RETURN;
END; ! of routine EDT$$PUSH_CMD
!<BLF/PAGE>
%SBTTL 'EDT$$XDDT_CMD - Invoke DDT'
GLOBAL ROUTINE EDT$$XDDT_CMD ! Invoke DDT
: NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine calls DDT so that breakpoints can be set and
! items of EDT's internals examined.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! Maps DDT into pages 766 to 777 and sets .JBDDT (location 74).
!--
BEGIN
EXTERNAL ROUTINE
EDT$$FMT_STR, ! Output a message
EDT$$FMT_CRLF,
EDT$$OUT_FMTBUF,
EDT$$FMT_MSG; ! Print error message
LOCAL
DDT_JFN; ! JFN of SYS:UDDT.EXE
LITERAL
JBDDT = %O'74', ! .JBDDT address
JBSYM = %O'116'; ! .JBSYM address
MESSAGES ((NODDTAVL));
IF (.JBDDT EQL 0)
THEN
BEGIN
IF ( NOT _GTJFN (GJ_OLD + GJ_SHT,
CH$PTR (UPLIT (%ASCIZ 'SYS:UDDT.EXE')); DDT_JFN)) THEN
BEGIN
EDT$$FMT_MSG (EDT$_NODDTAVL);
RETURN;
END;
IF ( NOT _GET (FLD ($FHSLF, FLD_LHS) + GT_PRL + GT_ADR + .DDT_JFN,
FLD (%O'766', FLD_LHS) + FLD (%O'777', FLD_RHS))) THEN
BEGIN
EDT$$FMT_MSG (EDT$_NODDTAVL);
RETURN;
END;
JBDDT = %O'770000'; ! Set the entry address
.(%O'770001')<0,18> = .JBSYM; ! Copy the symbol pointer
END;
EDT$$FMT_STR (CH$PTR (UPLIT ('Type POPJ P,<ESC>X to return')), 28);
EDT$$FMT_CRLF ();
EDT$$OUT_FMTBUF ();
(.JBDDT)<0,18> ();
RETURN;
END;
!<BLF/PAGE>
END ! of module LPUSH
ELUDOM