Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0172/lex.bli
There is 1 other file named lex.bli in the archive. Click here to see a list.
!<BLF/macro>
!<BLF/lowercase_user>
!<BLF/uppercase_key>
MODULE lex ( !
%IF %BLISS (BLISS32)
%THEN
ADDRESSING_MODE (EXTERNAL = LONG_RELATIVE, !
NONEXTERNAL = LONG_RELATIVE) ,
%FI
IDENT = '8.3'
) =
BEGIN
!++
! FACILITY: BLISS Formatter
!
! ABSTRACT:
! This module contains the interface between the scanner,
! which returns each token from the input stream, and
! the parser, which is in control of the process of getting
! and disposing of lexemes.
!
! LEX$GETSYM communicates with the output module to format
! lexemes which must be formatted at the lexical level,
! e.g. %IF.
!
! Environment: Transportable, with XPORT
!
!
! REVISION HISTORY
!
! 8-Oct-81 TT Inserted all new builtins for Bliss V2.1
! and V3. Note that some are machine-specific
! but are in this list nevertheless. When things
! get commonized this should be fixed.
!
! 12-Oct-81 TT Add s_empty as a type. For now, this is
! basically a no-op. It'll be used in the future
! to help parse empty macros IE %ASSIGN. This is
! already in the 10/20 version, so it will help
! in commonization as well.
!
! 20-Oct-81 TT Add NODEFAULT and %REQUIRE into the keyword
! list. Bumped indent to 7.0 from 6.3-6.
!
! 19-Jan-82 TT Added EMUL, EDIV builtins. Remove unused
! external declaration of Lst$line.
!
! 21-Jan-82 TT STACKLOCAL was declared twice; causing
! it to be looked at as just a name!
!
! 12-Feb-82 TT Per user request, allow !<BLF/ to be any
! combination of upper or lower case.
!
! END OF REVISION HISTORY
!--
!<BLF/page>
!++
! Table of contents:
!--
FORWARD ROUTINE
lex$def_synonym : NOVALUE, ! Process synonym control line
lex$getsym : NOVALUE, ! Main interface from parser
lex$init : NOVALUE, ! Data initialization
lookup : NOVALUE; ! Loookup names known to BLISS
!++
! Include files:
!--
REQUIRE 'BLFCSW'; ! Defines control switches, i.e. 'sw_...'
REQUIRE 'SCNBLK'; ! Defines variables pertaining to scanning context
REQUIRE 'TOKTYP'; ! Defines 'token' and the token type values 's_...'
REQUIRE 'UTLCOD'; ! Defines error codes, i.e. 'er_...'
!++
! Macros:
!--
MACRO
plit_count (aplit) =
((aplit) - %UPVAL) %;
MACRO
scnt (s) =
%CHARCOUNT (s), UPLIT(s) %;
!++
! Equated Symbols:
!--
LITERAL
true = 1 EQL 1,
false = 1 NEQ 1,
casebit = %C'A' XOR %c'a',
entry_size = 3; ! In LOOKUP's table
LITERAL
special_token = s_multiply,
lex_list_size = 400, ! Total symbols in synonym list
syn_name_len = 31,
syn_table_size = 50; ! max no. of synonyms permitted
FIELD
syn_field =
SET
first_lex_syn = [0, 0, %BPVAL, 0], !
final_lex_syn = [1, 0, %BPVAL, 0], !
lth_syn_name = [2, 0, %BPVAL, 0], !
syn_name = [3, 0, 0, 0] !
TES;
!++
! Own storage:
!--
OWN
comment : VECTOR [CH$ALLOCATION (buf_len)], ! Buffer for comment lines
last_tok : INITIAL (null_symbol); ! = s_name if must issue space
OWN
syn_state : BLOCK [scn_blk_size] FIELD (in_field),
stk : REF BLOCK FIELD (in_field) INITIAL (syn_state);
OWN
lex_index,
lex_list : VECTOR [lex_list_size], ! List of lexeme types defining synonyms
syn_index,
syn_list : BLOCKVECTOR !
[syn_table_size, 3 + CH$ALLOCATION (syn_name_len)] !
FIELD (syn_field);
OWN
cur_lex : INITIAL (1), ! Subscript of first synonym lexeme
end_lex : INITIAL (0), ! Subscript of final synonym lexeme
index, ! Subscript of synonym entry in table
match; ! True if name has synonym.
GLOBAL
tok : INITIAL (s_eludom); ! Returned symbol
!++
! The following variable is a count of the level of %IF control.
! It is used to permit or suppress ejects in OUTPUT.
!--
GLOBAL
in_pc_if : INITIAL (0);
!++
! External references:
!--
EXTERNAL ROUTINE !
ctl$command : NOVALUE, ! Process command comments
ctl$switch, ! Values of switches
lst$dot : NOVALUE, ! Set dotting flag for listing
lst$line : NOVALUE, ! Write line to listing file
lst$subtitle : NOVALUE, ! Save subtitle
lst$title : NOVALUE, ! Save title
out$break : NOVALUE, ! Break the current line
out$comment : NOVALUE, ! Output comment or remark
out$eject : NOVALUE, ! Eject current page
out$force : NOVALUE, ! Force a BREAK on next token
out$indent : NOVALUE, ! Set relative indent level
out$nit : NOVALUE, ! (Re-)initialize output
out$ntbreak : NOVALUE, ! BREAK but don't tab.
out$pend_skip : NOVALUE, ! Skip a line after this one
out$print : NOVALUE, ! Debugging printer
out$remark : NOVALUE, ! Output an end-of-line comment
out$skip : NOVALUE, ! Skip lines
out$space : NOVALUE, ! Output n spaces
out$stoks : NOVALUE, ! Output space/token/space
out$tab : NOVALUE, ! Output a TAB character, or if
! at beginning, TAB to Indent level
out$tok : NOVALUE, ! Output the current token
prs$block : NOVALUE, ! Parse1
prs$expression : NOVALUE, ! Format an expression
prs$_mac_level, ! = Current macro def level
scn$fin_verb : NOVALUE, ! Reenter automatic mode
scn$getsym : NOVALUE, ! Scanner
scn$pop : NOVALUE, ! Scanner state stack
scn$push : NOVALUE, ! Scanner state stack
scn$strt_verb : NOVALUE, ! Enter manual mode
utl$error : NOVALUE; ! Central ERROR reporting
EXTERNAL !
token : tok_block; ! Only one token processed at a time
GLOBAL ROUTINE lex$def_synonym (arg) : NOVALUE = !
!++
! Functional description:
! This routine analyses a control statement of the form
! !<BLF/synonym name=token1 token2 ...>
! It adds an entry, "name", to the synonym table so that future
! references to "name" can be replaced by the token stream.
!
! Formal parameters:
! arg - a character pointer to the text of the definition, i.e.
! after "!<blf/synonym " has been passed over.
!
! Implicit inputs:
! None
!
! Implicit outputs:
! A new entry in the synonym table.
!
! Routine value:
! None
!
! Side effects:
! None
!--
BEGIN
LOCAL
ch,
lth,
ptr;
! Set up the scanning context for the synonym token list.
stk [cp] = .arg;
stk [rem] = stk [len] = buf_len - 13; ! 13 = len(!<blf/synonym)
stk [col] = 1;
stk [chr] = null_symbol;
scn$push (syn_state); ! Direct scanner to scan rest of synonym definition
lex$getsym (); ! Get the name of the synonym
IF .tok NEQ s_name THEN (utl$error (er_syn_def); scn$pop (); RETURN );
!+
! Enter the newly found name (capitalized) into the table
!-
! Capitalize name before moving to table
lth = MIN (syn_name_len, .token [tok_len]);
ptr = .token [tok_cp];
INCR i FROM 1 TO .lth DO
BEGIN
ch = CH$RCHAR (.ptr);
IF .ch GEQ %C'a' AND .ch LEQ %C'z'
THEN
CH$WCHAR_A (.ch XOR casebit, ptr) !
ELSE
ptr = CH$PLUS (.ptr, 1);
END;
CH$COPY (.token [tok_len], !
.token [tok_cp], !
%C' ', !
syn_name_len, !
CH$PTR (syn_list [.syn_index, syn_name]));
syn_list [.syn_index, lth_syn_name] = .lth;
lex$getsym ();
IF .tok EQL s_equal
THEN
BEGIN
! Begin fetching lexemes from the line
lex$getsym ();
UNTIL .token [tok_type] EQL s_rangle OR !
.token [tok_type] EQL s_end_of_file OR !
.token [tok_type] EQL s_newline OR !
.lex_index GEQ lex_list_size DO
BEGIN
lex_list [.lex_index] = .token [tok_type];
lex_index = .lex_index + 1;
lex$getsym ();
END;
syn_list [.syn_index, final_lex_syn] = .lex_index;
syn_index = .syn_index + 1;
syn_list [.syn_index, first_lex_syn] = .lex_index;
END;
scn$pop (); ! Resume normal scanning
END; ! End of routine 'lex$def_synonym'
GLOBAL ROUTINE lex$getsym : NOVALUE = !
!++
! Functional description:
! This routine filters tokens between the scanner and the
! Parser. There is a class of tokens which are
! part of the BLISS "meta" language. These
! tokens control the flow of lexemes
! to the parser, and include certain forms of macros,
! and compile time conditionals (%IF, for example).
! Since the parser never "sees" the tokens controlling
! the stream of lexemes to it, and since these are part
! of the BLISS program, they have to be formatted by
! a module outside of the parser. This is that module.
! This module has responsibility for formatting comments
! and compile time conditionals.
!
! Formal parameters:
! None
!
! Implicit inputs:
! token - output of scanner
!
! Implicit outputs:
! token
!
! Completion codes:
! Returns eof$_code on end of file
!
! Side effects:
! Token is modified if it is a name known to BLISS, and is
! meaningful to the formatter.
!--
!<BLF/page>
BEGIN
IF .cur_lex LEQ .end_lex ! Check for synonym generation
THEN
BEGIN
! token [tok_cp] = CH$PTR (syn_list [.index, syn_name]);
tok = token [tok_type] = null_symbol;
IF .cur_lex EQL .end_lex
THEN
! Check for previous return of the synonym name
BEGIN
IF .match
THEN ! Last chance to output the name
BEGIN
token [tok_len] = .syn_list [.index, lth_syn_name]; !
out$stoks (); ! output it
match = false; ! Indicate name has been output
END;
END
ELSE
BEGIN
! return a lexeme from current synonym list.
tok = token [tok_type] = .lex_list [.cur_lex];
token [tok_len] = 0;
IF .match AND .tok EQL special_token
THEN
BEGIN
token [tok_len] = .syn_list [.index, lth_syn_name]; !
tok = token [tok_type] = null_symbol;
out$stoks (); ! output it.
match = false;
END
END;
cur_lex = .cur_lex + 1;
END
ELSE
!<BLF/page>
BEGIN
LOCAL
pquote; ! flag; true if %QUOTE found
pquote = false;
WHILE .tok NEQ s_end_of_file DO
BEGIN ! Loop
scn$getsym (true); ! 'True' implies from input file
SELECTONE .token [tok_type] OF
SET
[s_name] :
BEGIN
IF .last_tok EQL s_name ! Assure a space between names
THEN
out$space (1);
lookup (); ! Look up reserved word
last_tok = s_name; ! Ignore refinement of type
END;
[s_numeric] :
BEGIN
!+
! Ensure numbers not merged with names, etc.
!-
IF .last_tok EQL s_name !
THEN
out$space (1);
last_tok = s_name;
END;
[s_newline] :
! Leave last_tok alone
;
[start_embedded] : ! %(
BEGIN
IF .last_tok EQL s_name THEN out$space (1);
last_tok = null_symbol;
END;
[OTHERWISE] :
last_tok = null_symbol; ! Anything else can be juxtaposed
TES;
SELECTONE .token [tok_type] OF
SET
[s_percent_if] :
BEGIN ! Format %IF
in_pc_if = .in_pc_if + 1;
out$skip (1);
IF prs$_mac_level () EQL 0
THEN
out$ntbreak () ! line break
ELSE
out$break ();
out$tok (); ! Move %IF to buffer
out$space (1);
lex$getsym (); ! start of conditional expression
prs$expression (s_lparen);
IF .tok NEQ s_percent_then
THEN
utl$error (er_pthen)
ELSE
IF prs$_mac_level () EQL 0
THEN
out$ntbreak () ! line break
ELSE
out$break ();
out$tok (); ! Move %THEN to buffer
IF prs$_mac_level () GTR 0 THEN out$indent (1);
out$force ();
END;
[s_percent_else] :
BEGIN
IF prs$_mac_level () EQL 0
THEN
BEGIN
out$ntbreak (); ! line break
END
ELSE
BEGIN
out$indent (-1);
out$break ();
END;
out$tok ();
IF prs$_mac_level () GTR 0 THEN out$indent (+1);
out$force ();
END;
[s_percent_fi] :
BEGIN
in_pc_if = .in_pc_if - 1;
IF prs$_mac_level () EQL 0
THEN
BEGIN
out$ntbreak (); ! line break
END
ELSE
BEGIN
out$indent (-1);
out$break ();
END;
out$tok ();
out$pend_skip (1);
out$force ();
END;
[s_p_title, s_p_subtitle] :
BEGIN
LOCAL
type;
out$ntbreak (); ! put on newline
type = .token [tok_type];
out$eject (.type);
out$tok (); ! "%TITLE" or "%SBTTL"
scn$getsym (); ! Get quoted string
out$stoks (); ! " '...' "
IF .type EQL s_p_title
THEN
lst$title (.token [tok_len], .token [tok_cp])
ELSE
lst$subtitle (.token [tok_len], .token [tok_cp]);
out$force ();
END;
[s_p_compiler,s_empty] : ! TT 12-Oct-81
BEGIN
out$stoks (); ! "%BLISS16", etc.
lex$getsym ();
prs$block ();
EXITLOOP;
END;
[s_p_quote] :
BEGIN ! Format %QUOTE
out$stoks (); ! " %QUOTE "
pquote = true; ! Ignore type of next token
END;
[start_embedded] :
BEGIN
out$tok ();
lst$dot (false); ! Stop dotting listing
END;
[mid_embedded] :
BEGIN
lst$dot (false);
out$tok (); ! Comment line
! The no-tab-break here is needed to prevent embedded comments
! from growing by 4 spaces each time the file is processed.
out$ntbreak ();
END;
[end_embedded] :
BEGIN
out$tok ();
lst$dot (true); ! Resume dotting listing
END;
[full_line_com] :
BEGIN
LOCAL ! Used in case conversion
ch,
lcp,
tcp,
command: vector [CH$ALLOCATION (6)];
IF CH$NEQ (9, .token [tok_cp], !
9, CH$PTR (UPLIT('!!ERROR!!')))
THEN
BEGIN
IF CH$EQL (3, .token [tok_cp], !
3, CH$PTR (UPLIT('!++')))
THEN
out$skip (1); ! Pre- block skip
out$ntbreak ();
out$tok (); ! Full-line COMMENT
out$break ();
!+
! Look for special control comments of the form
! <BLF/...>
! Begin by converting to upper case.
!-
tcp = .token [tok_cp];
lcp = CH$PTR (comment);
INCR n FROM 1 TO .token [tok_len] DO
BEGIN
ch = CH$RCHAR_A (tcp);
IF .ch GEQ %C'a' AND .ch LEQ %C'z' THEN ch = .ch XOR casebit;
CH$WCHAR_A (.ch, lcp);
END;
tcp = CH$PTR (command);
lcp = CH$PTR (comment);
INCR i from 1 to 6 DO
BEGIN
ch = CH$RCHAR_A (lcp);
IF .ch GEQ %C'a' AND .ch LEQ %C'z'
THEN
ch = .ch XOR casebit;
CH$WCHAR_A (.ch, tcp);
END;
IF CH$EQL (6, CH$PTR (command), !
6, CH$PTR (UPLIT('!<BLF/')))
THEN ! Analyse the rest of the line.
ctl$command (CH$PTR (comment));
CH$FILL (%C' ', 20, CH$PTR (comment)); ! Erase last comment
IF CH$EQL (3, .token [tok_cp], !
3, CH$PTR (UPLIT('!--'))) OR !
CH$EQL (3, .token [tok_cp], !
3, CH$PTR (UPLIT('!__')))
THEN
out$skip (1); ! Post-block skip
END;
END;
[start_block_com, mid_block_com, end_block_com] :
BEGIN
IF .token [tok_type] EQL start_block_com THEN out$skip (1);
out$comment ();
out$break ();
IF .token [tok_type] EQL end_block_com THEN out$skip (1);
END;
[remark] :
(out$force (); out$remark (); );
[s_newpage] :
; ! Delete formfeeds
[s_newline] :
; ! Ignore end-of-line lexemes.
[s_eludom] :
BEGIN
out$break ();
out$nit (); ! Recover from all errors in indentation
EXITLOOP;
END;
[s_end_of_file] :
BEGIN
! There may be comments and such left...
out$ntbreak ();
EXITLOOP;
END;
[OTHERWISE] :
EXITLOOP;
TES;
END; ! Loop
!+
! If not processing macros, the sequence "%QUOTE %" must be ignored.
! This is done by converting a percent that follows "%QUOTE" to a
! comma.
!-
IF .pquote AND !
NOT ctl$switch (sw_macro) AND !
.token [tok_type] EQL s_percent
THEN
tok = s_comma ! Ignore token type
ELSE
tok = .token [tok_type];
IF ctl$switch (sw_debug) THEN out$print ();
END; ! End of routine 'LEX$GETSYM'
END;
GLOBAL ROUTINE lex$init : NOVALUE = !
!++
! Functional description:
! This routine initializes own data for this module, in particular
! the tables associated with the SYNONYM facility.
!
! Formal parameters:
! None
!
! Implicit inputs:
! None
!
! Implicit outputs:
! None
!
! Routine value:
! None
!
! Side effects:
! None
!
!--
BEGIN
INCR i FROM 0 TO syn_table_size - 1 DO
BEGIN
! Clear out the synonym tables...
syn_list [.i, first_lex_syn] = !
syn_list [.i, final_lex_syn] = 0;
CH$FILL (%C' ', syn_name_len, !
CH$PTR (syn_list [.i, syn_name]));
END;
lex_index = syn_index = 0; ! Ignore previous synonym definitions
in_pc_if = 0; ! Zero count of %IF blocks
END; ! End of routine 'lex$init'
ROUTINE lookup : NOVALUE = !
!++
! Functional description:
! Identifies those words meaningful to the formatter.
!
! Formal parameters:
! None
!
! Implicit inputs:
! None
!
! Implicit outputs:
! None
!
! Routine value:
! None
!
! Side effects:
! The input text may be converted to upper or to lower case.
!--
BEGIN
LITERAL
max_sym_len = 31;
LOCAL
i, ! search index
hi, ! upper range on binary search
lo, ! lower range on binary search
lptr, ! pointer to 'locase'
uptr, ! pointer to 'upcase'
ch, ! storage for a character
iptr, ! pointer to input string
locase : VECTOR [CH$ALLOCATION (max_sym_len)], ! Storage for lower case string
upcase : VECTOR [CH$ALLOCATION (max_sym_len)]; ! Storage for upper case string
!<BLF/page>
!<BLF/noformat>
!++
! The following table is a complete list of all BLISS keywords,
! (with the exception of some machine-specific BUILTIN function names)
! in alphabetical (ASCII) sequence, with the associated lexeme type.
! Lexemes which have no effect on the formatter are included (with
! type = s_name) to permit automatic upper- lower- case
! conversions to take place. As new keywords are added to the language,
! they should be added to the table at the appropriate place.
!--
BIND
rnames = PLIT( !
s_name, scnt('$CODE$'), !
s_name, scnt('$COUNT'), !
s_name, scnt('$GLOBAL$'), !
s_name, scnt('$LENGTH'), !
s_name, scnt('$NAME'), !
s_name, scnt('$OWN$'), !
s_name, scnt('$PLIT$'), !
s_name, scnt('$QUOTE'), !
s_name, scnt('$REMAINING'), !
s_name, scnt('$STRING'), !
s_name, scnt('$UNQUOTE'), !
s_name, scnt('%ALLOCATION'), !
s_name, scnt('%ASCIC'), !
s_name, scnt('%ASCID'), !
s_name, scnt('%ASCII'), !
s_name, scnt('%ASCIZ'), !
s_empty, scnt('%ASSIGN'), !
s_name, scnt('%B'), !
s_name, scnt('%BLISS'), !
s_p_compiler, scnt('%BLISS16'), !
s_p_compiler, scnt('%BLISS32'), !
s_p_compiler, scnt('%BLISS36'), !
s_name, scnt('%BPADDR'), !
s_name, scnt('%BPUNIT'), !
s_name, scnt('%BPVAL'), !
s_name, scnt('%C'), !
s_name, scnt('%CHAR'), !
s_name, scnt('%CHARCOUNT'), !
s_name, scnt('%COUNT'), !
s_empty, scnt('%CTCE'), !
s_name, scnt('%D'), !
s_name, scnt('%DECIMAL'), !
s_name, scnt('%DECLARED'), !
s_name, scnt('%E'), !
s_percent_else, scnt('%ELSE'), !
s_empty, scnt('%ERROR'), !
s_empty, scnt('%ERRORMACRO'), !
s_name, scnt('%EXACTSTRING'), !
s_name, scnt('%EXITITERATION'), !
s_name, scnt('%EXITMACRO'), !
s_name, scnt('%EXPAND'), !
s_name, scnt('%EXPLODE'), !
s_percent_fi, scnt('%FI'), !
s_name, scnt('%FIELDEXPAND'), !
s_name, scnt('%IDENTICAL'), !
s_percent_if, scnt('%IF'), !
s_empty, scnt('%INFORM'), !
s_empty, scnt('%ISSTRING'), !
s_name, scnt('%LENGTH'), !
s_empty, scnt('%LTCE'), !
s_empty, scnt('%MESSAGE'), !
s_name, scnt('%NAME'), !
s_name, scnt('%NBITS'), !
s_name, scnt('%NBITSU'), !
s_name, scnt('%NULL'), !
s_name, scnt('%NUMBER'), !
s_name, scnt('%O'), !
s_name, scnt('%P'), !
s_EMPTY, scnt('%PRINT'), !
s_p_quote, scnt('%QUOTE'), !
s_name, scnt('%RAD50_10'), !
s_name, scnt('%RAD50_11'), !
s_name, scnt('%REF'), !
s_name, scnt('%REQUIRE'), ! ! TT 20-Oct-81
s_name, scnt('%REMAINING'), !
s_name, scnt('%REMOVE'), !
s_p_subtitle, scnt('%SBTTL'), !
s_name, scnt('%SIXBIT'), !
s_name, scnt('%SIZE'), !
s_name, scnt('%STRING'), !
s_name, scnt('%SWITCHES'), !
s_percent_then, scnt('%THEN'), !
s_p_title, scnt('%TITLE'), !
s_name, scnt('%UNQUOTE'), !
s_name, scnt('%UPVAL'), !
s_name, scnt('%VARIANT'), !
s_EMPTY, scnt('%WARN'), !
s_name, scnt('%X'), !
s_name, scnt('ABS'), !
s_name, scnt('ABSOLUTE'), !
s_name, scnt('ACTUALCOUNT'), !
s_name, scnt('ACTUALPARAMETER'),!
s_name, scnt('ACTUALTYPE'), !
s_name, scnt('ADDD'), !
s_name, scnt('ADDF'), !
s_name, scnt('ADDG'), !
s_name, scnt('ADDH'), !
s_name, scnt('ADDM'), !
s_name, scnt('ADDRESSING_MODE'),!
s_name, scnt('ALIGN'), !
s_name, scnt('ALWAYS'), !
s_and, scnt('AND'), !
s_name, scnt('AP'), !
s_name, scnt('ARGPTR'), !
s_name, scnt('ASHP'), !
s_name, scnt('ASSEMBLY'), !
s_begin, scnt('BEGIN'), !
s_name, scnt('BICPSW'), !
s_name, scnt('BINARY'), !
s_bind, scnt('BIND'), !
s_name, scnt('BISPSW'), !
s_name, scnt('BIT'), !
s_name, scnt('BITVECTOR'), !
s_name, scnt('BLISS'), !
s_name, scnt('BLISS10'), !
s_name, scnt('BLISS10_OTS'), !
s_name, scnt('BLISS10_REGS'), !
s_name, scnt('BLISS16'), !
s_name, scnt('BLISS32'), !
s_name, scnt('BLISS36'), !
s_name, scnt('BLISS36C'), !
s_name, scnt('BLISS36C_OTS'), !
s_name, scnt('BLOCK'), !
s_name, scnt('BLOCKVECTOR'), !
s_builtin, scnt('BUILTIN'), !
s_by, scnt('BY'), !
s_byte, scnt('BYTE'), !
s_name, scnt('CALL'), !
s_name, scnt('CALLG'), !
s_case, scnt('CASE'), !
s_name, scnt('CAVEAT'), !
s_name, scnt('CH$ALLOCATION'), !
s_name, scnt('CH$A_RCHAR'), !
s_name, scnt('CH$A_WCHAR'), !
s_name, scnt('CH$COMPARE'), !
s_name, scnt('CH$COPY'), !
s_name, scnt('CH$DIFF'), !
s_name, scnt('CH$EQL'), !
s_name, scnt('CH$FAIL'), !
s_name, scnt('CH$FILL'), !
s_name, scnt('CH$FIND_CH'), !
s_name, scnt('CH$FIND_NOT_CH'), !
s_name, scnt('CH$FIND_SUB'), !
s_name, scnt('CH$GEQ'), !
s_name, scnt('CH$GTR'), !
s_name, scnt('CH$LEQ'), !
s_name, scnt('CH$LSS'), !
s_name, scnt('CH$MOVE'), !
s_name, scnt('CH$NEQ'), !
s_name, scnt('CH$PLUS'), !
s_name, scnt('CH$PTR'), !
s_name, scnt('CH$RCHAR'), !
s_name, scnt('CH$RCHAR_A'), !
s_name, scnt('CH$SIZE'), !
s_name, scnt('CH$TRANSLATE'), !
s_plit, scnt('CH$TRANSTABLE'), !
s_name, scnt('CH$WCHAR'), !
s_name, scnt('CH$WCHAR_A'), !
s_name, scnt('CLEARSTACK'), !
s_name, scnt('CMPC3'), !
s_name, scnt('CMPC5'), !
s_name, scnt('CMPD'), !
s_name, scnt('CMPF'), !
s_name, scnt('CMPG'), !
s_name, scnt('CMPH'), !
s_name, scnt('CMPM'), !
s_name, scnt('CODE'), !
s_codecomment, scnt('CODECOMMENT'), !
s_name, scnt('COMMENTARY'), !
s_compiletime, scnt('COMPILETIME'), !
s_name, scnt('CONCATENATE'), !
s_name, scnt('CRC'), !
s_name, scnt('CVTDF'), !
s_name, scnt('CVTDI'), !
s_name, scnt('CVTFD'), !
s_name, scnt('CVTFG'), !
s_name, scnt('CVTFH'), !
s_name, scnt('CVTFI'), !
s_name, scnt('CVTGF'), !
s_name, scnt('CVTGH'), !
s_name, scnt('CVTGL'), !
s_name, scnt('CVTHF'), !
s_name, scnt('CVTHG'), !
s_name, scnt('CVTHL'), !
s_name, scnt('CVTID'), !
s_name, scnt('CVTIF'), !
s_name, scnt('CVTLG'), !
s_name, scnt('CVTLH'), !
s_name, scnt('CVTRGH'), !
s_name, scnt('CVTRGL'), !
s_name, scnt('DEBUG'), !
s_decr, scnt('DECR'), !
s_decra, scnt('DECRA'), !
s_decru, scnt('DECRU'), !
s_name, scnt('DIVD'), !
s_name, scnt('DIVF'), !
s_name, scnt('DIVH'), !
s_do, scnt('DO'), !
s_name, scnt('EDIV'), !
s_name, scnt('EIS'), !
s_else, scnt('ELSE'), !
s_eludom, scnt('ELUDOM'), !
s_name, scnt('EMT'), !
s_name, scnt('EMUL'), !
s_enable, scnt('ENABLE'), !
s_end, scnt('END'), !
s_name, scnt('ENTRY'), !
s_name, scnt('ENVIRONMENT'), !
s_eql, scnt('EQL'), !
s_eqla, scnt('EQLA'), !
s_eqlu, scnt('EQLU'), !
s_eqv, scnt('EQV'), !
s_name, scnt('ERRS'), !
s_name, scnt('EXECUTE'), !
s_exitloop, scnt('EXITLOOP'), !
s_name, scnt('EXPAND'), !
s_name, scnt('EXTENDED'), !
s_external, scnt('EXTERNAL'), !
s_name, scnt('F10'), !
s_name, scnt('FFC'), !
s_name, scnt('FFS'), !
s_field, scnt('FIELD'), !
s_name, scnt('FIRSTONE'), !
s_name, scnt('FORTRAN'), !
s_name, scnt('FORTRAN_FUNC'), !
s_name, scnt('FORTRAN_SUB'), !
s_forward, scnt('FORWARD'), !
s_name, scnt('FP'), !
s_name, scnt('FRAMETYPE'), !
s_from, scnt('FROM'), !
s_name, scnt('GENERAL'), !
s_geq, scnt('GEQ'), !
s_geqa, scnt('GEQA'), !
s_gequ, scnt('GEQU'), !
s_global, scnt('GLOBAL'), !
s_gtr, scnt('GTR'), !
s_gtra, scnt('GTRA'), !
s_gtru, scnt('GTRU'), !
s_name, scnt('HALT'), !
s_name, scnt('IDENT'), !
s_if, scnt('IF'), !
s_incr, scnt('INCR'), !
s_incra, scnt('INCRA'), !
s_incru, scnt('INCRU'), !
s_name, scnt('INDEX'), !
s_initial, scnt('INITIAL'), !
s_name, scnt('INRANGE'), !
s_name, scnt('INSQUE'), !
s_name, scnt('INTERRUPT'), !
s_name, scnt('IOPAGE'), !
s_name, scnt('IOT'), !
s_name, scnt('JSB'), !
s_name, scnt('JSR'), ! BLISS-16
s_name, scnt('JSYS'), ! BLISS-36
s_keywordmacro, scnt('KEYWORDMACRO'), !
s_label, scnt('LABEL'), !
s_name, scnt('LANGUAGE'), !
s_leave, scnt('LEAVE'), !
s_leq, scnt('LEQ'), !
s_leqa, scnt('LEQA'), !
s_lequ, scnt('LEQU'), !
s_library, scnt('LIBRARY'), !
s_linkage, scnt('LINKAGE'), !
s_name, scnt('LINKAGE_REGS'), !
s_name, scnt('LIST'), !
s_literal, scnt('LITERAL'), !
s_local, scnt('LOCAL'), !
s_name, scnt('LOCC'), !
s_long, scnt('LONG'), !
s_name, scnt('LONG_RELATIVE'), !
s_lss, scnt('LSS'), !
s_lssa, scnt('LSSA'), !
s_lssu, scnt('LSSU'), !
s_macro, scnt('MACRO'), !
s_name, scnt('MAIN'), !
s_map, scnt('MAP'), !
s_name, scnt('MATCHC'), !
s_name, scnt('MAX'), !
s_name, scnt('MAXA'), !
s_name, scnt('MAXU'), !
s_name, scnt('MFPR'), !
s_name, scnt('MIN'), !
s_name, scnt('MINA'), !
s_name, scnt('MINU'), !
s_mod, scnt('MOD'), !
s_module, scnt('MODULE'), !
s_name, scnt('MOVC3'), !
s_name, scnt('MOVC5'), !
s_name, scnt('MOVPSL'), !
s_name, scnt('MOVTC'), !
s_name, scnt('MOVPSL'), ! BLISS-32
s_name, scnt('MOVTUC'), ! BLISS-32
s_name, scnt('MPTR'), !
s_name, scnt('MULD'), !
s_name, scnt('MULF'), !
s_name, scnt('MULG'), !
s_name, scnt('MULH'), !
s_neq, scnt('NEQ'), !
s_neqa, scnt('NEQA'), !
s_nequ, scnt('NEQU'), !
s_name, scnt('NOASSEMBLY'), !
s_name, scnt('NOBINARY'), !
s_name, scnt('NOCODE'), !
s_name, scnt('NOCOMMENTARY'), !
s_name, scnt('NODEBUG'), !
s_name, scnt('NODEFAULT'), ! ! TT 20-Oct-81
s_name, scnt('NOEIS'), ! BLISS-16
s_name, scnt('NOERRS'), !
s_name, scnt('NOEXECUTE'), !
s_name, scnt('NOEXPAND'), !
s_name, scnt('NONEXTERNAL'), !
s_name, scnt('NOOBJECT'), !
s_name, scnt('NOOPTIMIZE'), !
s_name, scnt('NOPIC'), !
s_name, scnt('NOPRESERVE'), !
s_name, scnt('NOREAD'), !
s_name, scnt('NOREQUIRE'), !
s_name, scnt('NOSAFE'), !
s_name, scnt('NOSHARE'), !
s_name, scnt('NOSOURCE'), !
s_name, scnt('NOSYMBOLIC'), !
s_not, scnt('NOT'), !
s_name, scnt('NOTRACE'), !
s_name, scnt('NOTUSED'), !
s_name, scnt('NOUNAMES'), !
s_name, scnt('NOVALUE'), !
s_name, scnt('NOWRITE'), !
s_name, scnt('NOZIP'), !
s_name, scnt('NULLPARAMETER'), !
s_name, scnt('OBJECT'), !
s_of, scnt('OF'), !
s_name, scnt('OPTIMIZE'), !
s_name, scnt('OPTLEVEL'), !
s_or, scnt('OR'), !
s_name, scnt('OTHERWISE'), !
s_name, scnt('OTS'), !
s_name, scnt('OUTRANGE'), !
s_name, scnt('OVERLAY'), !
s_own, scnt('OWN'), !
s_name, scnt('PC'), !
s_name, scnt('PIC'), !
s_plit, scnt('PLIT'), !
s_name, scnt('POINT'), !
s_name, scnt('PORTAL'), !
s_name, scnt('PRESERVE'), !
s_initial, scnt('PRESET'), !
s_name, scnt('PROBER'), !
s_name, scnt('PROBEW'), !
s_psect, scnt('PSECT'), !
s_name, scnt('PUSHJ'), !
s_name, scnt('R0'), !
s_name, scnt('R1'), !
s_name, scnt('R10'), !
s_name, scnt('R11'), !
s_name, scnt('R2'), !
s_name, scnt('R3'), !
s_name, scnt('R4'), !
s_name, scnt('R5'), !
s_name, scnt('R6'), !
s_name, scnt('R7'), !
s_name, scnt('R8'), !
s_name, scnt('R9'), !
s_name, scnt('READ'), !
s_name, scnt('RECORD'), !
s_name, scnt('REF'), !
s_register, scnt('REGISTER'), !
s_name, scnt('RELATIVE'), !
s_name, scnt('RELOCATABLE'), !
s_name, scnt('REMQUE'), !
s_rep, scnt('REP'), !
s_name, scnt('REPLACEI'), !
s_name, scnt('REPLACEN'), !
s_require, scnt('REQUIRE'), !
s_name, scnt('RESERVE'), !
s_name, scnt('RESOLVED'), !
s_return, scnt('RETURN'), !
s_name, scnt('ROT'), !
s_routine, scnt('ROUTINE'), !
s_name, scnt('RTT'), !
s_name, scnt('SAFE'), !
s_select, scnt('SELECT'), !
s_selecta, scnt('SELECTA'), !
s_selectone, scnt('SELECTONE'), !
s_selectonea, scnt('SELECTONEA'), !
s_selectoneu, scnt('SELECTONEU'), !
s_selectu, scnt('SELECTU'), !
s_set, scnt('SET'), !
s_name, scnt('SETUNWIND'), !
s_name, scnt('SHARE'), !
s_name, scnt('SHOW'), !
s_name, scnt('SIGN'), !
s_name, scnt('SIGNAL'), !
s_name, scnt('SIGNAL_STOP'), !
s_name, scnt('SIGNED'), !
s_name, scnt('SKPC'), !
s_name, scnt('SOURCE'), !
s_name, scnt('SP'), !
s_name, scnt('STACK'), !
s_stacklocal, scnt('STACKLOCAL'), !
s_name, scnt('STANDARD'), !
s_name, scnt('STANDARD_OTS'), !
s_structure, scnt('STRUCTURE'), !
s_name, scnt('SUBD'), !
s_name, scnt('SUBF'), !
s_name, scnt('SUBG'), !
s_name, scnt('SUBH'), !
s_name, scnt('SUBM'), !
s_switches, scnt('SWITCHES'), !
s_name, scnt('SYMBOLIC'), !
s_name, scnt('SYSLOCAL'), !
s_tes, scnt('TES'), !
s_name, scnt('TESTBITCC'), !
s_name, scnt('TESTBITCCI'), !
s_name, scnt('TESTBITCS'), !
s_name, scnt('TESTBITSC'), !
s_name, scnt('TESTBITSS'), !
s_name, scnt('TESTBITSSI'), !
s_then, scnt('THEN'), !
s_to, scnt('TO'), !
s_name, scnt('TOPS10'), !
s_name, scnt('TOPS20'), !
s_name, scnt('TRACE'), !
s_name, scnt('TRAP'), !
s_name, scnt('TYPEPRESENT'), !
s_name, scnt('UNAMES'), !
s_undeclare, scnt('UNDECLARE'), !
s_name, scnt('UNRESOLVED'), !
s_name, scnt('UNSIGNED'), !
s_until, scnt('UNTIL'), !
s_uplit, scnt('UPLIT'), !
s_name, scnt('VECTOR'), !
s_name, scnt('VERSION'), !
s_name, scnt('VOLATILE'), !
s_name, scnt('WEAK'), !
s_while, scnt('WHILE'), !
s_with, scnt('WITH'), !
s_word, scnt('WORD'), !
s_name, scnt('WORD_RELATIVE'), !
s_name, scnt('WRITE'), !
s_name, scnt('XFC'), !
s_xor, scnt('XOR'), !
s_name, scnt('ZIP') !
) : VECTOR;
!<BLF/PAGE>
!+
! Convert the input identifier to both upper and lower case.
!-
iptr = .token [tok_cp];
lptr = CH$PTR (locase);
uptr = CH$PTR (upcase);
INCR i FROM 1 TO MIN (max_sym_len, .token [tok_len]) DO
BEGIN
ch = CH$RCHAR_A (iptr);
SELECTONE .ch OF
SET
[%C'A' TO %C'Z'] :
BEGIN
CH$WCHAR_A (.ch, uptr);
CH$WCHAR_A (.ch XOR casebit, lptr);
END;
[%C'a' TO %C'z'] :
BEGIN
CH$WCHAR_A (.ch, lptr);
CH$WCHAR_A (.ch XOR casebit, uptr);
END;
[OTHERWISE] :
BEGIN
CH$WCHAR_A (.ch, lptr);
CH$WCHAR_A (.ch, uptr);
END;
TES;
END;
!+
! Now look up (capitalized) symbol in BLISS keyword table.
! (Binary search is used.)
!-
lptr = CH$PTR (locase);
uptr = CH$PTR (upcase);
lo = 0;
hi = .plit_count (rnames)/entry_size - 1;
UNTIL .hi LSS .lo DO
BEGIN
LITERAL
_lss = -1,
_eql = 0,
_gtr = +1;
i = (.hi + .lo)/2; ! Midpoint of rest of table
!+
! Compare upper-case input name with BLISS keyword list
!-
CASE CH$COMPARE (.token [tok_len], .uptr, !
.rnames [1 + entry_size*.i], !
CH$PTR (.rnames [2 + entry_size*.i])) !
FROM _lss TO _gtr OF
SET
[_lss] :
hi = .i - 1;
[_eql] : ! Found name in table
BEGIN
token [tok_type] = .rnames [entry_size*.i];
EXITLOOP;
END;
[_gtr] :
lo = .i + 1;
TES;
END;
IF .hi LSS .lo
THEN ! No match was found, so
! it's a user name.
CASE ctl$switch (sw_user_case) FROM 0 TO 2 OF
SET
[sw_locase] :
CH$MOVE (MIN (max_sym_len, .token [tok_len]), !
.lptr, !
.token [tok_cp]);
[sw_upcase] :
CH$MOVE (MIN (max_sym_len, .token [tok_len]), !
.uptr, !
.token [tok_cp]);
[sw_nocase] :
0; ! leave it alone
TES
ELSE
CASE ctl$switch (sw_key_case) FROM 0 TO 2 OF
SET
[sw_locase] :
CH$MOVE (MIN (max_sym_len, .token [tok_len]), !
.lptr, !
.token [tok_cp]);
[sw_upcase] :
CH$MOVE (MIN (max_sym_len, .token [tok_len]), !
.uptr, !
.token [tok_cp]);
[sw_nocase] :
0; ! leave it alone
TES;
match = false; ! Assume not a synonym.
INCR i FROM 0 TO .syn_index DO
IF CH$EQL (.token [tok_len], .uptr, !
.syn_list [.i, lth_syn_name], !
CH$PTR (syn_list [.i, syn_name]), !
%C' ')
THEN
BEGIN
index = .i;
match = true;
EXITLOOP;
END;
IF .match
THEN
BEGIN
cur_lex = .syn_list [.index, first_lex_syn];
end_lex = .syn_list [.index, final_lex_syn];
token [tok_type] = null_symbol; ! Prevent immediate return of the name
! Now when LEX$GETSYM is entered, synonym lexemes will be returned
! until cur_lex catches up to end_lex.
END;
END; ! End of routine 'LOOKUP'
%TITLE 'Last page of LEX.BLI'
END ! End of module 'LEX'
ELUDOM