COMPILATION LISTING OF SEGMENT probe_language_request_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/27/88 1239.8 mst Thu Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 /****^ HISTORY COMMENTS: 15* 1) change(88-09-07,WAAnderson), approve(88-09-30,MCR7952), 16* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 17* Added format control comment to make the source more readable. 18* END HISTORY COMMENTS */ 19 20 21 /* format: style1,insnl,ifthendo,indthenelse,^indnoniterdo,^inditerdo,indcom,^indthenbegin,^indprocbody,ind2,ll78,initcol0,dclind4,idind24,struclvlind1,comcol41 */ 22 23 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 24 25 probe_language_request_: 26 proc (P_probe_info_ptr); 27 28 dcl P_probe_info_ptr ptr parameter; 29 dcl null builtin; 30 31 dcl probe_lang_type_ entry (char (*)) returns (fixed bin); 32 33 dcl probe_error_ entry options (variable); 34 dcl ioa_$ioa_switch entry options (variable); 35 36 dcl probe_et_$too_many_args fixed bin (35) external static; 37 38 probe_info_ptr = P_probe_info_ptr; 39 40 if probe_info.ct -> token.type >= probe_info.end_token 41 then call ioa_$ioa_switch (probe_info.output_switch, 42 "Current language is ^a", 43 official_language_names (probe_info.language_type)); 44 else do; 45 if probe_info.ct -> token.type ^= NAME_TYPE 46 then call probe_error_ (probe_info_ptr, 0, 47 "A language name is required"); 48 if probe_info.ct -> token.next = null () | 49 probe_info.ct -> token.next -> token.type < probe_info.end_token 50 then call probe_error_ (probe_info_ptr, probe_et_$too_many_args); 51 52 probe_info.language_type = probe_lang_type_ (current_identifier_name); 53 probe_info.ct = probe_info.ct -> token.next; 54 end; /* setting the lang */ 55 56 return; 57 58 59 1 1 /* BEGIN INCLUDE FILE probe_info.incl.pl1 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(88-10-24,WAAnderson), approve(88-10-24,MCR7952), 1 7* audit(88-10-24,RWaters), install(88-10-27,MR12.2-1194): 1 8* Added field 'retry_using_main' to add new C feature. 1 9* END HISTORY COMMENTS */ 1 10 1 11 1 12 /* Created: 04/22/79 W. Olin Sibert, from subsystem_info 1 13* Modified: 22 Sept 79 JRd to remove: default (ptr & (auto|based)) init (null ()); 1 14* Added flags.setting_break 08/22/83 Steve Herbst 1 15* Added flags.executing_quit_request 01/15/85 Steve Herbst 1 16**/ 1 17 1 18 dcl 1 probe_info aligned based (probe_info_ptr), /* standard data for a probe invocation */ 1 19 2 probe_info_version fixed bin, /* version of this structure */ 1 20 1 21 2 static_info_ptr pointer unaligned, /* pointer to static information structure */ 1 22 2 modes_ptr pointer unaligned, /* pointer to probe_modes structure */ 1 23 1 24 2 ptr_to_current_source ptr, /* current_source is based on this */ 1 25 2 ptr_to_initial_source ptr, /* initial_source is based on this */ 1 26 2 machine_cond_ptr pointer, /* pointer to machine conditions, if we faulted to get here */ 1 27 1 28 2 token_info aligned, /* information about token chain currently being processed */ 1 29 3 first_token pointer unaligned, /* first token in chain */ 1 30 3 ct pointer unaligned, /* pointer to current token; updated in MANY places */ 1 31 3 end_token bit (18) aligned, /* token type at which to stop scanning token chain */ 1 32 3 buffer_ptr pointer unaligned, /* pointer to input buffer */ 1 33 3 buffer_lth fixed bin (21), /* and length */ 1 34 1 35 2 random_info aligned, 1 36 3 current_stack_frame pointer unaligned, /* stack frame pointer for frame in which probe was invoked */ 1 37 3 input_type fixed bin, /* current input type */ 1 38 3 language_type fixed bin, /* current language being processed */ 1 39 3 return_method fixed bin, /* how we should return after exiting probe */ 1 40 3 entry_method fixed bin, /* how we got here in the first place */ 1 41 3 pad1 (19) bit (36) aligned, 1 42 1 43 2 break_info, /* break info -- only interesting if we got here via a break */ 1 44 3 break_slot_ptr pointer, /* pointer to break slot -- non-null IFF at a break */ 1 45 3 last_break_slot_ptr pointer unaligned, /* pointer to previous break slot, not presently used */ 1 46 3 break_reset bit (1) aligned, /* this break has been reset by somebody further on */ 1 47 3 real_break_return_loc pointer, /* where to REALLY return to, modulo previous bit */ 1 48 1 49 2 probe_area_info, /* information about various probe areas */ 1 50 3 break_segment_ptr pointer unaligned, /* pointer to Personid.probe */ 1 51 3 break_area_ptr pointer unaligned, /* pointer to area in break segment */ 1 52 3 scratch_area_ptr pointer unaligned, /* pointer to probe scratch seg in process dir */ 1 53 3 probe_area_ptr pointer unaligned, /* This area lasts as long as an invocation of probe. */ 1 54 3 work_area_ptr pointer unaligned, /* This area lasts as long as the current request line */ 1 55 3 expression_area_ptr pointer unaligned, /* This area lasts as long as the current command */ 1 56 1 57 2 flags aligned, /* this, in particular, should be saved and restored correctly */ 1 58 (3 execute, /* "1"b => execute requests, "0"b => just check syntax */ 1 59 3 in_listener, /* ON => in probe listener loop */ 1 60 3 executing_request, /* ON => executing a request */ 1 61 3 in_interpret_line, /* executing in probe_listen_$interpret_line */ 1 62 3 setting_break, /* executing "after" or "before": check syntax of "if" */ 1 63 3 executing_quit_request, /* to prevent error looping during "quit" request */ 1 64 3 pad (30)) bit (1) unaligned, 1 65 1 66 2 io_switches, /* switches probe will do normal I/O on */ 1 67 3 input_switch pointer, 1 68 3 output_switch pointer, 1 69 1 70 2 error_info, /* information about the last error saved for later printing */ 1 71 3 error_code fixed bin (35), 1 72 3 error_message char (300) varying, 1 73 1 74 2 listener_info, /* internal use by probe listener */ 1 75 3 request_name character (32) varying, /* primary name of the request being processed */ 1 76 3 abort_probe_label label variable, 1 77 3 abort_line_label label variable, 1 78 3 depth fixed binary, /* count of active invocations of probe */ 1 79 3 previous pointer unaligned, /* -> previous invocation's info */ 1 80 3 next pointer unaligned, 1 81 1 82 2 end_of_probe_info pointer aligned, 1 83 2 retry_using_main fixed bin aligned; 1 84 1 85 1 86 dcl probe_info_ptr pointer; 1 87 1 88 dcl probe_info_version fixed bin static options (constant) initial (1); 1 89 1 90 dcl probe_info_version_1 fixed bin static options (constant) initial (1); 1 91 1 92 dcl scratch_area area based (probe_info.scratch_area_ptr); 1 93 dcl probe_area area based (probe_info.probe_area_ptr); 1 94 dcl work_area area based (probe_info.work_area_ptr); 1 95 dcl expression_area area based (probe_info.expression_area_ptr); 1 96 1 97 /* END INCLUDE FILE probe_info.incl.pl1 */ 60 61 62 /* ;;;;;;; */ 63 2 1 /* BEGIN INCLUDE FILE probe_tokens.incl.pl1 */ 2 2 /* Split up into probe_tokens and probe_references, 04/22/79 WOS */ 2 3 2 4 dcl 1 token_header aligned based, /* header information common to all tokens */ 2 5 2 next pointer unaligned, /* pointer to next token in chain */ 2 6 2 prev pointer unaligned, /* same for previous token */ 2 7 2 type bit (18) aligned, 2 8 2 buffer_ptr pointer unaligned, /* pointer to beginning of input buffer */ 2 9 2 location fixed bin (17) unal, /* offset in input buffer */ 2 10 2 length fixed bin (17) unal, 2 11 2 flags aligned, 2 12 (3 leading_whitespace, /* there is whitespace before thios token */ 2 13 3 trailing_whitespace) bit (1) unaligned, /* and same for after */ 2 14 3 pad1 bit (34) unaligned; 2 15 2 16 dcl 1 token aligned based, /* produced by scan_probe_input_ */ 2 17 2 header aligned like token_header; /* that's all there is */ 2 18 2 19 dcl 1 identifier aligned based, /* keyword or identifier token */ 2 20 2 header aligned like token_header, 2 21 2 length fixed bin, /* length of name */ 2 22 2 name pointer unaligned; /* to string in buffer containing name */ 2 23 2 24 dcl 1 operator aligned based, /* for punctuation */ 2 25 2 header aligned like token_header; /* nothing but a header here */ 2 26 2 27 dcl 1 constant aligned based, /* for strings pointers numbers etc */ 2 28 2 header aligned like token_header, 2 29 2 encoded_precision aligned, /* encoded precision kludge for assign_ */ 2 30 3 scale fixed bin (17) unaligned, /* arithmetic scale */ 2 31 3 precision fixed bin (17) unaligned, /* arithmetic precision or other size */ 2 32 2 scale_and_precision fixed bin (35), /* An identical copy of the two values above */ 2 33 2 data_type fixed bin, /* standard data type code + packed bit */ 2 34 2 data_ptr pointer unaligned; 2 35 2 36 2 37 dcl (OPERATOR_TYPE init ("100"b), /* types for above */ 2 38 NAME_TYPE init ("010"b), 2 39 CONSTANT_TYPE init ("001"b)) bit (18) internal static options (constant); 2 40 2 41 2 42 dcl current_identifier_name /* Overlays for looking at the current tokens */ 2 43 char (probe_info.ct -> identifier.length) based (probe_info.ct -> identifier.name); 2 44 dcl 1 current_constant aligned like constant based (probe_info.ct); 2 45 dcl 1 current_token aligned like token based (probe_info.ct); 2 46 2 47 /* END INCLUDE FILE probe_tokens.incl.pl1 */ 64 65 66 /* ;;;;;;; */ 67 3 1 /* BEGIN INCLUDE FILE ... probe_lang_types.incl.pl1 3 2* 3 3* JRD 26 June 79 3 4* MBW 31 July 1981 to add algol68 */ 3 5 3 6 3 7 /****^ HISTORY COMMENTS: 3 8* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 3 9* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 3 10* Added C Language type. 3 11* END HISTORY COMMENTS */ 3 12 3 13 3 14 /* Modified June 83 JMAthane to add PASCAL language type */ 3 15 /* Modified April 88 Hinatsu to add C language type */ 3 16 3 17 dcl (UNKNOWN_lang_type init (1), 3 18 OTHER_lang_type init (2), 3 19 PL1_lang_type init (3), 3 20 FORTRAN_lang_type init (4), 3 21 COBOL_lang_type init (5), 3 22 ALM_lang_type init (6), 3 23 ALGOL68_lang_type init (7), 3 24 PASCAL_lang_type init (8), 3 25 C_lang_type init (9)) fixed bin internal static options (constant); 3 26 3 27 dcl official_language_names (9) char (32) internal static options (constant) init 3 28 ("Unknown", "other", "PL/I", "FORTRAN", "COBOL", "ALM", "Algol 68", "Pascal", "C"); 3 29 3 30 dcl palatable_language_names (9) char (32) internal static options (constant) init 3 31 ("Unknown", "Other", "pl1", "fortran", "cobol", "alm", "algol68", "pascal", "c"); 3 32 3 33 /* END INCLUDE FILE ... probe_lang_types.incl.pl1 */ 68 69 70 end probe_language_request_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/27/88 1224.4 probe_language_request_.pl1 >spec>install>MR12.2-1194>probe_language_request_.pl1 60 1 10/27/88 1223.7 probe_info.incl.pl1 >spec>install>MR12.2-1194>probe_info.incl.pl1 64 2 11/26/79 1320.6 probe_tokens.incl.pl1 >ldd>include>probe_tokens.incl.pl1 68 3 10/26/88 1255.5 probe_lang_types.incl.pl1 >ldd>include>probe_lang_types.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. NAME_TYPE constant bit(18) initial packed unaligned dcl 2-37 ref 45 P_probe_info_ptr parameter pointer dcl 28 ref 25 38 constant based structure level 1 dcl 2-27 ct 13 based pointer level 3 packed packed unaligned dcl 1-18 set ref 40 45 48 48 52 52 52 53* 53 current_identifier_name based char packed unaligned dcl 2-42 set ref 52* end_token 14 based bit(18) level 3 dcl 1-18 ref 40 48 header based structure level 2 dcl 2-16 identifier based structure level 1 dcl 2-19 io_switches 66 based structure level 2 dcl 1-18 ioa_$ioa_switch 000014 constant entry external dcl 34 ref 40 language_type 21 based fixed bin(17,0) level 3 dcl 1-18 set ref 40 52* length 6 based fixed bin(17,0) level 2 dcl 2-19 ref 52 52 name 7 based pointer level 2 packed packed unaligned dcl 2-19 ref 52 next based pointer level 3 packed packed unaligned dcl 2-16 ref 48 48 53 null builtin function dcl 29 ref 48 official_language_names 000000 constant char(32) initial array packed unaligned dcl 3-27 set ref 40* output_switch 70 based pointer level 3 dcl 1-18 set ref 40* probe_error_ 000012 constant entry external dcl 33 ref 45 48 probe_et_$too_many_args 000016 external static fixed bin(35,0) dcl 36 set ref 48* probe_info based structure level 1 dcl 1-18 probe_info_ptr 000100 automatic pointer dcl 1-86 set ref 38* 40 40 40 40 45 45* 48 48 48 48* 52 52 52 52 53 53 probe_lang_type_ 000010 constant entry external dcl 31 ref 52 random_info 17 based structure level 2 dcl 1-18 token based structure level 1 dcl 2-16 token_header based structure level 1 dcl 2-4 token_info 12 based structure level 2 dcl 1-18 type 2 based bit(18) level 3 dcl 2-16 ref 40 45 48 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ALGOL68_lang_type internal static fixed bin(17,0) initial dcl 3-17 ALM_lang_type internal static fixed bin(17,0) initial dcl 3-17 COBOL_lang_type internal static fixed bin(17,0) initial dcl 3-17 CONSTANT_TYPE internal static bit(18) initial packed unaligned dcl 2-37 C_lang_type internal static fixed bin(17,0) initial dcl 3-17 FORTRAN_lang_type internal static fixed bin(17,0) initial dcl 3-17 OPERATOR_TYPE internal static bit(18) initial packed unaligned dcl 2-37 OTHER_lang_type internal static fixed bin(17,0) initial dcl 3-17 PASCAL_lang_type internal static fixed bin(17,0) initial dcl 3-17 PL1_lang_type internal static fixed bin(17,0) initial dcl 3-17 UNKNOWN_lang_type internal static fixed bin(17,0) initial dcl 3-17 current_constant based structure level 1 dcl 2-44 current_token based structure level 1 dcl 2-45 expression_area based area(1024) dcl 1-95 operator based structure level 1 dcl 2-24 palatable_language_names internal static char(32) initial array packed unaligned dcl 3-30 probe_area based area(1024) dcl 1-93 probe_info_version internal static fixed bin(17,0) initial dcl 1-88 probe_info_version_1 internal static fixed bin(17,0) initial dcl 1-90 scratch_area based area(1024) dcl 1-92 work_area based area(1024) dcl 1-94 NAME DECLARED BY EXPLICIT CONTEXT. probe_language_request_ 000142 constant entry external dcl 25 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 412 432 322 422 Length 664 322 20 216 70 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME probe_language_request_ 104 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME probe_language_request_ 000100 probe_info_ptr probe_language_request_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_$ioa_switch probe_error_ probe_lang_type_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. probe_et_$too_many_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 25 000137 38 000147 40 000153 45 000211 48 000237 52 000267 53 000313 56 000320 ----------------------------------------------------------- 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