Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 7-sources/diutpamac.r36
There are 4 other files named diutpamac.r36 in the archive. Click here to see a list.
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
!	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.
!
! Macros to generate TPARSE state tables
!
!	Version X03-000

!++
!
! FACILITY:	BLISS COMMON
!
! ABSTRACT:
!
!	These macros are used to generate the state table used with TPARSE.
!	See the TPARSE module for a complete description.
!
! ENVIRONMENT:
!
!	DEC processor running BLISS
!
!--

!
!
! AUTHOR:  Andrew C. Goldstein,	 CREATION DATE:  30-Aug-1977  16:33
!
! MODIFIED BY:
!
!	V0006	ACG0048		Andrew C. Goldstein,  20-Jun-1979  14:17
!	Change state table PSECTs to EXE
!
!	V0005	ACG0043		Andrew C. Goldstein,  23-May-1979  21:20
!	Change state table PSECTs to PIC
!
!	V0004	ACG0024		Andrew C. Goldstein,  27-Feb-1979  16:42
!	Fix PSECT names for new RTL standards
!
!   Andrew C. Goldstein, 4-Oct-1977  16:35
!   X0002 - Add action routine parameter; allow for keyword uniqueness testing.
!
!   Andrew C. Goldstein, 22-Feb-1978  10:42
!   X0003 - State table format changes (BL5)
!
!   Dennis E. Phillips, 13-May-1981
!   X0103 - Change state table format to use BLISS COMMON UPLITs
!
!*****
!
! Do some clean up so that this require file can co-exist with the 
! Starlet library.
!
%if %declared( %quote tpa$l_count ) 
	%then undeclare %quote tpa$l_count; %fi
%if %declared( %quote tpa$k_count0 ) 
	%then undeclare %quote tpa$k_count0; %fi
%if %declared( %quote tpa$l_options ) 
	%then undeclare %quote tpa$l_options; %fi
%if %declared( %quote tpa$v_blanks ) 
	%then undeclare %quote tpa$v_blanks; %fi
%if %declared( %quote tpa$m_blanks ) 
	%then undeclare %quote tpa$m_blanks; %fi
%if %declared( %quote tpa$v_abbrev ) 
	%then undeclare %quote tpa$v_abbrev; %fi
%if %declared( %quote tpa$m_abbrev ) 
	%then undeclare %quote tpa$m_abbrev; %fi
%if %declared( %quote tpa$v_abbrfm ) 
	%then undeclare %quote tpa$v_abbrfm; %fi
%if %declared( %quote tpa$m_abbrfm ) 
	%then undeclare %quote tpa$m_abbrfm; %fi
%if %declared( %quote tpa$v_ambig ) 
	%then undeclare %quote tpa$v_ambig; %fi
%if %declared( %quote tpa$m_ambig ) 
	%then undeclare %quote tpa$m_ambig; %fi
%if %declared( %quote tpa$b_mcount ) 
	%then undeclare %quote tpa$b_mcount; %fi
%if %declared( %quote tpa$l_stringcnt ) 
	%then undeclare %quote tpa$l_stringcnt; %fi
%if %declared( %quote tpa$l_stringptr ) 
	%then undeclare %quote tpa$l_stringptr; %fi
%if %declared( %quote tpa$l_tokencnt ) 
	%then undeclare %quote tpa$l_tokencnt; %fi
%if %declared( %quote tpa$l_tokenptr ) 
	%then undeclare %quote tpa$l_tokenptr; %fi
%if %declared( %quote tpa$l_char ) 
	%then undeclare %quote tpa$l_char; %fi
%if %declared( %quote tpa$b_char ) 
	%then undeclare %quote tpa$b_char; %fi
%if %declared( %quote tpa$l_number ) 
	%then undeclare %quote tpa$l_number; %fi
%if %declared( %quote tpa$l_param ) 
	%then undeclare %quote tpa$l_param; %fi
%if %declared( %quote tpa$c_length0 ) 
	%then undeclare %quote tpa$c_length0; %fi
