{
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. *)
Copyright (c) 1990-92 Albert Graef <ag@muwiinfa.geschichte.uni-mainz.de>
Copyright (C) 1996 Berend de Boer <berend@pobox.com>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
$Revision: 1.2 $
$Modtime: 96-07-31 21:15 $
$History: YACCTABL.PAS $
*
* ***************** Version 2 *****************
* User: Berend Date: 96-10-10 Time: 21:16
* Updated in $/Lex and Yacc/tply
* Updated for protected mode, windows and Delphi 1.X and 2.X.
}
unit YaccTabl;
interface
uses
YaccBase;
{$IFNDEF Win32}
var max_bytes : LongInt;
(* available memory *)
function n_bytes : LongInt;
(* memory actually used *)
{$ENDIF}
const
(* Maximum table sizes: *)
max_keys = 997; (* size of hash symbol table (prime number!) *)
{$IFDEF MsDos}
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 = 2400; (* number of items *)
max_trans = 2400; (* number of transitions *)
max_redns = 1200; (* number of reductions *)
{$ELSE}
max_nts = 900; (* maximum number of nonterminals *)
max_lits = max_nts+256; (* number of literals (300+256) *)
max_rules = max_nts+1; (* number of rules (300+1) *)
max_types = 100; (* number of type tags *)
max_prec = 50; (* maximum precedence level *)
{$IFDEF Windows}
max_states = 800; (* number of LR(0) states *)
{$ELSE}
max_states = 1200; (* number of LR(0) states *)
{$ENDIF}
max_items = 9600; (* number of items *)
max_trans = 9600; (* number of transitions *)
max_redns = 1200; (* number of reductions *)
{$ENDIF}
{$IFDEF MsDos}
max_rule_len = 64; (* maximum length of rules *)
max_set_items = 64; (* maximum number of items in an item set *)
{$ELSE}
max_rule_len = 64; (* maximum length of rules *)
max_set_items = 96; (* maximum number of items in an item set *)
{$ENDIF}
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;
{$IFNDEF Win32}
function n_bytes : LongInt;
begin
n_bytes := max_bytes-memAvail
end(*n_bytes*);
{$ENDIF}
(* 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*);
{$ifndef fpc}{$F+}{$endif}
function lookup(k : Integer) : String;
{$ifndef fpc}{$F-}{$endif}
(* print name of symbol no. k *)
begin
with sym_table^[k] do
if pname=nil then
lookup := ''
else
lookup := pname^
end(*lookup*);
{$ifndef fpc}{$F+}{$endif}
procedure entry(k : Integer; symbol : String);
{$ifndef fpc}{$F-}{$endif}
(* 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, {$ifdef fpc}@{$endif}lookup,
{$ifdef fpc}@{$endif}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 begin
if sym_table^[sym_key^[sym]].pname^[1]=''''
then begin
pname := singleQuoteStr(
copy( sym_table^[sym_key^[sym]].pname^,
2,
length(sym_table^[sym_key^[sym]].pname^)-2)
)
end
else begin
pname := sym_table^[sym_key^[sym]].pname^;
end;
end;
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*);
{$ifndef fpc}{$F+}{$endif}
function rule_less ( i, j : Integer ) : Boolean;
{$ifndef fpc}{$F-}{$endif}
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*);
{$ifndef fpc}{$F+}{$endif}
procedure rule_swap ( i, j : Integer );
{$ifndef fpc}{$F-}{$endif}
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, {$ifdef fpc}@{$endif}rule_less,
{$ifdef fpc}@{$endif}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_nt_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: *)
{$ifndef fpc}{$F+}{$endif}
function type_less ( i, j : Integer ) : Boolean;
{$ifndef fpc}{$F-}{$endif}
begin
type_less := sym_table^[type_table^[i]].pname^<
sym_table^[type_table^[j]].pname^
end(*type_less*);
{$ifndef fpc}{$F+}{$endif}
procedure type_swap ( i, j : Integer );
{$ifndef fpc}{$F-}{$endif}
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 : Integer;
begin
(* sort: *)
quicksort(1, n_types, {$ifdef fpc}@{$endif}type_less,
{$ifdef fpc}@{$endif}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: *)
{$ifndef fpc}{$F+}{$endif}
function items_less ( i, j : Integer ) : Boolean;
{$ifndef fpc}{$F-}{$endif}
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*);
{$ifndef fpc}{$F+}{$endif}
procedure items_swap ( i, j : Integer );
{$ifndef fpc}{$F-}{$endif}
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, {$ifdef fpc}@{$endif}items_less,
{$ifdef fpc}@{$endif}items_swap);
item_set := sort_items;
end(*sort_item_set*);
var i : Integer;
begin
verbose := false;
debug := false;
startnt := 0;
{$IFNDEF Win32}
max_bytes := memAvail;
{$ENDIF}
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*).
syntax highlighted by Code2HTML, v. 0.9.1