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))%;