%if %declared( %quote tpa$k_length0 ) 
	%then undeclare %quote tpa$k_length0; %fi
!
! Declare the various literals and compile time constants used to generate
! state tables.
!

COMPILETIME
    TP$_FIRST = 0,
    TP$_KEYFLAG = 0,
    TP$_TYPEVAL = 0,
    TP$_FINAL = 0,
    TP$_SUBEXPR = 0,
    TP$_TRUE = 1,
    TP$_FALSE = 0,
    TP$_STATE_COUNT = 0,
    TP$_NEXT_STATE = 1,
    tp$_exptarget = 0;

LITERAL
    TPA$M_CODEFLAG = 256,			! type is a keyword, special, etc
    TPA$M_LASTFLAG = 512,			! last transition in state
    TPA$M_EXTFLAG = 1024,			! subexpression pointer present
    TPA$M_TRANFLAG = 2048,			! explicit target present
    TPA$M_MASKFLAG = 4096,			! mask longword present
    TPA$M_ADDRFLAG = 8192,			! data address present
    TPA$M_ACTFLAG = 16384,			! action routine present
    TPA$M_PARMFLAG = 32768;			! action routine parameter present

LITERAL
    TPA$_KEYWORD = 256,				! keyword base type
    TPA$_EXIT = -1,				! exit parser
    TPA$_FAIL = -2,				! exit with failure
    TPA$_ANY = 493,				! any single character
    TPA$_ALPHA = 494,				! any alphabetic character
    TPA$_DIGIT = 495,				! any numeric character
    TPA$_STRING = 496,				! any alphanumeric string
    TPA$_SYMBOL = 497,				! any symbol constituent set string
    TPA$_BLANK = 498,				! any string of spaces and tabs
    TPA$_DECIMAL = 499,				! decimal number
    TPA$_OCTAL = 500,				! octal number
    TPA$_HEX = 501,				! hexadecimal number
    TPA$_LAMBDA = 502,				! empty string
    TPA$_EOS = 503,				! end of string
    TPA$_SUBEXPR = 504;				! subexpression

!
!	These literals have been added to replace the return values
!       LIB$_SYNTAXERR, LIB$_INVTYPE, SS$_INSFARG.  These values are
!       returned by TPARSE and checked by the user.

%IF %BLISS (BLISS36)
%THEN
literal
    LIB$_syntaxerr = %X'158284',
    LIB$_invtype = %X'15828C',
    SS$_INSFARG = %X'000114';
%FI

%IF %BLISS (BLISS16)
%THEN
literal
    lib$_syntaxerr = %x'0284',
    lib$_invtype = %x'028C',
    ss$_insfarg = %x'0114';
%FI
!
!
!	These macros and literal are the TPARSE control block.  It is one
!       of the arguments used in the call to TPARSE.
!

macro
    TPA$L_COUNT = 0,0,%BPVAL,0%;	!argument count (number of words)

literal
    TPA$K_COUNT0 = 8;			!zero level value of 8

macro
    TPA$L_OPTIONS = 1,0,%BPVAL,0%;	!options word

macro
    TPA$V_BLANKS = 1,0,1,0%;		!process blanks and tabs explicitly

literal
    TPA$M_BLANKS = 1^1 - 1^0;

macro
    TPA$V_ABBREV = 1,1,1,0%;		!allow minimal abbreviation

literal
    TPA$M_ABBREV = 1^2 - 1^1;

macro
    TPA$V_ABBRFM = 1,2,1,0%;		!allow first match abbreviation

literal
    TPA$M_ABBRFM = 1^3 - 1^2;

macro
    TPA$V_AMBIG = 1,3,1,0%;		!ambiguous keyword at this state

literal
    TPA$M_AMBIG = 1^4 - 1^3;

macro
    TPA$B_MCOUNT = 1,8,8,0%;		!minimum abbreviation on keywords

macro
    TPA$L_STRINGCNT = 2,0,%BPVAL,0%;	!byte count of string parsed

macro
    TPA$L_STRINGPTR = 3,0,%BPVAL,0%;	!address of parsed string

