COMPILATION LISTING OF SEGMENT lisp_error_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/05/86 1100.0 mst Wed Options: optimize map 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 lisp_error_: proc; 7 8 /* 9* * The new lisp error handler which supports user interrupts. 10* * and uses lisp argument passing conventions instead of pl1 arguments. 11* * Contains several associated lisp functions. 12* * 13* * arguments: 14* * last two words on unmarked pdl are error code, code2 (file_system_error only) 15* * If the error takes a lisp form to be printed out, it is on 16* * the top of the marked pdl. 17* * 18* * lisp_error_ does all user interrupting and error recovery on 19* * correctable errors. 20* * 21* * Written by David Moon, 3 July 1972 22* * reorganized 28 July 72 DAM 23* * pdl ptr format changed to -#, +#, or nil. DAM 5-aug-72 24* * function names for bad_argument, bad_arg_correctable added 25 Aygust 1972 DAM 25* * err function moved here from lisp_prog_fns_, DAM 15 October 1972 26* * err_op entry added, DAM 21 Oct 72 27* * error tables moved into seperate module lisp_error_table_.alm, DAM, 7 Jan 73 28* * freturn added, 23 Jan 73 by DAM 29* * changed for new I/O system, 19 Mar 73 by DAM 30* * entry point for the lsubr 'error' added 11 May 1973 by DAM 31* * modified 73.10.25 by DAM to make evalframe smarter 32* * modified 74.06.03 by DAM for new-arrays 33* * modified 74.09.12 by DAM for cleaning up and new frame formats 34* * 35* * The data kept around by an error consists of: 36* * 37* * bits (some useful bits declared somewhere or other) 38* * stack -> 39* * temp(1) the message 40* * temp(2) the datum (NotThere if none) 41* * temp(3) the interrupt channel (atom whose value is handler, NotThere if not to interrupt) 42* * 43* * unm -> fault_save: 44* * stack_ptr = rel(stack) 45* * code1 a positive number 46* * code2 bits (unspecly) 47* */ 48 49 dcl lisp_error_table_$hbound fixed bin aligned external, /* number of err codes */ 50 lisp_error_table_$msgs aligned bit(36) external, 51 msgs (100:lisp_error_table_$hbound) char(40) aligned based(addr(lisp_error_table_$msgs)), /* messages to be typed out */ 52 msgbuf char(128) aligned automatic, /* buffer for constructed messages */ 53 lisp_error_table_$uintnum aligned bit(36) external, 54 uintnum (100:hbound(msgs,1)) fixed bin aligned based(addr(lisp_error_table_$uintnum)), /* user intr channel */ 55 lisp_error_table_$bit_tbl aligned bit(36) external, 56 bit_tbl(100:hbound(msgs,1)) bit(36) aligned based(addr(lisp_error_table_$bit_tbl)), /* action control bits */ 57 lisp_error_table_$fnames_hbound fixed bin aligned external, 58 lisp_error_table_$fnames aligned bit(36) external, 59 fnames(10:lisp_error_table_$fnames_hbound) char(16) aligned based(addr(lisp_error_table_$fnames)); /* names 60* of functions indi & ated by code2 */ 61 62 /* table of bits to control action on interrupts */ 63 64 dcl ( datf init("1"b), /* data on stack from our caller */ 65 printf init("01"b), /* s-expression is to be printed in err msg */ 66 nilconsf init("001"b), /* listify before passing to intr service routine */ 67 spbeg init("0001"b), /* special action to be taken first thing */ 68 uintf init("00001"b), /* cause user interrupt on channel uintnum(code) */ 69 evalf init("000001"b), /* evaluate value returned by intr service function */ 70 spint init("0000001"b), /* special action to be taken before giving interrupt */ 71 spfin init("00000001"b), /* special action to be taken after interrupt */ 72 fserr init("000000001"b), /* message comes from file system rather than msgs(code) */ 73 74 err_recf init("0000000001"b), /* fault_save frame is created _b_e_f_o_r_e calling lisp_error_ */ 75 sptrapf init("00000000001"b), /* *rset-trap or errset trap */ 76 fnamef init("000000000001"b) /* code2 designates function name to be given */ 77 ) bit(36) aligned static, 78 79 bits bit(36) aligned automatic, /* buffer in which the above bits are held */ 80 81 82 err_fcn_f bit(1) aligned init("0"b), 83 errsw bit(1), /* errprint / errframe entry switch */ 84 bfb fixed bin (35) aligned based, 85 stack ptr, 86 error_data ptr, 87 argument_pointer pointer, 88 evals_stack ptr, 89 unm ptr, 90 code fixed bin, 91 code2 fixed bin, /* 2nd code, at present used only by file_system_error */ 92 myname fixed bin, /* this is the other use for code2, fcn name codes. */ 93 com_err_ ext entry options(variable), 94 ioa_ ext entry options(variable), 95 1 label_overlay aligned based, 96 2 label_ptr_1 aligned ptr, 97 2 label_ptr_2 aligned ptr, 98 dummy_aligned aligned fixed bin(35) based, 99 (null, addr, addrel, fixed, bit, ptr, rel, size, min, length, 100 divide, reverse, verify, lbound, hbound, unspec, substr) builtin, 101 lisp_fault_handler_$nointerrupt entry, 102 lisp_reader_$maknam entry, 103 lisp_prog_fns_$lisp_unwinder entry, 104 lisp_$freturn_real external, 105 106 1 label aligned automatic, 107 2 adr pointer, 108 2 sp pointer, 109 label0 label aligned based(addr(label)), 110 111 lisp_prog_fns_$lisp_err entry (bit(1) aligned), 112 unm2 ptr, 113 posf bit(1), /* "1"b if a + pdl ptr was used, "0"b if - */ 114 loc bit(18) aligned, 115 dbl_word fixed bin(71), 116 (i, nargs, uint_ch_num_spec) fixed bin; 117 118 dcl 1 call1_cruft aligned based, /* pushed on marked pdl by funcall and the call1 operator */ 119 2 form fixed bin(71), 120 2 fcn fixed bin(71), 121 2 argl structure, 122 3 arg_rel_ptr bit(18) unaligned, 123 3 uncollectable_bits bit(18) unaligned, 124 3 number_of_args fixed bin(17) unaligned, 125 3 number_of_args_times_minus_two fixed bin(17) unaligned, 126 2 plist fixed bin(71); 127 128 dcl uncollectable_tag bit(18) static init("000110000000000000"b), 129 apply_frame_bit bit(18) static init("000000000000000001"b), 130 marked_stack_frame pointer; /* -> stuff pushed on as part of eval frame (see pdlframe:) */ 131 132 dcl 1 loc_ovly aligned based(addr(loc)), /* so that we can add 1 to loc */ 133 2 locfb fixed bin(17) unaligned, 134 2 extrabits bit(18) unal; 135 136 dcl lisp_special_fns_$cons ext entry, 137 lisp_special_fns_$xcons entry, 138 lisp_special_fns_$ncons entry, 139 lisp_alloc_ ext entry (fixed bin, fixed bin(71) aligned), 140 lisp_static_vars_$readeof_atom fixed bin(71) external, 141 lisp_static_vars_$infile fixed bin(71) external, 142 infile fixed bin(71) def (lisp_static_vars_$infile), 143 lisp_static_vars_$outfiles fixed bin(71) external, 144 outfiles fixed bin(71) def (lisp_static_vars_$outfiles), 145 lisp_static_vars_$errlist external pointer, 146 lisp_get_atom_ ext entry(char(*) aligned, fixed bin(71) aligned), 147 lisp_$apply ext entry, 148 lisp_$eval ext entry; 149 150 dcl lisp_print_$type_nl entry, 151 lisp_print_$type_string entry(char(*)), 152 ioa_$rsnpnnl ext entry options(variable), 153 retlen fixed bin, 154 msgbufb char(retlen) aligned based(addr(msgbuf)), /* get significant portion of msgbuf */ 155 convert_status_code_ ext entry(fixed bin, char(8) aligned) returns (char(100) aligned); 156 157 dcl lisp_static_vars_$emptying_buffers fixed bin external, 158 lisp_io_control_$empty_all_buffers entry; 159 160 dcl NotThere fixed bin(71) static init(0); 161 162 dcl (lisp_static_vars_$err_atom, 163 lisp_static_vars_$eval_atom, 164 lisp_static_vars_$apply_atom, 165 lisp_static_vars_$princ_atom, 166 lisp_static_vars_$prin1_atom) fixed bin(71) external; 167 168 /* Error Codes */ 169 170 dcl (lisp_error_table_$not_pdl_ptr, 171 lisp_error_table_$stack_loss_error) fixed bin external, 172 not_pdl_ptr fixed bin defined lisp_error_table_$not_pdl_ptr, 173 stack_loss_error fixed bin defined lisp_error_table_$stack_loss_error; 174 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 */ 175 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 176 3 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 3 2* describes format of storage for lisp 3 3* character strings. 3 4* D. Reed 4/1/71 */ 3 5 3 6 dcl 1 lisp_string based aligned, 3 7 2 string_length fixed bin, 3 8 2 string char(1 refer(string_length)); 3 9 3 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 177 4 1 4 2 /* BEGIN INCLUDE FILE lisp_unmkd_pdl.incl.pl1 */ 4 3 4 4 /* which describes the format of information that gets 4 5* put on the unmarked pdl */ 4 6 4 7 dcl errcode(2) fixed bin aligned based, /* (1) is error code for lisp_error_ */ 4 8 /* (2) is file system code (if any) */ 4 9 4 10 1 frame aligned based, /* many types of frames are pushed */ 4 11 2 prev_frame bit(18) unaligned, /* rel ptr to previous frame same type, or 0 */ 4 12 2 stack_ptr bit(18) unaligned, /* rel(stack_ptr) when the frame was created */ 4 13 2 (dat1, dat2) bit(18) unaligned, /* available for any lawful purpose */ 4 14 2 ret label; /* where to return to */ 4 15 4 16 dcl nframeptrs fixed bin static init(6), /* in the following two declarations, 4 17* I used 6 where I meant nframeptrs because of compiler bug */ 4 18 lisp_static_vars_$frame_ptrs (0:6) ptr ext static, 4 19 frame_ptrs (0 : 6) pointer defined (lisp_static_vars_$frame_ptrs); /* prog_frame, err_frame, etc. */ 4 20 4 21 4 22 /* END INCLUDE FILE lisp_unmkd_pdl.incl.pl1 */ 4 23 178 5 1 /* lisp number format -- overlaid on standard its pointer. */ 5 2 5 3 5 4 dcl 1 fixnum_fmt based aligned, 5 5 2 type_info bit(36) aligned, 5 6 2 fixedb fixed bin, 5 7 5 8 1 flonum_fmt based aligned, 5 9 2 type_info bit(36) aligned, 5 10 2 floatb float bin, 5 11 5 12 fixnum_type bit(36) aligned static init("000000000000000000000100000000100111"b), 5 13 flonum_type bit(36) aligned static init("000000000000000000000010000000100111"b); 5 14 5 15 /* end of lisp number format */ 5 16 179 6 1 /* Include file lisp_atom_fmt.incl.pl1; 6 2* describes internal format of atoms in the lisp system 6 3* D.Reed 4/1/71 */ 6 4 6 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 6 6 2 value fixed bin(71), /* atom's value */ 6 7 2 plist fixed bin(71), /* property list */ 6 8 2 pnamel fixed bin, /* length of print name */ 6 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 6 10 6 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 6 12 2 value ptr, 6 13 2 plist ptr, 6 14 6 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 6 16 2 value bit(72), 6 17 2 plist bit(72); 6 18 6 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 180 7 1 7 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 7 3 7 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 7 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 7 6* are used so that the name of the function which is rejecting its argument 7 7* can be printed. Please note that all these codes are negative. */ 7 8 7 9 dcl ( 7 10 fn_do init (-10), 7 11 fn_arg init (-11), 7 12 fn_setarg init (-12), 7 13 fn_status init (-13), 7 14 fn_sstatus init (-14), 7 15 fn_errprint init (-15), 7 16 fn_errframe init (-16), 7 17 fn_evalframe init (-17), 7 18 fn_defaultf init (-18), 7 19 fn_tyo init (-22), 7 20 fn_ascii init (-23), 7 21 fn_rplaca init (-24), 7 22 fn_definedp init (-25), 7 23 fn_setq init (-26), 7 24 fn_set init (-27), 7 25 fn_delete init (-28), 7 26 fn_delq init (-29), 7 27 fn_stringlength init (-30), 7 28 fn_catenate init (-31), 7 29 fn_array init (-32), 7 30 fn_substr init (-33), 7 31 fn_index init (-34), 7 32 fn_get_pname init (-35), 7 33 fn_make_atom init (-36), 7 34 fn_ItoC init (-37), 7 35 fn_CtoI init (-38), 7 36 fn_defsubr init (-39), 7 37 fn_star_array init (-40), 7 38 fn_args init (-41), 7 39 fn_sysp init (-42), 7 40 fn_get init (-43), 7 41 fn_getl init (-44), 7 42 fn_putprop init (-45), 7 43 fn_remprop init (-46), 7 44 fn_save init (-47), 7 45 fn_add1 init (-48), 7 46 fn_sub1 init (-49), 7 47 fn_greaterp init (-50), 7 48 fn_lessp init (-51), 7 49 fn_minus init (-52), 7 50 fn_plus init (-53), 7 51 fn_times init (-54), 7 52 fn_difference init (-55), 7 53 fn_quotient init (-56), 7 54 fn_abs init (-57), 7 55 fn_expt init (-58), 7 56 fn_boole init (-59), 7 57 fn_rot init (-60), 7 58 fn_lsh init (-61), 7 59 fn_signp init (-62), 7 60 fn_fix init (-63), 7 61 fn_float init (-64), 7 62 fn_remainder init (-65), 7 63 fn_max init (-66), 7 64 fn_min init (-67), 7 65 fn_add1_fix init (-68), 7 66 fn_add1_flo init (-69), 7 67 fn_sub1_fix init (-70), 7 68 fn_sub1_flo init (-71), 7 69 fn_plus_fix init (-72), 7 70 fn_plus_flo init (-73), 7 71 fn_times_fix init (-74), 7 72 fn_times_flo init (-75), 7 73 fn_diff_fix init (-76), 7 74 fn_diff_flo init (-77), 7 75 fn_quot_fix init (-78), 7 76 fn_quot_flo init (-79), 7 77 fn_eval init (-80), 7 78 fn_apply init (-81), 7 79 fn_prog init (-82), 7 80 fn_errset init (-83), 7 81 fn_catch init (-84), 7 82 fn_throw init (-85), 7 83 fn_store init (-86), 7 84 fn_defun init (-87), 7 85 fn_baktrace init (-88), 7 86 fn_bltarray init (-89), 7 87 fn_star_rearray init (-90), 7 88 fn_gensym init (-91), 7 89 fn_makunbound init (-92), 7 90 fn_boundp init (-93), 7 91 fn_star_status init (-94), 7 92 fn_star_sstatus init (-95), 7 93 fn_freturn init (-96), 7 94 fn_cos init (-97), 7 95 fn_sin init (-98), 7 96 fn_exp init (-99), 7 97 fn_log init (-100), 7 98 fn_sqrt init (-101), 7 99 fn_isqrt init (-102), 7 100 fn_atan init (-103), 7 101 fn_sleep init (-104), 7 102 fn_oddp init (-105), 7 103 fn_tyipeek init (-106), 7 104 fn_alarmclock init (-107), 7 105 fn_plusp init (-108), 7 106 fn_minusp init (-109), 7 107 fn_ls init (-110), 7 108 fn_eql init (-111), 7 109 fn_gt init (-112), 7 110 fn_alphalessp init (-113), 7 111 fn_samepnamep init (-114), 7 112 fn_getchar init (-115), 7 113 fn_opena init (-116), 7 114 fn_sxhash init (-117), 7 115 fn_gcd init (-118), 7 116 fn_allfiles init (-119), 7 117 fn_chrct init (-120), 7 118 fn_close init (-121), 7 119 fn_deletef init (-122), 7 120 fn_eoffn init (-123), 7 121 fn_filepos init (-124), 7 122 fn_inpush init (-125), 7 123 fn_linel init (-126), 7 124 fn_mergef init (-127), 7 125 fn_namelist init (-128), 7 126 fn_names init (-129), 7 127 fn_namestring init (-130), 7 128 fn_openi init (-131), 7 129 fn_openo init (-132), 7 130 fn_prin1 init (-133), 7 131 fn_princ init (-134), 7 132 fn_print init (-135), 7 133 fn_read init (-136), 7 134 fn_readch init (-137), 7 135 fn_readstring init (-138), 7 136 fn_rename init (-139), 7 137 fn_shortnamestring init (-140), 7 138 fn_tyi init (-141), 7 139 fn_setsyntax init (-142), 7 140 fn_cursorpos init (-143), 7 141 fn_force_output init (-144), 7 142 fn_clear_input init (-145), 7 143 fn_random init (-146), 7 144 fn_haulong init (-147), 7 145 fn_haipart init (-148), 7 146 fn_cline init (-149), 7 147 fn_fillarray init (-150), 7 148 fn_listarray init (-151), 7 149 fn_sort init (-152), 7 150 fn_sortcar init (-153), 7 151 fn_zerop init (-154), 7 152 fn_listify init (-155), 7 153 fn_charpos init (-156), 7 154 fn_pagel init (-157), 7 155 fn_linenum init (-158), 7 156 fn_pagenum init (-159), 7 157 fn_endpagefn init (-160), 7 158 fn_arraydims init (-161), 7 159 fn_loadarrays init (-162), 7 160 fn_dumparrays init (-163), 7 161 fn_expt_fix init (-164), 7 162 fn_expt_flo init (-165), 7 163 fn_nointerrupt init (-166), 7 164 fn_open init (-167), 7 165 fn_in init (-168), 7 166 fn_out init (-169), 7 167 fn_truename init (-170), 7 168 fn_ifix init (-171), 7 169 fn_fsc init (-172), 7 170 fn_progv init (-173), 7 171 fn_mapatoms init (-174), 7 172 fn_unwind_protect init (-175), 7 173 fn_eval_when init (-176), 7 174 fn_read_from_string init (-177), 7 175 fn_displace init (-178), 7 176 fn_nth init (-179), 7 177 fn_nthcdr init (-180), 7 178 fn_includef init (-181) 7 179 ) fixed bin static; 7 180 7 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 181 8 1 /* include file lisp_stack_fmt.incl.pl1 -- 8 2* describes the format of the pushdown list 8 3* used by the lisp evaluator and lisp subrs 8 4* for passing arguments, saving atom bindings, 8 5* and as temporaries */ 8 6 8 7 dcl 8 8 temp(10000) fixed bin(71) aligned based, 8 9 8 10 temp_ptr(10000) ptr aligned based, 8 11 1 push_down_list_ptr_types(10000) based aligned, 8 12 2 junk bit(21) unaligned, 8 13 2 temp_type bit(9) unaligned, 8 14 2 more_junk bit(42) unaligned, 8 15 8 16 1 pdl_ptr_types36(10000) based aligned, 8 17 2 temp_type36 bit(36), 8 18 2 junk bit(36), 8 19 8 20 1 binding_block aligned based, 8 21 2 top_block bit(18) unaligned, 8 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 8 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 8 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 8 25 8 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 8 27 2 old_val fixed bin(71) aligned, 8 28 2 atom fixed bin(71) aligned; 8 29 8 30 8 31 8 32 /* end include file lisp_stack_fmt.incl.pl1 */ 182 9 1 /* Include file lisp_ptr_fmt.incl.pl1; 9 2* describes the format of lisp pointers as 9 3* a bit string overlay on the double word ITS pair 9 4* which allows lisp to access some unused bits in 9 5* the standard ITS pointer format. It should be noted that 9 6* this is somewhat of a kludge, since 9 7* it is quite machine dependent. However, to store type 9 8* fields in the pointer, saves 2 words in each cons, 9 9* plus some efficiency problems. 9 10* 9 11* D.Reed 4/1/71 */ 9 12 /* modified to move type field to other half of ptr */ 9 13 /* D.Reed 5/31/72 */ 9 14 9 15 9 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 9 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 9 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 9 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 9 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 9 21 2 type bit(9) unaligned, /* type field */ 9 22 2 itsmod bit(6) unaligned, 9 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 9 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 9 25 9 26 /* manifest constant strings for testing above type field */ 9 27 9 28 ( 9 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 9 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 9 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 9 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 9 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 9 34 Bignum init("000001000"b), /* a multiple-precision number */ 9 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 9 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 9 37* means a special internal uncollectable weird object */ 9 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 9 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 9 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 9 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 9 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 9 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 9 44 ) bit(9) static, 9 45 9 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 9 47 9 48 9 49 ( 9 50 Cons36 init("000000000000000000000000000000"b), 9 51 Fixed36 init("000000000000000000000100000000"b), 9 52 Float36 init("000000000000000000000010000000"b), 9 53 Atsym36 init("000000000000000000000001000000"b), 9 54 Atomic36 init("000000000000000000000111111100"b), 9 55 Bignum36 init("000000000000000000000000001000"b), 9 56 System_Subr36 9 57 init("000000000000000000000000000100"b), 9 58 Bigfix36 init("000000000000000000000000001000"b), 9 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 9 60 NotConsOrAtsym36 9 61 init("000000000000000000000110111111"b), 9 62 SubrNumeric36 9 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 9 64 String36 init("000000000000000000000000100000"b), 9 65 Subr36 init("000000000000000000000000010000"b), 9 66 File36 init("000000000000000000000000000001"b), 9 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 9 68 9 69 /* undefined pointer value is double word of zeros */ 9 70 9 71 Undefined bit(72) static init(""b); 9 72 9 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 183 10 1 /* Include file lisp_common_vars.incl.pl1; 10 2* describes the external static variables which may be referenced 10 3* by lisp routines. 10 4* D. Reed 4/1/71 */ 10 5 10 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 10 7 2 cclist_ptr ptr, /* pointer to list of constants kept 10 8* by compiled programs */ 10 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 10 10 10 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 10 12 err_recp ptr defined (lisp_static_vars_$err_recp), 10 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 10 14 lisp_static_vars_$eval_frame ptr ext static, 10 15 lisp_static_vars_$prog_frame ptr ext aligned, 10 16 lisp_static_vars_$err_frame ptr ext aligned, 10 17 lisp_static_vars_$catch_frame ptr ext aligned, 10 18 lisp_static_vars_$unwp_frame ptr ext aligned, 10 19 lisp_static_vars_$stack_ptr ptr ext aligned, 10 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 10 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 10 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 10 23 lisp_static_vars_$binding_top ptr ext aligned, 10 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 10 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 10 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 10 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 10 28 binding_top ptr defined (lisp_static_vars_$binding_top), 10 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 10 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 10 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 10 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 10 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 10 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 10 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 10 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 10 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 10 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 10 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 10 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 10 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 10 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 10 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 10 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 10 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 10 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 10 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 10 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 10 49 10 50 10 51 /* end include file lisp_common_vars.incl.pl1 */ 184 11 1 /* INCLUDE FILE lisp_io.incl.pl1 */ 11 2 11 3 /* data structures used by the lisp i/o system */ 11 4 12 1 /* BEGIN INCLUDE FILE lisp_iochan.incl.pl1 */ 12 2 12 3 /* This include file describes the format of the 'iochan' block, 12 4* which is used to implement lisp file-objects. The iochan 12 5* is the central data base of the i/o system. When open 12 6* is used, an iochan is created in lisp static storage. 12 7* When the lisp environment is booted, 2 iochans for input and 12 8* output on the tty are created. Iochans are saved and restored 12 9* by the save mechanism */ 12 10 12 11 /* open i/o channel information */ 12 12 12 13 dcl 1 iochan based aligned, /* format of a file object */ 12 14 2 ioindex fixed bin(24), /* 0-origin character position in block */ 12 15 2 iolength fixed bin(24), /* size of block in chars - actual(in), max(out) */ 12 16 2 ioptr pointer, /* -> block */ 12 17 2 thread pointer, /* list of all iochans open; from lisp_static_vars_$iochan_list */ 12 18 2 fcbp pointer, /* for tssi_ */ 12 19 2 aclinfop pointer, /* .. */ 12 20 2 component fixed bin, /* .. */ 12 21 2 charpos fixed bin, /* 0-origin horizontal position on line */ 12 22 2 linel fixed bin, /* (out) line length, 0 => oo */ 12 23 2 flags unaligned, 12 24 3 seg bit(1), /* 1 => msf, 0 => stream */ 12 25 3 read bit(1), /* 0 => openi, 1 => not */ 12 26 3 write bit(1), /* 0 => openo, 1 => not */ 12 27 3 gc_mark bit(1), /* for use by the garbage collector */ 12 28 3 interactive bit(1), /* 1 => input => this is the tty 12 29* output => flush buff after each op */ 12 30 3 must_reopen bit(1), /* 1 => has been saved and not reopend yet */ 12 31 3 nlsync bit(1), /* 1 => there is a NL in the buffer (output streams only) */ 12 32 3 charmode bit(1), /* enables instant ios_$write */ 12 33 3 extra_nl_done bit(1), /* 1 => last char output was extra NL for chrct */ 12 34 3 fixnum_mode bit(1), /* to be used with in and out functions */ 12 35 3 image_mode bit(1), /* just suppresses auto-cr */ 12 36 3 not_yet_used bit(25), 12 37 2 function fixed bin(71), /* EOF function (input), or endpagefn (output) <<< gc-able >>> */ 12 38 2 namelist fixed bin(71), /* list of names, car is directory pathname <<< gc-able >>> */ 12 39 2 name char(32) unaligned, /* stream name or entry name */ 12 40 2 pagel fixed bin, /* number of lines per page */ 12 41 2 linenum fixed bin, /* current line number, starting from 0 */ 12 42 2 pagenum fixed bin, /* current page number, starting from 0 */ 12 43 12 44 flag_reset_mask bit(36) aligned static init( /* anded into flags with each char */ 12 45 "111011110111111111"b); 12 46 12 47 /* END INCLUDE FILE lisp_iochan.incl.pl1 */ 11 5 11 6 11 7 /* masks for checking iochan.flags, seeing if lisp_io_control_$fix_not_ok_iochan should be called */ 11 8 11 9 dcl not_ok_to_read bit(36) static init("0100010001"b), /* mask for checking iochan.flags on input */ 11 10 not_ok_to_write bit(36) static init("0010010001"b);/* mask for checking iochan.flags on output */ 11 11 dcl not_ok_to_read_fixnum bit(36) static init("0100010000"b), 11 12 not_ok_to_write_fixnum bit(36) static init("0010010000"b); 11 13 11 14 11 15 /* miscellaneous global, static variables and atoms used by the I/O system */ 11 16 11 17 dcl lisp_static_vars_$read_print_nl_sync bit(36) ext, 11 18 read_print_nl_sync bit(36) defined (lisp_static_vars_$read_print_nl_sync), 11 19 lisp_static_vars_$ibase ext fixed bin(71), 11 20 ibase fixed bin(71) defined (lisp_static_vars_$ibase), 11 21 11 22 lisp_static_vars_$quote_atom ext fixed bin (71), 11 23 quote_atom fixed bin(71) defined (lisp_static_vars_$quote_atom), 11 24 11 25 lisp_static_vars_$base ext fixed bin(71), 11 26 base fixed bin(71) defined ( lisp_static_vars_$base), 11 27 11 28 lisp_static_vars_$stnopoint ext fixed bin(71), 11 29 stnopoint fixed bin(71) defined (lisp_static_vars_$stnopoint), 11 30 11 31 lisp_static_vars_$tty_atom ext fixed bin(71), 11 32 tty_atom fixed bin(71) defined (lisp_static_vars_$tty_atom), 11 33 lisp_static_vars_$status_gctwa ext fixed bin(71), 11 34 status_gctwa fixed bin(71) defined (lisp_static_vars_$status_gctwa), 11 35 11 36 lisp_static_vars_$s_atom ext fixed bin(71), 11 37 s_atom fixed bin(71) defined (lisp_static_vars_$s_atom), 11 38 11 39 lisp_static_vars_$readtable ext fixed bin(71), 11 40 readtable fixed bin(71) defined (lisp_static_vars_$readtable), 11 41 11 42 lisp_static_vars_$plus_status ext fixed bin(71), 11 43 plus_status fixed bin(71) defined (lisp_static_vars_$plus_status); 11 44 13 1 /* BEGIN INCLUDE FILE lisp_control_chars.incl.pl1 */ 13 2 13 3 /* Last modified D. Reed 6/29/72 */ 13 4 13 5 dcl lisp_static_vars_$ctrlD ext fixed bin(71), 13 6 ctrlD fixed bin(71) defined (lisp_static_vars_$ctrlD); 13 7 13 8 dcl lisp_static_vars_$ctrlQ ext fixed bin(71), 13 9 ctrlQ fixed bin(71) defined (lisp_static_vars_$ctrlQ); 13 10 13 11 dcl lisp_static_vars_$ctrlR ext fixed bin(71), 13 12 ctrlR fixed bin(71) defined (lisp_static_vars_$ctrlR); 13 13 13 14 dcl lisp_static_vars_$ctrlW ext fixed bin(71), 13 15 ctrlW fixed bin(71) defined (lisp_static_vars_$ctrlW); 13 16 13 17 /* END INCLUDE FILE lisp_control_chars.incl.pl1 */ 13 18 11 45 11 46 /* END INCLUDE FILE lisp_io.incl.pl1 */ 11 47 185 /* for ctrlW */ 14 1 /* Include file lisp_cons_fmt.incl.pl1; 14 2* defines the format for a cons within the lisp system 14 3* D.Reed 4/1/71 */ 14 4 14 5 dcl consptr ptr, 14 6 1 cons aligned based (consptr), /* structure defining format for cons */ 14 7 2 car fixed bin(71), 14 8 2 cdr fixed bin(71), 14 9 14 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 14 11 2 car ptr, 14 12 2 cdr ptr, 14 13 14 14 14 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 14 16 2 padding bit(21) unaligned, 14 17 2 car bit(9) unaligned, 14 18 2 padding2 bit(63) unaligned, 14 19 2 cdr bit(9) unaligned, 14 20 2 padend bit(42) unaligned; 14 21 14 22 dcl 1 cons_types36 aligned based, 14 23 2 car bit(36), 14 24 2 pada bit(36), 14 25 2 cdr bit(36), 14 26 2 padd bit(36); 14 27 14 28 14 29 /* end include file lisp_cons_fmt.incl.pl1 */ 186 15 1 /* lisp stack header format */ 15 2 /* Last modified 7/21/72 by Reed for in_pl1 flag */ 15 3 /* Modified 1978 by Greenberg for unwind-protect ops */ 15 4 15 5 declare 15 6 15 7 1 stack_seg based aligned, /* stored in base of unmkd_pdl segment */ 15 8 2 marked_stack_bottom ptr, /* where marked stack begins... */ 15 9 2 unmkd_stack_bottom ptr, /* where unmkd_ stack actually starts */ 15 10 2 stack_ptr_ptr ptr, /* points at lisp_static_vars_$stack_ptr */ 15 11 2 unmkd_ptr_ptr ptr, /* points at lisp_static_vars_$unmkd_ptr's offset word */ 15 12 2 array_pointer ptr, /* obsolete */ 15 13 2 nil fixed bin(71), /* object for nil */ 15 14 2 true fixed bin(71), /* object for t */ 15 15 2 in_pl1_code bit(36), /* flag indicating that we are in pl1 code if non-zero */ 15 16 2 padding0 bit(36), /* double word boundary preservation */ 15 17 2 bind_op ptr, /* pointers to operators for run-time support */ 15 18 2 unbind_op ptr, 15 19 2 errset1_op ptr, 15 20 2 errset2_op ptr, 15 21 2 unerrset_op ptr, 15 22 2 call_op ptr, 15 23 2 catch1_op ptr, 15 24 2 catch2_op ptr, 15 25 2 uncatch_op ptr, 15 26 2 gensym_data (2) bit(36) aligned, /* stuff used by the gensym function */ 15 27 2 system_lp ptr, /* pointer to the system's linkage section */ 15 28 2 iogbind_op ptr, 15 29 2 unseen_go_tag_op ptr, 15 30 2 throw1_op ptr, 15 31 2 throw2_op ptr, 15 32 2 signp_op ptr, 15 33 2 type_fields bit(72) aligned, /* fixnum, flonum type for compiled code */ 15 34 2 return_op ptr, 15 35 2 err_op ptr, 15 36 2 pl1_interface ptr, /* pointer to pl1 interface for type 2 subrs. */ 15 37 2 pl1_lsubr_interface ptr, /* same for type -2 subrs */ 15 38 2 cons_opr ptr, /* cons operator */ 15 39 2 ncons_opr ptr, /* ncons operator */ 15 40 2 xcons_opr ptr, /* xcons operator */ 15 41 2 begin_list_opr ptr, /* operator to make initial cell of list */ 15 42 2 append_list_opr ptr, /* operator to append to last-made cell of list */ 15 43 2 terminate_list_opr ptr, /* opeator to append last cell to next to last cell of list */ 15 44 2 compare_op ptr, /* fixnum/flonum comparison operator */ 15 45 2 link_op ptr, 15 46 2 array_operator pointer, /* accessing operator, invoked by arrays */ 15 47 2 dead_array_operator pointer, /* dead arrays invoke this operator instead */ 15 48 2 store_operator pointer, /* operator to do compiled store */ 15 49 2 floating_store_operator pointer, /* ditto, but operand is in EAQ */ 15 50 2 array_info_for_store pointer, /* -> array_info block of last array referenced */ 15 51 2 array_offset_for_store fixed bin(18), /* offset in array_data block of last array element referenced */ 15 52 2 padding bit(36), 15 53 2 array_link_snap_opr pointer, 15 54 2 create_string_desc_op ptr, 15 55 2 create_array_desc_op ptr, 15 56 2 pl1_call_op ptr, 15 57 2 cons_string_op ptr, 15 58 2 create_varying_string_op ptr, 15 59 2 unwp1_op ptr, 15 60 2 unwp2_op ptr, 15 61 2 ununwp_op ptr, 15 62 2 irest_return_op ptr, 15 63 2 pl1_call_nopop_op ptr, 15 64 2 rcv_char_star_op ptr, 15 65 2 spare2 (7) ptr, 15 66 2 begin_unmkd_stack(16325) fixed bin(71); /* rest of segment is the unmarked pdl */ 15 67 15 68 dcl call_array_operator bit(36) static init("100112273120"b3), /* tspbb ab|112,* */ 15 69 call_dead_array_operator bit(36) static init("100114273120"b3); /* tspbb ab|114,* */ 15 70 15 71 /* end stack segment format */ 187 188 189 190 /*lisp_error_: entry; */ 191 192 dcl (lisp_static_vars_$go_atom, 193 lisp_static_vars_$return_atom, 194 lisp_static_vars_$setq_atom) external fixed bin(71) aligned, 195 setq_atom fixed bin(71) aligned defined(lisp_static_vars_$setq_atom), 196 go_atom fixed bin(71) aligned defined (lisp_static_vars_$go_atom), 197 return_atom fixed bin(71) aligned defined (lisp_static_vars_$return_atom); 198 199 200 /* set up pointers to stack */ 201 202 stack = stack_ptr; 203 unm = addrel(unmkd_ptr, -2); /* points to error code */ 204 code = unm -> errcode(1); /* pick up error code from unmarked pdl */ 205 code2 = unm -> errcode(2); /* get 2nd code in case file_system_error */ 206 if code < lbound(msgs, 1) | code > hbound(msgs, 1) then do; 207 call ioa_("lisp_error_: undefined code ^d.", code); 208 go to unwind; 209 end; 210 211 bits = bit_tbl(code); /* pick up controlling bits */ 212 if ^ bits & datf then do; 213 stack_ptr = addr(stack -> temp(2)); 214 stack -> temp(1) = NotThere; 215 end; 216 else stack = addrel(stack, -2); /* -> data on pdl */ 217 218 stack_ptr = addr(stack -> temp(4)); 219 stack -> temp(2) = stack -> temp(1); /* get the data */ 220 221 /* get the message into lispish form */ 222 223 if bits & fserr then call ioa_$rsnpnnl("lisp: ^a ", 224 msgbuf, retlen, convert_status_code_(code2,"")); 225 else if bits & fnamef then do; 226 code2 = - code2; 227 if code2 < lbound(fnames,1) then code2 = hbound(fnames,1); 228 else if code2 > hbound(fnames,1) then code2 = hbound(fnames,1); 229 call ioa_$rsnpnnl(substr(msgs(code), 1, index(msgs(code), "`")-1), /* control string so fcn name can be inserted */ 230 msgbuf, retlen, fnames(code2)); 231 code2 = -code2; 232 end; 233 else call ioa_$rsnpnnl("lisp: ^a ", msgbuf, retlen, (msgs(code)) ); 234 call lisp_alloc_(divide(retlen+7,4,18,0), stack -> temp(1)); 235 stack -> temp_type(1) = String; 236 stack -> temp_ptr(1) -> lisp_string.string_length = retlen; 237 stack -> temp_ptr(1) -> lisp_string.string = msgbuf; 238 239 /* get the interrupt channel */ 240 241 if ^bits & uintf then stack -> temp(3) = NotThere; /* none such */ 242 else do; 243 addr(stack -> temp(3)) -> fixnum_fmt.type_info = fixnum_type; 244 addr(stack -> temp(3)) -> fixedb = uintnum(code); 245 end; 246 247 if bits & spbeg then go to spbegtv(code); /* do special action */ 248 spbegxx: /* ... and return here */ 249 250 go to handle_error; 251 252 /* the LISP lsubr 'error', which makes the error system extensible. */ 253 254 error: entry; 255 256 stack = addrel(stack_ptr, -2); 257 nargs = stack -> fixedb; /* lsubr */ 258 if nargs = 0 then do; /* with no args, is like (err) */ 259 stack -> temp(1) = nil; 260 err_fcn_f = "1"b; 261 go to unwind; /* like err_aa */ 262 end; 263 stack = addrel(stack, nargs); 264 stack_ptr = addr(stack -> temp(4)); /* change missing args to NotThere */ 265 if nargs > -6 then stack -> temp(3) = NotThere; 266 if nargs > -4 then stack -> temp(2) = NotThere; 267 bits = ""b; 268 code = 1; 269 unm = unmkd_ptr; 270 271 handle_error: /* All types of errors join in here */ 272 273 /* canonicalize the interrupt handler */ 274 275 if addr(stack -> temp(3)) -> fixnum_fmt.type_info = fixnum_type then do; 276 uint_ch_num_spec = addr(stack -> temp(3)) -> fixedb; 277 if uint_ch_num_spec >= 0 & 278 uint_ch_num_spec < hbound(user_intr_array, 1) + 1 279 then stack -> temp(3) = user_intr_array(uint_ch_num_spec); 280 else stack -> temp(3) = NotThere; 281 end; 282 else if stack -> temp_type36(3) & Atsym36 /* uint chn spec as atom */ 283 then do; 284 if stack -> temp(3) ^= nil then /* unused channel marker */ 285 do uint_ch_num_spec = 0 to hbound(user_intr_array, 1); 286 if user_intr_array(uint_ch_num_spec) = stack -> temp(3) 287 then go to exitloop; 288 end; 289 stack -> temp(3) = NotThere; /* bad uint chn */ 290 exitloop: end; 291 else stack -> temp(3) = NotThere; /* bad uint chn */ 292 293 /* do JONL's ncons hack on channels 5, 6, 7, and 8 */ 294 295 do uint_ch_num_spec = 5 to 8; 296 if stack -> temp(3) = user_intr_array(uint_ch_num_spec) 297 then bits = bits | nilconsf; 298 end; 299 300 /* flush all output buffers */ 301 302 lisp_static_vars_$emptying_buffers = lisp_static_vars_$emptying_buffers + 1; 303 if lisp_static_vars_$emptying_buffers = 0 then call lisp_io_control_$empty_all_buffers; 304 lisp_static_vars_$emptying_buffers = lisp_static_vars_$emptying_buffers - 1; 305 306 /* Check for user interrupt action to be performed */ 307 308 if stack -> temp(3) ^= NotThere then if rel(err_frame) then 309 if addr(user_intr_array(4)) -> based_ptr -> atom.value ^= nil then go to user_interrupter; else; 310 else go to user_interrupter; 311 312 313 uintdis: /* come here when user interrupt is disabled */ 314 315 if code = stack_loss_error then go to user_interrupter; /* in this case, always interrupt */ 316 317 uintdis0: 318 /* check if errset (...) nil has suppressed error messages */ 319 320 if rel(err_frame) then if err_frame -> frame.dat1 then go to unwind; /* yes, skip msg */ 321 322 /* no, print the error message */ 323 324 call prmes_immediate; 325 326 327 /* non user interrupt or suppressed by errset, just unwind the pdl */ 328 329 unwind: /* check for the need to do a *rset-trap */ 330 331 if rel(err_frame) = ""b then /* going to go all the way, take a *rset-trap first */ 332 if addr(user_intr_array(19)) -> based_ptr -> atom.value = nil then; /* disabled */ 333 else do; 334 i = 19; 335 uuint: stack_ptr = addr(stack -> temp(6)); 336 bits = bits | sptrapf; 337 stack -> temp(4) = user_intr_array(i); 338 stack -> temp(5) = nil; /* call service fcn with no args */ 339 go to uint0; 340 end; 341 342 else do; /* caught be errset, take user intr 4 */ 343 if addr(user_intr_array(4)) -> based_ptr -> atom.value = nil then; /* disabled */ 344 else do; 345 i = 4; 346 go to uuint; 347 end; 348 end; 349 350 unwind1: stack_ptr = addr(stack -> temp(2)); 351 call lisp_prog_fns_$lisp_err(err_fcn_f); /* never returns */ 352 353 /* Routine to do user interrupts */ 354 355 user_interrupter: 356 357 stack_ptr = addr(stack -> temp(6)); 358 stack -> temp(5) = stack -> temp(2); /* make copy of losing form */ 359 if spint & bits then go to spinttv(code); /* if special action needed */ 360 spintxx: 361 if bits & nilconsf then do; 362 stack_ptr = addr(stack -> temp(7)); 363 stack -> temp(6) = nil; 364 call lisp_special_fns_$cons; 365 end; 366 stack -> temp(4) = stack -> temp(3); /* pick up interrupt handler */ 367 go to uint0; 368 369 fs_err_com: 370 call lisp_special_fns_$cons; 371 go to spbegxx; 372 373 374 375 /* for nihil_ex_nihile fail-act, make the list (setq (nil)) 376* as arg to the interrupt service function */ 377 378 spinttv(128): 379 stack_ptr = addr(stack -> temp(8)); 380 stack -> temp(6), stack -> temp(7) = nil; /* make (nil) */ 381 call lisp_special_fns_$cons; 382 stack_ptr = addr(stack -> temp(8)); 383 stack -> temp(7) = nil; /* and listify it with setq */ 384 stack -> temp(5) = setq_atom; 385 call lisp_special_fns_$cons; 386 call lisp_special_fns_$cons; 387 go to spintxx; 388 389 390 spinttv(121): /* bad_prog_op, construct list (go return) */ 391 stack_ptr = addr(stack -> temp(8)); 392 stack -> temp(7) = nil; 393 stack -> temp(6) = lisp_static_vars_$return_atom; 394 stack -> temp(5) = lisp_static_vars_$go_atom; 395 call lisp_special_fns_$cons; 396 call lisp_special_fns_$cons; 397 go to spintxx; 398 399 spinttv(124): /* bad ibase, construct list (ibase) */ 400 stack -> temp(5) = lisp_static_vars_$ibase; 401 go to spintxx; /* let nilconsf listify it */ 402 403 spinttv(125): /* bad base, construct list (base) */ 404 stack -> temp(5) = lisp_static_vars_$base; 405 go to spintxx; /* and let nilcons listify it */ 406 407 408 spinttv(145): /* eof_in_object : args -<- '(read-eof) */ 409 stack -> temp(5) = lisp_static_vars_$readeof_atom; 410 go to spintxx; /* and let nilconsf listify it */ 411 412 413 414 spbegtv(124): /* bad ibase -- reset it to 8 */ 415 addr(ibase)->based_ptr -> fixnum_fmt.type_info = fixnum_type; 416 addr(ibase)->based_ptr -> fixedb = 8; 417 go to spbegxx; 418 419 spbegtv(125): /* bad base -- reset it to 8 */ 420 addr(base)->based_ptr -> fixnum_fmt.type_info = fixnum_type; 421 addr(base)->based_ptr -> fixedb = 8; 422 go to spbegxx; 423 424 425 426 uint0: unm = unmkd_ptr; 427 428 /* make a fault_save frame for this error, unless one is already there */ 429 430 if ^ bits & err_recf then do; 431 unmkd_ptr = addrel(unm, size(fault_save)); 432 fault_save.prev_frame = rel(err_recp); 433 fault_save.stack_ptr = rel(stack); 434 fault_save.sv_gc_inhibit = gc_inhibit; 435 fault_save.sv_masked = masked; 436 fault_save.code1 = code; 437 unspec(fault_save.code2) = bits; 438 unspec(fault_save.sv_array_info) = unspec(ptr(unm, ""b) -> stack_seg.array_info_for_store); 439 fault_save.sv_array_offset = ptr(unm, ""b) -> stack_seg.array_offset_for_store; 440 fault_save.sv_rdr_state = rdr_state; 441 fault_save.sv_rdr_ptr = rdr_ptr; 442 fault_save.sv_rdr_label = rdr_label; 443 err_recp = unm; 444 445 rdr_state = 0; /* reset rdr to normal */ 446 /* leave gc_inhibit the same */ 447 end; 448 449 450 /* now call the user interrupt service function */ 451 452 uint1: stack_ptr = addr(stack -> temp(6)); /* shouldn't be needed, but... */ 453 call lisp_special_fns_$ncons; /* make arg list */ 454 stack -> temp(4) = stack -> temp_ptr(4) -> atom.value; 455 if stack -> temp(4) = nil then go to uintdis0; /* disabled...no intr */ 456 call lisp_$apply; /* apply fcn to args */ 457 458 /* special kludge for pdl-overflow - ignore returned value and go on. */ 459 460 if user_intr_array(12) = stack -> temp(3) then go to popoff; 461 462 /* error recovery code - if returned value is not a list, don't recover but error out */ 463 464 if bits & sptrapf then go to unwind1; 465 if stack -> temp_type(4) then do; /* if returned value is not a list. */ 466 /* NB - nil is now an atomic symbol, not a list */ 467 stack_ptr = addr(stack -> temp(2)); 468 go to unwind; /* don't print dumb err msg twice. */ 469 end; 470 471 if bits & spfin then go to spfintv(code); 472 stack -> temp(1) = stack -> temp_ptr(4) -> cons.car; /* service function returns list */ 473 stack_ptr = addr(stack -> temp(2)); 474 if bits & evalf then call lisp_$eval; /* ... if returned result is to be evaluated */ 475 476 477 /* Since we have recovered from the error and are not going to unwind ... */ 478 /* Now pop the err_record off of the unmarked pdl... */ 479 480 if ^ bits & err_recf then /* ...but only if we made one */ 481 do; 482 unspec(ptr(unm, ""b) -> stack_seg.array_info_for_store) = unspec(fault_save.sv_array_info); 483 ptr(unm, ""b) -> stack_seg.array_offset_for_store = fault_save.sv_array_offset; 484 rdr_state = fault_save.sv_rdr_state; 485 rdr_ptr = fault_save.sv_rdr_ptr; 486 rdr_label = fault_save.sv_rdr_label; 487 gc_inhibit = fault_save.sv_gc_inhibit; 488 489 /* restore masked state */ 490 491 stack_ptr = addr(stack -> temp(3)); 492 if fault_save.sv_masked.against.alarm then stack -> temp(2) = t_atom; 493 else if fault_save.sv_masked.against.tty then stack -> temp(2) = tty_atom; 494 else stack -> temp(2) = nil; 495 call lisp_fault_handler_$nointerrupt; 496 497 err_recp = ptr(err_recp, fault_save.prev_frame); 498 end; 499 popoff: unmkd_ptr = addrel(unm, -2); /* popoff the frame and the error code */ 500 501 stack_ptr = addr(stack -> temp(2)); 502 return; /* return a value to our caller, who will correct the error */ 503 504 505 506 507 /* special recovery from correctable error routines */ 508 509 /* interrupts which cannot be corrected */ 510 spfintv(121): /* bad prog op */ 511 spfintv(122): /* bad lexpr tv */ 512 spfintv(128): 513 call lisp_print_$type_string("lisp: this fail-act is uncorrectable 514 "); 515 go to uintdis; 516 517 /* interrupts which need to clear the stack before returning */ 518 spfintv(124): 519 /* bad ibase */ 520 spfintv(125): /* bad base */ 521 spfinclrpdl: 522 if ^ bits & err_recf then err_recp = ptr(unm, unm -> frame.prev_frame); 523 unmkd_ptr = addrel(unm, -2); /* pop code too */ 524 stack_ptr = stack; 525 return; 526 527 /* err function, causes an error. Takes errset traps and *rset-traps where appropriate */ 528 529 err: entry; 530 531 stack = addrel(stack_ptr, -2); /* fsubr */ 532 if stack -> temp_type(1) then stack -> temp(1) = nil; /* no args given, use nil */ 533 else do; 534 /* an arg was given, so eval it and return it to errset. 535* but first check for a second arg, which if it is present 536* and non-nil means don't eval the first arg until after 537* unwinding back to the errset */ 538 539 if stack -> temp_ptr(1) -> cons_types.cdr then; 540 else if stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons.car = nil then; 541 else do; /* yes, 2nd arg is non - nil */ 542 if rel(err_frame) then err_frame -> frame.dat2 = "1"b; /* flag indicates that first arg 543* has not yet been evaled. */ 544 stack -> temp(1) = stack -> temp_ptr(1) -> cons.car; /* get 1st arg */ 545 go to err_aa; 546 end; 547 stack -> temp(1) = stack -> temp_ptr(1) -> cons.car; /* eval 1st arg */ 548 call lisp_$eval; 549 end; 550 551 /* at this point, stack->temp(1) contains the value to be returned to errset */ 552 553 err_aa: err_fcn_f = "1"b; 554 go to unwind; 555 556 557 err_op: entry; /* from err operator in lisp_oprs_, 558* for compiled version of err fcn */ 559 560 stack = addrel(stack_ptr, -2); 561 go to err_aa; 562 563 errprint: entry; /* the lisp errprint function */ 564 565 errsw = "0"b; 566 myname = fn_errprint; 567 568 errprint_retry: 569 stack = addrel(stack_ptr, -2); /* take one arg which is a pdl ptr */ 570 posf = "0"b; /* assume will not be a positive number */ 571 if stack -> temp(1) = nil then do; /* use most recent */ 572 loc = rel(err_recp); 573 if loc then locfb = locfb+1; /* if -> real frame, skip past it */ 574 end; 575 else if stack -> temp_type36(1) & Fixed36 then 576 if stack -> fixedb < 0 then 577 578 /* get negative pdl ptr & simulate downward search */ 579 580 loc = substr(unspec(stack->fixedb), 19, 18); 581 582 else do; 583 584 /* get positive pdl ptr & simulate upward search */ 585 586 i = - stack->fixedb; /* mumble, mumble, can't take unspec of an expression any more */ 587 loc = substr(unspec(i), 19, 18); /* change sign of pdl ptr */ 588 posf = "1"b; /* but remember + */ 589 end; 590 else do; /* not a fixed number, correctable error */ 591 errprint_bad_pdl_ptr: 592 call badpdlptr; 593 go to errprint_retry; 594 end; 595 596 /* check validity of pdl ptr - must lie in the stack */ 597 598 if loc >= rel(unmkd_ptr) then go to errprint_bad_pdl_ptr; 599 600 if loc = ""b then if posf then go to errprint0; 601 else go to errmes_not_there; 602 if loc < rel( ptr(unmkd_ptr, ""b) -> stack_seg.unmkd_stack_bottom ) 603 then go to errprint_bad_pdl_ptr; 604 605 /* search for the err_record that we want */ 606 607 errprint0: 608 unm2 = null; 609 do unm = err_recp repeat (ptr(unm, unm -> fault_save.prev_frame)) while (rel(unm)); 610 /* chase the threaded list of err_records */ 611 if rel(unm) < loc then go to errprint1; 612 if posf then if rel(unm) = loc then go to errprint1; 613 unm2 = unm; 614 end; 615 if posf then go to errprint1a; /* in case of starting from 0 */ 616 617 /* No error message was there, just return nil */ 618 619 errmes_not_there: 620 stack -> temp(1) = nil; 621 return; 622 623 errprint1: /* found a stacked up error, print message and return t */ 624 625 if posf then do; /* special hac to make it look like an upward search */ 626 errprint1a: 627 if unm2 = null then go to errmes_not_there; 628 unm = unm2; 629 end; 630 631 code = fault_save.code1; 632 if code = 0 then /* not an errprintable error, skip it */ 633 if posf then do; 634 if unm = err_recp then go to errmes_not_there; 635 loc = rel(unm); 636 do unm = err_recp repeat(ptr(unm, unm -> fault_save.prev_frame)) 637 while (unm -> fault_save.prev_frame ^= loc); 638 /* find fault_save frame just above current one */ 639 end; 640 go to errprint1; 641 end; 642 else do; 643 unm = ptr(unm, unm -> fault_save.prev_frame); 644 if rel(unm) = ""b then go to errmes_not_there; 645 go to errprint1; 646 end; 647 bits = unspec(fault_save.code2); 648 649 if errsw then go to errframe_fin; /* if entered from errframe, don't prmes */ 650 call prmes0; 651 652 stack_ptr = addr(stack -> temp(2)); 653 stack -> temp(1) = t_atom; 654 return; 655 656 prmes: proc; /* Does the actual printing of an error msg */ 657 658 /* bind ^w so that the message will be sure to go to the terminal */ 659 /* also bind ^r so that the message does n_o_t_ go to the output 660* file, since the s ser might want to read it back in */ 661 662 dcl (mkp, unmkp, spmsgp) ptr; 663 dcl esw fixed bin; 664 665 esw = 1; 666 go to bindings; 667 668 prmes_immediate: entry; /* prmes with no err frame pushed */ 669 670 esw = -1; 671 672 bindings: mkp = stack_ptr; 673 stack_ptr = addr(mkp -> temp(5)); 674 unmkp = unmkd_ptr; 675 unmkd_ptr = addrel(unmkp, 2); 676 mkp -> temp(2) = ctrlW; 677 mkp -> temp(1) = addr(ctrlW) -> based_ptr -> atom.value; 678 mkp -> temp(4) = ctrlR; 679 mkp -> temp(3) = addr(ctrlR) -> based_ptr -> atom.value; 680 unmkp -> binding_block.bot_block = rel(mkp); 681 unmkp -> binding_block.top_block = rel(stack_ptr); 682 unmkp -> binding_block.back_ptr = rel(binding_top); 683 binding_top = unmkp; 684 addr(ctrlW)->based_ptr -> atom.value = nil; 685 addr(ctrlR) -> based_ptr -> atom.value = nil; 686 if esw < 0 then do; 687 error_data = stack; 688 go to JOIN2; 689 end; 690 691 JOIN: error_data = ptr(stack, unm -> fault_save.stack_ptr); 692 693 JOIN2: spmsgp = stack_ptr; 694 stack_ptr = addr(spmsgp -> temp(3)); 695 spmsgp -> temp(2) = error_data -> temp(1); /* pick up message */ 696 spmsgp -> temp(1) = lisp_static_vars_$princ_atom; /* and apply print to it */ 697 call lisp_special_fns_$ncons; 698 call lisp_print_$type_nl; 699 call lisp_$apply; 700 701 /* If there is a losing form to be printed, do so. */ 702 703 if error_data -> temp(2) ^= NotThere then do; 704 stack_ptr = addr(spmsgp -> temp(3)); 705 spmsgp -> temp(2) = error_data -> temp(2); 706 spmsgp -> temp(1) = lisp_static_vars_$prin1_atom; 707 call lisp_special_fns_$ncons; 708 call lisp_$apply; 709 end; 710 711 /* put out a newline to end the message */ 712 713 call lisp_print_$type_nl; 714 if esw = 0 then go to rtn_3; 715 716 /* unbind ^w and ^r */ 717 718 addr(ctrlW)->based_ptr -> atom.value = mkp -> temp(1); 719 addr(ctrlR) -> based_ptr -> atom.value = mkp -> temp(3); 720 binding_top = ptr(unmkp, unmkp -> binding_block.back_ptr); 721 unmkd_ptr = unmkp; 722 stack_ptr = mkp; 723 return; 724 725 /* entry to print message without binding ^w or ^r */ 726 727 prmes0: entry; 728 729 esw = 0; 730 go to JOIN; 731 rtn_3: return; 732 end prmes; 733 734 /* the errframe function takes the same input argument as 735* errprint, but it returns the list: 736* (pdlptr (message datum intr-chan) alist) */ 737 738 errframe: entry; 739 740 myname = fn_errframe; 741 errsw = "1"b; 742 go to errprint_retry; /* join with errprint to analyze the input pdl ptr */ 743 744 /* comes back here with code, code2, bits, stack->temp(1), and unm set up */ 745 746 errframe_fin: 747 error_data = ptr(stack, unm -> fault_save.stack_ptr); 748 stack_ptr = addr(stack -> temp(6)); 749 stack -> temp(1) = lisp_static_vars_$err_atom; /* type of frame */ 750 stack -> temp(2) = error_data -> temp(1); 751 stack -> temp(3) = error_data -> temp(2); 752 if stack -> temp(3) = NotThere 753 then stack_ptr = addr(stack -> temp(4)); 754 else do; 755 stack -> temp(4) = error_data -> temp(3); 756 if stack -> temp(4) = NotThere 757 then stack_ptr = addr(stack -> temp(5)); 758 end; 759 addrel(stack_ptr, -2) -> temp(1) = nil; 760 do while(stack_ptr ^= addr(stack -> temp(3))); 761 call lisp_special_fns_$cons; 762 end; 763 764 go to return_a_frame; /* use pdlframe code to make the return list */ 765 766 /* badpdlptr is an internal error recovery proc */ 767 768 badpdlptr: proc; 769 770 unm = unmkd_ptr; 771 unmkd_ptr = addrel(unm, 2); 772 unm -> errcode(1) = not_pdl_ptr; 773 unm -> errcode(2) = myname; 774 call lisp_error_; 775 return; 776 end; 777 778 779 /* the lisp pdlframe function */ 780 /* (has been renamed evalframe) */ 781 782 pdlframe: entry; 783 784 /* declare the two names by which this function can be referenced */ 785 786 dcl lisp_static_vars_$evalframe_atom fixed bin(71) aligned external, 787 evalframe_atom fixed bin(71) aligned defined (lisp_static_vars_$evalframe_atom); 788 dcl lisp_static_vars_$pdlframe_atom fixed bin(71) aligned external, 789 pdlframe_atom fixed bin(71) aligned defined (lisp_static_vars_$pdlframe_atom); 790 791 stack = addrel(stack_ptr, -2); /* subr of one arg */ 792 myname = fn_evalframe; 793 pdl_frame_retry: 794 posf = "0"b; /* assume will not be a positive number */ 795 if stack -> temp(1) = nil then do; /* most recent */ 796 loc = rel(eval_frame); 797 if loc then locfb = locfb+1; /* if frame real, skip past it */ 798 end; /* so that the code below will 799* return it and not its sucessor */ 800 else if stack -> temp_type36(1) & Fixed36 then 801 if stack -> fixedb < 0 then do; 802 803 /* get negative pdl ptr & simulate downward search */ 804 805 loc = substr(unspec(stack -> fixedb), 19, 18); 806 if myname = fn_freturn then locfb = locfb + 1; /* want the frame itself , 807* not the next one down */ 808 end; 809 810 else do; 811 812 /* get positive pdl ptr & simulate upward search */ 813 814 i = - stack->fixedb; /* mumble, mumble, can't take unspec of an expression any more */ 815 loc = substr(unspec(i), 19, 18); 816 posf = "1"b; 817 end; 818 819 else do; 820 pdlframe_bad_pdl_ptr: 821 call badpdlptr; 822 go to pdl_frame_retry; 823 end; 824 825 /* check validity - pdl ptr must lie in the unmarked stack */ 826 827 if loc >= rel(unmkd_ptr) then go to pdlframe_bad_pdl_ptr; 828 if loc = ""b then if posf then go to pdlframe0; 829 else go to no_pdl_frame; 830 if loc < rel( ptr(unmkd_ptr,""b) -> stack_seg.unmkd_stack_bottom ) 831 then go to pdlframe_bad_pdl_ptr; 832 833 /* search for the eval_frame that we want */ 834 835 pdlframe0: 836 unm2 = null; 837 do unm = eval_frame repeat (ptr(unm, unm -> frame.prev_frame)) while (rel(unm)); 838 if rel(unm) < loc then go to pdl_fr_0; 839 if posf then if rel(unm) = loc then go to pdl_fr_0; /* (pdlframe -n) should not return (-n () -n), 840* but the next lower frame */ 841 unm2 = unm; 842 end; 843 if posf then go to pdlframe1a; /* in case searching from 0 */ 844 845 /* no pdl frame found, return nil */ 846 847 no_pdl_frame: 848 if myname = fn_freturn then go to pdlframe_bad_pdl_ptr; /* freturn barfs if no frame found */ 849 stack_ptr = addr(stack -> temp(2)); 850 stack -> temp(1) = nil; 851 return; 852 853 854 pdl_fr_0: 855 if posf then do; /* special hac to make +# simulate upward scan */ 856 pdlframe1a: 857 if unm2 = null then go to no_pdl_frame; 858 unm = unm2; 859 end; 860 861 pdl_fr_1: 862 if myname = fn_freturn then go to freturn0; /* if freturn, unjoin back to it */ 863 stack_ptr = addr(stack -> temp(5)); 864 loc = unm -> frame.stack_ptr; 865 stack -> temp(2) = ptr(stack, loc) -> temp(1); /* the form being evaled */ 866 stack -> temp(1) = lisp_static_vars_$eval_atom; 867 if unm -> frame.dat1 & apply_frame_bit /* special frame - do neat things */ 868 then do; 869 870 marked_stack_frame = ptr(stack, unm -> frame.stack_ptr); 871 if marked_stack_frame -> call1_cruft.uncollectable_bits = uncollectable_tag 872 then do; /* if looks like a call1 type eval frame */ 873 874 /* call1 or funcall frame - cons up arg list */ 875 876 stack_ptr = addr(stack -> temp(3)); 877 call lisp_special_fns_$ncons; /* start list of pseudo-form being evaled */ 878 stack -> temp(1) = stack -> temp(2); /* save start of list */ 879 stack_ptr = addr(stack -> temp(4)); 880 argument_pointer = ptr(marked_stack_frame, marked_stack_frame -> call1_cruft.arg_rel_ptr); 881 do i = marked_stack_frame -> call1_cruft.number_of_args by -1 while(i > 0); 882 stack -> temp(3) = argument_pointer -> temp(1); 883 argument_pointer = addrel(argument_pointer, 2); 884 call lisp_special_fns_$ncons; 885 stack -> temp_ptr(2) -> cons.cdr = stack -> temp(3); 886 stack -> temp(2) = stack -> temp(3); 887 end; 888 stack_ptr = addr(stack -> temp(5)); 889 stack -> temp(2) = stack -> temp(1); /* recover start of list */ 890 end; 891 892 else do; 893 894 /* apply or map, cons up pseudo-form */ 895 896 stack -> temp(3) = marked_stack_frame -> temp(3); /* argl */ 897 stack_ptr = addr(stack -> temp(4)); 898 call lisp_special_fns_$cons; 899 stack_ptr = addr(stack -> temp(5)); 900 end; 901 stack -> temp(1) = lisp_static_vars_$apply_atom; 902 end; 903 904 else if stack -> temp_ptr(2) -> cons.car = evalframe_atom then go to skip_this_pdlframe; 905 else if stack -> temp_ptr(2) -> cons.car = pdlframe_atom then do; 906 907 /* Woops, its ourself - skip it */ 908 909 skip_this_pdlframe: 910 if posf then do; /* positive pdl ptr was given -- 911* have to get kludgy and up-scan */ 912 if unm = eval_frame then go to no_pdl_frame; /* none above to get */ 913 loc = rel(unm); 914 do unm = eval_frame repeat ( ptr(unm, unm -> frame.prev_frame)) 915 while ( unm -> frame.prev_frame ^= loc); 916 /* this do-repeat scans down for the eval_frame just above 917* the one we're currently at */ 918 end; 919 end; 920 921 else do; 922 unm = ptr(unm, unm -> frame.prev_frame); 923 if rel(unm) = ""b then go to no_pdl_frame; 924 end; 925 go to pdl_fr_1; 926 end; 927 928 /* return a frame. stack -> temp(1) = frame type, 929* stack -> temp(2) = middle part of frame, 930* unm -> the stack loc */ 931 932 return_a_frame: 933 stack_ptr = addr(stack -> temp(6)); 934 stack -> temp(5) = nil; 935 stack -> temp(3) = stack -> temp(2); 936 addr(stack -> temp(4)) -> fixnum_fmt.type_info, 937 addr(stack -> temp(2)) -> fixnum_fmt.type_info = fixnum_type; 938 unspec( addr(stack->temp(4)) -> fixedb) = (17)"1"b || "0"b || rel(unm); 939 unspec(addr(stack -> temp(2)) -> fixedb) = (18)"1"b || rel(unm); /* pdl ptr -> unmarked pdl */ 940 do while(stack_ptr ^= addr(stack -> temp(2))); 941 call lisp_special_fns_$cons; 942 end; 943 return; 944 945 /* The freturn subr, which allows returning from an arbitrary evaluation 946* Subr of 2 args: 1) pdl ptr, 2) return value */ 947 948 freturn: entry; 949 950 stack = addrel(stack_ptr, -4); /* 2 args */ 951 myname = fn_freturn; 952 dbl_word = stack -> temp(1); /* interchange arguments to be like pdlframe, */ 953 stack -> temp(1) = stack -> temp(2); /* having the pdl ptr arg at top of stack */ 954 stack -> temp(2) = dbl_word; 955 stack = addr(stack -> temp(2)); 956 go to pdl_frame_retry; /* go find frame corresponding to first arg */ 957 958 freturn0: 959 /* unm -> the frame, stack -> temp(1) = the value we want to make that frame return with */ 960 961 /* make sure that this frame lies within the Multics stack properly - could be problem 962* if unseen-go-tag on very non local go happens after the stack is unwound, then user 963* tries to freturn into stack between the prog and the non local go - can't be done 964* because stack frames (sp stack) for functions in that part of lisp stack no longer 965* exist - since freturn is usually done from command level we want to say bad_pdl_ptr 966* rather than wait and get unwinder_error */ 967 968 label0 = freturn0; /* just a KLUDGE to do a sprisp instruction */ 969 if rel(label.sp) <= eval_frame_part.dat1 then go to pdlframe_bad_pdl_ptr; 970 971 /* check for a frame with screwed up registers in it, which indicates an undf fcntn or something occurred */ 972 /* such frames may not be returned to because they lose!! */ 973 974 if substr(unspec(saved_index_registers), 31, 6) = "100011"b /* its modifier, can never occur in 975* a saved x2 from evaluator since 976* would indicate applying a macro */ 977 then go to pdlframe_bad_pdl_ptr; /* Go barf at user */ 978 979 980 stack = addrel(stack, -2); 981 982 /* declare the format of the evaluators unmarked pdl (lisp_.alm) */ 983 984 dcl 1 the_eval_frame aligned based(unm), 985 2 eval_frame_part , 986 3 prev_frame bit(18) unal, 987 3 stack_ptr fixed bin (17) unal, 988 3 dat1 bit(18) unal, 989 3 dat2 bit(18) unal, 990 2 saved_index_registers fixed bin(71), 991 2 binding_frame_part fixed bin(71); 992 993 /* unwind down to but not including the evalframe - unwind its binding block */ 994 995 unm2 = unmkd_ptr; 996 unmkd_ptr = addrel(unm2, 2); 997 unm2 -> based_ptr = addr(binding_frame_part); /* unwinder takes arg on unmkd pdl */ 998 evals_stack = ptr(stack, eval_frame_part.stack_ptr); /* -> eval's garbage on the marked pdl */ 999 evals_stack -> temp(4) = stack -> temp(1); /* drop return value into ap|plist */ 1000 call lisp_prog_fns_$lisp_unwinder; /* unwind back to the point of evaluation */ 1001 1002 /* Now go call the evaluator, and let it clean things up, since it alone knows how */ 1003 1004 unmkd_ptr = addrel(unm, size(the_eval_frame)); /* make unmkd_ptr where eval expects it */ 1005 stack_ptr = addr(evals_stack -> temp(5)); /* in case was cruft on marked pdl below b.b. */ 1006 label.adr = addr(lisp_$freturn_real); /* make label variable to get to the evaluator */ 1007 label.sp = ptr(label.sp, eval_frame_part.dat1 & "111111111111111110"b); 1008 1009 /* save return ptr in stack frame going to go to since goddamn unwinder_ wrecks it. */ 1010 1011 unspec(binding_frame_part) /* use this double word since not in use right now */ 1012 = unspec(label.sp -> stack_frame.return_ptr); 1013 1014 go to label0; 1015 end lisp_error_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/86 1042.5 lisp_error_.pl1 >special_ldd>install>MR12.0-1206>lisp_error_.pl1 175 1 11/03/86 1114.7 stack_frame.incl.pl1 >special_ldd>install>MR12.0-1206>stack_frame.incl.pl1 176 2 03/27/82 0437.0 lisp_faults.incl.pl1 >ldd>include>lisp_faults.incl.pl1 177 3 03/27/82 0436.9 lisp_string_fmt.incl.pl1 >ldd>include>lisp_string_fmt.incl.pl1 178 4 03/27/82 0436.9 lisp_unmkd_pdl.incl.pl1 >ldd>include>lisp_unmkd_pdl.incl.pl1 179 5 03/27/82 0437.0 lisp_nums.incl.pl1 >ldd>include>lisp_nums.incl.pl1 180 6 03/27/82 0437.1 lisp_atom_fmt.incl.pl1 >ldd>include>lisp_atom_fmt.incl.pl1 181 7 07/06/83 1111.5 lisp_name_codes.incl.pl1 >ldd>include>lisp_name_codes.incl.pl1 182 8 03/27/82 0437.0 lisp_stack_fmt.incl.pl1 >ldd>include>lisp_stack_fmt.incl.pl1 183 9 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 184 10 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 185 11 03/27/82 0437.0 lisp_io.incl.pl1 >ldd>include>lisp_io.incl.pl1 11-5 12 03/27/82 0437.0 lisp_iochan.incl.pl1 >ldd>include>lisp_iochan.incl.pl1 11-45 13 03/27/82 0437.0 lisp_control_chars.incl.pl1 >ldd>include>lisp_control_chars.incl.pl1 186 14 03/27/82 0437.0 lisp_cons_fmt.incl.pl1 >ldd>include>lisp_cons_fmt.incl.pl1 187 15 07/06/83 1111.5 lisp_stack_seg.incl.pl1 >ldd>include>lisp_stack_seg.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. Atsym36 constant bit(36) initial dcl 9-17 ref 282 Fixed36 constant bit(36) initial dcl 9-17 ref 575 800 NotThere 000044 constant fixed bin(71,0) initial dcl 160 ref 214 241 265 266 280 289 291 308 703 752 756 String constant bit(9) initial unaligned dcl 9-17 ref 235 addr builtin function dcl 64 ref 206 206 211 213 218 227 227 228 228 229 229 229 229 229 233 243 244 244 264 271 276 308 329 335 343 350 355 362 378 382 390 414 416 419 421 435 452 467 473 491 501 573 573 652 673 677 679 684 685 694 704 718 719 748 752 756 760 797 797 806 806 849 863 876 879 888 897 899 932 936 936 938 939 940 955 958 997 1005 1006 1014 addrel builtin function dcl 64 ref 203 216 256 263 431 499 523 531 560 568 675 759 771 791 883 950 980 996 1004 adr 000162 automatic pointer level 2 dcl 64 set ref 1006* against 1(01) based structure level 3 packed unaligned dcl 2-25 alarm 1(02) based bit(1) level 4 packed unaligned dcl 2-25 set ref 492 apply_frame_bit constant bit(18) initial unaligned dcl 128 ref 867 arg_rel_ptr 4 based bit(18) level 3 packed unaligned dcl 118 ref 880 argl 4 based structure level 2 dcl 118 argument_pointer 000150 automatic pointer dcl 64 set ref 880* 882 883* 883 array_info_for_store 122 based pointer level 2 dcl 15-5 set ref 438 482* array_offset_for_store 124 based fixed bin(18,0) level 2 dcl 15-5 set ref 439 483* atom based structure level 1 dcl 6-5 back_ptr 1 based bit(18) level 2 packed unaligned dcl 8-7 set ref 682* 720 base defined fixed bin(71,0) dcl 11-17 set ref 419 421 based_ptr based pointer dcl 9-16 set ref 308 329 343 414 416 419 421 677 679 684 685 718 719 997* binding_block based structure level 1 dcl 8-7 binding_frame_part 4 based fixed bin(71,0) level 2 dcl 984 set ref 997 1011* binding_top defined pointer dcl 10-6 set ref 682 683* 720* bit_tbl based bit(36) array dcl 49 ref 211 bits 000140 automatic bit(36) dcl 64 set ref 211* 212 223 225 241 247 267* 296* 296 336* 336 359 360 430 437 464 471 474 480 518 647* bot_block 0(18) based bit(18) level 2 packed unaligned dcl 8-7 set ref 680* call1_cruft based structure level 1 dcl 118 car based fixed bin(71,0) level 2 dcl 14-5 ref 472 540 544 547 904 905 cdr 2 based fixed bin(71,0) level 2 in structure "cons" dcl 14-5 in procedure "lisp_error_" set ref 885* cdr 2(21) based bit(9) level 2 in structure "cons_types" packed unaligned dcl 14-5 in procedure "lisp_error_" ref 539 cdr 2 based pointer level 2 in structure "cons_ptrs" dcl 14-5 in procedure "lisp_error_" ref 540 code 000156 automatic fixed bin(17,0) dcl 64 set ref 204* 206 206 207* 211 229 229 229 229 233 244 247 268* 313 359 436 471 631* 632 code1 2 based fixed bin(17,0) level 2 dcl 2-25 set ref 436* 631 code2 3 based fixed bin(17,0) level 2 in structure "fault_save" dcl 2-25 in procedure "lisp_error_" set ref 437* 647 code2 000157 automatic fixed bin(17,0) dcl 64 in procedure "lisp_error_" set ref 205* 223* 223* 226* 226 227 227* 228 228* 229 231* 231 cons based structure level 1 dcl 14-5 cons_ptrs based structure level 1 dcl 14-5 cons_types based structure level 1 dcl 14-5 convert_status_code_ 000060 constant entry external dcl 150 ref 223 223 ctrlR defined fixed bin(71,0) dcl 13-11 set ref 678 679 685 719 ctrlW defined fixed bin(71,0) dcl 13-14 set ref 676 677 684 718 dat1 1 based bit(18) level 2 in structure "frame" packed unaligned dcl 4-7 in procedure "lisp_error_" ref 317 867 dat1 1 based bit(18) level 3 in structure "the_eval_frame" packed unaligned dcl 984 in procedure "lisp_error_" ref 969 1007 dat2 1(18) based bit(18) level 2 packed unaligned dcl 4-7 set ref 542* datf constant bit(36) initial dcl 64 ref 212 dbl_word 000172 automatic fixed bin(71,0) dcl 64 set ref 952* 954 divide builtin function dcl 64 ref 234 234 err_fcn_f 000141 automatic bit(1) initial dcl 64 set ref 64* 260* 351* 553* err_frame defined pointer dcl 10-6 ref 308 317 317 329 542 542 err_recf constant bit(36) initial dcl 64 ref 430 480 518 err_recp defined pointer dcl 10-6 set ref 432 443* 497* 497 518* 572 609 634 636 errcode based fixed bin(17,0) array dcl 4-7 set ref 204 205 772* 773* error_data 000146 automatic pointer dcl 64 set ref 687* 691* 695 703 705 746* 750 751 755 errsw 000142 automatic bit(1) unaligned dcl 64 set ref 565* 649 741* esw 000220 automatic fixed bin(17,0) dcl 663 set ref 665* 670* 686 714 729* eval_frame defined pointer dcl 10-6 ref 796 837 912 914 eval_frame_part based structure level 2 dcl 984 evalf constant bit(36) initial dcl 64 ref 474 evalframe_atom defined fixed bin(71,0) dcl 786 ref 904 evals_stack 000152 automatic pointer dcl 64 set ref 998* 999 1005 fault_save based structure level 1 dcl 2-25 set ref 431 fixedb 1 based fixed bin(17,0) level 2 dcl 5-4 set ref 244* 257 276 416* 421* 575 575 586 800 805 814 938* 939* fixnum_fmt based structure level 1 dcl 5-4 fixnum_type constant bit(36) initial dcl 5-4 ref 243 271 414 419 936 fn_errframe constant fixed bin(17,0) initial dcl 7-9 ref 740 fn_errprint constant fixed bin(17,0) initial dcl 7-9 ref 566 fn_evalframe constant fixed bin(17,0) initial dcl 7-9 ref 792 fn_freturn 003056 constant fixed bin(17,0) initial dcl 7-9 ref 806 847 861 951 fnamef constant bit(36) initial dcl 64 ref 225 fnames based char(16) array dcl 49 set ref 227 227 228 228 229* frame based structure level 1 dcl 4-7 fserr constant bit(36) initial dcl 64 ref 223 gc_inhibit defined bit(1) dcl 2-45 set ref 434 487* hbound builtin function dcl 64 ref 206 227 228 228 277 284 i 000174 automatic fixed bin(17,0) dcl 64 set ref 334* 337 345* 586* 587 814* 815 881* 881* ibase defined fixed bin(71,0) dcl 11-17 set ref 414 416 ioa_ 000024 constant entry external dcl 64 ref 207 ioa_$rsnpnnl 000056 constant entry external dcl 150 ref 223 229 233 label 000162 automatic structure level 1 dcl 64 set ref 958 1014 label0 based label variable dcl 64 set ref 958* 1014 lbound builtin function dcl 64 ref 206 227 lisp_$apply 000046 constant entry external dcl 136 ref 456 699 708 lisp_$eval 000050 constant entry external dcl 136 ref 474 548 lisp_$freturn_real 000032 external static fixed bin(17,0) dcl 64 set ref 1006 lisp_alloc_ 000042 constant entry external dcl 136 ref 234 lisp_error_table_$bit_tbl 000016 external static bit(36) dcl 49 set ref 211 lisp_error_table_$fnames 000022 external static bit(36) dcl 49 set ref 227 227 228 228 229 lisp_error_table_$fnames_hbound 000020 external static fixed bin(17,0) dcl 49 ref 227 228 228 lisp_error_table_$hbound 000010 external static fixed bin(17,0) dcl 49 ref 206 lisp_error_table_$msgs 000012 external static bit(36) dcl 49 set ref 206 206 229 229 229 229 233 lisp_error_table_$not_pdl_ptr 000100 external static fixed bin(17,0) dcl 170 ref 772 772 lisp_error_table_$stack_loss_error 000102 external static fixed bin(17,0) dcl 170 ref 313 313 lisp_error_table_$uintnum 000014 external static bit(36) dcl 49 set ref 244 lisp_fault_handler_$nointerrupt 000026 constant entry external dcl 64 ref 495 lisp_io_control_$empty_all_buffers 000064 constant entry external dcl 157 ref 303 lisp_print_$type_nl 000052 constant entry external dcl 150 ref 698 713 lisp_print_$type_string 000054 constant entry external dcl 150 ref 510 lisp_prog_fns_$lisp_err 000034 constant entry external dcl 64 ref 351 lisp_prog_fns_$lisp_unwinder 000030 constant entry external dcl 64 ref 1000 lisp_special_fns_$cons 000036 constant entry external dcl 136 ref 364 369 381 385 386 395 396 761 898 941 lisp_special_fns_$ncons 000040 constant entry external dcl 136 ref 453 697 707 877 884 lisp_static_vars_$apply_atom 000072 external static fixed bin(71,0) dcl 162 ref 901 lisp_static_vars_$base 000142 external static fixed bin(71,0) dcl 11-17 ref 403 419 419 421 421 lisp_static_vars_$binding_top 000132 external static pointer dcl 10-6 set ref 682 682 683* 683 720* 720 lisp_static_vars_$ctrlR 000146 external static fixed bin(71,0) dcl 13-11 ref 678 678 679 679 685 685 719 719 lisp_static_vars_$ctrlW 000150 external static fixed bin(71,0) dcl 13-14 ref 676 676 677 677 684 684 718 718 lisp_static_vars_$emptying_buffers 000062 external static fixed bin(17,0) dcl 157 set ref 302* 302 303 304* 304 lisp_static_vars_$err_atom 000066 external static fixed bin(71,0) dcl 162 ref 749 lisp_static_vars_$err_frame 000122 external static pointer dcl 10-6 ref 308 308 317 317 317 317 329 329 542 542 542 542 lisp_static_vars_$err_recp 000116 external static pointer dcl 10-6 set ref 432 432 443* 443 497* 497 497 497 518* 518 572 572 609 609 634 634 636 636 lisp_static_vars_$eval_atom 000070 external static fixed bin(71,0) dcl 162 ref 866 lisp_static_vars_$eval_frame 000120 external static pointer dcl 10-6 ref 796 796 837 837 912 912 914 914 lisp_static_vars_$evalframe_atom 000160 external static fixed bin(71,0) dcl 786 ref 904 904 lisp_static_vars_$garbage_collect_inhibit 000104 external static bit(1) dcl 2-45 set ref 434 434 487* 487 lisp_static_vars_$go_atom 000152 external static fixed bin(71,0) dcl 192 ref 394 lisp_static_vars_$ibase 000140 external static fixed bin(71,0) dcl 11-17 ref 399 414 414 416 416 lisp_static_vars_$masked 000106 external static structure level 1 dcl 2-45 set ref 435 lisp_static_vars_$nil 000134 external static fixed bin(71,0) dcl 10-6 ref 259 259 284 284 308 308 329 329 338 338 343 343 363 363 380 380 383 383 392 392 455 455 494 494 532 532 540 540 571 571 619 619 684 684 685 685 759 759 795 795 850 850 934 934 lisp_static_vars_$pdlframe_atom 000162 external static fixed bin(71,0) dcl 788 ref 905 905 lisp_static_vars_$prin1_atom 000076 external static fixed bin(71,0) dcl 162 ref 706 lisp_static_vars_$princ_atom 000074 external static fixed bin(71,0) dcl 162 ref 696 lisp_static_vars_$rdr_label 000110 external static label variable dcl 2-45 set ref 442 442 486* 486 lisp_static_vars_$rdr_ptr 000112 external static pointer dcl 2-45 set ref 441 441 485* 485 lisp_static_vars_$rdr_state 000114 external static fixed bin(17,0) dcl 2-45 set ref 440 440 445* 445 484* 484 lisp_static_vars_$readeof_atom 000044 external static fixed bin(71,0) dcl 136 ref 408 lisp_static_vars_$return_atom 000154 external static fixed bin(71,0) dcl 192 ref 393 lisp_static_vars_$setq_atom 000156 external static fixed bin(71,0) dcl 192 ref 384 384 lisp_static_vars_$stack_ptr 000124 external static pointer dcl 10-6 set ref 202 202 213* 213 218* 218 256 256 264* 264 335* 335 350* 350 355* 355 362* 362 378* 378 382* 382 390* 390 452* 452 467* 467 473* 473 491* 491 501* 501 524* 524 531 531 560 560 568 568 652* 652 672 672 673* 673 681 681 693 693 694* 694 704* 704 722* 722 748* 748 752* 752 756* 756 759 759 760 760 791 791 849* 849 863* 863 876* 876 879* 879 888* 888 897* 897 899* 899 932* 932 940 940 950 950 1005* 1005 lisp_static_vars_$t_atom 000126 external static fixed bin(71,0) dcl 10-6 ref 492 492 653 653 lisp_static_vars_$tty_atom 000144 external static fixed bin(71,0) dcl 11-17 ref 493 493 lisp_static_vars_$unmkd_ptr 000130 external static pointer dcl 10-6 set ref 203 203 269 269 426 426 431* 431 499* 499 523* 523 598 598 602 602 674 674 675* 675 721* 721 770 770 771* 771 827 827 830 830 995 995 996* 996 1004* 1004 lisp_static_vars_$user_intr_array 000136 external static fixed bin(71,0) array dcl 10-45 ref 277 277 277 277 284 284 286 286 296 296 308 308 329 329 337 337 343 343 460 460 lisp_string based structure level 1 dcl 3-6 loc 000171 automatic bit(18) dcl 64 set ref 572* 573 573 573 575* 587* 598 600 602 611 612 635* 636 796* 797 797 797 805* 806 806 815* 827 828 830 838 839 864* 865 913* 914 loc_ovly based structure level 1 dcl 132 locfb based fixed bin(17,0) level 2 packed unaligned dcl 132 set ref 573* 573 797* 797 806* 806 marked_stack_frame 000200 automatic pointer dcl 128 set ref 870* 871 880 880 881 896 masked based structure level 1 dcl 2-45 ref 435 mkp 000212 automatic pointer dcl 662 set ref 672* 673 676 677 678 679 680 718 719 722 msgbuf 000100 automatic char(128) dcl 49 set ref 223* 229* 233* 237 msgs based char(40) array dcl 49 ref 206 206 229 229 229 229 233 myname 000160 automatic fixed bin(17,0) dcl 64 set ref 566* 740* 773 792* 806 847 861 951* nargs 000175 automatic fixed bin(17,0) dcl 64 set ref 257* 258 263 265 266 nil defined fixed bin(71,0) dcl 10-6 ref 259 284 308 329 338 343 363 380 383 392 455 494 532 540 571 619 684 685 759 795 850 934 nilconsf constant bit(36) initial dcl 64 ref 296 360 not_pdl_ptr defined fixed bin(17,0) dcl 170 ref 772 null builtin function dcl 64 ref 607 626 835 856 number_of_args 5 based fixed bin(17,0) level 3 packed unaligned dcl 118 ref 881 pdl_ptr_types36 based structure array level 1 dcl 8-7 pdlframe_atom defined fixed bin(71,0) dcl 788 ref 905 posf 000170 automatic bit(1) unaligned dcl 64 set ref 570* 588* 600 612 615 623 632 793* 816* 828 839 843 854 909 prev_frame based bit(18) level 2 in structure "frame" packed unaligned dcl 4-7 in procedure "lisp_error_" ref 518 842 914 918 922 prev_frame based bit(18) level 2 in structure "fault_save" packed unaligned dcl 2-25 in procedure "lisp_error_" set ref 432* 497 614 636 639 643 ptr builtin function dcl 64 ref 438 439 482 483 497 518 602 614 639 643 691 720 746 830 842 865 870 880 918 922 998 1007 push_down_list_ptr_types based structure array level 1 dcl 8-7 rdr_label defined label variable dcl 2-45 set ref 442 486* rdr_ptr defined pointer dcl 2-45 set ref 441 485* rdr_state defined fixed bin(17,0) dcl 2-45 set ref 440 445* 484* rel builtin function dcl 64 ref 308 317 329 432 433 542 572 598 602 609 611 612 635 644 680 681 682 796 827 830 837 838 839 913 923 938 939 969 retlen 000202 automatic fixed bin(17,0) dcl 150 set ref 223* 229* 233* 234 234 236 return_ptr 24 based pointer level 2 dcl 1-36 ref 1011 saved_index_registers 2 based fixed bin(71,0) level 2 dcl 984 ref 974 setq_atom defined fixed bin(71,0) dcl 192 ref 384 size builtin function dcl 64 ref 431 1004 sp 2 000162 automatic pointer level 2 dcl 64 set ref 969 1007* 1007 1011 spbeg constant bit(36) initial dcl 64 ref 247 spfin constant bit(36) initial dcl 64 ref 471 spint constant bit(36) initial dcl 64 ref 359 spmsgp 000216 automatic pointer dcl 662 set ref 693* 694 695 696 704 705 706 sptrapf constant bit(36) initial dcl 64 ref 336 464 stack 000144 automatic pointer dcl 64 set ref 202* 213 214 216* 216 218 219 219 234 235 236 237 241 243 244 256* 257 259 263* 263 264 265 266 271 276 277 280 282 284 286 289 291 296 308 335 337 338 350 355 358 358 362 363 366 366 378 380 380 382 383 384 390 392 393 394 399 403 408 433 452 454 454 455 460 465 467 472 472 473 491 492 493 494 501 524 531* 532 532 539 540 544 544 547 547 560* 568* 571 575 575 575 586 619 652 653 687 691 746 748 749 750 751 752 752 755 756 756 760 791* 795 800 800 805 814 849 850 863 865 865 866 870 876 878 878 879 882 885 885 886 886 888 889 889 896 897 899 901 904 905 932 934 935 935 936 936 938 939 940 950* 952 953 953 954 955* 955 980* 980 998 999 stack_frame based structure level 1 dcl 1-36 stack_loss_error defined fixed bin(17,0) dcl 170 ref 313 stack_ptr 0(18) based fixed bin(17,0) level 3 in structure "the_eval_frame" packed unaligned dcl 984 in procedure "lisp_error_" ref 998 stack_ptr 0(18) based bit(18) level 2 in structure "frame" packed unaligned dcl 4-7 in procedure "lisp_error_" ref 864 870 stack_ptr 0(18) based bit(18) level 2 in structure "fault_save" packed unaligned dcl 2-25 in procedure "lisp_error_" set ref 433* 691 746 stack_ptr defined pointer dcl 10-6 in procedure "lisp_error_" set ref 202 213* 218* 256 264* 335* 350* 355* 362* 378* 382* 390* 452* 467* 473* 491* 501* 524* 531 560 568 652* 672 673* 681 693 694* 704* 722* 748* 752* 756* 759 760 791 849* 863* 876* 879* 888* 897* 899* 932* 940 950 1005* stack_seg based structure level 1 dcl 15-5 string 1 based char level 2 dcl 3-6 set ref 237* string_length based fixed bin(17,0) level 2 dcl 3-6 set ref 236* 237 substr builtin function dcl 64 ref 229 229 575 587 805 815 974 sv_array_info 4 based pointer level 2 dcl 2-25 set ref 438* 482 sv_array_offset 15 based fixed bin(18,0) level 2 dcl 2-25 set ref 439* 483 sv_gc_inhibit 1 based bit(1) level 2 packed unaligned dcl 2-25 set ref 434* 487 sv_masked 1(01) based structure level 2 packed unaligned dcl 2-25 set ref 435* sv_rdr_label 6 based label variable level 2 dcl 2-25 set ref 442* 486 sv_rdr_ptr 12 based pointer level 2 dcl 2-25 set ref 441* 485 sv_rdr_state 14 based fixed bin(17,0) level 2 dcl 2-25 set ref 440* 484 t_atom defined fixed bin(71,0) dcl 10-6 ref 492 653 temp based fixed bin(71,0) array dcl 8-7 set ref 213 214* 218 219* 219 234* 241* 243 244 259* 264 265* 266* 271 276 277* 280* 284 286 289* 291* 296 308 335 337* 338* 350 355 358* 358 362 363* 366* 366 378 380* 380* 382 383* 384* 390 392* 393* 394* 399* 403* 408* 452 454* 455 460 467 472* 473 491 492* 493* 494* 501 532* 544* 547* 571 619* 652 653* 673 676* 677* 678* 679* 694 695* 695 696* 703 704 705* 705 706* 718 719 748 749* 750* 750 751* 751 752 752 755* 755 756 756 759* 760 795 849 850* 863 865* 865 866* 876 878* 878 879 882* 882 885 886* 886 888 889* 889 896* 896 897 899 901* 932 934* 935* 935 936 936 938 939 940 952 953* 953 954* 955 999* 999 1005 temp_ptr based pointer array dcl 8-7 ref 236 237 454 472 539 540 544 547 885 904 905 temp_type 0(21) based bit(9) array level 2 packed unaligned dcl 8-7 set ref 235* 465 532 temp_type36 based bit(36) array level 2 dcl 8-7 ref 282 575 800 the_eval_frame based structure level 1 dcl 984 set ref 1004 top_block based bit(18) level 2 packed unaligned dcl 8-7 set ref 681* tty 1(01) based bit(1) level 4 packed unaligned dcl 2-25 set ref 493 tty_atom defined fixed bin(71,0) dcl 11-17 ref 493 type_info based bit(36) level 2 dcl 5-4 set ref 243* 271 414* 419* 936* 936* uint_ch_num_spec 000176 automatic fixed bin(17,0) dcl 64 set ref 276* 277 277 277 284* 286* 295* 296* uintf constant bit(36) initial dcl 64 ref 241 uintnum based fixed bin(17,0) array dcl 49 ref 244 uncollectable_bits 4(18) based bit(18) level 3 packed unaligned dcl 118 ref 871 uncollectable_tag constant bit(18) initial unaligned dcl 128 ref 871 unm 000154 automatic pointer dcl 64 set ref 203* 204 205 269* 426* 431 431 432 433 434 435 436 437 438 438 439 439 440 441 442 443 482 482 483 483 484 485 486 487 492 493 497 499 518 518 523 609* 609* 611 612 613* 614 614 628* 631 634 635 636* 636* 639 639 643* 643 643 644 647 691 746 770* 771 772 773 837* 837* 838 839 841* 842 842 858* 864 867 870 912 913 914* 914* 918 918 922* 922 922 923 938 939 969 974 997 998 1004 1004 1007 1011 unm2 000166 automatic pointer dcl 64 set ref 607* 613* 626 628 835* 841* 856 858 995* 996 997 unmkd_ptr defined pointer dcl 10-6 set ref 203 269 426 431* 499* 523* 598 602 674 675* 721* 770 771* 827 830 995 996* 1004* unmkd_stack_bottom 2 based pointer level 2 dcl 15-5 ref 602 830 unmkp 000214 automatic pointer dcl 662 set ref 674* 675 680 681 682 683 720 720 721 unspec builtin function dcl 64 set ref 437* 438* 438 482* 482 575 587 647 805 815 938* 939* 974 1011* 1011 user_intr_array defined fixed bin(71,0) array dcl 10-45 set ref 277 277 284 286 296 308 329 337 343 460 value based fixed bin(71,0) level 2 dcl 6-5 set ref 308 329 343 454 677 679 684* 685* 718* 719* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Alarmclock_fault internal static fixed bin(17,0) initial dcl 2-10 Array internal static bit(9) initial unaligned dcl 9-17 Array36 internal static bit(36) initial dcl 9-17 Array_fault internal static fixed bin(17,0) initial dcl 2-10 Atomic internal static bit(9) initial unaligned dcl 9-17 Atomic36 internal static bit(36) initial dcl 9-17 Atsym internal static bit(9) initial unaligned dcl 9-17 Bigfix internal static bit(9) initial unaligned dcl 9-17 Bigfix36 internal static bit(36) initial dcl 9-17 Bignum internal static bit(9) initial unaligned dcl 9-17 Bignum36 internal static bit(36) initial dcl 9-17 Car_cdr_fault internal static fixed bin(17,0) initial dcl 2-10 Cons internal static bit(9) initial unaligned dcl 9-17 Cons36 internal static bit(36) initial dcl 9-17 Cput_fault internal static fixed bin(17,0) initial dcl 2-10 File internal static bit(9) initial unaligned dcl 9-17 File36 internal static bit(36) initial dcl 9-17 Fixed internal static bit(9) initial unaligned dcl 9-17 Float internal static bit(9) initial unaligned dcl 9-17 Float36 internal static bit(36) initial dcl 9-17 NotConsOrAtsym36 internal static bit(36) initial dcl 9-17 Numeric internal static bit(9) initial unaligned dcl 9-17 Numeric36 internal static bit(36) initial dcl 9-17 Old_store_fault internal static fixed bin(17,0) initial dcl 2-10 Pi_fault internal static fixed bin(17,0) initial dcl 2-10 Quit_fault internal static fixed bin(17,0) initial dcl 2-10 RETURN_PTR_MASK internal static bit(72) initial unaligned dcl 1-19 String36 internal static bit(36) initial dcl 9-17 Subr internal static bit(9) initial unaligned dcl 9-17 Subr36 internal static bit(36) initial dcl 9-17 SubrNumeric36 internal static bit(36) initial dcl 9-17 System_Subr internal static bit(9) initial unaligned dcl 9-17 System_Subr36 internal static bit(36) initial dcl 9-17 TRANSLATOR_ID_ALM internal static bit(18) initial unaligned dcl 1-25 TRANSLATOR_ID_PL1V1 internal static bit(18) initial unaligned dcl 1-26 TRANSLATOR_ID_PL1V2 internal static bit(18) initial unaligned dcl 1-24 TRANSLATOR_ID_SIGNALLER internal static bit(18) initial unaligned dcl 1-28 TRANSLATOR_ID_SIGNAL_CALLER internal static bit(18) initial unaligned dcl 1-27 Uncollectable internal static bit(9) initial unaligned dcl 9-17 Undefined internal static bit(72) initial unaligned dcl 9-17 Underflow_fault internal static fixed bin(17,0) initial dcl 2-10 Zerodivide_fault internal static fixed bin(17,0) initial dcl 2-10 array_atom defined fixed bin(71,0) dcl 10-6 atom_double_words based structure level 1 dcl 6-5 atom_ptrs based structure level 1 dcl 6-5 bfb based fixed bin(35,0) dcl 64 bindings based structure array level 1 dcl 8-7 bit builtin function dcl 64 call_array_operator internal static bit(36) initial unaligned dcl 15-68 call_dead_array_operator internal static bit(36) initial unaligned dcl 15-68 catch_frame defined pointer dcl 10-6 com_err_ 000000 constant entry external dcl 64 cons_types36 based structure level 1 dcl 14-22 consptr automatic pointer dcl 14-5 ctrlD defined fixed bin(71,0) dcl 13-5 ctrlQ defined fixed bin(71,0) dcl 13-8 deferred_interrupt defined bit(1) dcl 2-45 dummy_aligned based fixed bin(35,0) dcl 64 fixed builtin function dcl 64 flag_reset_mask internal static bit(36) initial dcl 12-13 flonum_fmt based structure level 1 dcl 5-4 flonum_type internal static bit(36) initial dcl 5-4 fn_CtoI internal static fixed bin(17,0) initial dcl 7-9 fn_ItoC internal static fixed bin(17,0) initial dcl 7-9 fn_abs internal static fixed bin(17,0) initial dcl 7-9 fn_add1 internal static fixed bin(17,0) initial dcl 7-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 7-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 7-9 fn_alarmclock internal static fixed bin(17,0) initial dcl 7-9 fn_allfiles internal static fixed bin(17,0) initial dcl 7-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 7-9 fn_apply internal static fixed bin(17,0) initial dcl 7-9 fn_arg internal static fixed bin(17,0) initial dcl 7-9 fn_args internal static fixed bin(17,0) initial dcl 7-9 fn_array internal static fixed bin(17,0) initial dcl 7-9 fn_arraydims internal static fixed bin(17,0) initial dcl 7-9 fn_ascii internal static fixed bin(17,0) initial dcl 7-9 fn_atan internal static fixed bin(17,0) initial dcl 7-9 fn_baktrace internal static fixed bin(17,0) initial dcl 7-9 fn_bltarray internal static fixed bin(17,0) initial dcl 7-9 fn_boole internal static fixed bin(17,0) initial dcl 7-9 fn_boundp internal static fixed bin(17,0) initial dcl 7-9 fn_catch internal static fixed bin(17,0) initial dcl 7-9 fn_catenate internal static fixed bin(17,0) initial dcl 7-9 fn_charpos internal static fixed bin(17,0) initial dcl 7-9 fn_chrct internal static fixed bin(17,0) initial dcl 7-9 fn_clear_input internal static fixed bin(17,0) initial dcl 7-9 fn_cline internal static fixed bin(17,0) initial dcl 7-9 fn_close internal static fixed bin(17,0) initial dcl 7-9 fn_cos internal static fixed bin(17,0) initial dcl 7-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 7-9 fn_defaultf internal static fixed bin(17,0) initial dcl 7-9 fn_definedp internal static fixed bin(17,0) initial dcl 7-9 fn_defsubr internal static fixed bin(17,0) initial dcl 7-9 fn_defun internal static fixed bin(17,0) initial dcl 7-9 fn_delete internal static fixed bin(17,0) initial dcl 7-9 fn_deletef internal static fixed bin(17,0) initial dcl 7-9 fn_delq internal static fixed bin(17,0) initial dcl 7-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 7-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 7-9 fn_difference internal static fixed bin(17,0) initial dcl 7-9 fn_displace internal static fixed bin(17,0) initial dcl 7-9 fn_do internal static fixed bin(17,0) initial dcl 7-9 fn_dumparrays internal static fixed bin(17,0) initial dcl 7-9 fn_endpagefn internal static fixed bin(17,0) initial dcl 7-9 fn_eoffn internal static fixed bin(17,0) initial dcl 7-9 fn_eql internal static fixed bin(17,0) initial dcl 7-9 fn_errset internal static fixed bin(17,0) initial dcl 7-9 fn_eval internal static fixed bin(17,0) initial dcl 7-9 fn_eval_when internal static fixed bin(17,0) initial dcl 7-9 fn_exp internal static fixed bin(17,0) initial dcl 7-9 fn_expt internal static fixed bin(17,0) initial dcl 7-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 7-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 7-9 fn_filepos internal static fixed bin(17,0) initial dcl 7-9 fn_fillarray internal static fixed bin(17,0) initial dcl 7-9 fn_fix internal static fixed bin(17,0) initial dcl 7-9 fn_float internal static fixed bin(17,0) initial dcl 7-9 fn_force_output internal static fixed bin(17,0) initial dcl 7-9 fn_fsc internal static fixed bin(17,0) initial dcl 7-9 fn_gcd internal static fixed bin(17,0) initial dcl 7-9 fn_gensym internal static fixed bin(17,0) initial dcl 7-9 fn_get internal static fixed bin(17,0) initial dcl 7-9 fn_get_pname internal static fixed bin(17,0) initial dcl 7-9 fn_getchar internal static fixed bin(17,0) initial dcl 7-9 fn_getl internal static fixed bin(17,0) initial dcl 7-9 fn_greaterp internal static fixed bin(17,0) initial dcl 7-9 fn_gt internal static fixed bin(17,0) initial dcl 7-9 fn_haipart internal static fixed bin(17,0) initial dcl 7-9 fn_haulong internal static fixed bin(17,0) initial dcl 7-9 fn_ifix internal static fixed bin(17,0) initial dcl 7-9 fn_in internal static fixed bin(17,0) initial dcl 7-9 fn_includef internal static fixed bin(17,0) initial dcl 7-9 fn_index internal static fixed bin(17,0) initial dcl 7-9 fn_inpush internal static fixed bin(17,0) initial dcl 7-9 fn_isqrt internal static fixed bin(17,0) initial dcl 7-9 fn_lessp internal static fixed bin(17,0) initial dcl 7-9 fn_linel internal static fixed bin(17,0) initial dcl 7-9 fn_linenum internal static fixed bin(17,0) initial dcl 7-9 fn_listarray internal static fixed bin(17,0) initial dcl 7-9 fn_listify internal static fixed bin(17,0) initial dcl 7-9 fn_loadarrays internal static fixed bin(17,0) initial dcl 7-9 fn_log internal static fixed bin(17,0) initial dcl 7-9 fn_ls internal static fixed bin(17,0) initial dcl 7-9 fn_lsh internal static fixed bin(17,0) initial dcl 7-9 fn_make_atom internal static fixed bin(17,0) initial dcl 7-9 fn_makunbound internal static fixed bin(17,0) initial dcl 7-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 7-9 fn_max internal static fixed bin(17,0) initial dcl 7-9 fn_mergef internal static fixed bin(17,0) initial dcl 7-9 fn_min internal static fixed bin(17,0) initial dcl 7-9 fn_minus internal static fixed bin(17,0) initial dcl 7-9 fn_minusp internal static fixed bin(17,0) initial dcl 7-9 fn_namelist internal static fixed bin(17,0) initial dcl 7-9 fn_names internal static fixed bin(17,0) initial dcl 7-9 fn_namestring internal static fixed bin(17,0) initial dcl 7-9 fn_nointerrupt internal static fixed bin(17,0) initial dcl 7-9 fn_nth internal static fixed bin(17,0) initial dcl 7-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 7-9 fn_oddp internal static fixed bin(17,0) initial dcl 7-9 fn_open internal static fixed bin(17,0) initial dcl 7-9 fn_opena internal static fixed bin(17,0) initial dcl 7-9 fn_openi internal static fixed bin(17,0) initial dcl 7-9 fn_openo internal static fixed bin(17,0) initial dcl 7-9 fn_out internal static fixed bin(17,0) initial dcl 7-9 fn_pagel internal static fixed bin(17,0) initial dcl 7-9 fn_pagenum internal static fixed bin(17,0) initial dcl 7-9 fn_plus internal static fixed bin(17,0) initial dcl 7-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 7-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 7-9 fn_plusp internal static fixed bin(17,0) initial dcl 7-9 fn_prin1 internal static fixed bin(17,0) initial dcl 7-9 fn_princ internal static fixed bin(17,0) initial dcl 7-9 fn_print internal static fixed bin(17,0) initial dcl 7-9 fn_prog internal static fixed bin(17,0) initial dcl 7-9 fn_progv internal static fixed bin(17,0) initial dcl 7-9 fn_putprop internal static fixed bin(17,0) initial dcl 7-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 7-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 7-9 fn_quotient internal static fixed bin(17,0) initial dcl 7-9 fn_random internal static fixed bin(17,0) initial dcl 7-9 fn_read internal static fixed bin(17,0) initial dcl 7-9 fn_read_from_string internal static fixed bin(17,0) initial dcl 7-9 fn_readch internal static fixed bin(17,0) initial dcl 7-9 fn_readstring internal static fixed bin(17,0) initial dcl 7-9 fn_remainder internal static fixed bin(17,0) initial dcl 7-9 fn_remprop internal static fixed bin(17,0) initial dcl 7-9 fn_rename internal static fixed bin(17,0) initial dcl 7-9 fn_rot internal static fixed bin(17,0) initial dcl 7-9 fn_rplaca internal static fixed bin(17,0) initial dcl 7-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 7-9 fn_save internal static fixed bin(17,0) initial dcl 7-9 fn_set internal static fixed bin(17,0) initial dcl 7-9 fn_setarg internal static fixed bin(17,0) initial dcl 7-9 fn_setq internal static fixed bin(17,0) initial dcl 7-9 fn_setsyntax internal static fixed bin(17,0) initial dcl 7-9 fn_shortnamestring internal static fixed bin(17,0) initial dcl 7-9 fn_signp internal static fixed bin(17,0) initial dcl 7-9 fn_sin internal static fixed bin(17,0) initial dcl 7-9 fn_sleep internal static fixed bin(17,0) initial dcl 7-9 fn_sort internal static fixed bin(17,0) initial dcl 7-9 fn_sortcar internal static fixed bin(17,0) initial dcl 7-9 fn_sqrt internal static fixed bin(17,0) initial dcl 7-9 fn_sstatus internal static fixed bin(17,0) initial dcl 7-9 fn_star_array internal static fixed bin(17,0) initial dcl 7-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 7-9 fn_star_sstatus internal static fixed bin(17,0) initial dcl 7-9 fn_star_status internal static fixed bin(17,0) initial dcl 7-9 fn_status internal static fixed bin(17,0) initial dcl 7-9 fn_store internal static fixed bin(17,0) initial dcl 7-9 fn_stringlength internal static fixed bin(17,0) initial dcl 7-9 fn_sub1 internal static fixed bin(17,0) initial dcl 7-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 7-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 7-9 fn_substr internal static fixed bin(17,0) initial dcl 7-9 fn_sxhash internal static fixed bin(17,0) initial dcl 7-9 fn_sysp internal static fixed bin(17,0) initial dcl 7-9 fn_throw internal static fixed bin(17,0) initial dcl 7-9 fn_times internal static fixed bin(17,0) initial dcl 7-9 fn_times_fix internal static fixed bin(17,0) initial dcl 7-9 fn_times_flo internal static fixed bin(17,0) initial dcl 7-9 fn_truename internal static fixed bin(17,0) initial dcl 7-9 fn_tyi internal static fixed bin(17,0) initial dcl 7-9 fn_tyipeek internal static fixed bin(17,0) initial dcl 7-9 fn_tyo internal static fixed bin(17,0) initial dcl 7-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 7-9 fn_zerop internal static fixed bin(17,0) initial dcl 7-9 frame_ptrs defined pointer array dcl 4-16 go_atom defined fixed bin(71,0) dcl 192 infile defined fixed bin(71,0) dcl 136 iochan based structure level 1 dcl 12-13 label_overlay based structure level 1 dcl 64 length builtin function dcl 64 lisp_fault_handler_$set_mask 000000 constant entry external dcl 2-45 lisp_get_atom_ 000000 constant entry external dcl 136 lisp_ptr based structure level 1 dcl 9-17 lisp_ptr_type based bit(36) dcl 9-17 lisp_reader_$maknam 000000 constant entry external dcl 64 lisp_special_fns_$xcons 000000 constant entry external dcl 136 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 10-6 lisp_static_vars_$catch_frame external static pointer dcl 10-6 lisp_static_vars_$ctrlD external static fixed bin(71,0) dcl 13-5 lisp_static_vars_$ctrlQ external static fixed bin(71,0) dcl 13-8 lisp_static_vars_$deferred_interrupt external static bit(1) dcl 2-45 lisp_static_vars_$errlist external static pointer dcl 136 lisp_static_vars_$frame_ptrs external static pointer array dcl 4-16 lisp_static_vars_$infile external static fixed bin(71,0) dcl 136 lisp_static_vars_$iochan_list external static pointer dcl 10-6 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 10-6 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 10-6 lisp_static_vars_$outfiles external static fixed bin(71,0) dcl 136 lisp_static_vars_$pending_ctrl external static bit(1) dcl 2-45 lisp_static_vars_$plus_status external static fixed bin(71,0) dcl 11-17 lisp_static_vars_$prog_frame external static pointer dcl 10-6 lisp_static_vars_$quote_atom external static fixed bin(71,0) dcl 11-17 lisp_static_vars_$read_print_nl_sync external static bit(36) unaligned dcl 11-17 lisp_static_vars_$readtable external static fixed bin(71,0) dcl 11-17 lisp_static_vars_$s_atom external static fixed bin(71,0) dcl 11-17 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 10-45 lisp_static_vars_$status_gctwa external static fixed bin(71,0) dcl 11-17 lisp_static_vars_$stnopoint external static fixed bin(71,0) dcl 11-17 lisp_static_vars_$top_level external static label variable dcl 10-6 lisp_static_vars_$tty_input_chan external static pointer dcl 10-6 lisp_static_vars_$tty_output_chan external static pointer dcl 10-6 lisp_static_vars_$unwp_frame external static pointer dcl 10-6 min builtin function dcl 64 msgbufb based char dcl 150 nframeptrs internal static fixed bin(17,0) initial dcl 4-16 nil_ptr based pointer dcl 10-6 not_ok_to_read internal static bit(36) initial unaligned dcl 11-9 not_ok_to_read_fixnum internal static bit(36) initial unaligned dcl 11-11 not_ok_to_write internal static bit(36) initial unaligned dcl 11-9 not_ok_to_write_fixnum internal static bit(36) initial unaligned dcl 11-11 obarray defined fixed bin(71,0) dcl 10-6 outfiles defined fixed bin(71,0) dcl 136 pending_ctrl defined bit(1) dcl 2-45 plus_status defined fixed bin(71,0) dcl 11-17 printf internal static bit(36) initial dcl 64 prog_frame defined pointer dcl 10-6 quote_atom defined fixed bin(71,0) dcl 11-17 read_print_nl_sync defined bit(36) unaligned dcl 11-17 readtable defined fixed bin(71,0) dcl 11-17 return_atom defined fixed bin(71,0) dcl 192 reverse builtin function dcl 64 s_atom defined fixed bin(71,0) dcl 11-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 10-45 status_gctwa defined fixed bin(71,0) dcl 11-17 stnopoint defined fixed bin(71,0) dcl 11-17 t_atom_ptr based pointer dcl 10-6 tty_input_chan defined pointer dcl 10-6 tty_output_chan defined pointer dcl 10-6 unwp_frame defined pointer dcl 10-6 verify builtin function dcl 64 NAMES DECLARED BY EXPLICIT CONTEXT. JOIN 002720 constant label dcl 691 ref 730 JOIN2 002725 constant label dcl 693 ref 688 badpdlptr 003035 constant entry internal dcl 768 ref 591 820 bindings 002643 constant label dcl 672 ref 666 err 001451 constant entry external dcl 529 err_aa 001522 constant label dcl 553 ref 545 561 err_op 001526 constant entry external dcl 557 errframe 001765 constant entry external dcl 738 errframe_fin 002000 constant label dcl 746 ref 649 errmes_not_there 001673 constant label dcl 619 ref 601 626 634 644 error 000501 constant entry external dcl 254 errprint 001543 constant entry external dcl 563 errprint0 001643 constant label dcl 607 set ref 600 errprint1 001677 constant label dcl 623 ref 611 612 640 645 errprint1a 001701 constant label dcl 626 ref 615 errprint_bad_pdl_ptr 001621 constant label dcl 591 ref 598 602 errprint_retry 001554 constant label dcl 568 ref 593 742 exitloop 000627 constant label dcl 290 ref 286 freturn 002511 constant entry external dcl 948 freturn0 002537 constant label dcl 958 ref 861 958 fs_err_com 001035 constant label dcl 369 handle_error 000547 constant label dcl 271 ref 248 lisp_error_ 000116 constant entry external dcl 6 ref 774 no_pdl_frame 002217 constant label dcl 847 ref 829 856 912 923 pdl_fr_0 002231 constant label dcl 854 ref 838 839 pdl_fr_1 002241 constant label dcl 861 ref 925 pdl_frame_retry 002072 constant label dcl 793 ref 822 956 pdlframe 002055 constant entry external dcl 782 pdlframe0 002166 constant label dcl 835 ref 828 pdlframe1a 002233 constant label dcl 856 ref 843 pdlframe_bad_pdl_ptr 002144 constant label dcl 820 ref 827 830 847 969 974 popoff 001410 constant label dcl 499 set ref 460 prmes 002634 constant entry internal dcl 656 prmes0 003031 constant entry internal dcl 727 ref 650 prmes_immediate 002640 constant entry internal dcl 668 ref 324 return_a_frame 002444 constant label dcl 932 ref 764 rtn_3 003034 constant label dcl 731 ref 714 skip_this_pdlframe 002410 constant label dcl 909 ref 904 spbegtv 000031 constant label array(124:125) dcl 414 ref 247 spbegxx 000477 constant label dcl 248 ref 371 417 422 spfinclrpdl 001434 constant label dcl 518 spfintv 000033 constant label array(121:128) dcl 510 ref 471 spinttv 000000 constant label array(121:145) dcl 378 ref 359 spintxx 001013 constant label dcl 360 ref 387 397 401 405 410 uint0 001152 constant label dcl 426 ref 339 367 uint1 001242 constant label dcl 452 uintdis 000702 constant label dcl 313 ref 515 uintdis0 000706 constant label dcl 317 ref 455 unwind 000717 constant label dcl 329 ref 208 261 317 468 554 unwind1 000765 constant label dcl 350 ref 464 user_interrupter 000777 constant label dcl 355 ref 308 308 313 uuint 000734 constant label dcl 335 ref 346 NAME DECLARED BY CONTEXT OR IMPLICATION. index builtin function ref 229 229 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3716 4102 3061 3726 Length 4774 3061 164 655 634 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp_error_ 224 external procedure is an external procedure. prmes internal procedure shares stack frame of external procedure lisp_error_. badpdlptr internal procedure shares stack frame of external procedure lisp_error_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lisp_error_ 000100 msgbuf lisp_error_ 000140 bits lisp_error_ 000141 err_fcn_f lisp_error_ 000142 errsw lisp_error_ 000144 stack lisp_error_ 000146 error_data lisp_error_ 000150 argument_pointer lisp_error_ 000152 evals_stack lisp_error_ 000154 unm lisp_error_ 000156 code lisp_error_ 000157 code2 lisp_error_ 000160 myname lisp_error_ 000162 label lisp_error_ 000166 unm2 lisp_error_ 000170 posf lisp_error_ 000171 loc lisp_error_ 000172 dbl_word lisp_error_ 000174 i lisp_error_ 000175 nargs lisp_error_ 000176 uint_ch_num_spec lisp_error_ 000200 marked_stack_frame lisp_error_ 000202 retlen lisp_error_ 000212 mkp prmes 000214 unmkp prmes 000216 spmsgp prmes 000220 esw prmes THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_in call_ext_out_desc call_ext_out return_mac tra_ext_2 shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. convert_status_code_ ioa_ ioa_$rsnpnnl lisp_$apply lisp_$eval lisp_alloc_ lisp_fault_handler_$nointerrupt lisp_io_control_$empty_all_buffers lisp_print_$type_nl lisp_print_$type_string lisp_prog_fns_$lisp_err lisp_prog_fns_$lisp_unwinder lisp_special_fns_$cons lisp_special_fns_$ncons THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lisp_$freturn_real lisp_error_table_$bit_tbl lisp_error_table_$fnames lisp_error_table_$fnames_hbound lisp_error_table_$hbound lisp_error_table_$msgs lisp_error_table_$not_pdl_ptr lisp_error_table_$stack_loss_error lisp_error_table_$uintnum lisp_static_vars_$apply_atom lisp_static_vars_$base lisp_static_vars_$binding_top lisp_static_vars_$ctrlR lisp_static_vars_$ctrlW lisp_static_vars_$emptying_buffers lisp_static_vars_$err_atom lisp_static_vars_$err_frame lisp_static_vars_$err_recp lisp_static_vars_$eval_atom lisp_static_vars_$eval_frame lisp_static_vars_$evalframe_atom lisp_static_vars_$garbage_collect_inhibit lisp_static_vars_$go_atom lisp_static_vars_$ibase lisp_static_vars_$masked lisp_static_vars_$nil lisp_static_vars_$pdlframe_atom lisp_static_vars_$prin1_atom lisp_static_vars_$princ_atom lisp_static_vars_$rdr_label lisp_static_vars_$rdr_ptr lisp_static_vars_$rdr_state lisp_static_vars_$readeof_atom lisp_static_vars_$return_atom lisp_static_vars_$setq_atom lisp_static_vars_$stack_ptr lisp_static_vars_$t_atom lisp_static_vars_$tty_atom lisp_static_vars_$unmkd_ptr lisp_static_vars_$user_intr_array LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 64 000112 6 000115 202 000124 203 000130 204 000134 205 000136 206 000140 207 000146 208 000165 211 000166 212 000172 213 000176 214 000200 215 000202 216 000203 218 000205 219 000207 223 000211 225 000262 226 000264 227 000266 228 000273 229 000300 231 000360 232 000363 233 000364 234 000423 235 000440 236 000444 237 000447 241 000453 243 000462 244 000465 247 000472 248 000477 254 000500 256 000507 257 000514 258 000516 259 000517 260 000521 261 000523 263 000524 264 000526 265 000530 266 000534 267 000541 268 000542 269 000544 271 000547 276 000555 277 000557 280 000573 281 000576 282 000577 284 000603 286 000613 288 000622 289 000624 290 000627 291 000630 295 000632 296 000637 298 000651 302 000653 303 000655 304 000663 308 000666 313 000702 317 000706 324 000716 329 000717 334 000732 335 000734 336 000740 337 000742 338 000750 339 000752 340 000753 343 000754 345 000762 346 000764 350 000765 351 000771 355 000777 358 001003 359 001006 360 001013 362 001016 363 001022 364 001025 366 001031 367 001034 369 001035 371 001042 378 001043 380 001045 381 001050 382 001054 383 001060 384 001063 385 001065 386 001071 387 001076 390 001077 392 001101 393 001103 394 001105 395 001107 396 001113 397 001120 399 001121 401 001123 403 001124 405 001126 408 001127 410 001131 414 001132 416 001136 417 001141 419 001142 421 001146 422 001151 426 001152 430 001156 431 001163 432 001166 433 001172 434 001175 435 001201 436 001213 437 001215 438 001217 439 001224 440 001226 441 001230 442 001233 443 001240 445 001241 452 001242 453 001245 454 001251 455 001254 456 001257 460 001263 464 001271 465 001274 467 001277 468 001301 471 001302 472 001307 473 001311 474 001313 480 001322 482 001324 483 001332 484 001334 485 001337 486 001341 487 001346 491 001351 492 001354 493 001363 494 001372 495 001375 497 001401 499 001410 501 001414 502 001417 510 001420 515 001433 518 001434 523 001443 524 001446 525 001447 529 001450 531 001457 532 001464 539 001472 540 001477 542 001503 544 001511 545 001513 547 001514 548 001516 553 001522 554 001524 557 001525 560 001534 561 001541 563 001542 565 001551 566 001552 568 001554 570 001561 571 001562 572 001565 573 001571 574 001577 575 001600 586 001611 587 001613 588 001616 589 001620 591 001621 593 001622 598 001623 600 001631 601 001635 602 001636 607 001643 609 001645 611 001653 612 001655 613 001662 614 001664 615 001671 619 001673 621 001676 623 001677 626 001701 628 001705 631 001707 632 001712 634 001715 635 001722 636 001724 639 001734 640 001740 643 001741 644 001745 645 001747 647 001750 649 001752 650 001754 652 001755 653 001761 654 001763 738 001764 740 001773 741 001775 742 001777 746 002000 748 002005 749 002011 750 002013 751 002016 752 002020 755 002024 756 002026 759 002031 760 002036 761 002046 762 002052 764 002053 782 002054 791 002063 792 002070 793 002072 795 002073 796 002077 797 002103 798 002111 800 002112 805 002120 806 002123 808 002133 814 002134 815 002136 816 002141 817 002143 820 002144 822 002145 827 002146 828 002154 829 002160 830 002161 835 002166 837 002170 838 002177 839 002201 841 002206 842 002210 843 002215 847 002217 849 002222 850 002226 851 002230 854 002231 856 002233 858 002237 861 002241 863 002244 864 002250 865 002253 866 002261 867 002263 870 002270 871 002274 876 002300 877 002302 878 002306 879 002311 880 002314 881 002322 882 002330 883 002333 884 002336 885 002343 886 002347 887 002351 888 002354 889 002360 890 002363 896 002364 897 002366 898 002370 899 002374 901 002400 902 002402 904 002403 905 002406 909 002410 912 002412 913 002416 914 002420 918 002430 919 002434 922 002435 923 002441 925 002443 932 002444 934 002450 935 002453 936 002455 938 002460 939 002465 940 002471 941 002502 942 002506 943 002507 948 002510 950 002517 951 002524 952 002526 953 002530 954 002532 955 002534 956 002536 958 002537 969 002542 974 002552 980 002556 995 002561 996 002565 997 002570 998 002572 999 002600 1000 002602 1004 002606 1005 002612 1006 002615 1007 002617 1011 002626 1014 002632 656 002634 665 002635 666 002637 668 002640 670 002641 672 002643 673 002647 674 002651 675 002654 676 002657 677 002661 678 002664 679 002666 680 002671 681 002674 682 002700 683 002704 684 002705 685 002710 686 002713 687 002715 688 002717 691 002720 693 002725 694 002731 695 002733 696 002735 697 002737 698 002743 699 002750 703 002755 704 002760 705 002764 706 002766 707 002770 708 002774 713 003001 714 003006 718 003010 719 003014 720 003020 721 003026 722 003027 723 003030 727 003031 729 003032 730 003033 731 003034 768 003035 770 003036 771 003042 772 003045 773 003047 774 003051 775 003055 ----------------------------------------------------------- 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