/* BEGIN INCLUDE FILE ..... ted_gv_p_.incl.pl1 ..... 07/10/81 J Falksen */ /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */ /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */ /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */ /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */ ted_gv_p_: proc (); /* Parser for tables created by LRK. */ current_state = 1; ls_top, ps_top = 0; la_put, la_get = 1; la_ct = 0; call rule_0; /* The parsing loop. */ NEXT: if (current_state = 0) then do; done_parse: if db_gv then call ioa_(); call end_cf; cf.op = tdone_op; cf.len = 0; cf.siz = size (cf); call end_cf; if db_gv then call tedshow_ (comptr, "gvx"); return; end; current_table = current_state; string (db_data) = ""; db_data.state = current_state; (subscriptrange): TRY_AGAIN: goto CASE (DPDA.v1 (current_table)); CASE (3): /* Shared look */ current_table = DPDA.v2 (current_table); CASE (1): /* Look. */ db_data.type = "LOOK"; la_use = mod (la_get + la_need - 1, -lbound (ls, 1)) + 1; if (la_need = -lbound (ls, 1)) then signal condition (lastk_ovflo); dcl lastk_ovflo condition; la_need = la_need + 1; goto read_look; CASE (10): /* Shared read */ current_table = DPDA.v2 (current_table); CASE (9): /* Read. */ db_data.type = "READ"; la_need = 1; la_use = la_get; goto read_look; CASE (2): /* Stack and Shared read */ current_table = DPDA.v2 (current_table); CASE (0): /* Stack and Read */ db_data.type = "READ"; db_data.flag = "*"; la_need = 1; la_use = la_get; if (ps_top = hbound (parse_stack, 1)) then do; msg = "tedgv_ parse stk oflow"; goto print_error; end; ps_top = ps_top + 1; /* Top of parsing stack. */ parse_stack (ps_top) = current_state; /* Stack the current state. */ cur_lex_top (ps_top) = ls_top; /* save cur lex top (for recovery) */ read_look: do while (la_ct < la_need); /* ensure enough symbols available */ call scanner (); la_put = mod (la_put, -lbound (ls, 1)) + 1; la_ct = la_ct + 1; end; test_symbol = ls.symbol (-la_use); m = 0; do i = current_table + 1 to current_table + DPDA.v2 (current_table); if (DPDA.v1 (i) = test_symbol) then do; next_state = DPDA.v2 (i); goto got_symbol; end; end; msg = "Vxx) Syntax- "; goto gv_msg_com; got_symbol: if db_gv then do; if (next_state < 0) /* is this a look-ahead state? */ then do; db_data.type = "LK01"; db_look = la_need; /* show only "name" on look-ahead */ db_data.data = geterm (test_symbol, 0); db_data.flag = " "; end; else db_data.data = getermc (test_symbol, la_get); /* display terminal "name" and data, */ /* if available */ call ioa_$ioa_switch_nnl (iox_$user_output, "^a^/", string (db_data)); end; current_state = next_state; if (current_state < 0) /* Transition is a look-ahead state. */ then current_state = -current_state; else do; if (ls_top = hbound (ls, 1)) then do; msg = "tedgv_ lex stk oflow"; goto print_error; end; ls_top = ls_top + 1; ls (ls_top) = ls (-la_get); la_get = mod (la_get, -lbound (ls, 1)) + 1; la_ct = la_ct - 1; end; goto NEXT; CASE (4): /* Apply state. */ /* . . . */ CASE (5): /* Apply single */ /* . . . */ CASE (6): /* Apply Shared */ /* . . . */ la_need = 1; rulen = DPDA.v1 (current_table + 2); altn = DPDA.v2 (current_table + 2); if db_gv then do; db_data.type = "APLY"; db_data.data = "("; call ioa_$ioa_switch_nnl (iox_$user_output, "^a^i ^i)", string (db_data), rulen, altn); end; if (rulen > 0) then call sem (rulen, altn); if db_gv then do; call ioa_$ioa_switch_nnl (iox_$user_output, "^-pd=^i ld=^i(", DPDA.v1 (current_table + 1), DPDA.v2 (current_table + 1)); do t = ps_top to ps_top - DPDA.v1 (current_table + 1) + 1 by -1; call ioa_$ioa_switch_nnl (iox_$user_output, " ^d", parse_stack (t)); end; call ioa_$ioa_switch_nnl (iox_$user_output, ")^/"); end; /* Delete parse and lex stack states */ ps_top = ps_top - DPDA.v1 (current_table + 1); ls_top = ls_top - DPDA.v2 (current_table + 1); if (DPDA.v1 (current_state) = 5) then do; current_state = DPDA.v2 (current_table + 3); goto NEXT; end; if (DPDA.v1 (current_state) = 6) then do; current_table = DPDA.v2 (current_table + 3); end; do i = current_table + 4 to current_table + DPDA.v2 (current_table); if (DPDA.v1 (i) = parse_stack (ps_top)) then do; current_state = DPDA.v2 (i); goto NEXT; end; end; current_state = DPDA.v2 (current_table + 3); goto NEXT; dcl (addr, mod, fixed) builtin; dcl db_look pic "99" defined (db_data.type) pos (3); dcl 1 db_data, 2 flag char (1), /* * means stacked */ 2 state pic "zzz9", 2 fil1 char (2), 2 type char (6), 2 data char (100); dcl DDop (-1:2) char (4) int static init ("LOOK", "FINI", "READ", "ERR"); dcl ioa_$ioa_switch_nnl entry options (variable); dcl iox_$user_output ptr ext static; dcl 1 ls (-4:50), /* -4:-1 look-ahead stack (FIFO) */ /* 1:50 lexical stack (LIFO) */ 2 symptr ptr, /* pointer to symbol (must be valid) */ 2 symlen fixed bin, /* length of symbol (may be 0) */ 2 line fixed bin (21), /* line where symbol begins */ 2 symbol fixed bin, /* encoding of symbol */ 2 true fixed bin, 2 false fixed bin, 2 loc fixed bin; dcl ls_top fixed bin; /* location of top of lexical stack */ dcl cur_lex_top (100) fixed bin; /* current lex top stack */ dcl parse_stack (100) fixed bin; /* parse stack */ dcl altn fixed bin; /* APPLY alternative number */ dcl current_state fixed bin; /* number of current state */ dcl test_symbol fixed bin; /* encoding of current symbol */ dcl current_table fixed bin; /* number of current table */ dcl i fixed bin (21); dcl la_ct fixed bin; /* # terminals in look-ahead stack */ dcl la_get fixed bin; /* where to get next symbol */ dcl la_need fixed bin; /* # look-ahead symbols needed */ dcl la_put fixed bin; /* where to put next symbol */ dcl la_use fixed bin (22); /* where stack to test with */ dcl (m, n) fixed bin; dcl next_state fixed bin; /* number of next state */ dcl ps_top fixed bin; /* location of top of parse stack */ dcl recov_msg char (150) var; dcl rulen fixed bin; /* APPLY rule number */ dcl t fixed bin; dcl ioa_ entry options (variable); geterm: proc (idx, ids) returns (char (100) var); dcl (idx, ids) fixed bin; dcl temp char (100) var; dcl c_str char (20000) based; temp = ""; get_rest: if (ids > 0) then if (ls (-ids).symlen > 0) then do; temp = temp || """"; temp = temp || substr (ls (-ids).symptr -> c_str, 1, min (50, ls (-ids).symlen)); temp = temp || """"; return (temp); end; if (idx = 0) then temp = "--EOI--"; else temp = substr (TC, TL.pt (idx), TL.ln (idx)); return (temp); getermc: entry (idx, ids) returns (char (100) var); if (idx = 0) then temp = "--EOI--"; else temp = substr (TC, TL.pt (idx), TL.ln (idx)); temp = temp || " "; goto get_rest; end; %page; scanner: proc; ls (-la_put).symptr = addr (rl_c (rl_i)); ls (-la_put).symlen = 0; cft.t, cft.f = 0; ls (-la_put).symbol = 9; ls (-la_put).loc = gvx.tot_len + 1; ls (-la_put).true = gvx.tot_len + 4; ls (-la_put).false = gvx.tot_len + 5; i = index ("(^|&) ", rl_c (rl_i)); if (i > 0) then do; rl_i = rl_i + 1; ls (-la_put).symbol = min (8, i + 2); return; end; if (rl_c (rl_i) = "{") then do; cft.op = teval_op; i = index (substr (rl_s, rl_i), "}"); call add_length (i); cft.da = substr (rl_s, rl_i, i); rl_i = rl_i + i; end; else do; cft.op = tsrch_op; call scan; rl_i = expr_b + expr_l + 1; cft.cexpml = 100; /* DO THIS RIGHT! */ call tedsrch_$compile (addr (rl_c (expr_b)), expr_l, addr (cft.cexpml), "1"b, (dbase.lit_sw), msg, code); if (code ^= 0) then goto print_error; dcl bfb fixed bin based; cft.cexpml = cft.cexpl + 4; call add_length((cft.cexpml)); end; cft.siz = size (cft); call end_cf; end scanner; %skip (4); rule_0: proc; if req_ch = "g" then i = 1; else i = 2; ls (-1).symbol = i; ls (-1).symptr = addr (rl_c (rl_i)); ls (-1).symlen = 0; ls (-1).loc, ls (-1).true, ls (-1).false = 0; la_put = 2; la_ct = 1; return; end rule_0; %include ted_gv_; end; /* END INCLUDE FILE ..... ted_gv_p_.incl.pl1 ..... */ */ ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved */