/**** Parser for tables created by LRK. */ dcl iti fixed bin; current_state = 1; lst, ps_top = 0; la_put, la_get = 1; la_ct = 0; /* The parsing loop. */ NEXT: if (current_state = 0) then do; done_parse: finish: if db_eval then call ioa_$ioa_switch_nnl (db_output, " **FINI**^2/"); code = 0; ain_l = nc - 1; return; end; current_table = current_state; string (db_data) = ""; db_data.state = current_state; (subscriptrange): goto CASE (DPDA.v1 (current_table)); CASE (3): /*** Shared look */ current_table = DPDA.v2 (current_table); CASE (1): /**** 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): current_table = DPDA.v2 (current_table); CASE (9): 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 signal condition (pstk_ovflo); dcl pstk_ovflo condition; ps_top = ps_top + 1; /* Top of parsing stack. */ parse_stack (ps_top) = current_state; /* Stack the current state. */ cur_lex_top (ps_top) = lst; /* save cur lex top (for recovery) */ read_look: do while (la_ct < la_need); /* make sure enuf symbols available */ ls.symbol (-la_put) = scanner (); la_put = mod (la_put, -lbound (ls, 1)) + 1; la_ct = la_ct + 1; end; test_symbol = ls.symbol (-la_use); if (test_symbol = 56) & (current_state ^= 1) then do; /* execute MACRO (bad news) */ ps_top = ps_top + 1; parse_stack (ps_top) = current_state; next_state = -1; ind = ind + 2; goto got_symbol; end; else 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; error: if db_eval then do; db_data.type = "ERR"; db_data.data = getermc (test_symbol, la_get); call ioa_$ioa_switch_nnl (db_output, "^vx^a^/", ind, string (db_data)); end; msg = "Vxx) Syntax- eval. "; err_text: iti = input.loc1 (0); input.loc1 (level) = nc; input.loc0 (level) = lgnc; msg = msg || """"; do i = 0 to level; if (i ^= 0) then msg = msg || " "; msg = msg || substr (input.pt (i) -> is, input.loc0 (i), input.loc1 (i) - input.loc0 (i)); end; msg = msg || """"; err_ret: code = 10; return; got_symbol: if db_eval then do; if (next_state < 0) /* is this a look-ahead state? */ then do; db_data.type = "LK01"; db_look = la_need; db_data.data = geterm (test_symbol, 0); /* 0 means display only terminal */ /* "name" on look-ahead */ /**** if (la_need = 1) then db_data.flag = "*"; */ end; else do; db_data.data = getermc (test_symbol, la_get); /* display terminal "name" and data, */ /* if available */ /**** db_data.flag = "*"; */ end; call ioa_$ioa_switch_nnl (db_output, "^vx^a^/", ind, string (db_data)); end; current_state = next_state; if (current_state < 0) then do; /* Transition is look-ahead state. */ current_state = -current_state; end; else do; if (lst = hbound (ls, 1)) then signal condition (lstk_ovflo); dcl lstk_ovflo condition; lst = lst + 1; ls (lst) = ls (-la_get); if db_eval then call dump_ls; la_get = mod (la_get, -lbound (ls, 1)) + 1; la_ct = la_ct - 1; end; goto NEXT; CASE (7): msg = "CASE7 encountered."; goto err_text; CASE (8): msg = "CASE8 encountered."; goto err_text; CASE (4): /*** Apply state. */ CASE (5): /*** Apply single */ CASE (6): /*** Apply Shared */ la_need = 1; p_del = DPDA.v1 (current_table + 1); l_del = DPDA.v2 (current_table + 1); rulen = DPDA.v1 (current_table + 2); altn = DPDA.v2 (current_table + 2); if (rulen > 0) then call ted_vtab_ (rulen, altn); if db_eval then do; db_data.type = "APLY"; db_data.data = "("; call ioa_$ioa_switch_nnl (db_output, "^vx^a^i ^i)", ind, string (db_data), rulen, altn); end; if ex_sw then do; if db_eval then call ioa_$ioa_switch_nnl (db_output, "[ex]"); p_del = p_del + 2; l_del = l_del + 1; end; if db_eval then do; call ioa_$ioa_switch_nnl (db_output, "^-pd=^i ld=^i(", p_del, l_del); do t = ps_top to ps_top - p_del + 1 by -1; call ioa_$ioa_switch_nnl (db_output, " ^d", parse_stack (t)); end; call ioa_$ioa_switch_nnl (db_output, ")^/"); end; if (DPDA.v1 (current_table + 1) = -1) /* Empty rule */ then parse_stack (ps_top + 1) = current_table; ps_top = ps_top - p_del; /* drop "p_del" parse stack states. */ lst = lst - l_del; /* drop "l_del" lex stack states */ if db_eval then call dump_ls; /**** l_del is (number of symbols in production)-1 */ dump_ls: proc; call ioa_ ("ls(^i)=^p,^3i [^i] ^i-^[aexp ^s^i^;cat ^p,^i,^i^;lexp ^s^i^]", lst, ls(lst).symptr, ls(lst).symlen, ls(lst).symbol, ls(lst).type, ls(lst).type+1, ls(lst).pt, ls(lst).num, ls(lst).loc); end dump_ls; if ex_sw then do; ex_sw = "0"b; current_state = parse_stack (ps_top + 1); ind = ind - 2; goto NEXT; end; if (DPDA.v1 (current_state) = 6) then do; current_table = DPDA.v2 (current_table + 3); end; jaf = parse_stack (ps_top); do i = current_table + 4 to current_table + DPDA.v2 (current_table); if (DPDA.v1 (i) = jaf) 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 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 (21), /* length of symbol (may be 0) */ 2 line fixed bin (21), /* line where symbol begins */ 2 symbol fixed bin (21), /* encoding of symbol */ 2 pt ptr, 2 mask bit (36), 2 type fixed bin, /* 0-aexp 1-cat 2-lexp */ 2 num fixed bin (21), 2 loc fixed bin (21); dcl (ABREV init (-1), AEXP init (0), CAT init (1), LEXP init (2) ) fixed bin (21) int static options (constant); dcl lst fixed bin (21); /* location of top of lexical stack */ dcl cur_lex_top (100) fixed bin; /* current lex top stack */ /* (with parse_stack) */ dcl parse_stack (100) fixed bin; /* parse stack */ dcl altn fixed bin (21); /* 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); /* temp */ dcl la_ct fixed bin; /* # terms in look-ahead stack */ dcl la_get fixed bin; /* look_ahead stack get next symbol */ dcl la_need fixed bin; /* # look-ahead symbols needed */ dcl la_put fixed bin; /* look_ahead stack put next symbol */ dcl la_use fixed bin (22); /* look-ahead stack test symbol */ dcl next_state fixed bin; /* # next state */ dcl nil_sym fixed bin; dcl ps_top fixed bin; /* top of parse stack */ dcl recov_msg char (150) var; dcl rulen fixed bin (21); /* APPLY rule number */ dcl t fixed bin (21); dcl jaf fixed bin (21); dcl ioa_ entry options (variable); dcl (l_del, p_del) fixed bin; 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; */ ----------------------------------------------------------- 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 */