main module Tables // TABLES -- Convert special CG table and template notation to Praxis // source. // Earl Killian, June 80 // MODIFICATIONS - version 7.2 // 06-Dec-1984 F. Holloway Added max pattern, action on printout // 07-Feb-1985 F. Holloway List ST rows from TABLET - debugging //------------------------------------------------------------------- import opcodes from OPCODE // for STE.opcode //-------------------------version 7.2-------------------- //import // file, // TTY, // EOF, // mode, // Open_file, // Close_file, // Out_record, // Out_character, // Out_string, // Out_padded_string, // Out_integer, // mode enumeration constants // read, write, // IO_open_failure // from TextIO use TEXTIO //----------------------------------- import reg, address_mode from OPERND // for STE.reg and STE.mode import C_code_tag from CCODE import operand_type from CCOPTYPE import action_type, Pattern_tag, Pattern, Pattern_tree_node, Pattern_tree_max, Pattern_tree_index, Action_max, Action_index, Action_datum, local_index, // for STE.label_number and // STE.temporary_number Pattern_line_max, Pattern_line_index, table_ccode_tag, sys_names, sys_strings from CGTDEFS import Token, null_token, reserve_symbol_type, Symbol_kind, STE, Symbol, ST, last_symbol from TABLET import Warn, Error, source, tables, arrays, ccarrays, listing_file, Space, Tab, LF, //---------version 7.2 ------------------ EOF, abort, //---------------------------------------- NextCharacter, NextNextCharacter, List_number, ReadCharacter, ReadInteger, Skip_character, Skip_horizontal_whitespace, Skip_whitespace, Read_non_whitespace, Skip_to_LF, Ins_character, Ins_string, ReadToken, ReadDefinedSymbol, Enter_symbol, ReadSymbol, error_called from TABLEZ // SamePattern: examine two pattern items and check for identity. function SamePattern(P1, P2: in ref Pattern) returns same: boolean initially false // pessimistic if P1.Ptag <> P2.Ptag or P1.invert <> P2.invert do return endif select P1.Ptag from case stack: if P1.n <> P2.n do return endif case element: if P1.Ctag <> P2.Ctag do return endif case operand_mode: if P1.mode <> P2.mode do return endif case specific_literal: if P1.literal_value <> P2.literal_value do return endif case ptrange: if P1.lo <> P2.lo or P1.hi <> P2.hi do return endif case class: if P1.class <> P2.class do return endif endselect same := true endfunction {SamePattern} // Declarations for processing patterns. declare Pattern_line is array[Pattern_line_index] of Pattern Pattern_tree: static array[Pattern_tree_index] of Pattern_tree_node Last_line: static Pattern_line last_line_max: static -1..Pattern_line_max initially -1 last_node: static -1..Pattern_tree_max initially -1 last_line_tree_index: static array[Pattern_line_index] of Pattern_tree_index enddeclare // Store a pattern into the pattern table. procedure Put_pattern(PL: in ref Pattern_line, N: in Pattern_line_index, A: in Action_index) // First find where the last pattern line and the new one differ. declare (Count: Pattern_line_index initially 0) if last_line_max >= 0 do // if there is a previous pattern while Count <= min(last_line_max, N) and SamePattern(Last_line[Count], PL[Count]) do Count *= + 1 endwhile // Count now contains index of first mismatch between Last_line and PL if last_node + (N-Count+1) > Pattern_tree_max do // make sure there's declare(Warned: static boolean initially false) // room if not Warned do Warn("Too many patterns, rest not loaded", "") Warned := true endif return endif if Count > last_line_max and // if initial segment of this pattern last_line_max < N do // line is same as last one then this // one can never be matched in // CGMAIN, so warn user and ignore. Warn("Redundant pattern line -- ignored", "") return endif if Count > N do Count *= - 1 endif Pattern_tree[last_line_tree_index[Count]].down := last_node + 1 // set down field of node // corresponding to first difference // in patterns to first node stored // into below endif for j := Count to N do // copy new pattern line after first // difference into tree last_node *= + 1 Last_line[j] := PL[j] // and also into last_line last_line_tree_index[j] := last_node Pattern_tree[last_node] := Pattern_tree_node(down: 0, right: 0, pattern: PL[j]) endfor Pattern_tree[last_node].right := A // indicate last node of pattern line // by setting right field to an // action number last_line_max := N endprocedure {Put_Pattern} // Process the action part of the templates. declare Action_count: static 0..Action_max initially 0 // number of actions so far Act_table: static array[Action_index] of Action_datum // table of action data enddeclare procedure Put_N(N: Action_datum) // store N into Act_table if Action_count = Action_max do Warn("Too many actions, rest not loaded", "") endif Action_count *= + 1 // so report actual number needed at // end if Action_count <= Action_max do Act_table[Action_count] := N endif endprocedure {Put_N} function Do_type() returns N: integer // read a type: $n long Skip_horizontal_whitespace() if NextCharacter = $$ do Skip_character() N := ReadInteger() - 1 otherwise declare (S: Symbol initially ReadSymbol()) if ST[S].kind <> type_name do Error("type expected", "") endif N := Pattern_line_max+1 + integer(ST[S].type) endif endfunction {Do_type} // Read a C-code item which, when CG executes, returns a C-code item. // Called from Do_operands and Do_action. procedure Do_Ccode() declare (S: Symbol initially ReadSymbol()) select ST[S].kind from case pattern_symbol: // reuse pattern symbols for // stack item or C-code item select ST[S].pattern.Ptag from case stack: // & (stack item) Put_N(integer(stack_ccode)) Put_N(ST[S].pattern.n) case element: // C-code item Put_N(integer(simple_ccode)) declare(L: logical initially logical(ST[S].pattern.ctag)) Put_N(integer((L rsh 8) and 8#377)) Put_N(integer(L and 8#377)) case specific_literal: Put_N(integer(literal_ccode)) Put_N(ST[S].pattern.literal_value) default: Error("'^a' not a C-code specifier", ST[S].T) endselect case ccode_ccode_table: // exists table ccode ==> ccode Put_N(integer(ccode_ccode)) Put_N(ST[S].table_n) Ins_character($() Do_ccode() Ins_character($)) case type_ccode_table: // use a type (e.g., $n) Put_N(integer(type_ccode)) Put_N(ST[S].table_n) Ins_character($() Put_N(Do_type()) Ins_character($)) case label_name: // Ln Put_N(integer(local_label_ccode)) Put_N(ST[S].label_number) case temporary_name: // Tn Put_N(integer(local_temporary_ccode)) Put_N(ST[S].temporary_number) case register_name: Put_N(integer(register_ccode)) Put_N(integer(ST[S].reg)) case operand_function: // instruction operand Put_N(integer(operand_ccode)) % if PDP10 if ST[S].mode = null_operand_mode do // use absolute_mode(R0) for null operand Put_N(integer(register_ccode)) Put_N(0) otherwise Ins_character($() Do_ccode() Ins_character($)) endif % otherwise Ins_character($() Do_ccode() Ins_character($)) % endif Put_N(integer(ST[S].mode)) case ccode_to_ccode_function: // ccode ==> ccode Put_N(integer(ST[S].funct)) // the function ID Ins_character($() get_args: repeat Do_ccode() Skip_whitespace() if NextCharacter<>$, do break get_args endif declare( c: char initially ReadCharacter() ) until false Ins_character($)) case type_ccode_to_ccode_function: // type, ccode ==> ccode Put_N(integer(ST[S].funct)) // the function ID Ins_character($() Put_N(Do_type()) Ins_character($,) Do_ccode() Ins_character($)) case ccode_number_to_ccode_function: // ccode, number ==> ccode Put_N(integer(ST[S].funct)) // the function ID Ins_character($() Do_ccode() Ins_character($,) Put_N(ReadInteger()) Ins_character($)) case system_name: Put_N(integer(sys_name_ccode)) Put_N(integer(ST[S].sys_id)) default: Error("'^a' not a C-code specifier", ST[S].T) endselect endprocedure {Do_ccode} // Read and process the operands for 1 instruction. // Called from Do_action. procedure Do_operands() Put_N(0) Skip_horizontal_whitespace() if NextCharacter = LF do Skip_character() return endif declare (Opcount_index: Action_Index initially Action_count) operands: while true do Do_Ccode() Act_table[Opcount_index] *= + 1 declare (c: char initially ReadCharacter()) if c = $, do loop operands endif if c = LF do break operands endif Error("Comma or end of line expected", "") endwhile {operands} endprocedure {Do_operands} // Process the action part of templates. procedure Do_action(S: Symbol) select ST[S].action from case end_action, stop_action, do_access_action, do_indirect_action, do_machine_action, do_select_action, do_semicolon_action, do_stack_adjust_action, do_subscript_action, do_entry_action, % if VAX do_cvt_v_action,vlass_action,vrass_action,do_scpent,do_scplve, % endif % if PDP11 do_push_m_action, do_cvt_v_action, vlass_action, vrass_action, do_fortran_entry_action, do_ref_action, % orif PDP10 do_ass_v_action, do_cvt_v_action, % endif not_implemented_action: Put_N(integer(ST[S].action)) Ins_character(LF) case newlabel_action: args: while true do Put_N(integer(newlabel_action)) S := ReadSymbol() if ST[S].kind <> label_name do Error("label name expected", "") endif Put_N(ST[S].label_number) declare(c: char initially ReadCharacter()) if c = $, do loop args endif if c = LF do break args endif endwhile {args} case newtemp_action: declare(T: integer initially Do_type()) Ins_character($,) args: while true do S := ReadSymbol() if ST[S].kind <> temporary_name do Error("temporary name expected", "") endif Put_N(integer(newtemp_action)) Put_N(T) Put_N(ST[S].temporary_number) declare(c: char initially ReadCharacter()) if c = LF do break args endif if c = $, do loop args endif Error("',' or LF expected", "") endwhile {args} % if PDP11 case placelabel_action, release_action, push_action, do_fortran_call_action: % orif VAX case placelabel_action, release_action, push_action: % orif PDP10 case placelabel_action, release_action, push_action, do_adjust_frame: % endif arguments: while true do Put_N(integer(ST[S].action)) Do_Ccode() declare (c: char initially ReadCharacter()) if c = $, do loop arguments endif if c = LF do break arguments endif Error("Comma or end of line expected", "") endwhile {arguments} case assign_action: arguments: while true do Put_N(integer(assign_action)) Put_N(Do_type()) Ins_character($,) Ins_character($R) Put_N(ReadInteger()) declare (c: char initially ReadCharacter()) if c = $, do loop arguments endif if c = LF do break arguments endif Error("Comma or end of line expected", "") endwhile {arguments} case moff_action: arguments: while true do Put_N(integer(moff_action)) Ins_character($&) Put_N(ReadInteger()-1) declare (c: char initially ReadCharacter()) if c = $, do loop arguments endif if c = LF do break arguments endif Error("Comma or end of line expected", "") endwhile {arguments} case simple_instruction_action: Put_N(integer(simple_instruction_action)) % if PDP10 Put_N(integer((logical(ST[S].opcode) rsh 8) and 8#377)) Put_N(integer( logical(ST[S].opcode) and 8#377)) % otherwise Put_N(integer(ST[S].opcode)) % endif Do_operands() case type_instruction_action: Put_N(integer(type_instruction_action)) Put_N(ST[S].table_number) Ins_character($() Put_N(Do_type()) Ins_character($)) Do_operands() case operator_instruction_action: Put_N(integer(operator_instruction_action)) Put_N(ST[S].table_number) Ins_character($() Do_Ccode() Ins_character($)) Do_operands() default: Error("unknown action for template: ^a", ST[S].T) endselect endprocedure {Do_action} procedure Do_tables() // read templates declare S: Symbol P: Pattern_line PLN: -1..Pattern_line_max enddeclare S := ReadSymbol() MAIN_LOOP: while true do guard // guard the entire loop PLN := -1 if ST[S].kind = reserved_symbol and ST[S].symbol_type = end_tables do break MAIN_LOOP endif // Start processing another pattern. List_number := last_node+1 // pattern number to listing file PATTERN_LOOP: while true do select ST[S].kind from case pattern_symbol: PLN *= + 1 P[PLN] := ST[S].pattern case action_symbol: break PATTERN_LOOP default: Error("Bad symbol in tables - '^a'", ST[S].T) endselect S := ReadSymbol() endwhile {PATTERN_LOOP} if PLN = -1 do Error("Action '^a' without pattern", ST[S].T) endif declare (Action_start: Action_index initially Action_count) ACTION_LOOP: while true do select ST[S].kind from case reserved_symbol, pattern_symbol: break ACTION_LOOP case action_symbol: Do_action(S) default: Error("'^a' is not an action symbol", ST[S].T) endselect S := ReadSymbol() endwhile {ACTION_LOOP} Put_N(integer(stop_action)) declare (Actions: integer initially Action_count-Action_start) Search: for i := 0 to Action_start-Actions do for j := 1 to Actions do if Act_table[i+j] <> Act_table[Action_start+j] do loop Search endif endfor Action_count := Action_start Action_start := i break Search endfor {Search} Put_pattern(P, PLN, Action_start+1) catch // catch any exceptions in MAIN_LOOP case error_called: Out_string(TTY, "rest of pattern ignored") Out_record(TTY) Skip_to_LF() S := ReadDefinedSymbol() while ST[S].kind <> reserved_symbol and ST[S].kind <> pattern_symbol do Skip_to_LF() S := ReadDefinedSymbol() endwhile endguard endwhile {MAIN_LOOP} endprocedure {Do_tables} // List one item in a pattern. procedure List_pattern_tree_node(PTN: Pattern_tree_node, ref place: file) Out_string(place, "PTN(right:") Out_integer(place, PTN.right) Out_string(place, ",down:") Out_integer(place, PTN.down) Out_string(place, ",pattern:Pattern(Ptag:") declare stupid_type_name1 is char initially $ stupid_type_name2 is array[Pattern_tag] of packed array[1..19] of stupid_type_name1 Ptag_name = stupid_type_name2( [stack]: "stack", [element]: "element", % if VAX or PDP11 [iuop]: "iuop", % endif % if VAX [ibop2]: "ibop2", [ibop3]: "ibop3", % orif PDP11 [ibop]: "ibop", [ibopr]: "ibopr", [ifrop]: "ifrop", % endif % if VAX or PDP11 [revop]: "revop", [irop]: "irop", % orif PDP10 [revop]: "revop", [op_x_op]: "op_x_op", [op_y_op]: "op_y_op", [op_m_op]: "op_m_op", % endif % if PDP11 or PDP10 [any_literal]: "any_literal", % endif [operand_mode]: "operand_mode", [nonnegative_literal]: "nonnegative_literal", [negative_literal]: "negative_literal", % if PDP10 [immediate_literal]:"immediate_literal", [power_of_2_literal]: "power_of_2_literal", % endif [specific_literal]: "specific_literal", [ptrange]: "ptrange", [class]: "class", [temporary]: "temporary" ) enddeclare Out_padded_string(place, Ptag_name[PTN.pattern.Ptag]) select PTN.pattern.Ptag from case stack: Out_string(place, ",n:") Out_integer(place, PTN.pattern.n) case element: Out_string(place, ",Ctag:C_code_tag(") Out_integer(place, integer(PTN.pattern.Ctag)) Out_character(place, $)) case operand_mode: % if VAX or PDP10 Out_string(place, ",mode:address_mode(") % orif PDP11 Out_string(place, ",mode:addr_modes(") % endif Out_integer(place, integer(PTN.pattern.mode)) Out_character(place, $)) case specific_literal: Out_string(place, ",literal_value:") Out_integer(place, PTN.pattern.literal_value) case ptrange: Out_string(place, ",lo:C_code_tag(") Out_integer(place, integer(PTN.pattern.lo)) Out_string(place, "),hi:C_code_tag(") Out_integer(place, integer(PTN.pattern.hi)) Out_character(place, $)) case class: Out_string(place, ",class:") Out_integer(place, PTN.pattern.class) endselect if PTN.pattern.invert do Out_string(place, ",invert:true") endif Out_string(place, "))") endprocedure {List_pattern_tree_node} // Routines to list all patterns and all actions procedure List_patterns(ref place: file) if last_node = -1 do return endif Out_string(place, "PTT is array[Pattern_tree_index] of Pattern_tree_node") Out_record(place) Out_string(place, "Pattern_tree = table PTT(") Out_record(place) for i := 0 to last_node-1 do if i mod 5 = 0 do Out_string(place, "// ") Out_integer(place, i) Out_record(place) endif List_pattern_tree_node(Pattern_tree[i], place) Out_character(place, $,) Out_record(place) endfor List_pattern_tree_node(Pattern_tree[last_node], place) Out_character(place, $)) Out_record(place) endprocedure {List_patterns} procedure List_Actions(ref place: file) if Action_count = 0 do return endif Out_string(place, "ATT is array[Action_index] of Action_datum") Out_record(place) Out_string(place, "Act_table = table ATT(") Out_record(place) for i := 1 to Action_count-1 do Out_integer(place, integer(logical(Act_table[i]) and 8#377)) Out_character(place, $,) if i mod 10 = 0 do Out_string(place, "// ") Out_integer(place, i-9) Out_record(place) endif endfor Out_integer(place, Act_table[Action_count]) Out_character(place, $)) Out_record(place) endprocedure {List_Actions} // Counters for number of elements in various tables. declare opcode_type_table_count: static integer initially 0 opcode_table_count: static integer initially 0 ccode_type_table_count: static integer initially 0 ccode_table_count: static integer initially 0 ccode_class_count: static integer initially 0 enddeclare procedure List_some_table // list one table param name_in_compiler: ref packed array[1..?M] of char type_in_compiler: ref packed array[1..?N] of char Count: integer Filter: function(S: Symbol) returns B: boolean P: inout ref file endparam declare TN: static integer initially integer($0) First: boolean Enum_suffix = "_xxx" enddeclare Out_record(P) Out_record(P) // Define the enumeration class. Out_string(P, name_in_compiler) Out_string(P, "_enum is [") First := true for S := 0 to last_symbol do if Filter(S) do if First do First := false otherwise Out_character(P, $,) endif Out_record(P) Out_string(P, " ") Out_padded_string(P, ST[S].T) Out_string(P, Enum_suffix) endif endfor Out_character(P, $] ) Out_record(P) // Define "Tn is ..." Out_record(P) TN *= + 1 Out_character(P, $T) Out_character(P, char(TN)) Out_string(P, " is array[" ) Out_string(P, name_in_compiler) Out_string(P, "_enum") Out_string(P, "] of ") Out_string(P, type_in_compiler) Out_record(P) // Now define the thing Out_record(P) Out_string(P, name_in_compiler) Out_string(P, " = T") Out_character(P, char(TN)) Out_string(P, " (" ) First := true for S := 0 to last_symbol do if Filter(S) do if First do First := false otherwise Out_character(P, $, ) endif Out_record(P) Out_string(P, " [") Out_padded_string(P, ST[S].T) Out_string(P, Enum_suffix) Out_string(P, "]: ") Out_padded_string(P, ST[S].T) endif endfor Out_character(P, $) ) Out_record(P) endprocedure {List_some_table} procedure Do_type_index(ref place: file) declare (c: char initially Read_non_whitespace()) Ins_character($:) select c from case $b: Out_string(place, "[bytex]:") case $w: Out_string(place, "[wordx]:") case $l: Out_string(place, "[long]:") case $q: Out_string(place, "[quad]:") case $f: Out_string(place, "[float]:") case $d: Out_string(place, "[double]:") case $m: Out_string(place, "[multiple]:") default: Warn("Illegal type", "") endselect endprocedure {Do_type_index} // Main routine that does all the work of reading input. procedure Do_it() declare (c: char) declare (S: Symbol) Next: while true do // do it all! Skip_whitespace() if NextCharacter = EOF do out_line (TTY, "---- END OF SOURCE FILE ----") return endif out_line (TTY, "Calling ReadSymbol") S := ReadSymbol() //-------------version 7.2 -- DEBUG out_string (TTY, ST[S].T) out_record (TTY) //----------------------------- if ST[S].kind <> reserved_symbol do Warn("Unexpected token '^a' - ignoring it", ST[S].T) loop Next endif guard // guard main loop out_line (TTY, "ST[S].symbol_type from") select ST[S].symbol_type from // What kind of table is it? default: Error("table name expected here -- missing", "") case begin_tables: // templates out_line (TTY, "begin_tables") Do_tables() case end_tables: // end of templates Warn("end_tables at top level", "") // ccode_class set of ccode items represented as a // list of ranges case operator_class: out_line (TTY, "operator_class:") S := Enter_symbol(ReadToken()) ST[S].kind := pattern_symbol ST[S].pattern.ptag := class ST[S].pattern.class := ccode_class_count List_number := ccode_class_count ccode_class_count *= + 1 Ins_character($=) Ins_character($() Out_record(ccarrays) Out_padded_string(ccarrays, ST[S].T) Out_character(ccarrays, $=) Out_string(ccarrays, "ccode_class (") Out_record(ccarrays) X: while true do Out_string(ccarrays, "[C_") declare (T1: Token initially ReadToken()) Out_padded_string(ccarrays, T1) Skip_horizontal_whitespace() if NextCharacter = $. and NextNextCharacter = $. do Skip_character() Skip_character() Out_string(ccarrays, "..C_") declare (T9: Token initially ReadToken()) Out_padded_string(ccarrays, T9) endif Out_string(ccarrays, "]:true") c := Read_non_whitespace() Out_character(ccarrays, c) Out_record(ccarrays) if c = $, do loop X endif if c = $) do break X endif Error("Comma or parenthesis expected", "") endwhile // ccode_table function: ccode ==> ccode case operator_table: out_line (TTY, "operator_table:") S := Enter_symbol(ReadToken()) ST[S].kind := ccode_ccode_table ST[S].table_n := ccode_table_count List_number := ccode_table_count ccode_table_count *= + 1 Ins_character($=) Ins_character($() Out_record(ccarrays) Out_padded_string(ccarrays, ST[S].T) Out_character(ccarrays, $=) Out_string(ccarrays, "operator_table (") Out_record(ccarrays) X: while true do Out_string(ccarrays, "[C_") declare (T1: Token initially ReadToken()) Out_padded_string(ccarrays, T1) Ins_character($:) Out_string(ccarrays, "]:C_") declare (T2: Token initially ReadToken()) Out_padded_string(ccarrays, T2) c := Read_non_whitespace() Out_character(ccarrays, c) Out_record(ccarrays) if c = $, do loop X endif if c = $) do break X endif Error("Comma or parenthesis expected", "") endwhile // ccode_type function: type ==> ccode case operator_type_array: out_LINE (TTY, "operator_type_array:") S := Enter_symbol(ReadToken()) ST[S].kind := type_ccode_table ST[S].table_n := ccode_type_table_count List_number := ccode_type_table_count ccode_type_table_count *= + 1 Ins_character($=) Skip_whitespace() Ins_character($() Out_record(ccarrays) Out_padded_string(ccarrays, ST[S].T) Out_character(ccarrays, $=) Out_string(ccarrays, "operator_type_table (") Out_record(ccarrays) X: while true do Do_type_index(ccarrays) Out_string(ccarrays, "C_") declare (T3: Token initially ReadToken()) Out_padded_string(ccarrays, T3) c := Read_non_whitespace() Out_character(ccarrays, c) Out_record(ccarrays) if c = $, do loop X endif if c = $) do break X endif Error("Comma or parenthesis expected", "") endwhile {X} // opcode_type function: size ==> opcode case opcode_type_array: out_line (TTY, "opcode_type_array:") S := Enter_symbol(ReadToken()) ST[S].kind := action_symbol ST[S].action := type_instruction_action ST[S].table_number := opcode_type_table_count List_number := opcode_type_table_count opcode_type_table_count *= + 1 Ins_character($=) Ins_character($() Out_record(ccarrays) Out_padded_string(ccarrays, ST[S].T) Out_character(ccarrays, $=) Out_string(ccarrays, "type_opcode_array (") Out_record(ccarrays) X: while true do Do_type_index(ccarrays) declare (T4: Token initially ReadToken()) Out_padded_string(ccarrays, T4) Out_string(ccarrays, "_op") c := Read_non_whitespace() Out_character(ccarrays, c) Out_record(ccarrays) if c = $, do loop X endif if c = $) do break X endif Error("Comma or parenthesis expected", "") endwhile {X} // opcode_array function: ccode ==> opcode case opcode_array: OUT_LINE (TTY, "opcode_array:") S := Enter_symbol(ReadToken()) ST[S].kind := action_symbol ST[S].action := operator_instruction_action ST[S].table_number := opcode_table_count List_number := opcode_table_count opcode_table_count *= + 1 Ins_character($=) Skip_whitespace() Ins_character($() declare (first_opcode_table: static boolean initially true) if not first_opcode_table do Out_character(arrays, $,) Out_record(arrays) endif first_opcode_table := false Out_string(arrays, "opcode_table (") Out_record(arrays) X: while true do Out_string(arrays, "[C_") declare (T5: Token initially ReadToken()) Out_padded_string(arrays, T5) Ins_character($:) Out_string(arrays, "]:") declare (T6: Token initially ReadToken()) Out_padded_string(arrays, T6) Out_string(arrays, "_op") c := Read_non_whitespace() Out_character(arrays, c) Out_record(arrays) if c = $, do loop X endif if c = $) do break X endif Error("Comma or parenthesis expected", "") endwhile // ccode_range range of values of ccode items case operator_range: OUT_line (TTY, "operator_range:") S := Enter_symbol(ReadToken()) ST[S].kind := pattern_symbol ST[S].pattern.Ptag := ptrange Ins_character($=) declare (S1: Symbol initially ReadSymbol()) if ST[S1].kind <> pattern_symbol or ST[S1].pattern.Ptag <> element do Error("Illegal operator name -- '^a'", ST[S1].T) endif ST[S].pattern.lo := ST[S1].pattern.Ctag Ins_string("..") declare (S2: Symbol initially ReadSymbol()) if ST[S2].kind <> pattern_symbol or ST[S2].pattern.Ptag <> element do Error("Illegal operator name -- '^a'", ST[S2].T) endif ST[S].pattern.hi := ST[S2].pattern.Ctag endselect catch // catch any errors in main loop case error_called: Out_string(TTY, "rest of line ignored") Out_record(TTY) Skip_to_LF() endguard endwhile {Next} endprocedure {Do_it} // MAIN PROGRAM guard Open_file(source, read, "CGTABLES.DAT") Open_file(tables, write, "CGTABLES.PRX") Open_file(arrays, write, "CGARRAYS.PRX") Open_file(ccarrays, write, "CCARRAYS.PRX") Open_file(listing_file, write, "CGTABLES.LIS") catch case IO_open_failure: Out_string(TTY, "Unable to open files") Out_record(TTY) raise Abort endguard guard // Locate the end of the built-in symbol table, marked by an empty token, // and update last_symbol. Also, check for name duplications. last_symbol := -1 while ST[last_symbol+1].T <> null_token do last_symbol *= + 1 //--------version 7.2 --------------------------------- // print out all fields of symbol table - debugging // out_string (TTY, ST [Last_symbol].T) out_string (TTY, "kind=") select ST [Last_symbol].kind from case reserved_symbol: out_string (TTY, "reserved_symbol") out_string (TTY, " symbol_type:") select ST [Last_symbol].symbol_type from case operator_table: out_string (TTY, "operator_table") case operator_class: out_string (TTY, "operator_class") endselect case action_symbol: out_string (TTY, "A_S") case pattern_symbol: out_string (TTY, "P_S") case register_name: out_string (TTY, "register_name") endselect out_record (TTY) //------------------------------------------------------ for N := 0 to last_symbol - 1 do if ST[N].T = ST[last_symbol].T do Warn("symbol '^a' appears twice in initial table", ST[N].T) endif endfor endwhile out_line (TTY, "END OF SYMBOL DEFINITIONS") // Enter system names into the symbol table. // These are IDs used in assembler for system utilities // called by compiled code. for sy in sys_names do declare( S: Symbol initially Enter_symbol(sys_strings[sy]) ) ST[S].kind := system_name ST[S].sys_id := sy endfor out_line (TTY, "Calling DO_IT") Do_it() Close_file(Source) if ccode_type_table_count > 0 do function F(S: Symbol) returns B: boolean B := ST[S].kind = type_ccode_table endfunction {F} List_some_table("type_ccode_table", "operator_type_table", ccode_type_table_count, F, ccarrays) endif if ccode_table_count > 0 do function F(S: Symbol) returns B: boolean B := ST[S].kind = ccode_ccode_table endfunction {F} List_some_table("ccode_ccode_table", "operator_table", ccode_table_count, F, ccarrays) endif if ccode_class_count > 0 do function F(S: Symbol) returns B: boolean B := ST[S].kind = pattern_symbol and ST[S].pattern.ptag = class endfunction {F} List_some_table("class_table", "ccode_class", ccode_class_count, F, ccarrays) endif if opcode_type_table_count > 0 do function F(S: Symbol) returns B: boolean B := ST[S].kind = action_symbol and ST[S].action = type_instruction_action endfunction {F} List_some_table("type_opcode_table", "type_opcode_array", opcode_type_table_count, F, ccarrays) endif Out_record(ccarrays) Out_string(ccarrays, "enddeclare") Out_record(ccarrays) Out_string(ccarrays, "endmodule") Out_record(ccarrays) Close_file(ccarrays) List_patterns(tables) List_actions(tables) Out_record(tables) Out_string(tables, "enddeclare") Out_record(tables) Out_string(tables, "endmodule") Out_record(tables) Close_file(tables) Out_record(arrays) Out_character(arrays, $)) Out_record(arrays) Out_string(arrays, "enddeclare") Out_record(arrays) Out_string(arrays, "endmodule") Out_record(arrays) Close_file(arrays) Out_integer(TTY, last_node+1) Out_string(TTY, " patterns") //-----------version 7.2 ------------------- Out_string (TTY, "Pattern_tree_Max = ") Out_integer (TTY, Pattern_tree_max) //------------------------------------ Out_record(TTY) Out_integer(TTY, Action_count) Out_string(TTY, " actions") //-------version 7.2--------- out_string (TTY, "Action_Max = ") out_integer (TTY, Action_Max) //---------------------------- Out_record(TTY) Out_record(listing_file) Out_integer(listing_file, last_node+1) Out_string(listing_file, " patterns") Out_record(listing_file) Out_integer(listing_file, Action_count) Out_string(listing_file, " actions") Out_record(listing_file) Close_file(listing_file) catch case abort: Out_string(TTY, "Controlled abort") Out_record(TTY) default: Out_string(TTY, "Execution aborted") Out_record(TTY) endguard endmodule