macro
    TPA$L_TOKENCNT = 4,0,%BPVAL,0%;	!byte count of matching token

macro
    TPA$L_TOKENPTR = 5,0,%BPVAL,0%;	!address of matching token
macro
    TPA$L_CHAR = 6,0,%BPVAL,0%;		!ascii code of single char token

LITERAL
    TPA$_CHAR_LEN = %IF %BLISS (BLISS36)
			%THEN	7
			%ELSE   8
		    %FI;

macro
    TPA$B_CHAR = 6,0,TPA$_CHAR_LEN,0%;		!byte form of single char cell

macro
    TPA$L_NUMBER = 7,0,%BPVAL,0%;		!numeric value of numeric token

macro
    TPA$L_PARAM = 8,0,%BPVAL,0%;		!parameter word from state table

literal
    TPA$C_LENGTH0 = (TPA$K_COUNT0+1)*%UPVAL;	!length of param block 
						!in addressable units

literal
    TPA$K_LENGTH0 = TPA$K_COUNT0+1;		!length of zero level param 
						!block in words
!
!
! The macro $INIT_STATE is used to initialize the table generator macros.
!
!	The code which generates a KEY_TABLE storage area is not used
!       in the BLISS COMMON version.  The KEY_TABLE argument to INIT_STATE
!       macro is for compatibility with the VAX native mode TPARSE.
!

MACRO
    $INIT_STATE (SR_STATE) =
	     %if %length neq 1
		%then
		    %warn ('Program is using Bliss common Tparse, make appropiate changes')
		%fi
             %ASSIGN (TP$_FIRST,TP$_TRUE)
	     %ASSIGN (TP$_STATE_COUNT,0)
	forward %name('tp$_',0);
	global bind sr_state = %name('tp$_',0);
	     %;
!
! The $STATE macro is the main level macro. Each call to $STATE generates
! one state in the state table. The first argument, if not null, is a label
! to be applied to this state. Each of the remaining n arguments is a
! transition to another state, consisting of a list of transition elements:
! the token type, the target state, address of the user's action routine,
! a bitmask, and an address in which to store the mask. All of the transition
! elements except the token type are optional.
!
! The $STATE macro generates its storage in a UPLIT.  All TARGET
!	variable are declared in the STATE_FORWARD macro.
!

MACRO
    $STATE (STATE_LABEL) =

	    %assign (tp$_next_state,tp$_state_count+1)

!	declare any referenced states as forward if they have
!	not already been declared

            %if not %null (%remaining) 
            %then $state_forward (%remaining) ;
            %fi
  
!	declare this state

	bind tp$_state = uplit (

            %if not %null (%remaining)
            %then $state_items (%remaining)
            %fi );

            %if not %null(state_label)
            %then own state_label : initial(tp$_state) ;
            %fi

	own %name($cur_state) : initial(tp$_state);

	    %ASSIGN (TP$_STATE_COUNT,TP$_STATE_COUNT+1)
	undeclare tp$_state;

            %;

!
! The macro $STATE_ITEMS is an iterative macro used to generate the transitions
! in a state.
!

MACRO
    $STATE_ITEMS [ELEMENT] =
		%ASSIGN (TP$_FINAL, %NULL (%REMAINING))
                $MAKE_TRAN (TP$_FINAL, %REMOVE (ELEMENT))
		%;
!
! The macro $MAKE_TRAN is called to generate each transition entry in a state.
! Its arguments include the final flag (set to 1 for the last transition in
! a state) followed by the elements  of the transition.
!

MACRO
    $MAKE_TRAN (TP$_FINAL, TYPE, TARGET, ACTION, MASK, ADDR, PARAM) =
		%ASSIGN (TP$_SUBEXPR, 0)
                %assign (tp$_keyflag, 0)
                %assign (tp$_typeval, 0)
		%assign (tp$_exptarget, 0)

		%IF $IFSUBEXPR (TYPE)
		%THEN %ASSIGN (TP$_TYPEVAL, TPA$_SUBEXPR)
		      %ASSIGN (TP$_SUBEXPR, 1)

		%ELSE
		    %IF $IFKEYWORD (TYPE)
		    %THEN
			%ASSIGN (TP$_keyflag, 1)
                        %assign (tp$_typeval, tpa$_keyword)
                    %else %if $ifsymbol(type)
                          %then %assign (tp$_typeval,type)
                          %else %assign (tp$_typeval,%quote %c type)
                          %fi
                    %fi
                %fi  

