Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

 %TITLE 'PRPUSH - new parse node'
MODULE PRPUSH (				! New parse node
		IDENT = '3-001'			! File: PRPUSH.BLI Edit: CJG3001
		) =
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:
!
!	Create a new parse node.
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: December 12, 1978
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 25-Feb-1981.  This module was created by
!	extracting routine PUSH from module PARSER.
! 1-002	- Regularize headers.  JBS 12-Mar-1981
! 1-003	- Use new message codes.  JBS 04-Aug-1981
! 3-001 - Fix the clear operation for TOPS-20. CJG 9-Mar-83
!--

%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$PA_CRERNGNOD,
    EDT$$PA_NEW_NOD;

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

REQUIRE 'EDTSRC:PARLITS';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$PA_NEW_NOD  - new parse node'

GLOBAL ROUTINE EDT$$PA_NEW_NOD (		! New parse node
	NT, 					! Stored in [NODE_TYPE]
	TYP					! Stored in [COM_NUM]
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Create a semantic node of the specified type and subtype.  If the
!	stack overflows, return a 0 otherwise, return the address of the new
!	node.
!
! FORMAL PARAMETERS:
!
!  NT			Stored in [NODE_TYPE]
!
!  TYP			Stored in [COM_NUM]
!
! IMPLICIT INPUTS:
!
!	PA_STK
!	PA_SP
!
! IMPLICIT OUTPUTS:
!
!	PA_ERRNO
!	PA_STK
!	PA_SP
!
! ROUTINE VALUE:
!
!	0 = parse stack overflow
!	non-zero = address of new parse semantic node
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    EXTERNAL
	PA_ERRNO,			! Error number of parsing error.
	PA_STK : BLOCKVECTOR [NUM_NODES, NODE_SIZE] FIELD (NODE_FIELDS),
	PA_SP;

    MESSAGES ((PARSTKOVF));

    LOCAL
	NODE : REF NODE_BLOCK;

    PA_SP = .PA_SP + 1;

    IF (.PA_SP GEQU NUM_NODES)
    THEN
	BEGIN
	PA_ERRNO = EDT$_PARSTKOVF;
	RETURN (0);
	END;

    NODE = PA_STK [.PA_SP, NODE_TYPE];
    CH$FILL (0, NODE_SIZE, CH$PTR (.NODE, 0, 36));
    NODE [NODE_TYPE] = .NT;
    NODE [COM_NUM] = .TYP;
    RETURN (.NODE);
    END;

%SBTTL 'EDT$$PA_CRERNGNOD  - create a range node'

GLOBAL ROUTINE EDT$$PA_CRERNGNOD (		! Create a range node
	RANTYP					! Type of range
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Create a range node of the type which has one numeric value.
!
! FORMAL PARAMETERS:
!
!  RANTYP		Type of range
!
! IMPLICIT INPUTS:
!
!	PA_CURRNG
!
! IMPLICIT OUTPUTS:
!
!	PA_CURRNG
!
! ROUTINE VALUE:
!
!	0 = unable to create the range node
!	1 = range node created
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    EXTERNAL
	PA_CURRNG : REF NODE_BLOCK;	! the current range node

    LOCAL
	NEWRANGE : REF NODE_BLOCK;

    IF ((NEWRANGE = EDT$$PA_NEW_NOD ()) EQL 0) THEN RETURN (0);

    EDT$$CPY_MEM (NODE_SIZE, .PA_CURRNG, .NEWRANGE);
    PA_CURRNG [SUB_RANGE] = .NEWRANGE;
    PA_CURRNG [RAN_TYPE] = .RANTYP;
    PA_CURRNG [RAN_VAL] = 1;
    RETURN (1);
    END;


END
ELUDOM