home *** CD-ROM | disk | FTP | other *** search
-
- unit YaccTables;
-
- (* 2-16-91 AG *)
-
- (* Copyright (c) 1990,91 by Albert Graef, Schillerstr. 18,
- 6509 Schornsheim/Germany
- All rights reserved *)
-
- interface
-
- uses YaccBase;
-
- (* This module collects the various tables used by the Yacc program:
- - the symbol table
- - the rule table
- - the precedence table
- - the closure table
- - the LALR state, item, transition and reduction table
- Note: All tables are allocated dynamically (at initialization time)
- because of the 64KB static data limit. *)
-
- var max_bytes : LongInt;
- (* available memory *)
-
- function n_bytes : LongInt;
- (* memory actually used *)
-
- const
-
- (* Maximum table sizes: *)
-
- max_keys = 997; (* size of hash symbol table (prime number!) *)
- max_nts = 300; (* maximum number of nonterminals *)
- max_lits = 556; (* number of literals (300+256) *)
- max_rules = 301; (* number of rules (300+1) *)
- max_types = 100; (* number of type tags *)
- max_prec = 50; (* maximum precedence level *)
- max_states = 600; (* number of LR(0) states *)
- max_items = 3000; (* number of items *)
- max_trans = 3000; (* number of transitions *)
- max_redns = 1200; (* number of reductions *)
-
- max_rule_len = 64; (* maximum length of rules *)
- max_set_items = 100; (* maximum number of items in an item set *)
-
- var
-
- (* Actual table sizes: *)
-
- n_nts : Integer;
- n_lits : Integer;
- n_rules : Integer;
- n_types : Integer;
- n_prec : Integer;
- n_states : Integer;
- n_items : Integer;
- n_trans : Integer;
- n_redns : Integer;
-
- type
-
- (* Table data structures: *)
-
- (* Symbol table: The symbol table consists of a hash table which stores
- print names and internal symbol numbers, and a key table which stores,
- for each internal symbol number, the corresponding hash key. *)
-
- SymRec = record
- pname : StrPtr;
- (* print name; empty entries are denoted by pname=nil *)
- deff : Boolean;
- (* flag denoting whether symbol is already defined *)
- sym : Integer;
- (* internal symbol number (0 or positive: literal symbols
- (literal characters have symbol numbers 1 thru 255);
- negative: nonterminal symbols; 0 denotes endmarker,
- -1 augmented start nonterminal, 256 is reserved for
- error token; note that the predefined symbols except
- the error literal are not actually stored in the symbol
- table; the error symbol is entered at initialization
- s.t. it always has number 256) *)
- end;
-
- SymTable = array [1..max_keys] of SymRec;
-
- SymKeyTable = array [-max_nts..max_lits-1] of Integer;
- (* hash keys for nonterminal and literal symbols *)
-
- (* Rule table: the rule table consists of an array storing the rules
- sequentially in the order in which they appear in the source grammar;
- a rule no.s table which is used to sort rules w.r.t. left-hand side
- nonterminals (after the rule table has been constructed and sorted, all
- references to rules are done indirectly via the rule_no array s.t. the
- rules for each nonterminal can be accessed easily); and an offset table
- which stores, for each nonterminal, the corresponding first and last
- index in the rule no.s table. *)
-
- RuleRec = record
- lhs_sym : Integer; (* lhs nonterminal *)
- rhs_len : Integer; (* length of rhs *)
- rhs_sym : array [1..max_rule_len] of Integer;
- (* rhs symbols *)
- end;
-
- RuleRecPtr = ^RuleRec;
-
- RuleTable = array [1..max_rules] of RuleRecPtr;
-
- RuleNoTable = array [1..max_rules] of Integer;
-
- RuleOffsRec = record
- rule_lo, rule_hi : Integer;
- end;
-
- RuleOffsTable = array [1..max_nts] of RuleOffsRec;
-
- (* Symbol type table: The symbol type table stores the types associated
- with the nonterminal and terminal grammar symbols (0 if none). *)
-
- TypeTable = array [1..max_types] of Integer;
- (* types declared in the definitions section *)
-
- SymTypeTable = array [-max_nts..max_lits-1] of Integer;
- (* symbol types *)
-
- (* Precedence table: The precedence table stores the type of each
- precedence level (left, right, nonassoc) and, for each literal
- symbol and grammar rule, the assigned precedence level (precedence
- level 0 if none). *)
-
- PrecType = ( left, right, nonassoc );
-
- PrecTable = array [1..max_prec] of PrecType;
-
- SymPrecTable = array [0..max_lits-1] of Integer;
-
- RulePrecTable = array [1..max_rules] of Integer;
-
- (* Closure and first symbols table: The closure table stores, for each
- nonterminal X, the set of those nonterminals Y for which there is a
- rightmost derivation X =>+ Y ... . Similarly, the first set table
- stores, for each nonterminal X, the set of literals a for which there
- is a derivation X =>+ a ... . Both tables are of type SymSetTable.
-
- The nullable table stores, for each nonterminal, a flag denoting whether
- the nonterminal is nullable (i.e. may be derived to the empty string).
-
- These tables are constructed by the routines in the YaccClosure unit,
- and are used by the LALR parser construction algorithms in YaccLR0 and
- YaccLookaheads. *)
-
- SymSetTable = array [1..max_nts] of IntSetPtr;
-
- NullableTable = array [1..max_nts] of Boolean;
-
- (* State table:
-
- Each state stores the first and last index of the kernel items,
- transitions and reductions belonging to it, and a hash key determined
- from the kernel items which is used to speed up searches for existing
- states.
-
- The items table stores the individual kernel items in the LR(0) set.
- Each entry consists of a rule number together with the item position,
- and a "next" field indicating the associated item in the successor state
- (0 if there is none). The ItemSet type is used to retrieve and manipulate
- individual item sets from the item table.
-
- The transition table stores the shift and goto transitions in each state
- (each transition is denoted by a (symbol, next_state) pair). Similarly,
- the reductions table stores the reductions in each state, where each
- action is denoted by a (symbolset, ruleno) pair. *)
-
- StateRec = record
- item_lo, item_hi : Integer;
- trans_lo, trans_hi : Integer;
- redns_lo, redns_hi : Integer;
- key : Integer;
- end;
-
- StateTable = array [0..max_states-1] of StateRec;
-
- ItemRec = record
- rule_no, pos_no : Integer;
- next : Integer;
- end;
-
- ItemSet = record
- n_items : Integer;
- item : array [1..max_set_items] of ItemRec;
- end;
-
- ItemTable = array [1..max_items] of ItemRec;
-
- TransRec = record
- sym, next_state : Integer;
- end;
-
- TransTable = array [1..max_trans] of TransRec;
-
- RednRec = record
- symset : IntSetPtr;
- rule_no : Integer;
- end;
-
- RednTable = array [1..max_redns] of RednRec;
-
- (* Lookaheads table: This table stores, for each kernel item, the
- corresponding LALR(1) lookahead symbol sets. *)
-
- LookaheadTable = array [1..max_items] of IntSetPtr;
-
- (* The propagation table is used to keep track of how lookaheads are
- propagated from kernel items to other lookahead sets. *)
-
- PropList = ^PropEntry;
-
- PropEntry = record
- symset : IntSetPtr;
- next : PropList;
- end;
-
- PropTable = array [1..max_items] of PropList;
-
-
- var
-
- verbose : Boolean; (* status of the verbose option *)
- debug : Boolean; (* status of the debug option *)
- startnt : Integer; (* start nonterminal of grammar
- (0 if undefined) *)
- sym_table : ^SymTable; (* symbol table *)
- sym_key : ^SymKeyTable; (* symbol keys *)
- rule_table : ^RuleTable; (* rule table *)
- type_table : ^TypeTable; (* type table *)
- sym_type : ^SymTypeTable; (* symbol types *)
- prec_table : ^PrecTable; (* precedence table *)
- sym_prec : ^SymPrecTable; (* literal symbols precedence *)
- rule_prec : ^RulePrecTable; (* rules precedence *)
- rule_no : ^RuleNoTable; (* rule no table *)
- rule_offs : ^RuleOffsTable; (* rule offset table *)
- closure_table : ^SymSetTable; (* closure table *)
- first_set_table : ^SymSetTable; (* first set table *)
- nullable : ^NullableTable; (* nullable flags table *)
- state_table : ^StateTable; (* LR(0) state table *)
- item_table : ^ItemTable; (* LR(0) kernel item table *)
- trans_table : ^TransTable; (* transition table *)
- redn_table : ^RednTable; (* reduction table *)
- lookahead_table : ^LookaheadTable; (* LALR lookaheads table *)
- prop_table : ^PropTable; (* lookahead propagation table *)
-
-
- (* Operations: *)
-
- (* Symbol table routines: *)
-
- function new_nt : Integer;
- (* returns a new nonterminal number (<-1) *)
-
- function new_lit : Integer;
- (* returns a new literal number above 256 *)
-
- procedure add_lit ( sym : Integer );
- (* this routine allows to add a user-defined literal symbol;
- the current literal symbols count is adjusted accordingly *)
-
- function get_key ( symbol : String ) : Integer;
- (* returns a hash key for symbol *)
-
- procedure def_key ( k : Integer; sym : Integer );
- (* defines k to be a new symbol with internal symbol number sym *)
-
- function is_def_key ( k : Integer; var sym : Integer ) : Boolean;
- (* checks whether symbol denoted by symbol table key k is already
- defined; if so, returns the corresponding symbol number *)
-
- function pname ( sym : Integer ) : String;
- (* returns the print name of an internal symbol (`$end' for
- symbol 0, `$accept' for nonterminal -1, and a single quoted
- character for literals 1..255) *)
-
- (* Rule table routines: *)
-
- function newRuleRec ( r : RuleRec ) : RuleRecPtr;
- (* obtains a dynamic copy of r (only the number of bytes actually
- needed is allocated) *)
-
- procedure add_rule ( r : RuleRecPtr );
- (* add a rule to the rule table *)
-
- procedure sort_rules;
- (* sorts rules w.r.t. left-hand sides into the rule no table *)
-
- procedure rule_offsets;
- (* computes rule offsets after rules have been sorted *)
-
- function n_nt_rules ( sym : Integer ) : Integer;
- (* returns number of rules for nonterminal sym *)
-
- (* Type Table routines: *)
-
- procedure add_type ( k : Integer );
- (* add a type identifier to the table *)
-
- procedure sort_types;
- (* sort the type table alphabetically, eliminate dups *)
-
- function search_type ( symbol : String ) : Boolean;
- (* search the sorted types table for the given type symbol *)
-
- (* Precedence table routines: *)
-
- function new_prec_level ( prec_type : PrecType ) : Integer;
- (* adds a new precedence level of the denoted type; returns: the new
- level *)
-
- (* State table routines: *)
-
- var act_state : Integer; (* state currently considered *)
-
- procedure new_state;
- (* build a new state *)
-
- procedure add_item ( rule_no, pos_no : Integer );
- (* add an item to the new state (initialize its next field to 0) *)
-
- function add_state : Integer;
- (* add the new state to the state table; if an equivalent state is already
- in the table, dispose the new state, and return the existing state
- number, otherwise return the new state number *)
-
- procedure start_trans;
- (* starts building transitions of the active state *)
-
- procedure add_trans ( sym, next_state : Integer );
- (* adds a transition to the active state *)
-
- procedure end_trans;
- (* ends transitions of the active state *)
-
- procedure start_redns;
- (* starts building reduction actions of the active state *)
-
- procedure add_redn ( symset : IntSetPtr; rule_no : Integer );
- (* adds a reduction to the active state *)
-
- procedure end_redns;
- (* ends reduction actions of the active state *)
-
- function n_state_items ( s : Integer ) : Integer;
- function n_state_trans ( s : Integer ) : Integer;
- function n_state_redns ( s : Integer ) : Integer;
- (* return the number of kernel items, transitions and reductions in state
- s, respectively *)
-
- function find_item( s : Integer; rule_no, pos_no : Integer ) : Integer;
- (* find item (rule_no, pos_no) in state s; returns: the item number *)
-
- (* Item set routines: *)
-
- procedure empty_item_set ( var item_set : ItemSet );
- (* initializes an empty item set *)
-
- procedure include_item_set ( var item_set : ItemSet;
- rule_no, pos_no : Integer);
- (* add the denoted item to the given item set *)
-
- procedure get_item_set ( s : Integer; var item_set : ItemSet);
- (* obtain the item set of state s from the item table *)
-
- procedure closure ( var item_set : ItemSet );
- (* compute the closure of item_set (using the closure table) *)
-
- procedure sort_item_set ( var item_set : ItemSet );
- (* sorts an item set w.r.t. position and rule numbers (higher positions,
- lower rules first) *)
-
- implementation
-
- uses YaccMsgs;
-
- function n_bytes : LongInt;
- begin
- n_bytes := max_bytes-memAvail
- end(*n_bytes*);
-
- (* Symbol table routines: *)
-
- function new_nt : Integer;
- begin
- inc(n_nts);
- if n_nts>max_nts then fatal(nt_table_overflow);
- sym_type^[-n_nts] := 0;
- new_nt := -n_nts;
- end(*new_nt*);
-
- function new_lit : Integer;
- begin
- inc(n_lits);
- if n_lits>max_lits then fatal(lit_table_overflow);
- sym_type^[n_lits-1] := 0;
- sym_prec^[n_lits-1] := 0;
- new_lit := n_lits-1;
- end(*new_lit*);
-
- procedure add_lit ( sym : Integer );
- begin
- if sym>n_lits then n_lits := sym;
- if n_lits>max_lits then fatal(lit_table_overflow);
- sym_type^[sym] := 0;
- sym_prec^[sym] := 0;
- end(*add_lit*);
-
- {$F+}
- function lookup(k : Integer) : String;
- {$F-}
- (* print name of symbol no. k *)
- begin
- with sym_table^[k] do
- if pname=nil then
- lookup := ''
- else
- lookup := pname^
- end(*lookup*);
-
- {$F+}
- procedure entry(k : Integer; symbol : String);
- {$F-}
- (* enter symbol into table *)
- begin
- sym_table^[k].pname := newStr(symbol);
- end(*entry*);
-
- function get_key ( symbol : String ) : Integer;
- begin
- get_key := key(symbol, max_keys, lookup, entry);
- end(*get_key*);
-
- procedure def_key ( k : Integer; sym : Integer );
- begin
- sym_key^[sym] := k;
- sym_table^[k].deff := true;
- sym_table^[k].sym := sym;
- end(*def_key*);
-
- function is_def_key ( k : Integer; var sym : Integer ) : Boolean;
- begin
- if sym_table^[k].deff then
- begin
- sym := sym_table^[k].sym;
- is_def_key := true;
- end
- else
- is_def_key := false
- end(*is_def_key*);
-
- function pname ( sym : Integer ) : String;
- begin
- case sym of
- 1..255 : pname := singleQuoteStr(chr(sym));
- 0 : pname := '$end';
- -1 : pname := '$accept';
- else if sym_table^[sym_key^[sym]].pname^[1]='''' then
- pname := singleQuoteStr(
- copy( sym_table^[sym_key^[sym]].pname^,
- 2,
- length(sym_table^[sym_key^[sym]].pname^)-2)
- )
- else
- pname := sym_table^[sym_key^[sym]].pname^
- end;
- end(*pname*);
-
- (* Rule table: *)
-
- function newRuleRec ( r : RuleRec ) : RuleRecPtr;
- var rp : RuleRecPtr;
- begin
- getmem(rp, 2*sizeOf(Integer)+r.rhs_len*sizeOf(Integer));
- move(r, rp^, 2*sizeOf(Integer)+r.rhs_len*sizeOf(Integer));
- newRuleRec := rp;
- end(*newRuleRec*);
-
- procedure add_rule ( r : RuleRecPtr );
- begin
- inc(n_rules);
- if n_rules>max_rules then fatal(rule_table_overflow);
- rule_table^[n_rules] := r;
- end(*add_rule*);
-
- {$F+}
- function rule_less ( i, j : Integer ) : Boolean;
- {$F-}
- begin
- if rule_table^[rule_no^[i]]^.lhs_sym =
- rule_table^[rule_no^[j]]^.lhs_sym then
- rule_less := rule_no^[i] < rule_no^[j]
- else
- rule_less := rule_table^[rule_no^[i]]^.lhs_sym >
- rule_table^[rule_no^[j]]^.lhs_sym
- end(*rule_less*);
-
- {$F+}
- procedure rule_swap ( i, j : Integer );
- {$F-}
- var x : Integer;
- begin
- x := rule_no^[i]; rule_no^[i] := rule_no^[j]; rule_no^[j] := x;
- end(*rule_swap*);
-
- procedure sort_rules;
- var i : Integer;
- begin
- for i := 1 to n_rules do rule_no^[i] := i;
- quicksort ( 1, n_rules, rule_less, rule_swap );
- end(*sort_rules*);
-
- procedure rule_offsets;
- var i, sym : Integer;
- begin
- for sym := 1 to n_nts do with rule_offs^[sym] do
- begin
- rule_lo := 1; rule_hi := 0;
- end;
- i := 1;
- while (i<=n_rules) do
- begin
- sym := rule_table^[rule_no^[i]]^.lhs_sym;
- rule_offs^[-sym].rule_lo := i;
- inc(i);
- while (i<=n_rules) and
- (rule_table^[rule_no^[i]]^.lhs_sym=sym) do
- inc(i);
- rule_offs^[-sym].rule_hi := i-1;
- end;
- end(*rule_offsets*);
-
- function n_nt_rules ( sym : Integer ) : Integer;
- begin
- with rule_offs^[-sym] do
- n_rules := rule_hi-rule_lo+1
- end(*n_nt_rules*);
-
- (* Type Table routines: *)
-
- procedure add_type ( k : Integer );
- begin
- inc(n_types);
- if n_types>max_types then fatal(type_table_overflow);
- type_table^[n_types] := k;
- end(*add_type*);
-
- (* Routines to sort type identifiers alphabetically: *)
-
- {$F+}
- function type_less ( i, j : Integer ) : Boolean;
- {$F-}
- begin
- type_less := sym_table^[type_table^[i]].pname^<
- sym_table^[type_table^[j]].pname^
- end(*type_less*);
-
- {$F+}
- procedure type_swap ( i, j : Integer );
- {$F-}
- var x : Integer;
- begin
- x := type_table^[i];
- type_table^[i] := type_table^[j];
- type_table^[j] := x;
- end(*type_swap*);
-
- procedure sort_types;
- var i, j, count, sym : Integer;
- begin
- (* sort: *)
- quicksort(1, n_types, type_less, type_swap);
- (* eliminate dups: *)
- i := 1; j := 1; count := 0;
- while i<=n_types do
- begin
- if i<>j then type_table^[j] := type_table^[i];
- while (i<n_types) and (type_table^[i+1]=type_table^[i]) do
- begin
- inc(i); inc(count);
- end;
- inc(i); inc(j);
- end;
- dec(n_types, count);
- end(*sort_types*);
-
- function search_type ( symbol : String ) : Boolean;
- var l, r, k : Integer;
- begin
- (* binary search: *)
- l := 1; r := n_types;
- k := l + (r-l) div 2;
- while (l<r) and (sym_table^[type_table^[k]].pname^<>symbol) do
- begin
- if sym_table^[type_table^[k]].pname^<symbol then
- l := succ(k)
- else
- r := pred(k);
- k := l + (r-l) div 2;
- end;
- search_type := (k<=n_types) and (sym_table^[type_table^[k]].pname^=symbol);
- end(*search_type*);
-
- (* Precedence table routines: *)
-
- function new_prec_level ( prec_type : PrecType ) : Integer;
- begin
- inc(n_prec);
- if n_prec>max_prec then fatal(prec_table_overflow);
- prec_table^[n_prec] := prec_type;
- new_prec_level := n_prec;
- end(*new_prec_level*);
-
- (* State table: *)
-
- procedure new_state;
- begin
- inc(n_states);
- if n_states>max_states then fatal(state_table_overflow);
- state_table^[n_states-1].item_lo := n_items+1;
- end(*new_state*);
-
- procedure add_item ( rule_no, pos_no : Integer );
- begin
- inc(n_items);
- if n_items>max_items then fatal(item_table_overflow);
- item_table^[n_items].rule_no := rule_no;
- item_table^[n_items].pos_no := pos_no;
- item_table^[n_items].next := 0;
- end(*add_item*);
-
- function add_state : Integer;
- function state_key ( s : Integer ) : Integer;
- (* determines a hash key for state s *)
- const max_key = 4001;
- (* should be prime number s.t. hash keys are distributed
- evenly *)
- var i, k : Integer;
- begin
- with state_table^[s] do
- begin
- k := 0;
- for i := item_lo to item_hi do
- with item_table^[i] do
- inc(k, rule_no+pos_no);
- state_key := k mod max_key;
- end;
- end(*state_key*);
- function search_state ( s, lo, hi : Integer; var t : Integer ) : Boolean;
- (* searches the range lo..hi in the state table for a state with the
- same kernel items as s; returns true if found, and then the
- corresponding state number in t *)
- function eq_items(s, t : Integer) : Boolean;
- (* compares kernel item sets of states s and t *)
- var i, i_s, i_t : Integer;
- begin
- if n_state_items(s)<>n_state_items(t) then
- eq_items := false
- else
- begin
- i_s := state_table^[s].item_lo;
- i_t := state_table^[t].item_lo;
- for i := 0 to n_state_items(s)-1 do
- if (item_table^[i_s+i].rule_no<>item_table^[i_t+i].rule_no) or
- (item_table^[i_s+i].pos_no<>item_table^[i_t+i].pos_no) then
- begin
- eq_items := false;
- exit;
- end;
- eq_items := true;
- end
- end(*eq_items*);
- var t1 : Integer;
- begin
- with state_table^[s] do
- for t1 := lo to hi do
- if (key=state_table^[t1].key) and
- eq_items(s, t1) then
- begin
- search_state := true;
- t := t1;
- exit;
- end;
- search_state := false;
- end(*search_state*);
- var s : Integer;
- begin
- with state_table^[n_states-1] do
- begin
- item_hi := n_items;
- key := state_key(n_states-1);
- if search_state(n_states-1, 0, n_states-2, s) then
- begin
- n_items := item_lo;
- dec(n_states);
- add_state := s;
- end
- else
- add_state := n_states-1;
- end;
- end(*add_state*);
-
- procedure start_trans;
- begin
- state_table^[act_state].trans_lo := n_trans+1;
- end(*start_trans*);
-
- procedure add_trans ( sym, next_state : Integer );
- begin
- inc(n_trans);
- if n_trans>max_trans then fatal(trans_table_overflow);
- trans_table^[n_trans].sym := sym;
- trans_table^[n_trans].next_state := next_state;
- end(*add_trans*);
-
- procedure end_trans;
- begin
- state_table^[act_state].trans_hi := n_trans;
- end(*end_trans*);
-
- procedure start_redns;
- begin
- state_table^[act_state].redns_lo := n_redns+1;
- end(*start_redns*);
-
- procedure add_redn ( symset : IntSetPtr; rule_no : Integer );
- begin
- inc(n_redns);
- if n_redns>max_redns then fatal(redn_table_overflow);
- redn_table^[n_redns].symset := symset;
- redn_table^[n_redns].rule_no := rule_no;
- end(*add_redn*);
-
- procedure end_redns;
- begin
- state_table^[act_state].redns_hi := n_redns;
- end(*end_redns*);
-
- function n_state_items ( s : Integer ) : Integer;
- begin
- with state_table^[s] do
- n_state_items := item_hi-item_lo+1
- end(*n_state_items*);
-
- function n_state_trans ( s : Integer ) : Integer;
- begin
- with state_table^[s] do
- n_state_trans := trans_hi-trans_lo+1
- end(*n_state_trans*);
-
- function n_state_redns ( s : Integer ) : Integer;
- begin
- with state_table^[s] do
- n_state_redns := redns_hi-redns_lo+1
- end(*n_state_redns*);
-
- function find_item( s : Integer; rule_no, pos_no : Integer ) : Integer;
- var i : Integer;
- begin
- with state_table^[s] do
- for i := item_lo to item_hi do
- if (item_table^[i].rule_no=rule_no) and
- (item_table^[i].pos_no=pos_no) then
- begin
- find_item := i;
- exit;
- end;
- find_item := 0;
- end(*find_item*);
-
- (* Item set routines: *)
-
- procedure empty_item_set ( var item_set : ItemSet );
- begin
- item_set.n_items := 0;
- end(*empty_item_set*);
-
- procedure include_item_set ( var item_set : ItemSet;
- rule_no, pos_no : Integer);
- begin
- with item_set do
- begin
- inc(n_items);
- if n_items> max_set_items then fatal(item_table_overflow);
- item[n_items].rule_no := rule_no;
- item[n_items].pos_no := pos_no;
- end;
- end(*include_item_set*);
-
- procedure get_item_set ( s : Integer; var item_set : ItemSet);
- begin
- with state_table^[s], item_set do
- begin
- n_items := n_state_items(s);
- move(item_table^[item_lo], item, n_items*sizeOf(ItemRec));
- end
- end(*get_item_set*);
-
- procedure closure ( var item_set : ItemSet );
- var i, j : Integer;
- nt_syms0, nt_syms : IntSet;
- begin
- with item_set do
- begin
- (* get the nonterminals at current positions in items: *)
- empty(nt_syms0);
- for i := 1 to n_items do
- with item[i], rule_table^[rule_no]^ do
- if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) then
- include(nt_syms0, rhs_sym[pos_no]);
- nt_syms := nt_syms0;
- (* add closure symbols: *)
- for i := 1 to size(nt_syms0) do
- setunion(nt_syms, closure_table^[-nt_syms0[i]]^);
- (* add the nonkernel items for the nonterminal symbols: *)
- for i := 1 to size(nt_syms) do
- with rule_offs^[-nt_syms[i]] do
- for j := rule_lo to rule_hi do
- include_item_set(item_set, rule_no^[j], 1);
- end;
- end(*closure*);
-
- var sort_items : ItemSet;
-
- (* comparison and swap routines for sort_item_set: *)
-
- {$F+}
- function items_less ( i, j : Integer ) : Boolean;
- {$F-}
- begin
- with sort_items do
- if item[i].pos_no=item[j].pos_no then
- items_less := item[i].rule_no<item[j].rule_no
- else
- items_less := item[i].pos_no>item[j].pos_no
- end(*items_less*);
-
- {$F+}
- procedure items_swap ( i, j : Integer );
- {$F-}
- var x : ItemRec;
- begin
- with sort_items do
- begin
- x := item[i]; item[i] := item[j]; item[j] := x;
- end
- end(*items_swap*);
-
- procedure sort_item_set ( var item_set : ItemSet );
- begin
- sort_items := item_set;
- quicksort(1, sort_items.n_items, items_less, items_swap);
- item_set := sort_items;
- end(*sort_item_set*);
-
- var i : Integer;
-
- begin
-
- verbose := false;
- debug := false;
- startnt := 0;
-
- max_bytes := memAvail;
-
- n_nts := 1;
- n_lits := 257;
- n_rules := 0;
- n_types := 0;
- n_prec := 0;
- n_states := 0;
- n_items := 0;
- n_trans := 0;
- n_redns := 0;
-
- (* allocate tables: *)
-
- new(sym_table);
- new(sym_key);
- new(rule_table);
- new(rule_no);
- new(rule_offs);
- new(type_table);
- new(sym_type);
- new(prec_table);
- new(sym_prec);
- new(rule_prec);
- new(closure_table);
- new(first_set_table);
- new(nullable);
- new(state_table);
- new(item_table);
- new(trans_table);
- new(redn_table);
- new(lookahead_table);
- new(prop_table);
-
- (* initialize symbol table: *)
-
- for i := 1 to max_keys do
- with sym_table^[i] do
- begin
- pname := nil;
- deff := false;
- end;
-
- (* enter predefined error symbol into symbol table: *)
-
- def_key(get_key('error'), 256);
-
- (* initialize type and precedence tables: *)
-
- for i := -max_nts to max_lits-1 do sym_type^[i] := 0;
- for i := 0 to max_lits-1 do sym_prec^[i] := 0;
- for i := 1 to max_rules do rule_prec^[i] := 0;
-
- end(*YaccTables*).
-