Google
 

Trailing-Edge - PDP-10 Archives - BB-R775C-BM - 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) 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 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