COMPILATION LISTING OF SEGMENT lisp_fault_handler_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1116.29_Tue_mdt Options: optimize map 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 lisp_fault_handler_: 7 procedure (a_fault_code, pbr, action); 8 9 10 /* modified 14 Nov 73 by DAM to change ^h to ^b and get rid of echofiles cruft */ 11 /* modified 74.06.03 by DAM for new arrays */ 12 /* Modified 78.01.05 by BSG for mulquit/mulpi */ 13 14 15 16 dcl a_fault_code fixed bin, 17 fault_code fixed bin, 18 pbr ptr, 19 action fixed bin, /* what to do when we return */ 20 chr char(1), 21 lisp_static_vars_$ignore_faults bit(1) static external, 22 lisp_static_vars_$space_names_atom external pointer, 23 lisp_static_vars_$zunderflow fixed bin(71) external, 24 lisp_static_vars_$quotient fixed bin(71) external, 25 lisp_static_vars_$transparent bit(1) static external, 26 transparent bit(1) def (lisp_static_vars_$transparent), /* "1"b makes lisp transparent to quits, for (ioc z) */ 27 lisp_static_vars_$quit_handler_flag bit(1) external, 28 qitf bit(1) def (lisp_static_vars_$quit_handler_flag), /* detects re-entrance of quit handler */ 29 ctrls(100) char(4) aligned static, /* buffer for deferred ctrl chars */ 30 (firstctrl, lastctrl) fixed bin static init(1), /* ptrs into the circular buffer ctrls */ 31 deferred_alrm_timer bit(1) static init("0"b), /* buffer for deferred timer */ 32 deferred_cput_timer bit(1) static init("0"b), /* .. */ 33 inbuf char(132) aligned, 34 nelemt fixed bin, 35 36 ctlchars char(50) static varying init( /* defined ctrl chars */ 37 "acdghqrstvwxz$.@\]^b?"), /* - z quits, $ calls db, others are standard */ 38 /* 0,1,2 cause user interrupt on channel 0,1,2 respectively */ 39 /* . is a no-op for quit-start-ing */ 40 unm ptr, 41 iog_unm ptr, 42 errcode(2) fixed bin(35) aligned based(unm), 43 unmtop ptr, 44 ercode fixed bin aligned based, 45 stack ptr, 46 tstack ptr, 47 1 array_head based aligned, 48 2 ndims fixed bin(17) unaligned, 49 2 infop fixed bin(17) unaligned, 50 2 first_instr bit(36) aligned, 51 ndims fixed bin, 52 i fixed bin, 53 argsp ptr, 54 iocidx fixed bin, 55 esw fixed bin, /* entry switch, 0 = quit, 1 = ioc/iog, 56* 2 = from gc, -1 = ctrl_from_reader */ 57 iogsw bit(1), /* 1 = iog, 0 = ioc */ 58 intrp ptr, /* -> interrupt fcn for ctrl_b_break */ 59 60 /* entry points called */ 61 62 (ioa_$ioa_switch, ioa_$ioa_switch_nnl) ext entry options(variable), 63 lisp_get_atom_ entry(char(*) aligned, fixed bin(71)), 64 rdr_save_f bit(1), 65 lisp_$eval entry, 66 debug ext entry, 67 lisp_prog_fns_$lisp_err entry(bit(1)aligned), /* direct interface to the unwinder */ 68 iox_$control entry(ptr, char(*), ptr, fixed bin(35)), 69 iox_$get_line entry(ptr, ptr, fixed bin, fixed bin, fixed bin(35)), 70 iox_$put_chars entry(ptr, ptr, fixed bin, fixed bin(35)), 71 iox_$user_io ptr external, 72 iox_$error_output ptr external, 73 io_status fixed bin(35), 74 lisp_error_ entry, 75 lisp_alloc_ entry(fixed bin, fixed bin(71)), 76 lisp_$apply entry, 77 lisp_segment_manager_$shrink_stacks entry, 78 lisp_io_control_$opena entry, 79 lisp_io_control_$close entry, 80 lisp_special_fns_$xcons entry, 81 lisp_special_fns_$ncons entry, 82 lisp_special_fns_$cons entry, 83 84 /* variables in lisp_static_vars_ */ 85 86 lisp_static_vars_$question_mark fixed bin(71) aligned external, 87 lisp_static_vars_$array fixed bin(71) aligned external, 88 array fixed bin(71) aligned defined (lisp_static_vars_$array), 89 lisp_static_vars_$arrayindex fixed bin(71) aligned external, 90 arrayindex fixed bin(71) aligned defined(lisp_static_vars_$arrayindex), 91 (lisp_static_vars_$mulquit_state, lisp_static_vars_$mulpi_state) fixed bin (17) external, 92 93 /* obarray format */ 94 95 htptr ptr, 96 htpos fixed bin, 97 1 obarray_struct based(htptr)aligned, 98 2 array_accessing_code(14)bit(36)aligned, 99 2 ht (0:510) fixed bin(71), 100 2 char_objects (0:127) fixed bin(71); 101 102 103 /* dcl for the CTRL/? feature */ 104 105 dcl 1 v based aligned, 106 2 lngth fixed bin(21), 107 2 string char(36), 108 lisp_static_vars_$i_am_gcing bit(1) external aligned, 109 (ms_tti init(";waiting for input from terminal. 110 "), ms_run init(";running. 111 "), ms_gc init(";garbage collection. 112 "), ms_masked init(";in (nointerrupt t) mode. 113 ") ) static char(36) varying options (constant), 114 NL char (1) static options (constant) init (" 115 "); 116 117 dcl (null, addr, addrel, ptr, index, substr, hbound, lbound, length, rel, size, binary, fixed, unspec, string) builtin; 118 119 dcl conversion condition; 120 121 /* Error Codes */ 122 123 dcl (lisp_error_table_$bad_arg_correctable, 124 lisp_error_table_$car_cdr_error, 125 lisp_error_table_$stack_loss_error, 126 lisp_error_table_$store_function_misused, 127 lisp_error_table_$underflow_fault, 128 lisp_error_table_$zerodivide_fault) fixed bin external, 129 bad_arg_correctable fixed bin defined lisp_error_table_$bad_arg_correctable, 130 car_cdr_error fixed bin defined lisp_error_table_$car_cdr_error, 131 stack_loss_error fixed bin defined lisp_error_table_$stack_loss_error, 132 store_function_misused fixed bin defined lisp_error_table_$store_function_misused, 133 underflow_fault fixed bin defined lisp_error_table_$underflow_fault, 134 zerodivide_fault fixed bin defined lisp_error_table_$zerodivide_fault; 135 136 /* Declarations for cleanup feature */ 137 138 dcl lisp_static_vars_$cleanup_list_exists bit(1) aligned external, 139 lisp_static_vars_$gc_unwinder_kludge external label, 140 lisp_static_vars_$activate_gc_unwinder_kludge bit(1) aligned external, 141 1 argument_list based aligned, 142 2 argument_count fixed bin(17) unaligned, 143 2 argument_list_format fixed bin(17) unaligned, 144 2 descriptor_count fixed bin(17) unaligned, 145 2 padding fixed bin(17) unaligned, 146 2 argument_pointer (1) pointer, 147 cleanup condition, 148 based_label_var based label variable, 149 cu_$stack_frame_ptr entry () returns(pointer); 150 1 1 /* BEGIN INCLUDE FILE ... stack_frame.incl.pl1 ... */ 1 2 1 3 /* format: off */ 1 4 1 5 /* Modified: 16 Dec 1977, D. Levin - to add fio_ps_ptr and pl1_ps_ptr */ 1 6 /* Modified: 3 Feb 1978, P. Krupp - to add run_unit_manager bit & main_proc bit */ 1 7 /* Modified: 21 March 1978, D. Levin - change fio_ps_ptr to support_ptr */ 1 8 /* Modified: 03/01/84, S. Herbst - Added RETURN_PTR_MASK */ 1 9 1 10 1 11 /****^ HISTORY COMMENTS: 1 12* 1) change(86-09-15,Kissel), approve(86-09-15,MCR7473), 1 13* audit(86-10-01,Fawcett), install(86-11-03,MR12.0-1206): 1 14* Modified to add constants for the translator_id field in the stack_frame 1 15* structure. 1 16* END HISTORY COMMENTS */ 1 17 1 18 1 19 dcl RETURN_PTR_MASK bit (72) int static options (constant) /* mask to be AND'd with stack_frame.return_ptr */ 1 20 init ("777777777777777777000000"b3); /* when copying, to ignore bits that a call fills */ 1 21 /* with indicators (nonzero for Fortran hexfp caller) */ 1 22 /* say: unspec(ptr) = unspec(stack_frame.return_ptr) & RETURN_PTR_MASK; */ 1 23 1 24 dcl TRANSLATOR_ID_PL1V2 bit (18) internal static options (constant) init ("000000"b3); 1 25 dcl TRANSLATOR_ID_ALM bit (18) internal static options (constant) init ("000001"b3); 1 26 dcl TRANSLATOR_ID_PL1V1 bit (18) internal static options (constant) init ("000002"b3); 1 27 dcl TRANSLATOR_ID_SIGNAL_CALLER bit (18) internal static options (constant) init ("000003"b3); 1 28 dcl TRANSLATOR_ID_SIGNALLER bit (18) internal static options (constant) init ("000004"b3); 1 29 1 30 1 31 dcl sp pointer; /* pointer to beginning of stack frame */ 1 32 1 33 dcl stack_frame_min_length fixed bin static init(48); 1 34 1 35 1 36 dcl 1 stack_frame based(sp) aligned, 1 37 2 pointer_registers(0 : 7) ptr, 1 38 2 prev_sp pointer, 1 39 2 next_sp pointer, 1 40 2 return_ptr pointer, 1 41 2 entry_ptr pointer, 1 42 2 operator_and_lp_ptr ptr, /* serves as both */ 1 43 2 arg_ptr pointer, 1 44 2 static_ptr ptr unaligned, 1 45 2 support_ptr ptr unal, /* only used by fortran I/O */ 1 46 2 on_unit_relp1 bit(18) unaligned, 1 47 2 on_unit_relp2 bit(18) unaligned, 1 48 2 translator_id bit(18) unaligned, /* Translator ID (see constants above) 1 49* 0 => PL/I version II 1 50* 1 => ALM 1 51* 2 => PL/I version I 1 52* 3 => signal caller frame 1 53* 4 => signaller frame */ 1 54 2 operator_return_offset bit(18) unaligned, 1 55 2 x(0: 7) bit(18) unaligned, /* index registers */ 1 56 2 a bit(36), /* accumulator */ 1 57 2 q bit(36), /* q-register */ 1 58 2 e bit(36), /* exponent */ 1 59 2 timer bit(27) unaligned, /* timer */ 1 60 2 pad bit(6) unaligned, 1 61 2 ring_alarm_reg bit(3) unaligned; 1 62 1 63 1 64 dcl 1 stack_frame_flags based(sp) aligned, 1 65 2 pad(0 : 7) bit(72), /* skip over prs */ 1 66 2 xx0 bit(22) unal, 1 67 2 main_proc bit(1) unal, /* on if frame belongs to a main procedure */ 1 68 2 run_unit_manager bit(1) unal, /* on if frame belongs to run unit manager */ 1 69 2 signal bit(1) unal, /* on if frame belongs to logical signal_ */ 1 70 2 crawl_out bit(1) unal, /* on if this is a signal caller frame */ 1 71 2 signaller bit(1) unal, /* on if next frame is signaller's */ 1 72 2 link_trap bit(1) unal, /* on if this frame was made by the linker */ 1 73 2 support bit(1) unal, /* on if frame belongs to a support proc */ 1 74 2 condition bit(1) unal, /* on if condition established in this frame */ 1 75 2 xx0a bit(6) unal, 1 76 2 xx1 fixed bin, 1 77 2 xx2 fixed bin, 1 78 2 xx3 bit(25) unal, 1 79 2 old_crawl_out bit (1) unal, /* on if this is a signal caller frame */ 1 80 2 old_signaller bit(1) unal, /* on if next frame is signaller's */ 1 81 2 xx3a bit(9) unaligned, 1 82 2 xx4(9) bit(72) aligned, 1 83 2 v2_pl1_op_ret_base ptr, /* When a V2 PL/I program calls an operator the 1 84* * operator puts a pointer to the base of 1 85* * the calling procedure here. (text base ptr) */ 1 86 2 xx5 bit(72) aligned, 1 87 2 pl1_ps_ptr ptr; /* ptr to ps for this frame; also used by fio. */ 1 88 1 89 /* format: on */ 1 90 1 91 /* END INCLUDE FILE ... stack_frame.incl.pl1 */ 151 2 1 /* BEGIN INCLUDE FILE lisp_faults.incl.pl1 */ 2 2 2 3 /* 2 4* * Written 14 Aug 72 by D A Moon 2 5* * Fault codes changed 4 Feb 73 by DAM, for user interrupt masking and new alarmclock facility 2 6* * Names changed 16 Dec 1973 by DAM because of a name conflict with lisp_free_storage.incl.pl1 2 7* * Modified 74.06.03 by DAM for new-arrays 2 8* * Modified 74.12.16 by DAM to change meaning of 'masked' 2 9* */ 2 10 dcl (Alarmclock_fault init(2), 2 11 Cput_fault init(1), 2 12 Car_cdr_fault init(6), 2 13 Quit_fault init(4), 2 14 Array_fault init(5), 2 15 Zerodivide_fault init(7), 2 16 Underflow_fault init(8), 2 17 Old_store_fault init(9), /* old/new array compatibility */ 2 18 Pi_fault init(10) /* program_interrupt signal */ 2 19 ) fixed bin static; 2 20 2 21 2 22 /* structure for saving info when a fault or an error ocuurs. 2 23* This structure gets pushed onto the unmkd pdl */ 2 24 2 25 dcl 1 fault_save aligned based (unm), 2 26 2 prev_frame bit(18)unaligned, /* thread */ 2 27 2 stack_ptr bit(18) unaligned, /* rel(stack_ptr) at time frame was created */ 2 28 2 sv_gc_inhibit bit(1) unaligned, /* save lisp_static_vars_$garbage_collect_inhibit */ 2 29 2 sv_masked like masked unaligned, /* save lisp_static_vars_$masked - for err breaks in (nointerrupt t) mode */ 2 30 2 code1 fixed bin, /* error code 1, 0 = not errprintable error */ 2 31 2 code2 fixed bin, /* error code 2, for file system errors */ 2 32 2 sv_array_info ptr, /* save array_info_for_store in stack header */ 2 33 2 sv_rdr_label label, /* -> abnormal return from call to ios_$read */ 2 34 2 sv_rdr_ptr ptr, /* datum used by reader for readlist control */ 2 35 2 sv_rdr_state fixed bin, /* 0=normal, 1=wait for input, 2=readlist */ 2 36 2 sv_array_offset fixed bin(18), /* save array_offset_for_store in stack header */ 2 37 2 padding bit(36), /* make structure an even number of words in size */ 2 38 2 dat_ptr bit(18); /* rel ptr to marked pdl slot containing losing form */ 2 39 /* needed by errprint */ 2 40 /* size(fault_save) must be even */ 2 41 2 42 2 43 /* declarations of the things that get saved here */ 2 44 2 45 dcl lisp_static_vars_$garbage_collect_inhibit bit(1) aligned external, 2 46 1 lisp_static_vars_$masked aligned external like masked, 2 47 lisp_static_vars_$pending_ctrl bit(1) aligned external, /* flag that we are doing stacked-up ctrl chars 2 48* right now, makes sure none get missed if ^G */ 2 49 lisp_static_vars_$deferred_interrupt bit(1) aligned external, /* when we unmask, we test this to */ 2 50 /* see if we must poll interrupts */ 2 51 lisp_static_vars_$rdr_label label external, 2 52 lisp_static_vars_$rdr_ptr ptr external, 2 53 lisp_static_vars_$rdr_state fixed bin external, 2 54 gc_inhibit bit(1) aligned defined(lisp_static_vars_$garbage_collect_inhibit), 2 55 deferred_interrupt bit (1) aligned defined (lisp_static_vars_$deferred_interrupt), 2 56 1 masked aligned based(addr(lisp_static_vars_$masked)), /* defined causes fault in compiler */ 2 57 2 against unaligned, /* things masked against: */ 2 58 3 tty bit(1), /* tty control characters */ 2 59 3 alarm bit(1), /* alarmclock interrupts */ 2 60 pending_ctrl bit(1) aligned defined (lisp_static_vars_$pending_ctrl), 2 61 lisp_fault_handler_$set_mask entry(1 aligned like masked), 2 62 rdr_label label defined (lisp_static_vars_$rdr_label), 2 63 rdr_ptr ptr defined (lisp_static_vars_$rdr_ptr), 2 64 rdr_state fixed bin defined (lisp_static_vars_$rdr_state); 2 65 2 66 2 67 /* END INCLUDE FILE lisp_faults.incl.pl1 */ 2 68 152 3 1 /* lisp stack header format */ 3 2 /* Last modified 7/21/72 by Reed for in_pl1 flag */ 3 3 /* Modified 1978 by Greenberg for unwind-protect ops */ 3 4 3 5 declare 3 6 3 7 1 stack_seg based aligned, /* stored in base of unmkd_pdl segment */ 3 8 2 marked_stack_bottom ptr, /* where marked stack begins... */ 3 9 2 unmkd_stack_bottom ptr, /* where unmkd_ stack actually starts */ 3 10 2 stack_ptr_ptr ptr, /* points at lisp_static_vars_$stack_ptr */ 3 11 2 unmkd_ptr_ptr ptr, /* points at lisp_static_vars_$unmkd_ptr's offset word */ 3 12 2 array_pointer ptr, /* obsolete */ 3 13 2 nil fixed bin(71), /* object for nil */ 3 14 2 true fixed bin(71), /* object for t */ 3 15 2 in_pl1_code bit(36), /* flag indicating that we are in pl1 code if non-zero */ 3 16 2 padding0 bit(36), /* double word boundary preservation */ 3 17 2 bind_op ptr, /* pointers to operators for run-time support */ 3 18 2 unbind_op ptr, 3 19 2 errset1_op ptr, 3 20 2 errset2_op ptr, 3 21 2 unerrset_op ptr, 3 22 2 call_op ptr, 3 23 2 catch1_op ptr, 3 24 2 catch2_op ptr, 3 25 2 uncatch_op ptr, 3 26 2 gensym_data (2) bit(36) aligned, /* stuff used by the gensym function */ 3 27 2 system_lp ptr, /* pointer to the system's linkage section */ 3 28 2 iogbind_op ptr, 3 29 2 unseen_go_tag_op ptr, 3 30 2 throw1_op ptr, 3 31 2 throw2_op ptr, 3 32 2 signp_op ptr, 3 33 2 type_fields bit(72) aligned, /* fixnum, flonum type for compiled code */ 3 34 2 return_op ptr, 3 35 2 err_op ptr, 3 36 2 pl1_interface ptr, /* pointer to pl1 interface for type 2 subrs. */ 3 37 2 pl1_lsubr_interface ptr, /* same for type -2 subrs */ 3 38 2 cons_opr ptr, /* cons operator */ 3 39 2 ncons_opr ptr, /* ncons operator */ 3 40 2 xcons_opr ptr, /* xcons operator */ 3 41 2 begin_list_opr ptr, /* operator to make initial cell of list */ 3 42 2 append_list_opr ptr, /* operator to append to last-made cell of list */ 3 43 2 terminate_list_opr ptr, /* opeator to append last cell to next to last cell of list */ 3 44 2 compare_op ptr, /* fixnum/flonum comparison operator */ 3 45 2 link_op ptr, 3 46 2 array_operator pointer, /* accessing operator, invoked by arrays */ 3 47 2 dead_array_operator pointer, /* dead arrays invoke this operator instead */ 3 48 2 store_operator pointer, /* operator to do compiled store */ 3 49 2 floating_store_operator pointer, /* ditto, but operand is in EAQ */ 3 50 2 array_info_for_store pointer, /* -> array_info block of last array referenced */ 3 51 2 array_offset_for_store fixed bin(18), /* offset in array_data block of last array element referenced */ 3 52 2 padding bit(36), 3 53 2 array_link_snap_opr pointer, 3 54 2 create_string_desc_op ptr, 3 55 2 create_array_desc_op ptr, 3 56 2 pl1_call_op ptr, 3 57 2 cons_string_op ptr, 3 58 2 create_varying_string_op ptr, 3 59 2 unwp1_op ptr, 3 60 2 unwp2_op ptr, 3 61 2 ununwp_op ptr, 3 62 2 irest_return_op ptr, 3 63 2 pl1_call_nopop_op ptr, 3 64 2 rcv_char_star_op ptr, 3 65 2 spare2 (7) ptr, 3 66 2 begin_unmkd_stack(16325) fixed bin(71); /* rest of segment is the unmarked pdl */ 3 67 3 68 dcl call_array_operator bit(36) static init("100112273120"b3), /* tspbb ab|112,* */ 3 69 call_dead_array_operator bit(36) static init("100114273120"b3); /* tspbb ab|114,* */ 3 70 3 71 /* end stack segment format */ 153 4 1 /***** BEGIN INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 4 2 4 3 /* This include file defines the format of the "new" LISP arrays. 4 4* Written 74.05.13 by DAM */ 4 5 4 6 /* Info block in static space. pointed at by array ptr */ 4 7 4 8 dcl 1 array_info aligned based structure, /* 8 words long */ 4 9 2 ndims fixed bin(17) unaligned, /* number of dimensions */ 4 10 2 gc_mark bit(18) unaligned, /* alternating bits for garbage coll. */ 4 11 2 call_array_operator bit(36), /* tspbp instruction to array opr */ 4 12 2 array_data_ptr pointer, /* -> array_data structure */ 4 13 2 array_load_sequence(3) bit(36), /* lda, ldq, tra bp|0 */ 4 14 2 type fixed bin(17) unaligned, /* type of array, see dcl below */ 4 15 2 minus_2_times_ndims fixed bin(17) unaligned; /* for convenience of array opr */ 4 16 4 17 /* Codes for the different types of arrays: 4 18* Name Value arg to *array to create one */ 4 19 4 20 dcl (S_expr_array init(0), /* t */ 4 21 Un_gc_array init(1), /* nil */ 4 22 Fixnum_array init(2), /* fixnum */ 4 23 Flonum_array init(3), /* flonum */ 4 24 Readtable_array init(4), /* readtable */ 4 25 Obarray_array init(5), /* obarray */ 4 26 Dead_array init(6) /* (*rearray a) */ 4 27 ) fixed bin(17) static; 4 28 4 29 /* Block of array data and dimensions, in garbage-collected Lists space */ 4 30 4 31 dcl 1 array_data aligned based structure, 4 32 2 dope_vector(ZERO), /* address by dope_vector(i-ndims). no way to dcl in PL/I */ 4 33 3 bounds fixed bin(35), /* 0 <_ subscript < bounds */ 4 34 3 multiplier fixed bin(35), /* multiplier in polynomial-type subscript calc. */ 4 35 2 data(0:1000) fixed bin(71); /* single or double words depending on type of array */ 4 36 4 37 dcl ZERO fixed bin static init(0); /* Circumvent a compiler bug causing reference through null pointer in get_array_size$multf */ 4 38 4 39 /***** END INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 154 5 1 /* INCLUDE FILE lisp_io.incl.pl1 */ 5 2 5 3 /* data structures used by the lisp i/o system */ 5 4 6 1 /* BEGIN INCLUDE FILE lisp_iochan.incl.pl1 */ 6 2 6 3 /* This include file describes the format of the 'iochan' block, 6 4* which is used to implement lisp file-objects. The iochan 6 5* is the central data base of the i/o system. When open 6 6* is used, an iochan is created in lisp static storage. 6 7* When the lisp environment is booted, 2 iochans for input and 6 8* output on the tty are created. Iochans are saved and restored 6 9* by the save mechanism */ 6 10 6 11 /* open i/o channel information */ 6 12 6 13 dcl 1 iochan based aligned, /* format of a file object */ 6 14 2 ioindex fixed bin(24), /* 0-origin character position in block */ 6 15 2 iolength fixed bin(24), /* size of block in chars - actual(in), max(out) */ 6 16 2 ioptr pointer, /* -> block */ 6 17 2 thread pointer, /* list of all iochans open; from lisp_static_vars_$iochan_list */ 6 18 2 fcbp pointer, /* for tssi_ */ 6 19 2 aclinfop pointer, /* .. */ 6 20 2 component fixed bin, /* .. */ 6 21 2 charpos fixed bin, /* 0-origin horizontal position on line */ 6 22 2 linel fixed bin, /* (out) line length, 0 => oo */ 6 23 2 flags unaligned, 6 24 3 seg bit(1), /* 1 => msf, 0 => stream */ 6 25 3 read bit(1), /* 0 => openi, 1 => not */ 6 26 3 write bit(1), /* 0 => openo, 1 => not */ 6 27 3 gc_mark bit(1), /* for use by the garbage collector */ 6 28 3 interactive bit(1), /* 1 => input => this is the tty 6 29* output => flush buff after each op */ 6 30 3 must_reopen bit(1), /* 1 => has been saved and not reopend yet */ 6 31 3 nlsync bit(1), /* 1 => there is a NL in the buffer (output streams only) */ 6 32 3 charmode bit(1), /* enables instant ios_$write */ 6 33 3 extra_nl_done bit(1), /* 1 => last char output was extra NL for chrct */ 6 34 3 fixnum_mode bit(1), /* to be used with in and out functions */ 6 35 3 image_mode bit(1), /* just suppresses auto-cr */ 6 36 3 not_yet_used bit(25), 6 37 2 function fixed bin(71), /* EOF function (input), or endpagefn (output) <<< gc-able >>> */ 6 38 2 namelist fixed bin(71), /* list of names, car is directory pathname <<< gc-able >>> */ 6 39 2 name char(32) unaligned, /* stream name or entry name */ 6 40 2 pagel fixed bin, /* number of lines per page */ 6 41 2 linenum fixed bin, /* current line number, starting from 0 */ 6 42 2 pagenum fixed bin, /* current page number, starting from 0 */ 6 43 6 44 flag_reset_mask bit(36) aligned static init( /* anded into flags with each char */ 6 45 "111011110111111111"b); 6 46 6 47 /* END INCLUDE FILE lisp_iochan.incl.pl1 */ 5 5 5 6 5 7 /* masks for checking iochan.flags, seeing if lisp_io_control_$fix_not_ok_iochan should be called */ 5 8 5 9 dcl not_ok_to_read bit(36) static init("0100010001"b), /* mask for checking iochan.flags on input */ 5 10 not_ok_to_write bit(36) static init("0010010001"b);/* mask for checking iochan.flags on output */ 5 11 dcl not_ok_to_read_fixnum bit(36) static init("0100010000"b), 5 12 not_ok_to_write_fixnum bit(36) static init("0010010000"b); 5 13 5 14 5 15 /* miscellaneous global, static variables and atoms used by the I/O system */ 5 16 5 17 dcl lisp_static_vars_$read_print_nl_sync bit(36) ext, 5 18 read_print_nl_sync bit(36) defined (lisp_static_vars_$read_print_nl_sync), 5 19 lisp_static_vars_$ibase ext fixed bin(71), 5 20 ibase fixed bin(71) defined (lisp_static_vars_$ibase), 5 21 5 22 lisp_static_vars_$quote_atom ext fixed bin (71), 5 23 quote_atom fixed bin(71) defined (lisp_static_vars_$quote_atom), 5 24 5 25 lisp_static_vars_$base ext fixed bin(71), 5 26 base fixed bin(71) defined ( lisp_static_vars_$base), 5 27 5 28 lisp_static_vars_$stnopoint ext fixed bin(71), 5 29 stnopoint fixed bin(71) defined (lisp_static_vars_$stnopoint), 5 30 5 31 lisp_static_vars_$tty_atom ext fixed bin(71), 5 32 tty_atom fixed bin(71) defined (lisp_static_vars_$tty_atom), 5 33 lisp_static_vars_$status_gctwa ext fixed bin(71), 5 34 status_gctwa fixed bin(71) defined (lisp_static_vars_$status_gctwa), 5 35 5 36 lisp_static_vars_$s_atom ext fixed bin(71), 5 37 s_atom fixed bin(71) defined (lisp_static_vars_$s_atom), 5 38 5 39 lisp_static_vars_$readtable ext fixed bin(71), 5 40 readtable fixed bin(71) defined (lisp_static_vars_$readtable), 5 41 5 42 lisp_static_vars_$plus_status ext fixed bin(71), 5 43 plus_status fixed bin(71) defined (lisp_static_vars_$plus_status); 5 44 7 1 /* BEGIN INCLUDE FILE lisp_control_chars.incl.pl1 */ 7 2 7 3 /* Last modified D. Reed 6/29/72 */ 7 4 7 5 dcl lisp_static_vars_$ctrlD ext fixed bin(71), 7 6 ctrlD fixed bin(71) defined (lisp_static_vars_$ctrlD); 7 7 7 8 dcl lisp_static_vars_$ctrlQ ext fixed bin(71), 7 9 ctrlQ fixed bin(71) defined (lisp_static_vars_$ctrlQ); 7 10 7 11 dcl lisp_static_vars_$ctrlR ext fixed bin(71), 7 12 ctrlR fixed bin(71) defined (lisp_static_vars_$ctrlR); 7 13 7 14 dcl lisp_static_vars_$ctrlW ext fixed bin(71), 7 15 ctrlW fixed bin(71) defined (lisp_static_vars_$ctrlW); 7 16 7 17 /* END INCLUDE FILE lisp_control_chars.incl.pl1 */ 7 18 5 45 5 46 /* END INCLUDE FILE lisp_io.incl.pl1 */ 5 47 155 8 1 /* lisp number format -- overlaid on standard its pointer. */ 8 2 8 3 8 4 dcl 1 fixnum_fmt based aligned, 8 5 2 type_info bit(36) aligned, 8 6 2 fixedb fixed bin, 8 7 8 8 1 flonum_fmt based aligned, 8 9 2 type_info bit(36) aligned, 8 10 2 floatb float bin, 8 11 8 12 fixnum_type bit(36) aligned static init("000000000000000000000100000000100111"b), 8 13 flonum_type bit(36) aligned static init("000000000000000000000010000000100111"b); 8 14 8 15 /* end of lisp number format */ 8 16 156 9 1 9 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 9 3 9 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 9 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 9 6* are used so that the name of the function which is rejecting its argument 9 7* can be printed. Please note that all these codes are negative. */ 9 8 9 9 dcl ( 9 10 fn_do init (-10), 9 11 fn_arg init (-11), 9 12 fn_setarg init (-12), 9 13 fn_status init (-13), 9 14 fn_sstatus init (-14), 9 15 fn_errprint init (-15), 9 16 fn_errframe init (-16), 9 17 fn_evalframe init (-17), 9 18 fn_defaultf init (-18), 9 19 fn_tyo init (-22), 9 20 fn_ascii init (-23), 9 21 fn_rplaca init (-24), 9 22 fn_definedp init (-25), 9 23 fn_setq init (-26), 9 24 fn_set init (-27), 9 25 fn_delete init (-28), 9 26 fn_delq init (-29), 9 27 fn_stringlength init (-30), 9 28 fn_catenate init (-31), 9 29 fn_array init (-32), 9 30 fn_substr init (-33), 9 31 fn_index init (-34), 9 32 fn_get_pname init (-35), 9 33 fn_make_atom init (-36), 9 34 fn_ItoC init (-37), 9 35 fn_CtoI init (-38), 9 36 fn_defsubr init (-39), 9 37 fn_star_array init (-40), 9 38 fn_args init (-41), 9 39 fn_sysp init (-42), 9 40 fn_get init (-43), 9 41 fn_getl init (-44), 9 42 fn_putprop init (-45), 9 43 fn_remprop init (-46), 9 44 fn_save init (-47), 9 45 fn_add1 init (-48), 9 46 fn_sub1 init (-49), 9 47 fn_greaterp init (-50), 9 48 fn_lessp init (-51), 9 49 fn_minus init (-52), 9 50 fn_plus init (-53), 9 51 fn_times init (-54), 9 52 fn_difference init (-55), 9 53 fn_quotient init (-56), 9 54 fn_abs init (-57), 9 55 fn_expt init (-58), 9 56 fn_boole init (-59), 9 57 fn_rot init (-60), 9 58 fn_lsh init (-61), 9 59 fn_signp init (-62), 9 60 fn_fix init (-63), 9 61 fn_float init (-64), 9 62 fn_remainder init (-65), 9 63 fn_max init (-66), 9 64 fn_min init (-67), 9 65 fn_add1_fix init (-68), 9 66 fn_add1_flo init (-69), 9 67 fn_sub1_fix init (-70), 9 68 fn_sub1_flo init (-71), 9 69 fn_plus_fix init (-72), 9 70 fn_plus_flo init (-73), 9 71 fn_times_fix init (-74), 9 72 fn_times_flo init (-75), 9 73 fn_diff_fix init (-76), 9 74 fn_diff_flo init (-77), 9 75 fn_quot_fix init (-78), 9 76 fn_quot_flo init (-79), 9 77 fn_eval init (-80), 9 78 fn_apply init (-81), 9 79 fn_prog init (-82), 9 80 fn_errset init (-83), 9 81 fn_catch init (-84), 9 82 fn_throw init (-85), 9 83 fn_store init (-86), 9 84 fn_defun init (-87), 9 85 fn_baktrace init (-88), 9 86 fn_bltarray init (-89), 9 87 fn_star_rearray init (-90), 9 88 fn_gensym init (-91), 9 89 fn_makunbound init (-92), 9 90 fn_boundp init (-93), 9 91 fn_star_status init (-94), 9 92 fn_star_sstatus init (-95), 9 93 fn_freturn init (-96), 9 94 fn_cos init (-97), 9 95 fn_sin init (-98), 9 96 fn_exp init (-99), 9 97 fn_log init (-100), 9 98 fn_sqrt init (-101), 9 99 fn_isqrt init (-102), 9 100 fn_atan init (-103), 9 101 fn_sleep init (-104), 9 102 fn_oddp init (-105), 9 103 fn_tyipeek init (-106), 9 104 fn_alarmclock init (-107), 9 105 fn_plusp init (-108), 9 106 fn_minusp init (-109), 9 107 fn_ls init (-110), 9 108 fn_eql init (-111), 9 109 fn_gt init (-112), 9 110 fn_alphalessp init (-113), 9 111 fn_samepnamep init (-114), 9 112 fn_getchar init (-115), 9 113 fn_opena init (-116), 9 114 fn_sxhash init (-117), 9 115 fn_gcd init (-118), 9 116 fn_allfiles init (-119), 9 117 fn_chrct init (-120), 9 118 fn_close init (-121), 9 119 fn_deletef init (-122), 9 120 fn_eoffn init (-123), 9 121 fn_filepos init (-124), 9 122 fn_inpush init (-125), 9 123 fn_linel init (-126), 9 124 fn_mergef init (-127), 9 125 fn_namelist init (-128), 9 126 fn_names init (-129), 9 127 fn_namestring init (-130), 9 128 fn_openi init (-131), 9 129 fn_openo init (-132), 9 130 fn_prin1 init (-133), 9 131 fn_princ init (-134), 9 132 fn_print init (-135), 9 133 fn_read init (-136), 9 134 fn_readch init (-137), 9 135 fn_readstring init (-138), 9 136 fn_rename init (-139), 9 137 fn_shortnamestring init (-140), 9 138 fn_tyi init (-141), 9 139 fn_setsyntax init (-142), 9 140 fn_cursorpos init (-143), 9 141 fn_force_output init (-144), 9 142 fn_clear_input init (-145), 9 143 fn_random init (-146), 9 144 fn_haulong init (-147), 9 145 fn_haipart init (-148), 9 146 fn_cline init (-149), 9 147 fn_fillarray init (-150), 9 148 fn_listarray init (-151), 9 149 fn_sort init (-152), 9 150 fn_sortcar init (-153), 9 151 fn_zerop init (-154), 9 152 fn_listify init (-155), 9 153 fn_charpos init (-156), 9 154 fn_pagel init (-157), 9 155 fn_linenum init (-158), 9 156 fn_pagenum init (-159), 9 157 fn_endpagefn init (-160), 9 158 fn_arraydims init (-161), 9 159 fn_loadarrays init (-162), 9 160 fn_dumparrays init (-163), 9 161 fn_expt_fix init (-164), 9 162 fn_expt_flo init (-165), 9 163 fn_nointerrupt init (-166), 9 164 fn_open init (-167), 9 165 fn_in init (-168), 9 166 fn_out init (-169), 9 167 fn_truename init (-170), 9 168 fn_ifix init (-171), 9 169 fn_fsc init (-172), 9 170 fn_progv init (-173), 9 171 fn_mapatoms init (-174), 9 172 fn_unwind_protect init (-175), 9 173 fn_eval_when init (-176), 9 174 fn_read_from_string init (-177), 9 175 fn_displace init (-178), 9 176 fn_nth init (-179), 9 177 fn_nthcdr init (-180), 9 178 fn_includef init (-181) 9 179 ) fixed bin static; 9 180 9 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 157 10 1 /* include file lisp_stack_fmt.incl.pl1 -- 10 2* describes the format of the pushdown list 10 3* used by the lisp evaluator and lisp subrs 10 4* for passing arguments, saving atom bindings, 10 5* and as temporaries */ 10 6 10 7 dcl 10 8 temp(10000) fixed bin(71) aligned based, 10 9 10 10 temp_ptr(10000) ptr aligned based, 10 11 1 push_down_list_ptr_types(10000) based aligned, 10 12 2 junk bit(21) unaligned, 10 13 2 temp_type bit(9) unaligned, 10 14 2 more_junk bit(42) unaligned, 10 15 10 16 1 pdl_ptr_types36(10000) based aligned, 10 17 2 temp_type36 bit(36), 10 18 2 junk bit(36), 10 19 10 20 1 binding_block aligned based, 10 21 2 top_block bit(18) unaligned, 10 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 10 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 10 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 10 25 10 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 10 27 2 old_val fixed bin(71) aligned, 10 28 2 atom fixed bin(71) aligned; 10 29 10 30 10 31 10 32 /* end include file lisp_stack_fmt.incl.pl1 */ 158 11 1 /* Include file lisp_common_vars.incl.pl1; 11 2* describes the external static variables which may be referenced 11 3* by lisp routines. 11 4* D. Reed 4/1/71 */ 11 5 11 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 11 7 2 cclist_ptr ptr, /* pointer to list of constants kept 11 8* by compiled programs */ 11 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 11 10 11 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 11 12 err_recp ptr defined (lisp_static_vars_$err_recp), 11 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 11 14 lisp_static_vars_$eval_frame ptr ext static, 11 15 lisp_static_vars_$prog_frame ptr ext aligned, 11 16 lisp_static_vars_$err_frame ptr ext aligned, 11 17 lisp_static_vars_$catch_frame ptr ext aligned, 11 18 lisp_static_vars_$unwp_frame ptr ext aligned, 11 19 lisp_static_vars_$stack_ptr ptr ext aligned, 11 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 11 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 11 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 11 23 lisp_static_vars_$binding_top ptr ext aligned, 11 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 11 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 11 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 11 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 11 28 binding_top ptr defined (lisp_static_vars_$binding_top), 11 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 11 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 11 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 11 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 11 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 11 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 11 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 11 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 11 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 11 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 11 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 11 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 11 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 11 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 11 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 11 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 11 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 11 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 11 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 11 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 11 49 11 50 11 51 /* end include file lisp_common_vars.incl.pl1 */ 159 12 1 /* Include file lisp_ptr_fmt.incl.pl1; 12 2* describes the format of lisp pointers as 12 3* a bit string overlay on the double word ITS pair 12 4* which allows lisp to access some unused bits in 12 5* the standard ITS pointer format. It should be noted that 12 6* this is somewhat of a kludge, since 12 7* it is quite machine dependent. However, to store type 12 8* fields in the pointer, saves 2 words in each cons, 12 9* plus some efficiency problems. 12 10* 12 11* D.Reed 4/1/71 */ 12 12 /* modified to move type field to other half of ptr */ 12 13 /* D.Reed 5/31/72 */ 12 14 12 15 12 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 12 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 12 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 12 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 12 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 12 21 2 type bit(9) unaligned, /* type field */ 12 22 2 itsmod bit(6) unaligned, 12 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 12 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 12 25 12 26 /* manifest constant strings for testing above type field */ 12 27 12 28 ( 12 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 12 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 12 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 12 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 12 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 12 34 Bignum init("000001000"b), /* a multiple-precision number */ 12 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 12 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 12 37* means a special internal uncollectable weird object */ 12 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 12 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 12 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 12 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 12 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 12 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 12 44 ) bit(9) static, 12 45 12 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 12 47 12 48 12 49 ( 12 50 Cons36 init("000000000000000000000000000000"b), 12 51 Fixed36 init("000000000000000000000100000000"b), 12 52 Float36 init("000000000000000000000010000000"b), 12 53 Atsym36 init("000000000000000000000001000000"b), 12 54 Atomic36 init("000000000000000000000111111100"b), 12 55 Bignum36 init("000000000000000000000000001000"b), 12 56 System_Subr36 12 57 init("000000000000000000000000000100"b), 12 58 Bigfix36 init("000000000000000000000000001000"b), 12 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 12 60 NotConsOrAtsym36 12 61 init("000000000000000000000110111111"b), 12 62 SubrNumeric36 12 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 12 64 String36 init("000000000000000000000000100000"b), 12 65 Subr36 init("000000000000000000000000010000"b), 12 66 File36 init("000000000000000000000000000001"b), 12 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 12 68 12 69 /* undefined pointer value is double word of zeros */ 12 70 12 71 Undefined bit(72) static init(""b); 12 72 12 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 160 13 1 /* Include file lisp_atom_fmt.incl.pl1; 13 2* describes internal format of atoms in the lisp system 13 3* D.Reed 4/1/71 */ 13 4 13 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 13 6 2 value fixed bin(71), /* atom's value */ 13 7 2 plist fixed bin(71), /* property list */ 13 8 2 pnamel fixed bin, /* length of print name */ 13 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 13 10 13 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 13 12 2 value ptr, 13 13 2 plist ptr, 13 14 13 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 13 16 2 value bit(72), 13 17 2 plist bit(72); 13 18 13 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 161 14 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 14 2* describes format of storage for lisp 14 3* character strings. 14 4* D. Reed 4/1/71 */ 14 5 14 6 dcl 1 lisp_string based aligned, 14 7 2 string_length fixed bin, 14 8 2 string char(1 refer(string_length)); 14 9 14 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 162 15 1 /* Include file lisp_cons_fmt.incl.pl1; 15 2* defines the format for a cons within the lisp system 15 3* D.Reed 4/1/71 */ 15 4 15 5 dcl consptr ptr, 15 6 1 cons aligned based (consptr), /* structure defining format for cons */ 15 7 2 car fixed bin(71), 15 8 2 cdr fixed bin(71), 15 9 15 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 15 11 2 car ptr, 15 12 2 cdr ptr, 15 13 15 14 15 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 15 16 2 padding bit(21) unaligned, 15 17 2 car bit(9) unaligned, 15 18 2 padding2 bit(63) unaligned, 15 19 2 cdr bit(9) unaligned, 15 20 2 padend bit(42) unaligned; 15 21 15 22 dcl 1 cons_types36 aligned based, 15 23 2 car bit(36), 15 24 2 pada bit(36), 15 25 2 cdr bit(36), 15 26 2 padd bit(36); 15 27 15 28 15 29 /* end include file lisp_cons_fmt.incl.pl1 */ 163 164 165 fault_code = a_fault_code; 166 call save_state; 167 168 save_state: proc; 169 170 /* save status of key variables, rdr, ... */ 171 172 stack = stack_ptr; 173 call save_state_only; 174 175 /* reset these statuses */ 176 177 gc_inhibit = "1"b; /* shut off gc since the routine we interrupted 178* might have a lisp object in the aq or bp or 179* even a lisp object on the pdl without type bits */ 180 lisp_static_vars_$rdr_state = 0; /* reset reader to normal state */ 181 end save_state; 182 183 184 save_state_only: procedure; 185 186 unm = unmkd_ptr; 187 unmkd_ptr = addrel(unm, size(fault_save)); 188 fault_save.prev_frame = rel(err_recp); 189 fault_save.stack_ptr = rel(stack); 190 fault_save.sv_gc_inhibit = gc_inhibit; 191 fault_save.sv_masked = masked; 192 fault_save.code1 = 0; /* no err msg yet */ 193 unspec(fault_save.sv_array_info) = unspec(ptr(unm, ""b) -> stack_seg.array_info_for_store); 194 fault_save.sv_array_offset = ptr(unm, ""b) -> stack_seg.array_offset_for_store; 195 fault_save.sv_rdr_label = rdr_label; 196 fault_save.sv_rdr_ptr = rdr_ptr; 197 fault_save.sv_rdr_state = rdr_state; 198 err_recp = unm; 199 200 end save_state_only; 201 202 /* determine what kind of fault we took, and go handle it */ 203 204 unmtop = unmkd_ptr; /* for pushing error codes */ 205 if fault_code = Alarmclock_fault then go to alarm; 206 else if fault_code = Cput_fault then go to alarm; 207 else if fault_code = Car_cdr_fault then go to car_cdr_of_num; 208 else if fault_code = Quit_fault then go to Quit; 209 else if fault_code = Array_fault then go to array_lossage; 210 else if fault_code = Old_store_fault then go to emulate_old_style_store; 211 else if fault_code = Zerodivide_fault then go to handle_zerodivide; 212 else if fault_code = Underflow_fault then go to handle_underflow; 213 else if fault_code = Pi_fault then go to handle_pi; 214 215 /* undefined fault code, barf and take as quit */ 216 217 call ioa_$ioa_switch(iox_$user_io, "^/lisp_fault_handler_: undefined fault code ^d.", fault_code); 218 219 /* quit handler, accepts 1 "control" character */ 220 221 Quit: /* if this is 2nd quit, previous invocation of quit handler must have 222* lost, so pass this quit on to standard system quit handler */ 223 224 if transparent then do; /* transparent quit - pass it along & clear flag */ 225 transparent = "0"b; 226 action = 2; 227 go to exit_nzq; 228 end; 229 if qitf then do; 230 action = 2; 231 go to exit_nzq; 232 end; 233 qitf = "1"b; /* remember that we are in lisp quit routine */ 234 esw = 0; 235 if masked.against.tty then go to masked_quit; 236 237 238 239 /* check for user quit-control */ 240 241 lisp_static_vars_$read_print_nl_sync = "1"b; /* Get newlines flushed */ 242 if fault_code = Pi_fault then; /* program_interrupt falls through */ 243 else if lisp_static_vars_$mulquit_state = -1 then; /* Fall through to ITS-like handling */ 244 else if lisp_static_vars_$mulquit_state = -2 then go to ctrl_z_handler; /* Let it go through */ 245 else do; /* Signal user interrupt */ 246 i = lisp_static_vars_$mulquit_state; 247 go to ioc_num_not_2; 248 end; 249 250 /* ask for a control character */ 251 252 ask_for_ctrl: 253 lisp_static_vars_$read_print_nl_sync = "1"b; /* user hit newline after typing the ctrl char */ 254 call ioa_$ioa_switch_nnl(iox_$user_io, "CTRL/"); 255 call iox_$get_line(iox_$user_io, addr(inbuf), length(inbuf), nelemt, io_status); 256 ctrl_aa: 257 chr = substr(inbuf, 1, 1); 258 if nelemt < 2 then go to ask_for_ctrl; 259 else if chr >= "0" & chr <= "9" then go to ctrl_num; 260 else if nelemt > 2 then do; 261 not_ctrl: call ioa_$ioa_switch(iox_$user_io, "lisp: ""^a"" is not a control character.", 262 substr(inbuf, 1, nelemt-1)); 263 go to ask_for_ctrl_0; /* reject it and try again */ 264 /* this keeps the user from screwing himself by 265* typing start */ 266 end; 267 268 269 dispatch: /* Make the character lower case if it as a letter */ 270 271 if chr < "A" then go to dispatch_1; 272 if chr > "Z" then go to dispatch_1; 273 unspec(chr) = unspec(chr) | "000100000"b; /* or in 40 */ 274 dispatch_1: 275 go to proc(index(ctlchars, chr)); 276 277 278 279 /* number entered -- is number of user interrupt to signal */ 280 281 ctrl_num: on conversion go to not_ctrl; 282 i = binary(substr(inbuf, 1, nelemt-1), 17); 283 revert conversion; 284 285 ioc_num: if i = 2 then go to proc(1); /* CTRL/2 handle specially as CTRL/a */ 286 ioc_num_not_2: 287 288 /* signal user interrupt on channel i with argument 'ioc */ 289 290 stack_ptr = addr(stack -> temp(4)); 291 if i < 0 then go to bad_int_num; 292 else if i >= 21 then go to bad_int_num; 293 stack -> temp(1) = user_intr_array(i); 294 if stack -> temp(1) = nil then go to bad_int_num; 295 stack -> temp(1) = stack -> temp_ptr(1) -> atom.value; 296 qitf = "0"b; 297 if stack -> temp(1) = nil then go to exit1; /* not anabled */ 298 call lisp_get_atom_("ioc", stack -> temp(2)); 299 stack -> temp(3) = nil; 300 call lisp_special_fns_$cons; 301 call lisp_$apply; 302 bad_int_num: /* just ignore */ 303 go to exit1; 304 305 306 proc(0): if esw = 1 then go to ioc_retn; /* ignore unknown chars from ioc, since other sys might have */ 307 call ioa_$ioa_switch(iox_$user_io, "lisp: undefined control character ""^1a""", chr); 308 if esw < 0 then go to exitv(-1); /* ctrl_from_reader - that's all */ 309 ask_for_ctrl_0: 310 if esw = 2 then if firstctrl ^= lastctrl then go to exitv(2); /* for deferred chars from gc, 311* allow retry only for last */ 312 go to ask_for_ctrl; 313 314 315 proc(2): /* CTRL/c gags the gc messages */ 316 317 addr(ctrlD) -> based_ptr -> atom.value = nil; 318 go to exit1; 319 320 proc(3): /* CTRL/d turns on the gc messages */ 321 322 addr(ctrlD) -> based_ptr -> atom.value = t_atom; 323 go to exit1; 324 325 326 proc(15): /* CTRL/. is a no-op which allows you to speed 327* up a slow multics by causing fake interactions */ 328 329 exit1: go to exitv(esw); 330 exitv(0): action = 0; 331 go to exit; 332 333 334 proc(4): /* CTRL/g causes quit all the way up to top level */ 335 ctrl_g_handler: 336 call ioa_$ioa_switch(iox_$user_io, "Quit"); 337 unwind_to_top_level: 338 err_frame = ptr(unmkd_ptr, ""b); /* get rid of errsets so we can can unwind 339* all the way up to top level */ 340 quitter: tty_input_chan -> iochan.ioindex = 0; 341 tty_input_chan -> iochan.iolength = 0; /* clear input buffer */ 342 tty_output_chan -> iochan.ioindex = 0; /* clear the printer's output buffer */ 343 qitf = "0"b; 344 call lisp_prog_fns_$lisp_err("0"b); /* unwind */ 345 346 proc(12): /* CTRL/x causes quit to first errset */ 347 348 call ioa_$ioa_switch(iox_$user_io, "quit"); /* note difference between this and the ^g msg */ 349 go to quitter; 350 351 proc(13): /* CTRL/z causes standard Multics QUIT */ 352 ctrl_z_handler: 353 354 qitf = "0"b; /* allow pi'ing back in */ 355 356 if esw ^= 0 then do; /* not already in a quit, must make one */ 357 dcl quit condition; 358 do_ctrl_z: 359 transparent = "1"b; /* make the quit fall through lisp */ 360 lisp_static_vars_$ignore_faults = "1"b; 361 on cleanup transparent, lisp_static_vars_$ignore_faults = "0"b; 362 signal quit; 363 lisp_static_vars_$ignore_faults = "0"b; 364 transparent = "0"b; 365 go to exit1; 366 end; 367 action = 2; 368 go to exit; /* action 2 is pass quit to next on-unit */ 369 370 proc(14): /* CTRL/$ causes debug to be called */ 371 372 lisp_static_vars_$ignore_faults = "1"b; 373 call ioa_$ioa_switch(iox_$user_io, "db"); 374 call debug; 375 lisp_static_vars_$ignore_faults = "0"b; 376 go to exit1; 377 378 379 proc(5): /* CTRL/h causes user interrupt number 1 -- obsolete but keep around for a while */ 380 proc(20): /* CTRL/b causes a break on user interrupt 1 */ 381 382 intrp = addr(user_intr_array(1)) -> based_ptr; 383 384 ctrl_b_break: 385 tty_input_chan -> iochan.ioindex = 0; /* clear input buffer */ 386 tty_input_chan -> iochan.iolength = 0; 387 tty_output_chan -> iochan.ioindex = 0; /* clear printer buffer */ 388 stack_ptr = addr(stack -> temp(4)); 389 stack -> temp(1) = intrp -> atom.value; 390 if stack -> temp(1) ^= nil then do; 391 stack -> temp(2) = nil; 392 stack -> temp(3) = nil; /* make the arg list */ 393 call lisp_special_fns_$cons; 394 qitf = "0"b; 395 call lisp_$apply; 396 end; 397 go to exit1; 398 399 400 /* control characters that change i/o switches -- q, r, s, t, w, v */ 401 402 proc(6): /* CTRL/q switches the rdr to input from uread channel */ 403 404 addr(ctrlQ) -> based_ptr -> atom.value = t_atom; 405 go to exit1; /* make sure the rdr doesn't get stuck 406* in tty input wait after ^q is issued */ 407 /* this assurance is now done by people who unwind err asynchronously 408* created fault_save's (i.e. our 'exit' routine) */ 409 410 proc(8): /* CTRL/s switches the reader back to input from the tty */ 411 412 addr(ctrlQ) -> based_ptr -> atom.value = nil; 413 go to exit1; /* let the reader finish what it is doing 414* before stopping since user won't notice 415* delay anyway.... */ 416 417 proc(7): /* CTRL/r activates output to uwrite channel from printer */ 418 419 addr(ctrlR) -> based_ptr -> atom.value = t_atom; 420 go to exit1; /* on next character output, printer 421* will notice the switch */ 422 423 proc(9): /* CTRL/t shuts off the uwrite channel */ 424 425 addr(ctrlR) -> based_ptr -> atom.value = nil; 426 go to exit1; /* the printer will soon gag itself */ 427 428 proc(10): /* CTRL/v turns on output to the tty */ 429 430 addr(ctrlW) -> based_ptr -> atom.value = nil; 431 go to exit1; /* printer will start typing out on next char */ 432 433 proc(11): /* CTRL/w turns off output to the tty */ 434 435 addr(ctrlW) -> based_ptr -> atom.value = t_atom; 436 if esw ^= 0 then go to exit1; /* suppress resetwrite unless entered by quit */ 437 call iox_$control(iox_$user_io, "start", null(), io_status); 438 call iox_$control(iox_$user_io, "resetwrite", null(), io_status); 439 tty_output_chan -> iochan.ioindex = 0; /* if he quit in the middle of printing a long 440* list, make sure it stops right away */ 441 go to exit1; 442 443 444 proc(1): /* CTRL/a updates the value of the atomic symbol ^a */ 445 /* and causes an interrupt to channel 2 */ 446 447 dcl lisp_static_vars_$ctrlA fixed bin(71) aligned external, 448 ctrlA fixed bin(71) aligned defined (lisp_static_vars_$ctrlA); 449 450 451 452 453 if addr( addr(ctrlA)->based_ptr->atom.value) -> lisp_ptr_type & Fixed36 454 then addr(ctrlA)->based_ptr->fixedb = 455 addr(ctrlA) -> based_ptr->fixedb + 1; /* if its a number, add 1 to it */ 456 else do; 457 addr(ctrlA) -> based_ptr -> fixnum_fmt.type_info = fixnum_type; 458 addr(ctrlA) -> based_ptr -> fixedb = 0; /* otherwise, set it to 0 */ 459 end; 460 intrp = addr(user_intr_array(2)) -> based_ptr; 461 go to ctrl_b_break; 462 463 464 proc(16): /* CTRL/@ causes user interrupt 0 */ 465 466 intrp = addrel(addr(user_intr_array(1)),-2) -> based_ptr; /* user_intr_array(0) */ 467 go to ctrl_b_break; 468 469 470 proc(17): /* CTRL/\\ causes user interrupt 14. */ 471 472 intrp = addr(user_intr_array(14)) -> based_ptr; 473 go to ctrl_b_break; 474 475 proc(18): /* CTRL/] causes user interrupt 15. */ 476 477 intrp = addr(user_intr_array(15)) -> based_ptr; 478 go to ctrl_b_break; 479 480 proc(19): /* CTRL/^ causes user interrupt 16. */ 481 482 intrp = addr(user_intr_array(16)) -> based_ptr; 483 go to ctrl_b_break; 484 485 proc(21): /* CTRL/? finds out what the hell is going on. */ 486 /* If we get here, at least it wasn't garbage collection */ 487 488 if esw = 0 then if fault_save.sv_rdr_state = 1 then go to proc_21_aa; 489 else go to proc_21_bb; 490 else if rdr_state = 1 then do; 491 proc_21_aa: intrp = addr(ms_tti); 492 nelemt = length(ms_tti); 493 end; 494 else do; 495 proc_21_bb: intrp = addr(ms_run); 496 nelemt = length(ms_run); 497 end; 498 whats_going_on: 499 call iox_$put_chars(iox_$error_output, addr(intrp->v.string), nelemt, io_status); 500 go to exit1; 501 502 /* the lisp ioc fsubr */ 503 504 ioc: entry; 505 506 iogsw = "0"b; 507 stack = addrel(stack_ptr, -2); 508 stack -> temp(1) = stack -> temp_ptr(1) -> cons.car; /* get argument */ 509 iogjoin: 510 esw = 1; 511 if stack -> temp(1) = nil then /* special case nil */ 512 go to ioc_exit; 513 else if stack -> temp_type36(1) & Fixed36 then do; /* numeric arg, signal user interrupt */ 514 iocidx = -1; 515 i = stack -> fixedb; 516 go to ioc_num; 517 end; 518 else if stack -> temp_type36(1) & Atsym36 then; 519 else go to ioc_exit; /* invalid arg, just ignore since is fsubr */ 520 521 /* split up pname of atom into characters, apply them as if typed in as ctrl characters */ 522 523 iocidx = 1; 524 exitv(1): 525 ioc_retn: if iocidx < 0 then go to ioc_exit; /* return from ioc_num */ 526 if iocidx > stack -> temp_ptr(1) -> atom.pnamel then 527 go to ioc_exit; /* done the whole pname */ 528 chr = substr(stack -> temp_ptr(1) -> atom.pname, iocidx, 1); 529 iocidx = iocidx + 1; 530 go to dispatch; 531 532 ioc_exit: if iogsw then go to iog_aa; 533 stack_ptr = addr(stack -> temp(2)); 534 stack -> temp(1) = t_atom; 535 return; 536 537 538 /* we just went into (nointerrupt nil) mode and there were 539* deferred ctrl characters. We can now process them */ 540 541 do_ctrl: 542 esw = 2; 543 exitv(2): 544 if firstctrl = lastctrl then go to do_ctrl_ret; 545 substr(inbuf, 1, 4) = ctrls(firstctrl); /* If we get interrupted here, the worst that 546* can happen is a ctrl char will get done 547* twice, which is not so bad. */ 548 if firstctrl < hbound(ctrls, 1) then firstctrl = firstctrl + 1; 549 else firstctrl = lbound(ctrls, 1); 550 nelemt = index(substr(inbuf, 1, 4), NL); 551 if nelemt = 0 then nelemt = 4; 552 go to ctrl_aa; /* process this ctrl char & return to exitv(2) for next */ 553 554 handle_zerodivide: 555 stack_ptr = addr(stack -> temp(4)); 556 stack -> temp(3) = nil; 557 stack -> temp(1) = lisp_static_vars_$quotient; 558 addr(stack -> temp(2)) -> fixnum_fmt.type_info = fixnum_type; 559 addr(stack -> temp(2)) -> fixedb = 0; 560 call lisp_special_fns_$cons; 561 call lisp_special_fns_$cons; 562 unmkd_ptr = addrel(unmtop, 2); 563 fault_save.code1, unmtop -> ercode = zerodivide_fault; 564 call lisp_error_; 565 action = 0; /* return means hack like divov t mode */ 566 go to exit_nzq; 567 568 569 handle_underflow: 570 stack_ptr = addr(stack -> temp(2)); 571 stack -> temp(1) = lisp_static_vars_$zunderflow; 572 call lisp_special_fns_$ncons; 573 unmkd_ptr = addrel(unmtop, 2); 574 fault_save.code1, unmtop -> ercode = underflow_fault; 575 call lisp_error_; 576 action = 0; /* return means hack like zunderflow t mode */ 577 go to exit_nzq; 578 579 handle_pi: 580 581 if lisp_static_vars_$mulpi_state = -1 then go to Quit; /* Normal ITS-like lisp */ 582 if masked.against.tty 583 then do; 584 if lisp_static_vars_$mulpi_state = -2 585 then inbuf = "g" || NL; 586 else inbuf = cv_interruptno (lisp_static_vars_$mulpi_state) || NL; 587 go to masked_ctrl_save; 588 end; 589 if lisp_static_vars_$mulpi_state = -2 then go to unwind_to_top_level; /* Signal ^g */ 590 591 /* Must be interrupt number */ 592 593 i = lisp_static_vars_$mulpi_state; 594 go to ioc_num; 595 596 597 598 /* some code for handling stack overflows */ 599 600 stack_loss: entry(which_stack); /* non-fatal stack overflow, give fail-act */ 601 602 dcl which_stack fixed bin parameter; 603 604 call save_state; /* push a fault frame */ 605 606 on condition(cleanup) call lisp_segment_manager_$shrink_stacks; /* if guy (ioc g)'s out, 607* set stacks back to norm 608* size so can detect again */ 609 unmtop = unmkd_ptr; 610 unmkd_ptr = addrel(unmtop, 2); 611 fault_save.code1, unmtop -> ercode = stack_loss_error; 612 613 /* push name of pdl that overflew onto stack */ 614 615 tstack = stack_ptr; 616 stack_ptr = addr(tstack -> temp(2)); 617 tstack -> temp(1) = lisp_static_vars_$space_names_atom -> atom.value; 618 do while(which_stack > 1); 619 tstack -> temp(1) = tstack -> temp_ptr(1) -> cons.cdr; 620 which_stack = which_stack - 1; 621 end; 622 tstack -> temp(1) = tstack -> temp_ptr(1) -> cons.car; 623 624 call lisp_error_; 625 626 stack_ptr = tstack; 627 go to exit_nzq; 628 629 630 631 wipe_stack: entry; /* fatal stack overflow, cleanup as best we can and ctrl/g */ 632 /* note that this routine is only called when the stack is 633* so full that it cannot be expanded (i.e. several pdl-overflow's have occurred */ 634 635 dcl damage bit(1) aligned; 636 637 call undamage_the_stacks; 638 639 undamage_the_stacks: proc; 640 641 642 dcl stattic_ptr (0:6) ptr aligned based(addr(unmkd_ptr)), 643 our_stack ptr, 644 stattic_bound bit(18) static init("001111111111110011"b), /* 12 down from 64K */ 645 /**** Note this kludgey stuff must be coordinated with lisp_segment_manager_ ****/ 646 stack_ptr_max bit(18) static init("001111111111111110"b), /* 2 down from 64K */ 647 stack_ptr_kludge bit(18) static init("001111111111111110"b); 648 dcl ioa_$ioa_stream entry options (variable), 649 hcs_$truncate_seg entry(pointer, fixed bin(18), fixed bin(35)), 650 lisp_static_vars_$top_level external label; 651 652 damage = "0"b; /* assume that we are winning */ 653 do i = 0 to 6; /* check for fatal damage */ 654 if rel(stattic_ptr(i)) > stattic_bound then damage = "1"b; /* this would be fatal damage */ 655 end; 656 if damage then do; 657 call ioa_$ioa_switch(iox_$error_output, 658 "lisp: Fatal stack damage. Major restart undertaken. Bindings will not be restored."); 659 if string(masked.against) 660 then call ioa_$ioa_switch(iox_$error_output, 661 "Warning: Either a garbage collection was in progress or (nointerrupt t) mode was in effect."); 662 our_stack = ptr(unmkd_ptr, 0); /* base of unmkd pdl */ 663 prog_frame, err_frame, catch_frame, binding_top, /* "major restart" */ 664 err_recp, eval_frame = our_stack; 665 unmkd_ptr = addr(our_stack -> stack_seg.begin_unmkd_stack); 666 stack_ptr = ptr(stack_ptr, 2); 667 call hcs_$truncate_seg(unmkd_ptr, fixed(rel(unmkd_ptr), 18), 0); 668 call hcs_$truncate_seg(stack_ptr, fixed(rel(stack_ptr), 18), 0); 669 lisp_static_vars_$garbage_collect_inhibit = "0"b; 670 lisp_static_vars_$rdr_state = 0; 671 go to lisp_static_vars_$top_level; /* "major restart" */ 672 end; 673 674 /* now check for non fatal damage - stack_ptr or unmkd_ptr slightly out of bounds */ 675 676 if rel(stack_ptr) >= stack_ptr_max then do; 677 stack_ptr = ptr(stack_ptr, stack_ptr_kludge); 678 damage = "1"b; 679 end; 680 if rel(unmkd_ptr) >= stack_ptr_max then do; 681 unmkd_ptr = ptr(unmkd_ptr, stack_ptr_kludge); 682 damage = "1"b; 683 end; 684 if damage then call ioa_$ioa_switch(iox_$error_output, 685 "Warning: There was minor damage to the lisp stacks."); 686 687 end undamage_the_stacks; 688 689 /* attempt to ctrl/g. If we were in garbage collector, will lose big, 690* but have already warned loser in that case so I guess it's all right */ 691 692 err_frame = ptr(unmkd_ptr, ""b); 693 go to quitter; 694 695 696 697 check_for_damage: entry(a_damage); /* called by lisp pi handler */ 698 699 dcl a_damage bit(1) aligned parameter; 700 701 call undamage_the_stacks; 702 a_damage = damage; 703 return; 704 705 /* The lisp iog fsubr: 706* binds ^q, ^r, ^w 707* then do first arg like ioc 708* then eval remaining args 709* then unbind & return value of last arg */ 710 711 iog: entry; 712 713 iogsw = "1"b; 714 stack = addrel(stack_ptr, -2); /* -> arg list for fsubr */ 715 stack_ptr = addr(stack -> temp(9)); /* room for binding block */ 716 stack -> temp(8) = stack -> temp_ptr(1) -> cons.car; /* get 1st arg */ 717 718 /* Make binding block for ^q, ^r, ^w */ 719 720 stack -> temp(3) = ctrlQ; 721 stack -> temp(2) = stack -> temp_ptr(3) -> atom.value; 722 stack -> temp(5) = ctrlR; 723 stack -> temp(4) = stack -> temp_ptr(5) -> atom.value; 724 stack -> temp(7) = ctrlW; 725 stack -> temp(6) = stack -> temp_ptr(7) -> atom.value; 726 iog_unm = unmkd_ptr; 727 unmkd_ptr = addrel(iog_unm, 2); 728 iog_unm -> binding_block.bot_block = rel(addr(stack -> temp(2))); 729 iog_unm -> binding_block.top_block = rel(addr(stack -> temp(8))); 730 iog_unm -> binding_block.back_ptr = rel(binding_top); 731 iog_unm -> binding_block.rev_ptr = ""b; 732 binding_top = iog_unm; 733 734 /* Now rebind them to nil */ 735 736 stack -> temp_ptr(3) -> atom.value, 737 stack -> temp_ptr(5) -> atom.value, 738 stack -> temp_ptr(7) -> atom.value = nil; 739 740 /* save reader status. If in a macro char function in readlist 741* he says (iog s ...) we want to leave the readlist and get out to the tty */ 742 743 if rdr_state = 2 then do; 744 rdr_save_f = "1"b; /* so we can undo this later */ 745 call save_state_only; 746 rdr_state = 0; 747 end; 748 else rdr_save_f = "0"b; 749 750 stack = addr(stack -> temp(8)); 751 go to iogjoin; 752 753 /* comes back here after doing ioc to our first arg */ 754 755 iog_aa: stack = addrel(stack, -14); /* unbump ptr */ 756 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 757 /* is list of forms to eval */ 758 do while (stack -> temp_type(1) = Cons); 759 stack -> temp(8) = stack -> temp_ptr(1) -> cons.car; 760 call lisp_$eval; 761 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 762 end; 763 stack -> temp(1) = stack -> temp(8); /* value is value of last form evaled */ 764 765 if rdr_save_f then do; /* restore the state of the reader */ 766 rdr_label = fault_save.sv_rdr_label; 767 rdr_ptr = fault_save.sv_rdr_ptr; 768 rdr_state = fault_save.sv_rdr_state; 769 err_recp = ptr(unm, fault_save.prev_frame); 770 end; 771 772 /* restore the bindings of ^q, ^r, ^w */ 773 774 stack -> temp_ptr(7) -> atom.value = stack -> temp(6); 775 stack -> temp_ptr(5) -> atom.value = stack -> temp(4); 776 stack -> temp_ptr(3) -> atom.value = stack -> temp(2); 777 778 /* get rid of the binding block */ 779 780 binding_top = ptr(iog_unm, binding_top -> binding_block.back_ptr); 781 unmkd_ptr = iog_unm; 782 stack_ptr = addr(stack -> temp(2)); 783 return; 784 785 /* car or cdr of a number --- at present this is an uncorrectable error */ 786 787 car_cdr_of_num: 788 unmkd_ptr = addrel(unmtop, 2); 789 fault_save.code1, 790 unmtop -> ercode = car_cdr_error; 791 call lisp_error_; /* never returns */ 792 793 794 /* alarmclock interrupt, apply the alarmclock user 795* inyerrupt service function to 'time or 'runtime */ 796 797 alarm: if masked.against.alarm then go to masked_alarm; 798 799 call alarm_proc; 800 action = 0; 801 go to exit_nzq; 802 803 804 do_alarm: 805 call alarm_proc; /* deferred alarm comes here when unmasked */ 806 go to do_ctrl_ret; 807 808 alarm_proc: proc; 809 810 stack_ptr = addr(stack->temp(4)); 811 string(new_mask.against) = copy("1"b,length(string(new_mask.against))); 812 call lisp_fault_handler_$set_mask(new_mask); /* alarmclock interrupt handler is supposed to be run masked. 813* this version of the code has a slight window. If it causes any problems 814* it can be fixed by kludging around with inhibited alarm calls and ips masks */ 815 stack -> temp(1) = addr(user_intr_array(3)) -> based_ptr -> atom.value; 816 if stack -> temp(1) ^= nil then do; 817 if fault_code = Alarmclock_fault then stack -> temp(2) = time; 818 else /* if fault_code = Cput_fault then */ stack -> temp(2) = runtime; 819 stack -> temp(3) = nil; /* make the arg list (nil) */ 820 call lisp_special_fns_$cons; 821 call lisp_$apply; 822 end; 823 end alarm_proc; 824 825 /* routine to exit, action must be set before coming here */ 826 827 exit: qitf = "0"b; 828 call unsave_state; 829 if action ^= 0 then return; /* if special action being taken, 830* must go through lisp_default_handler_ */ 831 if rdr_state = 1 then do; /* returning into an i/o wait, so 832* wake up the reader and make it 833* look at the ^q flag */ 834 go to rdr_label; 835 end; 836 return; 837 838 exit_nzq: 839 call unsave_state; 840 return; 841 842 unsave_state: proc; /* unsave at any speed */ 843 call iox_$control (iox_$user_io, "start", null(), io_status); 844 845 /* restore the key variables that we saved */ 846 847 gc_inhibit = fault_save.sv_gc_inhibit; 848 stack_ptr = addr(stack -> temp(2)); 849 call lisp_fault_handler_$set_mask((fault_save.sv_masked)); 850 unspec(ptr(unm, ""b) -> stack_seg.array_info_for_store) = unspec(fault_save.sv_array_info); 851 ptr(unm, ""b) -> stack_seg.array_offset_for_store = fault_save.sv_array_offset; 852 rdr_label = fault_save.sv_rdr_label; 853 rdr_ptr = fault_save.sv_rdr_ptr; 854 rdr_state = fault_save.sv_rdr_state; 855 err_recp = ptr(unm, fault_save.prev_frame); 856 stack_ptr = stack; /* now clr pdl's */ 857 unmkd_ptr = unm; 858 end unsave_state; 859 860 array_lossage: /* store was misused in such a way that the array moved between 861* the time the subscripts were processed and the time the store 862* was actually done */ 863 864 unmkd_ptr = addrel(unmtop, 2); /* signal uncorrectable error */ 865 fault_save.code1, unmtop -> ercode = store_function_misused; 866 call lisp_error_; 867 868 emulate_old_style_store: /* an old-arrays compiled program tried to store 869* using in-line code */ 870 871 dcl haventbarfedatthisyet bit(1) static init("1"b), 872 patchingmode bit(1) static init("0"b), 873 based_inst bit(36) aligned based, 874 call_store_operator bit(36) static init("001000000001001110010111010001010000"b); 875 876 if haventbarfedatthisyet then do; 877 call ioa_$ioa_switch(iox_$error_output, "lisp: A program is being run which contains old compiled ""store""s. Execution will proceed, but slowly."); 878 call ioa_$ioa_switch_nnl(iox_$user_io, "Do you want to go into patching mode? "); 879 call iox_$get_line(iox_$user_io, addr(inbuf), length(inbuf), nelemt, io_status); 880 if substr(inbuf, 1, nelemt-1) = "yes" then patchingmode = "1"b; 881 haventbarfedatthisyet = "0"b; 882 end; 883 884 if patchingmode then do; /* patch it to call new array store op */ 885 call ioa_$ioa_switch(iox_$error_output, "lisp_fault_handler_: Patching ^p to call new store operator.", pbr); 886 pbr -> based_inst = call_store_operator; 887 end; 888 889 argsp = addrel(ptr(unm, ""b) -> stack_seg.array_info_for_store, -2) -> array_info.array_data_ptr; 890 argsp = addrel(argsp, ptr(unm, ""b) -> stack_seg.array_offset_for_store); /* assume not a number array */ 891 action = 3; /* force instruction to be retried with new address */ 892 pbr = argsp; /* kludgily pass the address back */ 893 call unsave_state; 894 return; 895 896 /***** the alarmclock subr, for setting and resetting timers *****/ 897 898 alarmclock: entry; 899 900 /* 901* * function to implement the lisp alarmclock function, using timer_manager_ 902* * coded by D. A. Moon, 18 Aug 72 903* * 904* * changed to make alarmclock a cpu timer rather than an alarm timer, 905* * for compatiblity with pdp-10 lisp, 9 Sep 72 by DAM 906* * 907* * Major Rewrite 1 Feb 1973 by DAM for new alrm system 908* * 909* * modified 17 Jan 74 by DAM to stop hacking ips masks 910* */ 911 912 dcl lisp_default_handler_$alarm entry(ptr, char(*)), /* handler for both types of timer intr */ 913 lisp_static_vars_$time_atom fixed bin(71) external, 914 time fixed bin(71) def (lisp_static_vars_$time_atom), 915 lisp_static_vars_$runtime_atom fixed bin(71) external, 916 runtime fixed bin(71) def (lisp_static_vars_$runtime_atom), 917 1 old_mask aligned like masked, 918 1 new_mask aligned like masked, 919 timer_manager_$cpu_call ext entry(fixed bin(71), bit(2), entry), 920 timer_manager_$alarm_call ext entry(fixed bin(71), bit(2), entry), 921 timer_manager_$reset_cpu_call ext entry(entry), 922 timer_manager_$reset_alarm_call ext entry(entry), 923 stack2 ptr, 924 alarm_time fixed bin(71); 925 926 927 928 alarmclock0: 929 stack = addrel(stack_ptr, -4); /* subr of 2 args */ 930 931 stack2 = addr(stack -> temp(2)); 932 if stack -> temp(1) = time then go to alrm; 933 else if stack -> temp(1) = runtime then go to cput; 934 else do; /*** ERROR ***/ 935 unm = unmkd_ptr; 936 unmkd_ptr = addrel(unm, 2); 937 unm -> errcode(1) = bad_arg_correctable; 938 unm -> errcode(2) = fn_alarmclock; 939 stack_ptr = addr(stack -> temp(4)); 940 stack -> temp(3) = stack -> temp(1); 941 call lisp_error_; 942 stack -> temp(1) = stack -> temp(3); 943 go to alarmclock0; 944 end; 945 946 947 /*** real time interrupt, second arg is time in seconds */ 948 949 alrm: call timer_manager_$reset_alarm_call(lisp_default_handler_$alarm); /* get rid of any pending interrupt */ 950 951 if stack2 -> lisp_ptr_type & Fixed36 then alarm_time = stack2 -> fixedb*1000000; 952 else if stack2 -> lisp_ptr_type & Float36 then alarm_time = stack2 -> floatb*1000000e0; 953 else go to ret_nil; /** any other arg just shuts off timer and returns nil **/ 954 955 if alarm_time < 0 then go to ret_nil; /** negative arg does too due to ITS kludgery **/ 956 957 call timer_manager_$alarm_call(alarm_time, "10"b, /* relative microseconds */ 958 lisp_default_handler_$alarm); 959 960 ret_t: stack -> temp(1) = t_atom; 961 ret: stack_ptr = addr(stack -> temp(2)); 962 return; 963 964 965 /*** cpu time interrupt, second arg is time in microseconds ***/ 966 967 cput: call timer_manager_$reset_cpu_call(lisp_default_handler_$alarm); 968 969 if stack2 -> lisp_ptr_type & Fixed36 then alarm_time = stack2 -> fixedb; 970 else if stack2 -> lisp_ptr_type & Float36 then alarm_time = stack2 -> floatb; 971 else go to ret_nil; 972 973 if alarm_time < 0 then go to ret_nil; 974 975 call timer_manager_$cpu_call(alarm_time, "10"b, /* relative usec */ 976 lisp_default_handler_$alarm); 977 978 go to ret_t; 979 980 ret_nil: stack -> temp(1) = nil; 981 go to ret; 982 983 984 985 /*** The nointerrupt subr, which turns on or off cput and alrm timer 986* interrupts and ctrl chars other than ., z, and $ ***/ 987 988 nointerrupt: entry; 989 990 stack = addrel(stack_ptr, -2); /* subr of one arg */ 991 nointerrupt00: 992 if stack -> temp(1) = nil then string(new_mask.against) = ""b; 993 else if stack -> temp(1) = t_atom then string(new_mask.against) = copy("1"b,length(string(new_mask.against))); 994 else if stack -> temp(1) = tty_atom then do; 995 new_mask.against.alarm = "0"b; 996 new_mask.against.tty = "1"b; 997 end; 998 else do; /* error */ 999 unm = unmkd_ptr; 1000 unmkd_ptr = addrel(unm, 2); 1001 unm -> errcode(1) = bad_arg_correctable; 1002 unm -> errcode(2) = fn_nointerrupt; 1003 call lisp_error_; 1004 go to nointerrupt00; 1005 end; 1006 1007 /* encode old state of mask */ 1008 1009 if masked.against.alarm then stack -> temp(1) = t_atom; 1010 else if masked.against.tty then stack -> temp(1) = tty_atom; 1011 else stack -> temp(1) = nil; 1012 go to nointr_join; 1013 1014 interrupt_poll: 1015 entry (); 1016 1017 new_mask = masked; 1018 go to nointr_join; 1019 1020 set_mask: entry(a_new_mask); 1021 1022 dcl 1 a_new_mask aligned like masked; 1023 1024 new_mask = a_new_mask; 1025 nointr_join: 1026 stack = stack_ptr; 1027 1028 old_mask = masked; /* going to return previous value of the mask */ 1029 /**** we assume anyone who interrupts us will 1030* restore this mask to its previous state before rtn ***/ 1031 if new_mask.against.tty = "0"b then do; /* UNMASK CTRL CHARS */ 1032 1033 do_ctrl_ret: pending_ctrl = "1"b; /* so if we process a ctrl/g it doesn't screw us up */ 1034 if deferred_alrm_timer then do; 1035 fault_code = Alarmclock_fault; 1036 deferred_alrm_timer = "0"b; 1037 go to do_alarm; 1038 end; 1039 if deferred_cput_timer then do; 1040 fault_code = Cput_fault; 1041 deferred_cput_timer = "0"b; 1042 go to do_alarm; 1043 end; 1044 if lastctrl ^= firstctrl then go to do_ctrl; /* if there are chars in the circular buffer, 1045* go process them */ 1046 deferred_interrupt, /* no deferred interrupts left */ 1047 pending_ctrl = "0"b; /* ok, we processed all the stacked-up ctrl chars */ 1048 end; 1049 1050 masked = new_mask; /* SET THE MASK */ 1051 1052 stack_ptr = stack; /* either flush stack or leave argument */ 1053 return; 1054 1055 /***** SPECIAL TIMER HANDLER USED WHEN MASKED *****/ 1056 1057 masked_alarm: 1058 deferred_interrupt = "1"b; 1059 if fault_code = Alarmclock_fault then deferred_alrm_timer = "1"b; 1060 else if fault_code = Cput_fault then deferred_cput_timer = "1"b; 1061 action = 0; 1062 go to exit_nzq; 1063 1064 1065 /***** SPECIAL QUIT HANDLER USED WHEN MASKED *****/ 1066 1067 masked_quit: 1068 if lisp_static_vars_$mulquit_state = -1 1069 then; 1070 else if lisp_static_vars_$mulquit_state = -2 1071 then go to do_ctrl_z; 1072 else do; 1073 inbuf = cv_interruptno (lisp_static_vars_$mulquit_state); 1074 go to masked_ctrl_save; 1075 end; 1076 1077 if lisp_static_vars_$cleanup_list_exists /* cleanup feature */ 1078 then if lisp_static_vars_$i_am_gcing /* has to do strange things if gc in progress and unwind */ 1079 then on condition(cleanup) begin; 1080 dcl sp pointer; 1081 sp = cu_$stack_frame_ptr(); /* find target of unwindage */ 1082 g0001: 1083 sp = sp -> stack_frame.prev_sp; 1084 if sp -> stack_frame.arg_ptr -> argument_list.argument_count ^= 2 then go to g0001; /* 1 arg */ 1085 lisp_static_vars_$gc_unwinder_kludge = 1086 sp -> stack_frame.arg_ptr -> argument_list.argument_pointer(1) -> based_label_var; 1087 lisp_static_vars_$activate_gc_unwinder_kludge = "1"b; 1088 action = 0; /* restart fault */ 1089 go to exit; /* so finish gc and cleanup */ 1090 end; 1091 1092 substr(inbuf, 1, 4) = " "; 1093 masked_ctrl_ask: 1094 call ioa_$ioa_switch_nnl(iox_$user_io, "CTRL/"); /* really should tell user is (nointerrupt t) mode right now */ 1095 lisp_static_vars_$read_print_nl_sync = "1"b; /* user will hit newline after the ctrl char */ 1096 call iox_$get_line(iox_$user_io, addr(inbuf), length(inbuf), nelemt , io_status); 1097 if nelemt < 2 then go to masked_ctrl_ask; 1098 1099 /* check for control characters done immediately */ 1100 1101 if substr(inbuf, 1, 1) = "Z" | substr(inbuf, 1, 1) = "z" then do; 1102 go to do_ctrl_z; 1103 end; 1104 else if substr(inbuf, 1, 1) = "$" then go to proc(14); 1105 else if substr(inbuf, 1, 1) = "." then go to proc(15); 1106 else if substr(inbuf, 1, 1) = "?" then /* user wants to know what's going on */ 1107 if lisp_static_vars_$i_am_gcing then do; 1108 intrp = addr(ms_gc); 1109 nelemt = length(ms_gc); 1110 go to whats_going_on; 1111 end; 1112 else do; 1113 intrp = addr(ms_masked); 1114 nelemt = length(ms_masked); 1115 go to whats_going_on; 1116 end; 1117 1118 /* Can't be done immediately, save it up for when (nointerrupt nil) is done */ 1119 1120 masked_ctrl_save: 1121 deferred_interrupt = "1"b; 1122 ctrls(lastctrl) = substr(inbuf, 1, 4); /* fortunately we can't get interrupted here since qitf is on */ 1123 if lastctrl < hbound(ctrls, 1) then lastctrl = lastctrl + 1; 1124 else lastctrl = lbound(ctrls, 1); 1125 if lastctrl = firstctrl then call ioa_$ioa_switch(iox_$user_io, 1126 "lisp: Control character buffer overflow. While in (nointerrupt t) mode. Oldest chars lost."); 1127 action = 0; 1128 go to exit; 1129 1130 cv_interruptno: 1131 procedure (intno) returns (char (2)); 1132 1133 dcl intno fixed binary; 1134 dcl intno_pic picture "99"; 1135 1136 return (convert (intno_pic, intno)); 1137 end; 1138 1139 1140 init: entry; /* Called when the lisp command is entered */ 1141 1142 pending_ctrl = "0"b; 1143 lisp_static_vars_$i_am_gcing = "0"b; 1144 firstctrl, lastctrl = 1; /* clear this stupid buffer, in case he quat 1145* out of a previous lisp at an awkward time */ 1146 deferred_alrm_timer, deferred_cput_timer = "0"b; 1147 ctrls = ". 1148 "; /* fill this up with nops */ 1149 string(masked.against) = ""b; /* unmask */ 1150 1151 1152 return; 1153 1154 /* routine to process control characters noticed in the 1155* input stream by the reader. These are characters 1156* prefixed by \036 */ 1157 1158 ctrl_from_reader: entry(ctrl_from_rdr); 1159 1160 dcl ctrl_from_rdr char(1) aligned parameter; 1161 1162 chr = ctrl_from_rdr; /* copy arg into same place as other entries */ 1163 esw = -1; 1164 stack = stack_ptr; 1165 go to dispatch; /* hence numbers don't work in this mode */ 1166 1167 exitv(-1): 1168 stack_ptr = stack; 1169 return; 1170 1171 ctrl_g_function: entry; /* ^g subr */ 1172 1173 go to ctrl_g_handler; 1174 1175 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1116.2 lisp_fault_handler_.pl1 >udd>sm>ds>w>ml>lisp_fault_handler_.pl1 151 1 11/07/86 1650.3 stack_frame.incl.pl1 >ldd>incl>stack_frame.incl.pl1 152 2 03/27/82 0537.0 lisp_faults.incl.pl1 >ldd>incl>lisp_faults.incl.pl1 153 3 07/06/83 1211.5 lisp_stack_seg.incl.pl1 >ldd>incl>lisp_stack_seg.incl.pl1 154 4 03/27/82 0537.1 lisp_array_fmt.incl.pl1 >ldd>incl>lisp_array_fmt.incl.pl1 155 5 03/27/82 0537.0 lisp_io.incl.pl1 >ldd>incl>lisp_io.incl.pl1 5-5 6 03/27/82 0537.0 lisp_iochan.incl.pl1 >ldd>incl>lisp_iochan.incl.pl1 5-45 7 03/27/82 0537.0 lisp_control_chars.incl.pl1 >ldd>incl>lisp_control_chars.incl.pl1 156 8 03/27/82 0537.0 lisp_nums.incl.pl1 >ldd>incl>lisp_nums.incl.pl1 157 9 07/06/83 1211.5 lisp_name_codes.incl.pl1 >ldd>incl>lisp_name_codes.incl.pl1 158 10 03/27/82 0537.0 lisp_stack_fmt.incl.pl1 >ldd>incl>lisp_stack_fmt.incl.pl1 159 11 03/27/82 0537.0 lisp_common_vars.incl.pl1 >ldd>incl>lisp_common_vars.incl.pl1 160 12 03/27/82 0537.0 lisp_ptr_fmt.incl.pl1 >ldd>incl>lisp_ptr_fmt.incl.pl1 161 13 03/27/82 0537.1 lisp_atom_fmt.incl.pl1 >ldd>incl>lisp_atom_fmt.incl.pl1 162 14 03/27/82 0536.9 lisp_string_fmt.incl.pl1 >ldd>incl>lisp_string_fmt.incl.pl1 163 15 03/27/82 0537.0 lisp_cons_fmt.incl.pl1 >ldd>incl>lisp_cons_fmt.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. Alarmclock_fault constant fixed bin(17,0) initial dcl 2-10 ref 205 817 1035 1059 Array_fault constant fixed bin(17,0) initial dcl 2-10 ref 209 Atsym36 constant bit(36) initial dcl 12-17 ref 518 Car_cdr_fault constant fixed bin(17,0) initial dcl 2-10 ref 207 Cons constant bit(9) initial packed unaligned dcl 12-17 ref 758 Cput_fault constant fixed bin(17,0) initial dcl 2-10 ref 206 1040 1060 Fixed36 constant bit(36) initial dcl 12-17 ref 453 513 951 969 Float36 constant bit(36) initial dcl 12-17 ref 952 970 NL constant char(1) initial packed unaligned dcl 105 ref 550 584 586 Old_store_fault constant fixed bin(17,0) initial dcl 2-10 ref 210 Pi_fault constant fixed bin(17,0) initial dcl 2-10 ref 213 242 Quit_fault constant fixed bin(17,0) initial dcl 2-10 ref 208 Underflow_fault constant fixed bin(17,0) initial dcl 2-10 ref 212 Zerodivide_fault constant fixed bin(17,0) initial dcl 2-10 ref 211 a_damage parameter bit(1) dcl 699 set ref 697 702* a_fault_code parameter fixed bin(17,0) dcl 16 ref 6 165 a_new_mask parameter structure level 1 dcl 1022 ref 1020 1024 action parameter fixed bin(17,0) dcl 16 set ref 6 226* 230* 330* 367* 565* 576* 800* 829 891* 1061* 1088* 1127* addr builtin function dcl 117 ref 191 235 255 255 286 315 320 379 388 402 410 417 423 428 433 453 453 453 453 457 458 460 464 470 475 480 491 495 498 498 533 554 558 559 569 582 616 654 659 665 715 728 729 750 782 797 810 815 848 879 879 931 939 961 1009 1010 1017 1028 1050 1096 1096 1108 1113 1149 addrel builtin function dcl 117 ref 187 464 507 562 573 610 714 727 755 787 860 889 890 928 936 990 1000 against based structure level 2 in structure "masked" packed packed unaligned dcl 2-45 in procedure "lisp_fault_handler_" set ref 659 1149* against 000216 automatic structure level 2 in structure "new_mask" packed packed unaligned dcl 912 in procedure "lisp_fault_handler_" set ref 811* 811 991* 993* 993 alarm 0(01) 000216 automatic bit(1) level 3 in structure "new_mask" packed packed unaligned dcl 912 in procedure "lisp_fault_handler_" set ref 995* alarm 0(01) based bit(1) level 3 in structure "masked" packed packed unaligned dcl 2-45 in procedure "lisp_fault_handler_" set ref 797 1009 alarm_time 000222 automatic fixed bin(71,0) dcl 912 set ref 951* 952* 955 957* 969* 970* 973 975* arg_ptr 32 based pointer level 2 dcl 1-36 ref 1084 1085 argsp 000160 automatic pointer dcl 16 set ref 889* 890* 890 892 argument_count based fixed bin(17,0) level 2 packed packed unaligned dcl 138 ref 1084 argument_list based structure level 1 dcl 138 argument_pointer 2 based pointer array level 2 dcl 138 ref 1085 array_data_ptr 2 based pointer level 2 dcl 4-8 ref 889 array_info based structure level 1 dcl 4-8 array_info_for_store 122 based pointer level 2 dcl 3-5 set ref 193 850* 889 array_offset_for_store 124 based fixed bin(18,0) level 2 dcl 3-5 set ref 194 851* 890 atom based structure level 1 dcl 13-5 back_ptr 1 based bit(18) level 2 packed packed unaligned dcl 10-7 set ref 730* 780 bad_arg_correctable defined fixed bin(17,0) dcl 123 ref 937 1001 based_inst based bit(36) dcl 868 set ref 886* based_label_var based label variable dcl 138 ref 1085 based_ptr based pointer dcl 12-16 ref 315 320 379 402 410 417 423 428 433 453 453 453 457 458 460 464 470 475 480 815 begin_unmkd_stack 174 based fixed bin(71,0) array level 2 dcl 3-5 set ref 665 binary builtin function dcl 117 ref 282 binding_block based structure level 1 dcl 10-7 binding_top defined pointer dcl 11-6 set ref 663* 730 732* 780* 780 bot_block 0(18) based bit(18) level 2 packed packed unaligned dcl 10-7 set ref 728* call_store_operator 000032 constant bit(36) initial packed unaligned dcl 868 ref 886 car based fixed bin(71,0) level 2 dcl 15-5 ref 508 622 716 759 car_cdr_error defined fixed bin(17,0) dcl 123 ref 789 catch_frame defined pointer dcl 11-6 set ref 663* cdr 2 based fixed bin(71,0) level 2 dcl 15-5 ref 619 756 761 chr 000101 automatic char(1) packed unaligned dcl 16 set ref 256* 259 259 269 272 273* 273 274 307* 528* 1162* cleanup 000200 stack reference condition dcl 138 ref 361 606 1077 code1 2 based fixed bin(17,0) level 2 dcl 2-25 set ref 192* 563* 574* 611* 789* 865* cons based structure level 1 dcl 15-5 conversion 000172 stack reference condition dcl 119 ref 281 283 ctlchars 000103 constant varying char(50) initial dcl 16 ref 274 ctrlA defined fixed bin(71,0) dcl 444 set ref 453 453 453 457 458 ctrlD defined fixed bin(71,0) dcl 7-5 set ref 315 320 ctrlQ defined fixed bin(71,0) dcl 7-8 set ref 402 410 720 ctrlR defined fixed bin(71,0) dcl 7-11 set ref 417 423 722 ctrlW defined fixed bin(71,0) dcl 7-14 set ref 428 433 724 ctrl_from_rdr parameter char(1) dcl 1160 ref 1158 1162 ctrls 000010 internal static char(4) array dcl 16 set ref 545 548 549 1122* 1123 1124 1147* cu_$stack_frame_ptr 000266 constant entry external dcl 138 ref 1081 damage 000214 automatic bit(1) dcl 635 set ref 652* 654* 656 678* 682* 684 702 debug 000206 constant entry external dcl 16 ref 374 deferred_alrm_timer 000156 internal static bit(1) initial packed unaligned dcl 16 set ref 1034 1036* 1059* 1146* deferred_cput_timer 000157 internal static bit(1) initial packed unaligned dcl 16 set ref 1039 1041* 1060* 1146* deferred_interrupt defined bit(1) dcl 2-45 set ref 1046* 1057* 1120* ercode based fixed bin(17,0) dcl 16 set ref 563* 574* 611* 789* 865* err_frame defined pointer dcl 11-6 set ref 337* 663* 692* err_recp defined pointer dcl 11-6 set ref 188 198* 663* 769* 855* errcode based fixed bin(35,0) array dcl 16 set ref 937* 938* 1001* 1002* esw 000163 automatic fixed bin(17,0) dcl 16 set ref 234* 306 308 309 326 356 436 485 509* 541* 1163* eval_frame defined pointer dcl 11-6 set ref 663* fault_code 000100 automatic fixed bin(17,0) dcl 16 set ref 165* 205 206 207 208 209 210 211 212 213 217* 242 817 1035* 1040* 1059 1060 fault_save based structure level 1 dcl 2-25 set ref 187 firstctrl 000154 internal static fixed bin(17,0) initial dcl 16 set ref 309 543 545 548 548* 548 549* 1044 1125 1144* fixed builtin function dcl 117 ref 667 667 668 668 fixedb 1 based fixed bin(17,0) level 2 dcl 8-4 set ref 453* 453 458* 515 559* 951 969 fixnum_fmt based structure level 1 dcl 8-4 fixnum_type constant bit(36) initial dcl 8-4 ref 457 558 floatb 1 based float bin(27) level 2 dcl 8-4 ref 952 970 flonum_fmt based structure level 1 dcl 8-4 fn_alarmclock constant fixed bin(17,0) initial dcl 9-9 ref 938 fn_nointerrupt constant fixed bin(17,0) initial dcl 9-9 ref 1002 gc_inhibit defined bit(1) dcl 2-45 set ref 177* 190 847* haventbarfedatthisyet 000160 internal static bit(1) initial packed unaligned dcl 868 set ref 876 881* hbound builtin function dcl 117 ref 548 1123 hcs_$truncate_seg 000376 constant entry external dcl 648 ref 667 668 i 000156 automatic fixed bin(17,0) dcl 16 set ref 246* 282* 285 291 292 293 515* 593* 653* 654* inbuf 000102 automatic char(132) dcl 16 set ref 255 255 255 255 256 261 261 282 545* 550 584* 586* 879 879 879 879 880 1073* 1092* 1096 1096 1096 1096 1101 1101 1104 1105 1106 1122 index builtin function dcl 117 ref 274 550 intno parameter fixed bin(17,0) dcl 1133 ref 1130 1136 intno_pic automatic picture(2) packed unaligned dcl 1134 ref 1136 intrp 000166 automatic pointer dcl 16 set ref 379* 389 460* 464* 470* 475* 480* 491* 495* 498 498 1108* 1113* io_status 000171 automatic fixed bin(35,0) dcl 16 set ref 255* 437* 438* 498* 843* 879* 1096* ioa_$ioa_switch 000176 constant entry external dcl 16 ref 217 261 307 334 346 373 657 659 684 877 885 1125 ioa_$ioa_switch_nnl 000200 constant entry external dcl 16 ref 254 878 1093 iochan based structure level 1 dcl 6-13 iocidx 000162 automatic fixed bin(17,0) dcl 16 set ref 514* 523* 524 526 528 529* 529 iog_unm 000146 automatic pointer dcl 16 set ref 726* 727 728 729 730 731 732 780 781 iogsw 000164 automatic bit(1) packed unaligned dcl 16 set ref 506* 532 713* ioindex based fixed bin(24,0) level 2 dcl 6-13 set ref 340* 342* 384* 387* 439* iolength 1 based fixed bin(24,0) level 2 dcl 6-13 set ref 341* 386* iox_$control 000212 constant entry external dcl 16 ref 437 438 843 iox_$error_output 000222 external static pointer dcl 16 set ref 498* 657* 659* 684* 877* 885* iox_$get_line 000214 constant entry external dcl 16 ref 255 879 1096 iox_$put_chars 000216 constant entry external dcl 16 ref 498 iox_$user_io 000220 external static pointer dcl 16 set ref 217* 254* 255* 261* 307* 334* 346* 373* 437* 438* 843* 878* 879* 1093* 1096* 1125* lastctrl 000155 internal static fixed bin(17,0) initial dcl 16 set ref 309 543 1044 1122 1123 1123* 1123 1124* 1125 1144* lbound builtin function dcl 117 ref 549 1124 length builtin function dcl 117 ref 255 255 492 496 811 879 879 993 1096 1096 1109 1114 lisp_$apply 000226 constant entry external dcl 16 ref 301 395 821 lisp_$eval 000204 constant entry external dcl 16 ref 760 lisp_default_handler_$alarm 000360 constant entry external dcl 912 ref 949 949 957 957 967 967 975 975 lisp_error_ 000224 constant entry external dcl 16 ref 564 575 624 791 866 941 1003 lisp_error_table_$bad_arg_correctable 000244 external static fixed bin(17,0) dcl 123 ref 937 937 1001 1001 lisp_error_table_$car_cdr_error 000246 external static fixed bin(17,0) dcl 123 ref 789 789 lisp_error_table_$stack_loss_error 000250 external static fixed bin(17,0) dcl 123 ref 611 611 lisp_error_table_$store_function_misused 000252 external static fixed bin(17,0) dcl 123 ref 865 865 lisp_error_table_$underflow_fault 000254 external static fixed bin(17,0) dcl 123 ref 574 574 lisp_error_table_$zerodivide_fault 000256 external static fixed bin(17,0) dcl 123 ref 563 563 lisp_fault_handler_$set_mask 000306 constant entry external dcl 2-45 ref 812 849 lisp_get_atom_ 000202 constant entry external dcl 16 ref 298 lisp_prog_fns_$lisp_err 000210 constant entry external dcl 16 ref 344 lisp_ptr_type based bit(36) dcl 12-17 ref 453 951 952 969 970 lisp_segment_manager_$shrink_stacks 000230 constant entry external dcl 16 ref 606 lisp_special_fns_$cons 000234 constant entry external dcl 16 ref 300 393 560 561 820 lisp_special_fns_$ncons 000232 constant entry external dcl 16 ref 572 lisp_static_vars_$activate_gc_unwinder_kludge 000264 external static bit(1) dcl 138 set ref 1087* lisp_static_vars_$binding_top 000344 external static pointer dcl 11-6 set ref 663* 663 730 730 732* 732 780* 780 780 780 lisp_static_vars_$catch_frame 000334 external static pointer dcl 11-6 set ref 663* 663 lisp_static_vars_$cleanup_list_exists 000260 external static bit(1) dcl 138 ref 1077 lisp_static_vars_$ctrlA 000356 external static fixed bin(71,0) dcl 444 ref 453 453 453 453 453 453 457 457 458 458 lisp_static_vars_$ctrlD 000314 external static fixed bin(71,0) dcl 7-5 ref 315 315 320 320 lisp_static_vars_$ctrlQ 000316 external static fixed bin(71,0) dcl 7-8 ref 402 402 410 410 720 720 lisp_static_vars_$ctrlR 000320 external static fixed bin(71,0) dcl 7-11 ref 417 417 423 423 722 722 lisp_static_vars_$ctrlW 000322 external static fixed bin(71,0) dcl 7-14 ref 428 428 433 433 724 724 lisp_static_vars_$deferred_interrupt 000276 external static bit(1) dcl 2-45 set ref 1046* 1046 1057* 1057 1120* 1120 lisp_static_vars_$err_frame 000332 external static pointer dcl 11-6 set ref 337* 337 663* 663 692* 692 lisp_static_vars_$err_recp 000324 external static pointer dcl 11-6 set ref 188 188 198* 198 663* 663 769* 769 855* 855 lisp_static_vars_$eval_frame 000326 external static pointer dcl 11-6 set ref 663* 663 lisp_static_vars_$garbage_collect_inhibit 000270 external static bit(1) dcl 2-45 set ref 177* 177 190 190 669* 847* 847 lisp_static_vars_$gc_unwinder_kludge 000262 external static label variable dcl 138 set ref 1085* lisp_static_vars_$i_am_gcing 000242 external static bit(1) dcl 105 set ref 1077 1106 1143* lisp_static_vars_$ignore_faults 000162 external static bit(1) packed unaligned dcl 16 set ref 360* 361* 363* 370* 375* lisp_static_vars_$masked 000272 external static structure level 1 dcl 2-45 set ref 191 235 582 659 797 1009 1010 1017 1028 1050 1149 lisp_static_vars_$mulpi_state 000240 external static fixed bin(17,0) dcl 16 set ref 579 584 586* 589 593 lisp_static_vars_$mulquit_state 000236 external static fixed bin(17,0) dcl 16 set ref 243 244 246 1067 1070 1073* lisp_static_vars_$nil 000346 external static fixed bin(71,0) dcl 11-6 ref 294 294 297 297 299 299 315 315 390 390 391 391 392 392 410 410 423 423 428 428 511 511 556 556 736 736 816 816 819 819 980 980 991 991 1011 1011 lisp_static_vars_$pending_ctrl 000274 external static bit(1) dcl 2-45 set ref 1033* 1033 1046* 1046 1142* 1142 lisp_static_vars_$prog_frame 000330 external static pointer dcl 11-6 set ref 663* 663 lisp_static_vars_$quit_handler_flag 000174 external static bit(1) packed unaligned dcl 16 set ref 229 229 233* 233 296* 296 343* 343 351* 351 394* 394 827* 827 lisp_static_vars_$quotient 000170 external static fixed bin(71,0) dcl 16 ref 557 lisp_static_vars_$rdr_label 000300 external static label variable dcl 2-45 set ref 195 195 766* 766 834 834 852* 852 lisp_static_vars_$rdr_ptr 000302 external static pointer dcl 2-45 set ref 196 196 767* 767 853* 853 lisp_static_vars_$rdr_state 000304 external static fixed bin(17,0) dcl 2-45 set ref 180* 197 197 490 490 670* 743 743 746* 746 768* 768 831 831 854* 854 lisp_static_vars_$read_print_nl_sync 000310 external static bit(36) packed unaligned dcl 5-17 set ref 241* 252* 1095* lisp_static_vars_$runtime_atom 000364 external static fixed bin(71,0) dcl 912 ref 818 818 933 933 lisp_static_vars_$space_names_atom 000164 external static pointer dcl 16 ref 617 lisp_static_vars_$stack_ptr 000336 external static pointer dcl 11-6 set ref 172 172 286* 286 388* 388 507 507 533* 533 554* 554 569* 569 615 615 616* 616 626* 626 666* 666 666 666 668 668 668 668 668 668 676 676 677* 677 677 677 714 714 715* 715 782* 782 810* 810 848* 848 856* 856 928 928 939* 939 961* 961 990 990 1025 1025 1052* 1052 1164 1164 1167* 1167 lisp_static_vars_$t_atom 000340 external static fixed bin(71,0) dcl 11-6 ref 320 320 402 402 417 417 433 433 534 534 960 960 993 993 1009 1009 lisp_static_vars_$time_atom 000362 external static fixed bin(71,0) dcl 912 ref 817 817 932 932 lisp_static_vars_$top_level 000400 external static label variable dcl 648 ref 671 lisp_static_vars_$transparent 000172 external static bit(1) packed unaligned dcl 16 set ref 221 221 225* 225 358* 358 361* 361 364* 364 lisp_static_vars_$tty_atom 000312 external static fixed bin(71,0) dcl 5-17 ref 994 994 1010 1010 lisp_static_vars_$tty_input_chan 000350 external static pointer dcl 11-6 ref 340 340 341 341 384 384 386 386 lisp_static_vars_$tty_output_chan 000352 external static pointer dcl 11-6 ref 342 342 387 387 439 439 lisp_static_vars_$unmkd_ptr 000342 external static pointer dcl 11-6 set ref 186 186 187* 187 204 204 337 337 562* 562 573* 573 609 609 610* 610 654 654 662 662 665* 665 667 667 667 667 667 667 680 680 681* 681 681 681 692 692 726 726 727* 727 781* 781 787* 787 857* 857 860* 860 935 935 936* 936 999 999 1000* 1000 lisp_static_vars_$user_intr_array 000354 external static fixed bin(71,0) array dcl 11-45 ref 293 293 379 379 460 460 464 464 470 470 475 475 480 480 815 815 lisp_static_vars_$zunderflow 000166 external static fixed bin(71,0) dcl 16 ref 571 masked based structure level 1 dcl 2-45 set ref 191 1017 1028 1050* ms_gc 000045 constant varying char(36) initial dcl 105 set ref 1108 1109 ms_masked 000033 constant varying char(36) initial dcl 105 set ref 1113 1114 ms_run 000057 constant varying char(36) initial dcl 105 set ref 495 496 ms_tti 000071 constant varying char(36) initial dcl 105 set ref 491 492 nelemt 000143 automatic fixed bin(17,0) dcl 16 set ref 255* 258 260 261 261 282 492* 496* 498* 550* 551 551* 879* 880 1096* 1097 1109* 1114* new_mask 000216 automatic structure level 1 dcl 912 set ref 812* 1017* 1024* 1050 nil defined fixed bin(71,0) dcl 11-6 ref 294 297 299 315 390 391 392 410 423 428 511 556 736 816 819 980 991 1011 null builtin function dcl 117 ref 437 437 438 438 843 843 old_mask 000215 automatic structure level 1 dcl 912 set ref 1028* our_stack 000250 automatic pointer dcl 642 set ref 662* 663 665 patchingmode 000161 internal static bit(1) initial packed unaligned dcl 868 set ref 880* 884 pbr parameter pointer dcl 16 set ref 6 885* 886 892* pdl_ptr_types36 based structure array level 1 dcl 10-7 pending_ctrl defined bit(1) dcl 2-45 set ref 1033* 1046* 1142* pname 5 based char level 2 dcl 13-5 ref 528 pnamel 4 based fixed bin(17,0) level 2 dcl 13-5 ref 526 528 prev_frame based bit(18) level 2 packed packed unaligned dcl 2-25 set ref 188* 769 855 prev_sp 20 based pointer level 2 dcl 1-36 ref 1082 prog_frame defined pointer dcl 11-6 set ref 663* ptr builtin function dcl 117 ref 193 194 337 662 666 677 681 692 769 780 850 851 855 889 890 push_down_list_ptr_types based structure array level 1 dcl 10-7 qitf defined bit(1) packed unaligned dcl 16 set ref 229 233* 296* 343* 351* 394* 827* quit 000206 stack reference condition dcl 357 ref 362 rdr_label defined label variable dcl 2-45 set ref 195 766* 834 852* rdr_ptr defined pointer dcl 2-45 set ref 196 767* 853* rdr_save_f 000170 automatic bit(1) packed unaligned dcl 16 set ref 744* 748* 765 rdr_state defined fixed bin(17,0) dcl 2-45 set ref 197 490 743 746* 768* 831 854* rel builtin function dcl 117 ref 188 189 654 667 667 668 668 676 680 728 729 730 rev_ptr 1(18) based bit(18) level 2 packed packed unaligned dcl 10-7 set ref 731* runtime defined fixed bin(71,0) dcl 912 ref 818 933 size builtin function dcl 117 ref 187 sp 000100 automatic pointer dcl 1080 set ref 1081* 1082* 1082 1084 1085 stack 000152 automatic pointer dcl 16 set ref 172* 189 286 293 294 295 295 297 298 299 388 389 390 391 392 507* 508 508 511 513 515 518 526 528 533 534 554 556 557 558 559 569 571 714* 715 716 716 720 721 721 722 723 723 724 725 725 728 729 736 736 736 750* 750 755* 755 756 756 758 759 759 761 761 763 763 774 774 775 775 776 776 782 810 815 816 817 818 819 848 856 928* 931 932 933 939 940 940 942 942 960 961 980 990* 991 993 994 1009 1010 1011 1025* 1052 1164* 1167 stack2 000220 automatic pointer dcl 912 set ref 931* 951 951 952 952 969 969 970 970 stack_frame based structure level 1 dcl 1-36 stack_loss_error defined fixed bin(17,0) dcl 123 ref 611 stack_ptr defined pointer dcl 11-6 in procedure "lisp_fault_handler_" set ref 172 286* 388* 507 533* 554* 569* 615 616* 626* 666* 666 668* 668 668 676 677* 677 714 715* 782* 810* 848* 856* 928 939* 961* 990 1025 1052* 1164 1167* stack_ptr 0(18) based bit(18) level 2 in structure "fault_save" packed packed unaligned dcl 2-25 in procedure "lisp_fault_handler_" set ref 189* stack_ptr_kludge constant bit(18) initial packed unaligned dcl 642 ref 677 681 stack_ptr_max constant bit(18) initial packed unaligned dcl 642 ref 676 680 stack_seg based structure level 1 dcl 3-5 stattic_bound constant bit(18) initial packed unaligned dcl 642 ref 654 stattic_ptr based pointer array dcl 642 ref 654 store_function_misused defined fixed bin(17,0) dcl 123 ref 865 string builtin function dcl 117 in procedure "lisp_fault_handler_" set ref 659 811* 811 991* 993* 993 1149* string 1 based char(36) level 2 in structure "v" dcl 105 in procedure "lisp_fault_handler_" set ref 498 498 substr builtin function dcl 117 set ref 256 261 261 282 528 545* 550 880 1092* 1101 1101 1104 1105 1106 1122 sv_array_info 4 based pointer level 2 dcl 2-25 set ref 193* 850 sv_array_offset 15 based fixed bin(18,0) level 2 dcl 2-25 set ref 194* 851 sv_gc_inhibit 1 based bit(1) level 2 packed packed unaligned dcl 2-25 set ref 190* 847 sv_masked 1(01) based structure level 2 packed packed unaligned dcl 2-25 set ref 191* 849 sv_rdr_label 6 based label variable level 2 dcl 2-25 set ref 195* 766 852 sv_rdr_ptr 12 based pointer level 2 dcl 2-25 set ref 196* 767 853 sv_rdr_state 14 based fixed bin(17,0) level 2 dcl 2-25 set ref 197* 485 768 854 t_atom defined fixed bin(71,0) dcl 11-6 ref 320 402 417 433 534 960 993 1009 temp based fixed bin(71,0) array dcl 10-7 set ref 286 293* 294 295* 297 298* 299* 388 389* 390 391* 392* 508* 511 533 534* 554 556* 557* 558 559 569 571* 616 617* 619* 622* 715 716* 720* 721* 722* 723* 724* 725* 728 729 750 756* 759* 761* 763* 763 774 775 776 782 810 815* 816 817* 818* 819* 848 931 932 933 939 940* 940 942* 942 960* 961 980* 991 993 994 1009* 1010* 1011* temp_ptr based pointer array dcl 10-7 ref 295 508 526 528 619 622 716 721 723 725 736 736 736 756 759 761 774 775 776 temp_type 0(21) based bit(9) array level 2 packed packed unaligned dcl 10-7 ref 758 temp_type36 based bit(36) array level 2 dcl 10-7 ref 513 518 time defined fixed bin(71,0) dcl 912 ref 817 932 timer_manager_$alarm_call 000370 constant entry external dcl 912 ref 957 timer_manager_$cpu_call 000366 constant entry external dcl 912 ref 975 timer_manager_$reset_alarm_call 000374 constant entry external dcl 912 ref 949 timer_manager_$reset_cpu_call 000372 constant entry external dcl 912 ref 967 top_block based bit(18) level 2 packed packed unaligned dcl 10-7 set ref 729* transparent defined bit(1) packed unaligned dcl 16 set ref 221 225* 358* 361* 364* tstack 000154 automatic pointer dcl 16 set ref 615* 616 617 619 619 622 622 626 tty 000216 automatic bit(1) level 3 in structure "new_mask" packed packed unaligned dcl 912 in procedure "lisp_fault_handler_" set ref 996* 1031 tty based bit(1) level 3 in structure "masked" packed packed unaligned dcl 2-45 in procedure "lisp_fault_handler_" set ref 235 582 1010 tty_atom defined fixed bin(71,0) dcl 5-17 ref 994 1010 tty_input_chan defined pointer dcl 11-6 ref 340 341 384 386 tty_output_chan defined pointer dcl 11-6 ref 342 387 439 type_info based bit(36) level 2 dcl 8-4 set ref 457* 558* underflow_fault defined fixed bin(17,0) dcl 123 ref 574 unm 000144 automatic pointer dcl 16 set ref 186* 187 187 188 189 190 191 192 193 193 194 194 195 196 197 198 485 563 574 611 766 767 768 769 769 789 847 849 850 850 851 851 852 853 854 855 855 857 865 889 890 935* 936 937 938 999* 1000 1001 1002 unmkd_ptr defined pointer dcl 11-6 set ref 186 187* 204 337 562* 573* 609 610* 654 662 665* 667* 667 667 680 681* 681 692 726 727* 781* 787* 857* 860* 935 936* 999 1000* unmtop 000150 automatic pointer dcl 16 set ref 204* 562 563 573 574 609* 610 611 787 789 860 865 unspec builtin function dcl 117 set ref 193* 193 273* 273 850* 850 user_intr_array defined fixed bin(71,0) array dcl 11-45 set ref 293 379 460 464 470 475 480 815 v based structure level 1 dcl 105 value based fixed bin(71,0) level 2 dcl 13-5 set ref 295 315* 320* 389 402* 410* 417* 423* 428* 433* 453 617 721 723 725 736* 736* 736* 774* 775* 776* 815 which_stack parameter fixed bin(17,0) dcl 602 set ref 600 618 620* 620 zerodivide_fault defined fixed bin(17,0) dcl 123 ref 563 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Array internal static bit(9) initial packed unaligned dcl 12-17 Array36 internal static bit(36) initial dcl 12-17 Atomic internal static bit(9) initial packed unaligned dcl 12-17 Atomic36 internal static bit(36) initial dcl 12-17 Atsym internal static bit(9) initial packed unaligned dcl 12-17 Bigfix internal static bit(9) initial packed unaligned dcl 12-17 Bigfix36 internal static bit(36) initial dcl 12-17 Bignum internal static bit(9) initial packed unaligned dcl 12-17 Bignum36 internal static bit(36) initial dcl 12-17 Cons36 internal static bit(36) initial dcl 12-17 Dead_array internal static fixed bin(17,0) initial dcl 4-20 File internal static bit(9) initial packed unaligned dcl 12-17 File36 internal static bit(36) initial dcl 12-17 Fixed internal static bit(9) initial packed unaligned dcl 12-17 Fixnum_array internal static fixed bin(17,0) initial dcl 4-20 Float internal static bit(9) initial packed unaligned dcl 12-17 Flonum_array internal static fixed bin(17,0) initial dcl 4-20 NotConsOrAtsym36 internal static bit(36) initial dcl 12-17 Numeric internal static bit(9) initial packed unaligned dcl 12-17 Numeric36 internal static bit(36) initial dcl 12-17 Obarray_array internal static fixed bin(17,0) initial dcl 4-20 RETURN_PTR_MASK internal static bit(72) initial packed unaligned dcl 1-19 Readtable_array internal static fixed bin(17,0) initial dcl 4-20 S_expr_array internal static fixed bin(17,0) initial dcl 4-20 String internal static bit(9) initial packed unaligned dcl 12-17 String36 internal static bit(36) initial dcl 12-17 Subr internal static bit(9) initial packed unaligned dcl 12-17 Subr36 internal static bit(36) initial dcl 12-17 SubrNumeric36 internal static bit(36) initial dcl 12-17 System_Subr internal static bit(9) initial packed unaligned dcl 12-17 System_Subr36 internal static bit(36) initial dcl 12-17 TRANSLATOR_ID_ALM internal static bit(18) initial packed unaligned dcl 1-25 TRANSLATOR_ID_PL1V1 internal static bit(18) initial packed unaligned dcl 1-26 TRANSLATOR_ID_PL1V2 internal static bit(18) initial packed unaligned dcl 1-24 TRANSLATOR_ID_SIGNALLER internal static bit(18) initial packed unaligned dcl 1-28 TRANSLATOR_ID_SIGNAL_CALLER internal static bit(18) initial packed unaligned dcl 1-27 Un_gc_array internal static fixed bin(17,0) initial dcl 4-20 Uncollectable internal static bit(9) initial packed unaligned dcl 12-17 Undefined internal static bit(72) initial packed unaligned dcl 12-17 ZERO internal static fixed bin(17,0) initial dcl 4-37 array defined fixed bin(71,0) dcl 16 array_atom defined fixed bin(71,0) dcl 11-6 array_data based structure level 1 dcl 4-31 array_head based structure level 1 dcl 16 arrayindex defined fixed bin(71,0) dcl 16 atom_double_words based structure level 1 dcl 13-5 atom_ptrs based structure level 1 dcl 13-5 base defined fixed bin(71,0) dcl 5-17 bindings based structure array level 1 dcl 10-7 call_array_operator internal static bit(36) initial packed unaligned dcl 3-68 call_dead_array_operator internal static bit(36) initial packed unaligned dcl 3-68 cons_ptrs based structure level 1 dcl 15-5 cons_types based structure level 1 dcl 15-5 cons_types36 based structure level 1 dcl 15-22 consptr automatic pointer dcl 15-5 flag_reset_mask internal static bit(36) initial dcl 6-13 flonum_type internal static bit(36) initial dcl 8-4 fn_CtoI internal static fixed bin(17,0) initial dcl 9-9 fn_ItoC internal static fixed bin(17,0) initial dcl 9-9 fn_abs internal static fixed bin(17,0) initial dcl 9-9 fn_add1 internal static fixed bin(17,0) initial dcl 9-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 9-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 9-9 fn_allfiles internal static fixed bin(17,0) initial dcl 9-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 9-9 fn_apply internal static fixed bin(17,0) initial dcl 9-9 fn_arg internal static fixed bin(17,0) initial dcl 9-9 fn_args internal static fixed bin(17,0) initial dcl 9-9 fn_array internal static fixed bin(17,0) initial dcl 9-9 fn_arraydims internal static fixed bin(17,0) initial dcl 9-9 fn_ascii internal static fixed bin(17,0) initial dcl 9-9 fn_atan internal static fixed bin(17,0) initial dcl 9-9 fn_baktrace internal static fixed bin(17,0) initial dcl 9-9 fn_bltarray internal static fixed bin(17,0) initial dcl 9-9 fn_boole internal static fixed bin(17,0) initial dcl 9-9 fn_boundp internal static fixed bin(17,0) initial dcl 9-9 fn_catch internal static fixed bin(17,0) initial dcl 9-9 fn_catenate internal static fixed bin(17,0) initial dcl 9-9 fn_charpos internal static fixed bin(17,0) initial dcl 9-9 fn_chrct internal static fixed bin(17,0) initial dcl 9-9 fn_clear_input internal static fixed bin(17,0) initial dcl 9-9 fn_cline internal static fixed bin(17,0) initial dcl 9-9 fn_close internal static fixed bin(17,0) initial dcl 9-9 fn_cos internal static fixed bin(17,0) initial dcl 9-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 9-9 fn_defaultf internal static fixed bin(17,0) initial dcl 9-9 fn_definedp internal static fixed bin(17,0) initial dcl 9-9 fn_defsubr internal static fixed bin(17,0) initial dcl 9-9 fn_defun internal static fixed bin(17,0) initial dcl 9-9 fn_delete internal static fixed bin(17,0) initial dcl 9-9 fn_deletef internal static fixed bin(17,0) initial dcl 9-9 fn_delq internal static fixed bin(17,0) initial dcl 9-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 9-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 9-9 fn_difference internal static fixed bin(17,0) initial dcl 9-9 fn_displace internal static fixed bin(17,0) initial dcl 9-9 fn_do internal static fixed bin(17,0) initial dcl 9-9 fn_dumparrays internal static fixed bin(17,0) initial dcl 9-9 fn_endpagefn internal static fixed bin(17,0) initial dcl 9-9 fn_eoffn internal static fixed bin(17,0) initial dcl 9-9 fn_eql internal static fixed bin(17,0) initial dcl 9-9 fn_errframe internal static fixed bin(17,0) initial dcl 9-9 fn_errprint internal static fixed bin(17,0) initial dcl 9-9 fn_errset internal static fixed bin(17,0) initial dcl 9-9 fn_eval internal static fixed bin(17,0) initial dcl 9-9 fn_eval_when internal static fixed bin(17,0) initial dcl 9-9 fn_evalframe internal static fixed bin(17,0) initial dcl 9-9 fn_exp internal static fixed bin(17,0) initial dcl 9-9 fn_expt internal static fixed bin(17,0) initial dcl 9-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 9-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 9-9 fn_filepos internal static fixed bin(17,0) initial dcl 9-9 fn_fillarray internal static fixed bin(17,0) initial dcl 9-9 fn_fix internal static fixed bin(17,0) initial dcl 9-9 fn_float internal static fixed bin(17,0) initial dcl 9-9 fn_force_output internal static fixed bin(17,0) initial dcl 9-9 fn_freturn internal static fixed bin(17,0) initial dcl 9-9 fn_fsc internal static fixed bin(17,0) initial dcl 9-9 fn_gcd internal static fixed bin(17,0) initial dcl 9-9 fn_gensym internal static fixed bin(17,0) initial dcl 9-9 fn_get internal static fixed bin(17,0) initial dcl 9-9 fn_get_pname internal static fixed bin(17,0) initial dcl 9-9 fn_getchar internal static fixed bin(17,0) initial dcl 9-9 fn_getl internal static fixed bin(17,0) initial dcl 9-9 fn_greaterp internal static fixed bin(17,0) initial dcl 9-9 fn_gt internal static fixed bin(17,0) initial dcl 9-9 fn_haipart internal static fixed bin(17,0) initial dcl 9-9 fn_haulong internal static fixed bin(17,0) initial dcl 9-9 fn_ifix internal static fixed bin(17,0) initial dcl 9-9 fn_in internal static fixed bin(17,0) initial dcl 9-9 fn_includef internal static fixed bin(17,0) initial dcl 9-9 fn_index internal static fixed bin(17,0) initial dcl 9-9 fn_inpush internal static fixed bin(17,0) initial dcl 9-9 fn_isqrt internal static fixed bin(17,0) initial dcl 9-9 fn_lessp internal static fixed bin(17,0) initial dcl 9-9 fn_linel internal static fixed bin(17,0) initial dcl 9-9 fn_linenum internal static fixed bin(17,0) initial dcl 9-9 fn_listarray internal static fixed bin(17,0) initial dcl 9-9 fn_listify internal static fixed bin(17,0) initial dcl 9-9 fn_loadarrays internal static fixed bin(17,0) initial dcl 9-9 fn_log internal static fixed bin(17,0) initial dcl 9-9 fn_ls internal static fixed bin(17,0) initial dcl 9-9 fn_lsh internal static fixed bin(17,0) initial dcl 9-9 fn_make_atom internal static fixed bin(17,0) initial dcl 9-9 fn_makunbound internal static fixed bin(17,0) initial dcl 9-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 9-9 fn_max internal static fixed bin(17,0) initial dcl 9-9 fn_mergef internal static fixed bin(17,0) initial dcl 9-9 fn_min internal static fixed bin(17,0) initial dcl 9-9 fn_minus internal static fixed bin(17,0) initial dcl 9-9 fn_minusp internal static fixed bin(17,0) initial dcl 9-9 fn_namelist internal static fixed bin(17,0) initial dcl 9-9 fn_names internal static fixed bin(17,0) initial dcl 9-9 fn_namestring internal static fixed bin(17,0) initial dcl 9-9 fn_nth internal static fixed bin(17,0) initial dcl 9-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 9-9 fn_oddp internal static fixed bin(17,0) initial dcl 9-9 fn_open internal static fixed bin(17,0) initial dcl 9-9 fn_opena internal static fixed bin(17,0) initial dcl 9-9 fn_openi internal static fixed bin(17,0) initial dcl 9-9 fn_openo internal static fixed bin(17,0) initial dcl 9-9 fn_out internal static fixed bin(17,0) initial dcl 9-9 fn_pagel internal static fixed bin(17,0) initial dcl 9-9 fn_pagenum internal static fixed bin(17,0) initial dcl 9-9 fn_plus internal static fixed bin(17,0) initial dcl 9-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 9-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 9-9 fn_plusp internal static fixed bin(17,0) initial dcl 9-9 fn_prin1 internal static fixed bin(17,0) initial dcl 9-9 fn_princ internal static fixed bin(17,0) initial dcl 9-9 fn_print internal static fixed bin(17,0) initial dcl 9-9 fn_prog internal static fixed bin(17,0) initial dcl 9-9 fn_progv internal static fixed bin(17,0) initial dcl 9-9 fn_putprop internal static fixed bin(17,0) initial dcl 9-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 9-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 9-9 fn_quotient internal static fixed bin(17,0) initial dcl 9-9 fn_random internal static fixed bin(17,0) initial dcl 9-9 fn_read internal static fixed bin(17,0) initial dcl 9-9 fn_read_from_string internal static fixed bin(17,0) initial dcl 9-9 fn_readch internal static fixed bin(17,0) initial dcl 9-9 fn_readstring internal static fixed bin(17,0) initial dcl 9-9 fn_remainder internal static fixed bin(17,0) initial dcl 9-9 fn_remprop internal static fixed bin(17,0) initial dcl 9-9 fn_rename internal static fixed bin(17,0) initial dcl 9-9 fn_rot internal static fixed bin(17,0) initial dcl 9-9 fn_rplaca internal static fixed bin(17,0) initial dcl 9-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 9-9 fn_save internal static fixed bin(17,0) initial dcl 9-9 fn_set internal static fixed bin(17,0) initial dcl 9-9 fn_setarg internal static fixed bin(17,0) initial dcl 9-9 fn_setq internal static fixed bin(17,0) initial dcl 9-9 fn_setsyntax internal static fixed bin(17,0) initial dcl 9-9 fn_shortnamestring internal static fixed bin(17,0) initial dcl 9-9 fn_signp internal static fixed bin(17,0) initial dcl 9-9 fn_sin internal static fixed bin(17,0) initial dcl 9-9 fn_sleep internal static fixed bin(17,0) initial dcl 9-9 fn_sort internal static fixed bin(17,0) initial dcl 9-9 fn_sortcar internal static fixed bin(17,0) initial dcl 9-9 fn_sqrt internal static fixed bin(17,0) initial dcl 9-9 fn_sstatus internal static fixed bin(17,0) initial dcl 9-9 fn_star_array internal static fixed bin(17,0) initial dcl 9-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 9-9 fn_star_sstatus internal static fixed bin(17,0) initial dcl 9-9 fn_star_status internal static fixed bin(17,0) initial dcl 9-9 fn_status internal static fixed bin(17,0) initial dcl 9-9 fn_store internal static fixed bin(17,0) initial dcl 9-9 fn_stringlength internal static fixed bin(17,0) initial dcl 9-9 fn_sub1 internal static fixed bin(17,0) initial dcl 9-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 9-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 9-9 fn_substr internal static fixed bin(17,0) initial dcl 9-9 fn_sxhash internal static fixed bin(17,0) initial dcl 9-9 fn_sysp internal static fixed bin(17,0) initial dcl 9-9 fn_throw internal static fixed bin(17,0) initial dcl 9-9 fn_times internal static fixed bin(17,0) initial dcl 9-9 fn_times_fix internal static fixed bin(17,0) initial dcl 9-9 fn_times_flo internal static fixed bin(17,0) initial dcl 9-9 fn_truename internal static fixed bin(17,0) initial dcl 9-9 fn_tyi internal static fixed bin(17,0) initial dcl 9-9 fn_tyipeek internal static fixed bin(17,0) initial dcl 9-9 fn_tyo internal static fixed bin(17,0) initial dcl 9-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 9-9 fn_zerop internal static fixed bin(17,0) initial dcl 9-9 htpos automatic fixed bin(17,0) dcl 16 htptr automatic pointer dcl 16 ibase defined fixed bin(71,0) dcl 5-17 ioa_$ioa_stream 000000 constant entry external dcl 648 lisp_alloc_ 000000 constant entry external dcl 16 lisp_io_control_$close 000000 constant entry external dcl 16 lisp_io_control_$opena 000000 constant entry external dcl 16 lisp_ptr based structure level 1 dcl 12-17 lisp_special_fns_$xcons 000000 constant entry external dcl 16 lisp_static_vars_$array external static fixed bin(71,0) dcl 16 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 11-6 lisp_static_vars_$arrayindex external static fixed bin(71,0) dcl 16 lisp_static_vars_$base external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$ibase external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$iochan_list external static pointer dcl 11-6 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 11-6 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 11-6 lisp_static_vars_$plus_status external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$question_mark external static fixed bin(71,0) dcl 16 lisp_static_vars_$quote_atom external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$readtable external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$s_atom external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 11-45 lisp_static_vars_$status_gctwa external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$stnopoint external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$top_level external static label variable dcl 11-6 lisp_static_vars_$unwp_frame external static pointer dcl 11-6 lisp_string based structure level 1 dcl 14-6 ndims automatic fixed bin(17,0) dcl 16 nil_ptr based pointer dcl 11-6 not_ok_to_read internal static bit(36) initial packed unaligned dcl 5-9 not_ok_to_read_fixnum internal static bit(36) initial packed unaligned dcl 5-11 not_ok_to_write internal static bit(36) initial packed unaligned dcl 5-9 not_ok_to_write_fixnum internal static bit(36) initial packed unaligned dcl 5-11 obarray defined fixed bin(71,0) dcl 11-6 obarray_struct based structure level 1 dcl 16 plus_status defined fixed bin(71,0) dcl 5-17 quote_atom defined fixed bin(71,0) dcl 5-17 read_print_nl_sync defined bit(36) packed unaligned dcl 5-17 readtable defined fixed bin(71,0) dcl 5-17 s_atom defined fixed bin(71,0) dcl 5-17 sp automatic pointer dcl 1-31 stack_frame_flags based structure level 1 dcl 1-64 stack_frame_min_length internal static fixed bin(17,0) initial dcl 1-33 star_rset defined fixed bin(71,0) dcl 11-45 status_gctwa defined fixed bin(71,0) dcl 5-17 stnopoint defined fixed bin(71,0) dcl 5-17 t_atom_ptr based pointer dcl 11-6 unwp_frame defined pointer dcl 11-6 NAMES DECLARED BY EXPLICIT CONTEXT. Quit 000536 constant label dcl 221 ref 208 579 alarm 002474 constant label dcl 797 ref 205 206 alarm_proc 004213 constant entry internal dcl 808 ref 799 804 alarmclock 002712 constant entry external dcl 898 alarmclock0 002717 constant label dcl 928 set ref 943 alrm 002761 constant label dcl 949 ref 932 array_lossage 002526 constant label dcl 860 ref 209 ask_for_ctrl 000603 constant label dcl 252 ref 258 312 ask_for_ctrl_0 001116 constant label dcl 309 ref 263 bad_int_num 001064 constant label dcl 302 ref 291 292 294 car_cdr_of_num 002461 constant label dcl 787 ref 207 check_for_damage 002242 constant entry external dcl 697 cput 003044 constant label dcl 967 ref 933 ctrl_aa 000647 constant label dcl 256 ref 552 ctrl_b_break 001334 constant label dcl 384 ref 461 467 473 478 483 ctrl_from_reader 003642 constant entry external dcl 1158 ctrl_g_function 003666 constant entry external dcl 1171 ctrl_g_handler 001145 constant label dcl 334 ref 1173 ctrl_num 000746 constant label dcl 281 ref 259 ctrl_z_handler 001231 constant label dcl 351 ref 244 cv_interruptno 004407 constant entry internal dcl 1130 ref 586 1073 dispatch 000723 constant label dcl 269 ref 530 1165 dispatch_1 000734 constant label dcl 274 ref 269 272 do_alarm 002504 constant label dcl 804 ref 1037 1042 do_ctrl 001723 constant label dcl 541 ref 1044 do_ctrl_ret 003265 constant label dcl 1033 ref 543 806 do_ctrl_z 001236 constant label dcl 358 ref 1070 1102 emulate_old_style_store 002541 constant label dcl 868 ref 210 exit 002506 constant label dcl 827 ref 331 368 1089 1128 exit1 001140 constant label dcl 326 ref 297 302 318 323 365 376 397 405 413 420 426 431 436 441 500 exit_nzq 002524 constant label dcl 838 ref 227 231 566 577 627 801 1062 exitv 000026 constant label array(-1:2) dcl 330 ref 308 309 326 g0001 003406 constant label dcl 1082 ref 1084 handle_pi 002051 constant label dcl 579 ref 213 handle_underflow 002021 constant label dcl 569 ref 212 handle_zerodivide 001756 constant label dcl 554 ref 211 init 003604 constant entry external dcl 1140 interrupt_poll 003230 constant entry external dcl 1014 ioc 001637 constant entry external dcl 504 ioc_exit 001712 constant label dcl 532 ref 511 518 524 526 ioc_num 000777 constant label dcl 285 ref 516 594 ioc_num_not_2 001002 constant label dcl 286 set ref 247 ioc_retn 001677 constant label dcl 524 ref 306 iog 002255 constant entry external dcl 711 iog_aa 002361 constant label dcl 755 ref 532 iogjoin 001654 constant label dcl 509 ref 751 lisp_fault_handler_ 000453 constant entry external dcl 6 masked_alarm 003316 constant label dcl 1057 ref 797 masked_ctrl_ask 003437 constant label dcl 1093 ref 1097 masked_ctrl_save 003541 constant label dcl 1120 ref 587 1074 masked_quit 003333 constant label dcl 1067 ref 235 nointerrupt 003124 constant entry external dcl 988 nointerrupt00 003136 constant label dcl 991 ref 1004 nointr_join 003254 constant label dcl 1025 ref 1012 1018 not_ctrl 000664 constant label dcl 261 ref 281 proc 000000 constant label array(0:21) dcl 306 ref 274 285 1104 1105 proc_21_aa 001604 constant label dcl 491 ref 485 proc_21_bb 001611 constant label dcl 495 ref 489 quitter 001170 constant label dcl 340 ref 349 693 ret 003037 constant label dcl 961 ref 981 ret_nil 003117 constant label dcl 980 ref 952 955 970 973 ret_t 003034 constant label dcl 960 ref 978 save_state 003674 constant entry internal dcl 168 ref 166 604 save_state_only 003707 constant entry internal dcl 184 ref 173 745 set_mask 003244 constant entry external dcl 1020 stack_loss 002121 constant entry external dcl 600 undamage_the_stacks 003770 constant entry internal dcl 639 ref 637 701 unsave_state 004273 constant entry internal dcl 842 ref 828 838 893 unwind_to_top_level 001164 constant label dcl 337 ref 589 whats_going_on 001615 constant label dcl 498 ref 1110 1115 wipe_stack 002224 constant entry external dcl 631 NAMES DECLARED BY CONTEXT OR IMPLICATION. convert builtin function ref 1136 copy builtin function ref 811 993 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5614 6216 4437 5624 Length 7204 4437 402 751 1155 152 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp_fault_handler_ 469 external procedure is an external procedure. save_state internal procedure shares stack frame of external procedure lisp_fault_handler_. save_state_only internal procedure shares stack frame of external procedure lisp_fault_handler_. on unit on line 281 64 on unit on unit on line 361 64 on unit on unit on line 606 64 on unit undamage_the_stacks internal procedure shares stack frame of external procedure lisp_fault_handler_. alarm_proc internal procedure shares stack frame of external procedure lisp_fault_handler_. unsave_state internal procedure shares stack frame of external procedure lisp_fault_handler_. on unit on line 1077 70 on unit cv_interruptno internal procedure shares stack frame of external procedure lisp_fault_handler_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 ctrls lisp_fault_handler_ 000154 firstctrl lisp_fault_handler_ 000155 lastctrl lisp_fault_handler_ 000156 deferred_alrm_timer lisp_fault_handler_ 000157 deferred_cput_timer lisp_fault_handler_ 000160 haventbarfedatthisyet lisp_fault_handler_ 000161 patchingmode lisp_fault_handler_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lisp_fault_handler_ 000100 fault_code lisp_fault_handler_ 000101 chr lisp_fault_handler_ 000102 inbuf lisp_fault_handler_ 000143 nelemt lisp_fault_handler_ 000144 unm lisp_fault_handler_ 000146 iog_unm lisp_fault_handler_ 000150 unmtop lisp_fault_handler_ 000152 stack lisp_fault_handler_ 000154 tstack lisp_fault_handler_ 000156 i lisp_fault_handler_ 000160 argsp lisp_fault_handler_ 000162 iocidx lisp_fault_handler_ 000163 esw lisp_fault_handler_ 000164 iogsw lisp_fault_handler_ 000166 intrp lisp_fault_handler_ 000170 rdr_save_f lisp_fault_handler_ 000171 io_status lisp_fault_handler_ 000214 damage lisp_fault_handler_ 000215 old_mask lisp_fault_handler_ 000216 new_mask lisp_fault_handler_ 000220 stack2 lisp_fault_handler_ 000222 alarm_time lisp_fault_handler_ 000250 our_stack undamage_the_stacks on unit on line 1077 000100 sp on unit on line 1077 THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out return_mac fl2_to_fx2 tra_ext_1 tra_ext_2 signal_op enable_op shorten_stack ext_entry int_entry any_to_any_truncate_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$stack_frame_ptr debug hcs_$truncate_seg ioa_$ioa_switch ioa_$ioa_switch_nnl iox_$control iox_$get_line iox_$put_chars lisp_$apply lisp_$eval lisp_default_handler_$alarm lisp_error_ lisp_fault_handler_$set_mask lisp_get_atom_ lisp_prog_fns_$lisp_err lisp_segment_manager_$shrink_stacks lisp_special_fns_$cons lisp_special_fns_$ncons timer_manager_$alarm_call timer_manager_$cpu_call timer_manager_$reset_alarm_call timer_manager_$reset_cpu_call THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. iox_$error_output iox_$user_io lisp_error_table_$bad_arg_correctable lisp_error_table_$car_cdr_error lisp_error_table_$stack_loss_error lisp_error_table_$store_function_misused lisp_error_table_$underflow_fault lisp_error_table_$zerodivide_fault lisp_static_vars_$activate_gc_unwinder_kludge lisp_static_vars_$binding_top lisp_static_vars_$catch_frame lisp_static_vars_$cleanup_list_exists lisp_static_vars_$ctrlA lisp_static_vars_$ctrlD lisp_static_vars_$ctrlQ lisp_static_vars_$ctrlR lisp_static_vars_$ctrlW lisp_static_vars_$deferred_interrupt lisp_static_vars_$err_frame lisp_static_vars_$err_recp lisp_static_vars_$eval_frame lisp_static_vars_$garbage_collect_inhibit lisp_static_vars_$gc_unwinder_kludge lisp_static_vars_$i_am_gcing lisp_static_vars_$ignore_faults lisp_static_vars_$masked lisp_static_vars_$mulpi_state lisp_static_vars_$mulquit_state lisp_static_vars_$nil lisp_static_vars_$pending_ctrl lisp_static_vars_$prog_frame lisp_static_vars_$quit_handler_flag lisp_static_vars_$quotient lisp_static_vars_$rdr_label lisp_static_vars_$rdr_ptr lisp_static_vars_$rdr_state lisp_static_vars_$read_print_nl_sync lisp_static_vars_$runtime_atom lisp_static_vars_$space_names_atom lisp_static_vars_$stack_ptr lisp_static_vars_$t_atom lisp_static_vars_$time_atom lisp_static_vars_$top_level lisp_static_vars_$transparent lisp_static_vars_$tty_atom lisp_static_vars_$tty_input_chan lisp_static_vars_$tty_output_chan lisp_static_vars_$unmkd_ptr lisp_static_vars_$user_intr_array lisp_static_vars_$zunderflow LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000447 165 000460 166 000463 204 000464 205 000470 206 000473 207 000475 208 000477 209 000501 210 000503 211 000505 212 000507 213 000511 217 000513 221 000536 225 000542 226 000544 227 000547 229 000550 230 000553 231 000556 233 000557 234 000561 235 000562 241 000565 242 000567 243 000573 244 000577 246 000601 247 000602 252 000603 254 000606 255 000624 256 000647 258 000652 259 000655 260 000662 261 000664 263 000721 269 000723 272 000727 273 000732 274 000734 281 000746 282 000765 283 000776 285 000777 286 001002 291 001006 292 001010 293 001012 294 001016 295 001020 296 001023 297 001025 298 001030 299 001047 300 001053 301 001057 302 001064 306 001065 307 001070 308 001114 309 001116 312 001125 315 001126 318 001132 320 001133 323 001137 326 001140 330 001142 331 001144 334 001145 337 001164 340 001170 341 001173 342 001175 343 001177 344 001201 346 001211 349 001230 351 001231 356 001234 358 001236 360 001241 361 001243 362 001263 363 001266 364 001270 365 001272 367 001273 368 001276 370 001277 373 001302 374 001320 375 001325 376 001327 379 001330 384 001334 386 001337 387 001341 388 001343 389 001346 390 001350 391 001352 392 001355 393 001357 394 001363 395 001366 397 001372 402 001373 405 001377 410 001400 413 001404 417 001405 420 001411 423 001412 426 001416 428 001417 431 001423 433 001424 436 001430 437 001432 438 001461 439 001513 441 001516 453 001517 457 001527 458 001531 460 001533 461 001537 464 001540 467 001546 470 001547 473 001554 475 001555 478 001562 480 001563 483 001570 485 001571 489 001577 490 001600 491 001604 492 001606 493 001610 495 001611 496 001613 498 001615 500 001635 504 001636 506 001644 507 001645 508 001652 509 001654 511 001656 513 001662 514 001665 515 001667 516 001672 518 001673 523 001675 524 001677 526 001701 528 001705 529 001710 530 001711 532 001712 533 001714 534 001720 535 001722 541 001723 543 001725 545 001731 548 001733 549 001737 550 001741 551 001752 552 001755 554 001756 556 001761 557 001764 558 001766 559 001770 560 001771 561 001775 562 002002 563 002006 564 002012 565 002016 566 002020 569 002021 571 002024 572 002026 573 002032 574 002036 575 002042 576 002046 577 002050 579 002051 582 002054 584 002057 586 002070 587 002111 589 002112 593 002114 594 002115 600 002116 604 002126 606 002127 609 002150 610 002154 611 002157 615 002163 616 002166 617 002170 618 002173 619 002200 620 002204 621 002206 622 002207 624 002212 626 002217 627 002222 631 002223 637 002231 692 002232 693 002236 697 002237 701 002247 702 002250 703 002253 711 002254 713 002262 714 002264 715 002271 716 002273 720 002275 721 002277 722 002301 723 002303 724 002305 725 002307 726 002311 727 002314 728 002317 729 002323 730 002326 731 002332 732 002334 736 002335 743 002341 744 002344 745 002346 746 002351 747 002353 748 002354 750 002355 751 002360 755 002361 756 002364 758 002367 759 002373 760 002377 761 002404 762 002410 763 002411 765 002414 766 002416 767 002425 768 002427 769 002431 774 002436 775 002440 776 002442 780 002444 781 002454 782 002456 783 002460 787 002461 789 002464 791 002470 797 002474 799 002500 800 002501 801 002503 804 002504 806 002505 827 002506 828 002511 829 002512 831 002515 834 002521 836 002523 838 002524 840 002525 860 002526 865 002531 866 002535 876 002541 877 002544 878 002563 879 002603 880 002626 881 002640 884 002642 885 002644 886 002667 889 002673 890 002700 891 002703 892 002706 893 002707 894 002710 898 002711 928 002717 931 002724 932 002726 933 002731 935 002733 936 002736 937 002741 938 002743 939 002745 940 002747 941 002751 942 002755 943 002760 949 002761 951 002773 952 003003 955 003012 957 003013 960 003034 961 003037 962 003043 967 003044 969 003056 970 003066 973 003074 975 003075 978 003116 980 003117 981 003122 988 003123 990 003131 991 003136 993 003145 994 003160 995 003162 996 003164 997 003166 999 003167 1000 003172 1001 003175 1002 003177 1003 003201 1004 003205 1009 003206 1010 003216 1011 003224 1012 003226 1014 003227 1017 003235 1018 003240 1020 003241 1024 003251 1025 003254 1028 003260 1031 003262 1033 003265 1034 003270 1035 003272 1036 003274 1037 003275 1039 003276 1040 003300 1041 003302 1042 003303 1044 003304 1046 003307 1050 003311 1052 003313 1053 003315 1057 003316 1059 003320 1060 003325 1061 003330 1062 003332 1067 003333 1070 003337 1073 003341 1074 003357 1077 003360 1081 003400 1082 003406 1084 003411 1085 003415 1087 003425 1088 003427 1089 003432 1092 003435 1093 003437 1095 003456 1096 003461 1097 003503 1101 003506 1102 003515 1104 003516 1105 003520 1106 003522 1108 003527 1109 003531 1110 003533 1113 003534 1114 003536 1115 003540 1120 003541 1122 003544 1123 003547 1124 003554 1125 003556 1127 003600 1128 003602 1140 003603 1142 003611 1143 003613 1144 003614 1146 003617 1147 003621 1149 003634 1152 003636 1158 003637 1162 003647 1163 003652 1164 003654 1165 003660 1167 003661 1169 003664 1171 003665 1173 003673 168 003674 172 003675 173 003701 177 003702 180 003705 181 003706 184 003707 186 003710 187 003714 188 003717 189 003723 190 003726 191 003732 192 003744 193 003745 194 003752 195 003754 196 003761 197 003764 198 003766 200 003767 639 003770 652 003771 653 003772 654 003777 655 004010 656 004012 657 004014 659 004034 662 004057 663 004063 665 004071 666 004074 667 004100 668 004120 669 004141 670 004143 671 004144 676 004146 677 004154 678 004156 680 004160 681 004165 682 004167 684 004171 687 004212 808 004213 810 004214 811 004220 812 004230 815 004236 816 004243 817 004245 818 004254 819 004257 820 004261 821 004265 823 004272 842 004273 843 004274 847 004324 848 004331 849 004334 850 004354 851 004362 852 004364 853 004372 854 004374 855 004376 856 004403 857 004405 858 004406 1130 004407 1136 004411 ----------------------------------------------------------- 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