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) 1983, 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:
!
!	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