!	see if explicit target, if it is then set flag

		%if $ifexptarget (target)
		%then %assign(tp$_exptarget, 1)
		%fi

! (CAK) This expression generates the flags for the transition

                 (tp$_typeval + tp$_subexpr*TPA$M_extflag
                       %if not %null (param) %then +TPA$M_parmflag %fi
                       %if not %null (action) %then +TPA$M_actflag %fi
                       %if not %null (mask) %then +TPA$M_maskflag
                           %if %null (addr)
                           %then %error ('Mask address missing') %fi %fi
                        + tp$_exptarget*TPA$M_tranflag
                       %if not %null (addr) %then +TPA$M_addrflag %fi
                     + tp$_final*TPA$M_lastflag) 
               %if tp$_keyflag
               %then  ,uplit(%charcount(type), $key_string (type)) 
               %fi


		%IF TP$_SUBEXPR
		%THEN ,%REMOVE (TYPE)
		%FI

		%IF NOT %NULL (PARAM)
		%THEN  ,param
		%FI

		%IF NOT %NULL (ACTION)
		%THEN	,action
		%FI

		%IF NOT %NULL (ADDR)
		%THEN	,addr
		%FI

		%IF NOT %NULL (MASK)
		%THEN	,mask
		%FI

                %if not %null(target)
		%THEN  ,target
                %else  ,%name($next_state) 
                %fi

		%;

!
!
! (CAK) The following macros declares all arguements in the transition
!       list as forward if they are not already declared
!

macro
    $state_forward [element] =
 
             $make_forward (%remove(element))
             %;

macro
    $make_forward (type, target, action, mask, addr, param) =
            
             %if $ifsubexpr (type)
             %then %if not %declared(%remove(type))
                   %then forward %remove(type) ;
             %fi %fi

             %if not %null (target)
             %then %if not %declared(target)
                   %then forward target
                   %fi
             %else %if not %declared(%name($next_state))
		   %then forward %name($next_state)
		   %fi
             %fi
             %;
!
! The following macro returns 1 if the argument is a keyword, where a keyword
! is defined as an alphanumeric string of two or more characters.
!

MACRO
    $IFKEYWORD (TYPE) =
		%IDENTICAL (TYPE, %STRING (TYPE))
		AND %CHARCOUNT (%STRING (TYPE)) GTR 1
		%;

!
! The following macro returns 1 if the argument is a subexpression call,
! identified by being enclosed in parentheses.
!

MACRO
    $IFSUBEXPR (TYPE) =
		NOT %IDENTICAL (TYPE, %REMOVE (TYPE))
		%;

macro
    $ifsymbol (type) =
                not %identical (type, %string (type))
                %;

macro
    $ifexptarget (target) =
		NOT %ctce(target) OR %NULL(target)
		%;

!
! Macros to generate keyword strings. Handles the special string of the form
! 'A*', used to signify a single character keyword.
!

MACRO
    $KEY_STRING (TYPE) =
		%IF %CHARCOUNT (TYPE) EQL 2
		%THEN $ONE_STRING (%EXPLODE (TYPE))
		%ELSE TYPE
		%FI
		%;

MACRO
    $ONE_STRING (A, B) =
		%IF B EQL'*'
		%THEN A
		%ELSE %STRING (A, B)
		%FI
		%;
!
! Macros to form names based on the value of tp$_state_count
!

MACRO
    $NEXT_STATE =
 %string('TP$_',%NUMBER(TP$_NEXT_STATE))%;

MACRO
    $CUR_STATE =
 %string('TP$_',%NUMBER(TP$_STATE_COUNT))%;