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

 %TITLE 'PRSWITCH - parse a switch'
MODULE PRSWITCH (				! Parse a command
		IDENT = '3-003'			! File: PRSWITCH.BLI Edit:GB3003
		) =
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:
!
!	Parse a switch.
!
! ENVIRONMENT:	Runs on TOPS-20 only
!
! AUTHOR: Chris Gill, CREATION DATE: March 15, 1983
!
! MODIFIED BY:
!
! 3-002 - Check for control-C being typed. CJG 5-Jan-1984
! 3-003 - Allow switches to be specified twice without error. GB 16-Aug-1984
!--

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

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$PA_SWITCH,			! Parse a switch
    EDT$$PA_COLON;			! Parse a colon

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

REQUIRE 'EDTSRC:PARLITS';

REQUIRE 'SYS:JSYS';

!
! EXTERNAL REFERENCES:
!
!	In the routines
!
!
! MACROS:
!
!	NONE
!
!
! OWN STORAGE
!
!	NONE
!


%SBTTL 'EDT$$PA_SWITCH - Parse a set of switches'

GLOBAL ROUTINE EDT$$PA_SWITCH (				! Parse a switch
		FDB) =					! FDB to use

BEGIN

!
! FUNCTIONAL DESCRIPTION
!
! This subroutine parses a set of switches given the address of an
! FDB. The routine will create a new range node and fill in any values
! as required.
!
! ROUTINE VALUE
!
!	-1 - JSYS error, unable to create range node, value given to a
!		switch which does not take one.
!	 0 - Reparse required
!	+1 - All OK
!-

    EXTERNAL
	CSB,
	FD_TRR,
	LNO0 : LNOVECTOR [14],
	CC,					! Control-C flag
	PA_CURTOK,
	PA_CURTOKLEN,
	PA_NUMVAL : LN_BLOCK,
	PA_CURCMD : REF NODE_BLOCK;

    EXTERNAL ROUTINE
	EDT$$PA_NEW_NOD,			! Create a new node
	EDT$$PA_SCANTOK,			! Get atom length
	EDT$$PA_LINE_NUM,			! Parse a line number
	EDT$$PA_NUMBER;				! get a number

    LOCAL
	SWT_NODE : REF NODE_BLOCK,
	C_FLAG,					! COMND flags
	C_DATA,					! COMND data or pointer
	C_FDB,					! FDB used in parse
	CMDTYP,					! Type of current range atom
	VAL;

    BEGIN

!+
! Loop for all the switches
!-

    WHILE 1 DO
	BEGIN

!+
! Parse a switch
!-

	IF (NOT COMMAND (.FDB)) THEN RETURN (-1);
	IF (.CC NEQ 0) THEN RETURN (-1);
	IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);	! Reparse
	IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (1);	! No switch
	CMDTYP = .(.C_DATA)<0,18>;

!+
! Create a new node and preset it if required
!-

	IF (.PA_CURCMD [SWITS] EQL 0) THEN
	    BEGIN
	    IF ((SWT_NODE = EDT$$PA_NEW_NOD (SW_NODE, 0)) EQL 0) THEN RETURN (-1);
	    PA_CURCMD [SWITS] = .SWT_NODE;
	    END
	ELSE
	    SWT_NODE = .PA_CURCMD [SWITS];
!	IF ((.SWT_NODE [SW_BITS] AND (1 ^ .CMDTYP)) NEQ 0) THEN RETURN (-1);
	SWT_NODE [SW_BITS] = (.SWT_NODE [SW_BITS] OR (1 ^ .CMDTYP));

!+
! If there is a value when there should not be one - return an error
!-

	CASE .CMDTYP FROM SWT_QUERY TO SWT_STACK OF
	    SET

	[ SWT_QUERY, SWT_NOTYP, SWT_SAVE, SWT_STAY, SWT_GO ] :

	    BEGIN
	    IF ((.C_FLAG AND CM_SWT) NEQ 0) THEN RETURN (-1);
	    END;

	[ SWT_BRIEF, SWT_DUPL ] :

	    BEGIN
	    BIND
		SWITCH = .PA_CURCMD [SWITS] : NODE_BLOCK;

	    IF ((.C_FLAG AND CM_SWT) NEQ 0) THEN
		BEGIN
		VAL = EDT$$PA_NUMBER ();
		IF (.VAL LSS 0) THEN RETURN (.VAL + 1);
		MOVELINE (PA_NUMVAL, SWITCH [SW_VAL1]);
		SWITCH [SEQ_VAL] = 1;
		END;
	    END;

	[ SWT_SEQU ] :

	    BEGIN
	    BIND
		SWITCH = .PA_CURCMD [SWITS] : NODE_BLOCK;

	    MOVELINE (LNO0 [5], SWITCH [SW_VAL1]);
	    MOVELINE (LNO0 [5], SWITCH [SW_VAL2]);
	    SWITCH [SEQ_VAL] = 0;
	    IF ((.C_FLAG AND CM_SWT) NEQ 0) THEN
		BEGIN
		EDT$$PA_LINE_NUM (-1);
		MOVELINE (PA_NUMVAL, SWITCH [SW_VAL1]);
		VAL = EDT$$PA_COLON ();
		IF (.VAL LEQ 0) THEN RETURN (.VAL);
		IF (.VAL EQL 1) THEN
		    BEGIN
		    EDT$$PA_LINE_NUM (-1);
		    MOVELINE (PA_NUMVAL, SWITCH [SW_VAL2]);
		    END;
		END;
	    END;

	[ SWT_STACK ] :

	    BEGIN
	    BIND
		SWITCH = .PA_CURCMD [SWITS] : NODE_BLOCK;

	    IF ((.C_FLAG AND CM_SWT) NEQ 0) THEN
		BEGIN
		VAL = EDT$$PA_NUMBER ();
		IF (.VAL LSS 0) THEN RETURN (-1);
		SWITCH [SW_VAL2] = .VAL;
		END
	    ELSE
		RETURN (-1);
	    END;

	[ SWT_LOCN ] :

	    BEGIN
	    BIND
		SWITCH = .PA_CURCMD [SWITS] : NODE_BLOCK;

	    IF ((.C_FLAG AND CM_SWT) NEQ 0) THEN
		BEGIN
		IF (NOT COMMAND (FD_TRR)) THEN RETURN (-1);
		IF (.CC NEQ 0) THEN RETURN (-1);
		IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);	! Reparse
		IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (1);	! No switch
		EDT$$PA_SCANTOK (1, 0);
		SWITCH [AS_STR] = .PA_CURTOK;
		SWITCH [AS_LEN] = .PA_CURTOKLEN;
		END
	    ELSE
		RETURN (-1);
	    END;

	    TES;

	END;

    RETURN (1);
    END;

END;


%SBTTL 'EDT$$PA_COLON - Parse a colon'

GLOBAL ROUTINE EDT$$PA_COLON =				! Parse a colon

BEGIN

!+
! FUNCTIONAL DESCRIPTION
!
! This routine parses a single colon in the input and returns an error 
! if it was not there.
!-


    EXTERNAL
	CC,					! Control-C flag
	CSB,
	FD_COL,
	PA_ERRNO;

    LOCAL
	C_FLAG,					! COMND flags
	C_DATA,					! COMND data or pointer
	C_FDB;					! FDB used in parse

    MESSAGES (COLONREQ);

    BEGIN

    PA_ERRNO = EDT$_COLONREQ;
    IF (NOT COMMAND (FD_COL)) THEN RETURN (-1);
    IF (.CC NEQ 0) THEN RETURN (-1);
    IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
    IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
    RETURN (1);
    END;

END;

END
ELUDOM