COMPILATION LISTING OF SEGMENT lisp_default_handler_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0844.7 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 lisp_default_handler_: proc(a_mcp, cond_name, wcptr, infoptr, continue) options(support); 7 /* This isn't actually a `support' procedure, 8* but there is a bug in default_error_handler_... */ 9 10 /* procedure for receiving most faults and signals 11* * which occur during a lisp program execution. 12* * Coded by DPR 8/14/72. 13* * alarmclock bug fixed DAMoon 18 Aug 72 14* * changed 10 March 1973 by DAM to allow for case where a fault 15* * has occurred while signalling a previous fault. The machine 16* * conditions of the previous fault are used. 17* * Modified 16 January 1974 by DAM to stop using find_fault_frame_ 18* * and use find_condition_frame_ and find_condition_info_ instead. 19* * Modified by DPR on 20 Feb. 1974 to fix problems in continuing signal introduced with 20* * deletion of listener wall. Also fixed uninitialized vars in continue_signal_aa. 21* * Modified 29 November 1979 to fix alarm clock bug while executing in 22* * pl/1 code so timers will operate properly. -- Richard S. Lamson 23* */ 24 25 dcl (wcptr, infoptr) ptr, 26 fault_type fixed bin, 27 cond_name char(*), 28 continue bit(1) aligned, 29 lisp_static_vars_$ignore_faults bit(36) aligned ext, 30 lisp_static_vars_$binding_reversal_flag bit(36) aligned external, 31 signal_ entry(char(*), ptr, ptr), 32 temp ptr, 33 stack_base ptr, 34 temp_rel bit(18), 35 lisp_fault_handler_ entry(fixed bin, ptr, fixed bin), 36 convert_status_code_ entry(fixed bin(35), char(8) aligned, char(100) aligned), 37 brief_msg char(8) aligned, 38 long_msg char(100) aligned, 39 based_ptr pointer aligned based, 40 based_lisp_data bit(72) aligned based, 41 sp pointer, 42 ioa_$ioa_switch entry options(variable), 43 iox_$error_output ext ptr, 44 nop_0_du bit(36) static init("000000000000000000000001001000000011"b), 45 (null, hbound, lbound, baseno, baseptr, addr, addrel, substr, rel, ptr, bit, fixed, unspec, add) builtin, 46 in_pl1_code_flag bit(36), 47 fault_pbr ptr, 48 action fixed bin, 49 a_mcp ptr, 50 find_condition_frame_ entry(pointer) returns(pointer), 51 find_condition_info_ entry(pointer, pointer, fixed bin(35)), 52 short_name(4:6) char(4) aligned static init("quit", "mme4", "faul"), 53 full_names(4:6) char(12) aligned static init("quit", "mme4", "fault_tag_3"), 54 insts(0:1) bit(36) aligned based; 55 56 dcl flonum float bin(63), 57 based_flonum_1 float bin(27) aligned based, 58 based_flonum_2 float bin(63) aligned based, 59 fixedb fixed bin aligned based, 60 61 1 instruction aligned, 62 2 address bit(18) unaligned, 63 2 opcode bit(10) unaligned, 64 2 modifiers bit(8) unaligned, 65 1 based_instruction based aligned structure like instruction, 66 67 lisp_fault_handler_$wipe_stack entry, 68 lisp_fault_handler_$stack_loss entry(fixed bin), 69 which_stack fixed bin, 70 lisp_segment_manager_$grow_stacks entry(fixed bin(35)), 71 72 lisp_static_vars_$divov_flag fixed bin(71) external, 73 lisp_static_vars_$zunderflow fixed bin(71) external, 74 code fixed bin(35); 75 76 dcl 1 fault_tag_3_pointer aligned based, 77 2 fault_code fixed bin(17) unaligned, 78 2 fault_tag_3 fixed bin(17) unaligned; 79 80 81 dcl 1 cond_info automatic aligned structure, 1 1 /* BEGIN INCLUDE FILE ... cond_info.incl.pl1 1 2* coded by M. Weaver 12 July 1973 */ 1 3 1 4 2 mcptr ptr, /* ptr to machine conditions at time of fault */ 1 5 2 version fixed bin, /* version of this structure (now=1) */ 1 6 2 condition_name char(32) var, /* name of condition */ 1 7 2 infoptr ptr, /* ptr to software info structure */ 1 8 2 wcptr ptr, /* ptr to wall crossing machine conditions */ 1 9 2 loc_ptr ptr, /* ptr to location where condition occurred */ 1 10 2 flags aligned, 1 11 3 crawlout bit(1) unal, /* = "1"b if condition occurred in inner ring */ 1 12 3 pad1 bit(35) unal, 1 13 2 pad_word bit(36) aligned, 1 14 2 user_loc_ptr ptr, /* ptr to last non-support loc before condition */ 1 15 2 pad (4) bit(36) aligned; 1 16 1 17 /* END INCLUDE FILE ... cond_info.incl.pl1 */ 82 2 1 /* Include file describing the data related to the free storage allocation package */ 2 2 2 3 dcl lisp_alloc_$alloc_fault_word ext bit(36) aligned, 2 4 alloc_fault_word bit(36) defined ( lisp_alloc_$alloc_fault_word), 2 5 lisp_alloc_$alloc_info bit(288) aligned ext, /* info to save for recursiveness of lisp */ 2 6 2 7 /* FAULT BIT MASKS FOR FAULT BITS IN ALLOC_FAULT_WORD 2 8* THE FAULT CODES ARE: 2 9* 6 ft3 - car or cdr of number 2 10* 5 mme4 - array oob 2 11* 4 quit 2 12* 2 alrm 2 13* 1 cput 2 14* */ 2 15 2 16 2 17 quit_fault bit(36) static init ("000000000000000000000000000000000100"b), 2 18 alrm_fault bit(36) static init ("000000000000000000000000000000000010"b), 2 19 cput_fault bit(36) static init ("000000000000000000000000000000000001"b), 2 20 2 21 fault_mask bit(36) static init ("000000000000000000000000000000000111"b), 2 22 lisp_alloc_$gc_blk_cntr ext fixed bin, /* number of 16k blocks before next gc. */ 2 23 lisp_alloc_$seg_blk_cntr ext fixed bin, /* number of 16k blocks to end of segment */ 2 24 lisp_alloc_$consptr ext ptr aligned, /* pointer to ad tally word */ 2 25 1 consptr_ovly based (addr(lisp_alloc_$consptr)) aligned, /* overlay to set further modification field of pointer */ 2 26 2 padding bit(66) unal, 2 27 2 mod bit(6) unal, 2 28 lisp_alloc_$cur_seg ext ptr aligned, /* pointer to current allocation segment */ 2 29 2 30 1 alloc_segment based aligned, /* structure of a free storage segment */ 2 31 2 next_seg ptr, /* chain to next older segment */ 2 32 2 tally_word, /* ad tally word */ 2 33 3 seg_offset bit(18) unal, /* next address in this seg to be allocated */ 2 34 3 tally bit(12) unal, /* decremented once for every 4 words, 16k runout */ 2 35 3 delta fixed bin(5) unal, /* should be set to 4, the size of a cons */ 2 36 2 pad bit(36), 2 37 2 first_allocatable_word bit(72); 2 38 2 39 /* end include file describing free storage structure */ 83 3 1 /* BEGIN INCLUDE FILE lisp_faults.incl.pl1 */ 3 2 3 3 /* 3 4* * Written 14 Aug 72 by D A Moon 3 5* * Fault codes changed 4 Feb 73 by DAM, for user interrupt masking and new alarmclock facility 3 6* * Names changed 16 Dec 1973 by DAM because of a name conflict with lisp_free_storage.incl.pl1 3 7* * Modified 74.06.03 by DAM for new-arrays 3 8* * Modified 74.12.16 by DAM to change meaning of 'masked' 3 9* */ 3 10 dcl (Alarmclock_fault init(2), 3 11 Cput_fault init(1), 3 12 Car_cdr_fault init(6), 3 13 Quit_fault init(4), 3 14 Array_fault init(5), 3 15 Zerodivide_fault init(7), 3 16 Underflow_fault init(8), 3 17 Old_store_fault init(9), /* old/new array compatibility */ 3 18 Pi_fault init(10) /* program_interrupt signal */ 3 19 ) fixed bin static; 3 20 3 21 3 22 /* structure for saving info when a fault or an error ocuurs. 3 23* This structure gets pushed onto the unmkd pdl */ 3 24 3 25 dcl 1 fault_save aligned based (unm), 3 26 2 prev_frame bit(18)unaligned, /* thread */ 3 27 2 stack_ptr bit(18) unaligned, /* rel(stack_ptr) at time frame was created */ 3 28 2 sv_gc_inhibit bit(1) unaligned, /* save lisp_static_vars_$garbage_collect_inhibit */ 3 29 2 sv_masked like masked unaligned, /* save lisp_static_vars_$masked - for err breaks in (nointerrupt t) mode */ 3 30 2 code1 fixed bin, /* error code 1, 0 = not errprintable error */ 3 31 2 code2 fixed bin, /* error code 2, for file system errors */ 3 32 2 sv_array_info ptr, /* save array_info_for_store in stack header */ 3 33 2 sv_rdr_label label, /* -> abnormal return from call to ios_$read */ 3 34 2 sv_rdr_ptr ptr, /* datum used by reader for readlist control */ 3 35 2 sv_rdr_state fixed bin, /* 0=normal, 1=wait for input, 2=readlist */ 3 36 2 sv_array_offset fixed bin(18), /* save array_offset_for_store in stack header */ 3 37 2 padding bit(36), /* make structure an even number of words in size */ 3 38 2 dat_ptr bit(18); /* rel ptr to marked pdl slot containing losing form */ 3 39 /* needed by errprint */ 3 40 /* size(fault_save) must be even */ 3 41 3 42 3 43 /* declarations of the things that get saved here */ 3 44 3 45 dcl lisp_static_vars_$garbage_collect_inhibit bit(1) aligned external, 3 46 1 lisp_static_vars_$masked aligned external like masked, 3 47 lisp_static_vars_$pending_ctrl bit(1) aligned external, /* flag that we are doing stacked-up ctrl chars 3 48* right now, makes sure none get missed if ^G */ 3 49 lisp_static_vars_$deferred_interrupt bit(1) aligned external, /* when we unmask, we test this to */ 3 50 /* see if we must poll interrupts */ 3 51 lisp_static_vars_$rdr_label label external, 3 52 lisp_static_vars_$rdr_ptr ptr external, 3 53 lisp_static_vars_$rdr_state fixed bin external, 3 54 gc_inhibit bit(1) aligned defined(lisp_static_vars_$garbage_collect_inhibit), 3 55 deferred_interrupt bit (1) aligned defined (lisp_static_vars_$deferred_interrupt), 3 56 1 masked aligned based(addr(lisp_static_vars_$masked)), /* defined causes fault in compiler */ 3 57 2 against unaligned, /* things masked against: */ 3 58 3 tty bit(1), /* tty control characters */ 3 59 3 alarm bit(1), /* alarmclock interrupts */ 3 60 pending_ctrl bit(1) aligned defined (lisp_static_vars_$pending_ctrl), 3 61 lisp_fault_handler_$set_mask entry(1 aligned like masked), 3 62 rdr_label label defined (lisp_static_vars_$rdr_label), 3 63 rdr_ptr ptr defined (lisp_static_vars_$rdr_ptr), 3 64 rdr_state fixed bin defined (lisp_static_vars_$rdr_state); 3 65 3 66 3 67 /* END INCLUDE FILE lisp_faults.incl.pl1 */ 3 68 84 85 dcl unm pointer; /* not actually used anywhere. This is just to keep the compiler happy */ 4 1 /* */ 4 2 /* BEGIN INCLUDE FILE mc.incl.pl1 Created Dec 72 for 6180 - WSS. */ 4 3 /* Modified 06/07/76 by Greenberg for mc.resignal */ 4 4 /* Modified 07/07/76 by Morris for fault register data */ 4 5 /* Modified 08/28/80 by J. A. Bush for the DPS8/70M CVPU */ 4 6 4 7 4 8 /* words 0-15 pointer registers */ 4 9 4 10 dcl mcp ptr; 4 11 4 12 dcl 1 mc based (mcp) aligned, 4 13 2 prs (0:7) ptr, /* POINTER REGISTERS */ 4 14 (2 regs, /* registers */ 4 15 3 x (0:7) bit (18), /* index registers */ 4 16 3 a bit (36), /* accumulator */ 4 17 3 q bit (36), /* q-register */ 4 18 3 e bit (8), /* exponent */ 4 19 3 pad1 bit (28), 4 20 3 t bit (27), /* timer register */ 4 21 3 pad2 bit (6), 4 22 3 ralr bit (3), /* ring alarm register */ 4 23 4 24 2 scu (0:7) bit (36), 4 25 4 26 2 mask bit (72), /* mem controller mask at time of fault */ 4 27 2 ips_temp bit (36), /* Temporary storage for IPS info */ 4 28 2 errcode fixed bin (35), /* fault handler's error code */ 4 29 2 fim_temp, 4 30 3 unique_index bit (18) unal, /* unique index for restarting faults */ 4 31 3 resignal bit (1) unal, /* recompute signal name with fcode below */ 4 32 3 fcode bit (17) unal, /* fault code used as index to FIM table and SCT */ 4 33 2 fault_reg bit (36), /* fault register */ 4 34 2 pad2 bit (1), 4 35 2 cpu_type fixed bin (2) unsigned, /* L68 = 0, DPS8/70M = 1 */ 4 36 2 ext_fault_reg bit (15), /* extended fault reg for DPS8/70M CPU */ 4 37 2 fault_time bit (54), /* time of fault */ 4 38 4 39 2 eis_info (0:7) bit (36)) unaligned; 4 40 4 41 4 42 dcl (apx fixed bin init (0), 4 43 abx fixed bin init (1), 4 44 bpx fixed bin init (2), 4 45 bbx fixed bin init (3), 4 46 lpx fixed bin init (4), 4 47 lbx fixed bin init (5), 4 48 spx fixed bin init (6), 4 49 sbx fixed bin init (7)) internal static; 4 50 4 51 4 52 4 53 4 54 dcl scup ptr; 4 55 4 56 dcl 1 scu based (scup) aligned, /* SCU DATA */ 4 57 4 58 4 59 /* WORD (0) */ 4 60 4 61 (2 ppr, /* PROCEDURE POINTER REGISTER */ 4 62 3 prr bit (3), /* procedure ring register */ 4 63 3 psr bit (15), /* procedure segment register */ 4 64 3 p bit (1), /* procedure privileged bit */ 4 65 4 66 2 apu, /* APPENDING UNIT STATUS */ 4 67 3 xsf bit (1), /* ext seg flag - IT modification */ 4 68 3 sdwm bit (1), /* match in SDW Ass. Mem. */ 4 69 3 sd_on bit (1), /* SDW Ass. Mem. ON */ 4 70 3 ptwm bit (1), /* match in PTW Ass. Mem. */ 4 71 3 pt_on bit (1), /* PTW Ass. Mem. ON */ 4 72 3 pi_ap bit (1), /* Instr Fetch or Append cycle */ 4 73 3 dsptw bit (1), /* Fetch of DSPTW */ 4 74 3 sdwnp bit (1), /* Fetch of SDW non paged */ 4 75 3 sdwp bit (1), /* Fetch of SDW paged */ 4 76 3 ptw bit (1), /* Fetch of PTW */ 4 77 3 ptw2 bit (1), /* Fetch of pre-paged PTW */ 4 78 3 fap bit (1), /* Fetch of final address paged */ 4 79 3 fanp bit (1), /* Fetch of final address non-paged */ 4 80 3 fabs bit (1), /* Fetch of final address absolute */ 4 81 4 82 2 fault_cntr bit (3), /* number of retrys of EIS instructions */ 4 83 4 84 4 85 /* WORD (1) */ 4 86 4 87 2 fd, /* FAULT DATA */ 4 88 3 iro bit (1), /* illegal ring order */ 4 89 3 oeb bit (1), /* out of execute bracket */ 4 90 3 e_off bit (1), /* no execute */ 4 91 3 orb bit (1), /* out of read bracket */ 4 92 3 r_off bit (1), /* no read */ 4 93 3 owb bit (1), /* out of write bracket */ 4 94 3 w_off bit (1), /* no write */ 4 95 3 no_ga bit (1), /* not a gate */ 4 96 3 ocb bit (1), /* out of call bracket */ 4 97 3 ocall bit (1), /* outward call */ 4 98 3 boc bit (1), /* bad outward call */ 4 99 3 inret bit (1), /* inward return */ 4 100 3 crt bit (1), /* cross ring transfer */ 4 101 3 ralr bit (1), /* ring alarm register */ 4 102 3 am_er bit (1), /* associative memory fault */ 4 103 3 oosb bit (1), /* out of segment bounds */ 4 104 3 paru bit (1), /* processor parity upper */ 4 105 3 parl bit (1), /* processor parity lower */ 4 106 3 onc_1 bit (1), /* op not complete type 1 */ 4 107 3 onc_2 bit (1), /* op not complete type 2 */ 4 108 4 109 2 port_stat, /* PORT STATUS */ 4 110 3 ial bit (4), /* illegal action lines */ 4 111 3 iac bit (3), /* illegal action channel */ 4 112 3 con_chan bit (3), /* connect channel */ 4 113 4 114 2 fi_num bit (5), /* (fault/interrupt) number */ 4 115 2 fi_flag bit (1), /* 1 => fault, 0 => interrupt */ 4 116 4 117 4 118 /* WORD (2) */ 4 119 4 120 2 tpr, /* TEMPORARY POINTER REGISTER */ 4 121 3 trr bit (3), /* temporary ring register */ 4 122 3 tsr bit (15), /* temporary segment register */ 4 123 4 124 2 pad2 bit (9), 4 125 4 126 2 cpu_no bit (3), /* CPU number */ 4 127 4 128 2 delta bit (6), /* tally modification DELTA */ 4 129 4 130 4 131 /* WORD (3) */ 4 132 4 133 2 word3 bit (18), 4 134 4 135 2 tsr_stat, /* TSR STATUS for 1,2,&3 word instructions */ 4 136 3 tsna, /* Word 1 status */ 4 137 4 prn bit (3), /* Word 1 PR number */ 4 138 4 prv bit (1), /* Word 1 PR valid bit */ 4 139 3 tsnb, /* Word 2 status */ 4 140 4 prn bit (3), /* Word 2 PR number */ 4 141 4 prv bit (1), /* Word 2 PR valid bit */ 4 142 3 tsnc, /* Word 3 status */ 4 143 4 prn bit (3), /* Word 3 PR number */ 4 144 4 prv bit (1), /* Word 3 PR valid bit */ 4 145 4 146 2 tpr_tbr bit (6), /* TPR.TBR field */ 4 147 4 148 4 149 /* WORD (4) */ 4 150 4 151 2 ilc bit (18), /* INSTRUCTION COUNTER */ 4 152 4 153 2 ir, /* INDICATOR REGISTERS */ 4 154 3 zero bit (1), /* zero indicator */ 4 155 3 neg bit (1), /* negative indicator */ 4 156 3 carry bit (1), /* carryry indicator */ 4 157 3 ovfl bit (1), /* overflow indicator */ 4 158 3 eovf bit (1), /* eponent overflow */ 4 159 3 eufl bit (1), /* exponent underflow */ 4 160 3 oflm bit (1), /* overflow mask */ 4 161 3 tro bit (1), /* tally runout */ 4 162 3 par bit (1), /* parity error */ 4 163 3 parm bit (1), /* parity mask */ 4 164 3 bm bit (1), /* ^bar mode */ 4 165 3 tru bit (1), /* truncation mode */ 4 166 3 mif bit (1), /* multi-word instruction mode */ 4 167 3 abs bit (1), /* absolute mode */ 4 168 3 pad bit (4), 4 169 4 170 4 171 /* WORD (5) */ 4 172 4 173 2 ca bit (18), /* COMPUTED ADDRESS */ 4 174 4 175 2 cu, /* CONTROL UNIT STATUS */ 4 176 3 rf bit (1), /* on first cycle of repeat instr */ 4 177 3 rpt bit (1), /* repeat instruction */ 4 178 3 rd bit (1), /* repeat double instruction */ 4 179 3 rl bit (1), /* repeat link instruciton */ 4 180 3 pot bit (1), /* IT modification */ 4 181 3 pon bit (1), /* return type instruction */ 4 182 3 xde bit (1), /* XDE from Even location */ 4 183 3 xdo bit (1), /* XDE from Odd location */ 4 184 3 poa bit (1), /* operation preparation */ 4 185 3 rfi bit (1), /* tells CPU to refetch instruction */ 4 186 3 its bit (1), /* ITS modification */ 4 187 3 if bit (1), /* fault occured during instruction fetch */ 4 188 4 189 2 cpu_tag bit (6)) unaligned, /* computed tag field */ 4 190 4 191 4 192 /* WORDS (6,7) */ 4 193 4 194 2 even_inst bit (36), /* even instruction of faulting pair */ 4 195 4 196 2 odd_inst bit (36); /* odd instruction of faulting pair */ 4 197 4 198 4 199 4 200 4 201 4 202 4 203 /* ALTERNATE SCU DECLARATION */ 4 204 4 205 4 206 dcl 1 scux based (scup) aligned, 4 207 4 208 (2 pad0 bit (36), 4 209 4 210 2 fd, /* GROUP II FAULT DATA */ 4 211 3 isn bit (1), /* illegal segment number */ 4 212 3 ioc bit (1), /* illegal op code */ 4 213 3 ia_am bit (1), /* illegal address - modifier */ 4 214 3 isp bit (1), /* illegal slave procedure */ 4 215 3 ipr bit (1), /* illegal procedure */ 4 216 3 nea bit (1), /* non existent address */ 4 217 3 oobb bit (1), /* out of bounds */ 4 218 3 pad bit (29), 4 219 4 220 2 pad2 bit (36), 4 221 4 222 2 pad3a bit (18), 4 223 4 224 2 tsr_stat (0:2), /* TSR STATUS as an ARRAY */ 4 225 3 prn bit (3), /* PR number */ 4 226 3 prv bit (1), /* PR valid bit */ 4 227 4 228 2 pad3b bit (6)) unaligned, 4 229 4 230 2 pad45 (0:1) bit (36), 4 231 4 232 2 instr (0:1) bit (36); /* Instruction ARRAY */ 4 233 4 234 4 235 4 236 /* END INCLUDE FILE mc.incl.pl1 */ 86 5 1 /* Include file lisp_common_vars.incl.pl1; 5 2* describes the external static variables which may be referenced 5 3* by lisp routines. 5 4* D. Reed 4/1/71 */ 5 5 5 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 5 7 2 cclist_ptr ptr, /* pointer to list of constants kept 5 8* by compiled programs */ 5 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 5 10 5 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 5 12 err_recp ptr defined (lisp_static_vars_$err_recp), 5 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 5 14 lisp_static_vars_$eval_frame ptr ext static, 5 15 lisp_static_vars_$prog_frame ptr ext aligned, 5 16 lisp_static_vars_$err_frame ptr ext aligned, 5 17 lisp_static_vars_$catch_frame ptr ext aligned, 5 18 lisp_static_vars_$unwp_frame ptr ext aligned, 5 19 lisp_static_vars_$stack_ptr ptr ext aligned, 5 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 5 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 5 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 5 23 lisp_static_vars_$binding_top ptr ext aligned, 5 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 5 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 5 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 5 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 5 28 binding_top ptr defined (lisp_static_vars_$binding_top), 5 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 5 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 5 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 5 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 5 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 5 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 5 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 5 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 5 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 5 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 5 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 5 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 5 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 5 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 5 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 5 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 5 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 5 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 5 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 5 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 5 49 5 50 5 51 /* end include file lisp_common_vars.incl.pl1 */ 87 6 1 /* lisp stack header format */ 6 2 /* Last modified 7/21/72 by Reed for in_pl1 flag */ 6 3 /* Modified 1978 by Greenberg for unwind-protect ops */ 6 4 6 5 declare 6 6 6 7 1 stack_seg based aligned, /* stored in base of unmkd_pdl segment */ 6 8 2 marked_stack_bottom ptr, /* where marked stack begins... */ 6 9 2 unmkd_stack_bottom ptr, /* where unmkd_ stack actually starts */ 6 10 2 stack_ptr_ptr ptr, /* points at lisp_static_vars_$stack_ptr */ 6 11 2 unmkd_ptr_ptr ptr, /* points at lisp_static_vars_$unmkd_ptr's offset word */ 6 12 2 array_pointer ptr, /* obsolete */ 6 13 2 nil fixed bin(71), /* object for nil */ 6 14 2 true fixed bin(71), /* object for t */ 6 15 2 in_pl1_code bit(36), /* flag indicating that we are in pl1 code if non-zero */ 6 16 2 padding0 bit(36), /* double word boundary preservation */ 6 17 2 bind_op ptr, /* pointers to operators for run-time support */ 6 18 2 unbind_op ptr, 6 19 2 errset1_op ptr, 6 20 2 errset2_op ptr, 6 21 2 unerrset_op ptr, 6 22 2 call_op ptr, 6 23 2 catch1_op ptr, 6 24 2 catch2_op ptr, 6 25 2 uncatch_op ptr, 6 26 2 gensym_data (2) bit(36) aligned, /* stuff used by the gensym function */ 6 27 2 system_lp ptr, /* pointer to the system's linkage section */ 6 28 2 iogbind_op ptr, 6 29 2 unseen_go_tag_op ptr, 6 30 2 throw1_op ptr, 6 31 2 throw2_op ptr, 6 32 2 signp_op ptr, 6 33 2 type_fields bit(72) aligned, /* fixnum, flonum type for compiled code */ 6 34 2 return_op ptr, 6 35 2 err_op ptr, 6 36 2 pl1_interface ptr, /* pointer to pl1 interface for type 2 subrs. */ 6 37 2 pl1_lsubr_interface ptr, /* same for type -2 subrs */ 6 38 2 cons_opr ptr, /* cons operator */ 6 39 2 ncons_opr ptr, /* ncons operator */ 6 40 2 xcons_opr ptr, /* xcons operator */ 6 41 2 begin_list_opr ptr, /* operator to make initial cell of list */ 6 42 2 append_list_opr ptr, /* operator to append to last-made cell of list */ 6 43 2 terminate_list_opr ptr, /* opeator to append last cell to next to last cell of list */ 6 44 2 compare_op ptr, /* fixnum/flonum comparison operator */ 6 45 2 link_op ptr, 6 46 2 array_operator pointer, /* accessing operator, invoked by arrays */ 6 47 2 dead_array_operator pointer, /* dead arrays invoke this operator instead */ 6 48 2 store_operator pointer, /* operator to do compiled store */ 6 49 2 floating_store_operator pointer, /* ditto, but operand is in EAQ */ 6 50 2 array_info_for_store pointer, /* -> array_info block of last array referenced */ 6 51 2 array_offset_for_store fixed bin(18), /* offset in array_data block of last array element referenced */ 6 52 2 padding bit(36), 6 53 2 array_link_snap_opr pointer, 6 54 2 create_string_desc_op ptr, 6 55 2 create_array_desc_op ptr, 6 56 2 pl1_call_op ptr, 6 57 2 cons_string_op ptr, 6 58 2 create_varying_string_op ptr, 6 59 2 unwp1_op ptr, 6 60 2 unwp2_op ptr, 6 61 2 ununwp_op ptr, 6 62 2 irest_return_op ptr, 6 63 2 pl1_call_nopop_op ptr, 6 64 2 rcv_char_star_op ptr, 6 65 2 spare2 (7) ptr, 6 66 2 begin_unmkd_stack(16325) fixed bin(71); /* rest of segment is the unmarked pdl */ 6 67 6 68 dcl call_array_operator bit(36) static init("100112273120"b3), /* tspbb ab|112,* */ 6 69 call_dead_array_operator bit(36) static init("100114273120"b3); /* tspbb ab|114,* */ 6 70 6 71 /* end stack segment format */ 88 7 1 /* Include file lisp_atom_fmt.incl.pl1; 7 2* describes internal format of atoms in the lisp system 7 3* D.Reed 4/1/71 */ 7 4 7 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 7 6 2 value fixed bin(71), /* atom's value */ 7 7 2 plist fixed bin(71), /* property list */ 7 8 2 pnamel fixed bin, /* length of print name */ 7 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 7 10 7 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 7 12 2 value ptr, 7 13 2 plist ptr, 7 14 7 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 7 16 2 value bit(72), 7 17 2 plist bit(72); 7 18 7 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 89 90 91 92 93 stack_base = ptr(unmkd_ptr, "0"b); 94 in_pl1_code_flag = stack_base -> stack_seg.in_pl1_code; 95 96 97 do fault_type = lbound(short_name, 1) to hbound(short_name, 1); 98 if substr(cond_name,1,4) = short_name(fault_type) 99 then if cond_name = full_names(fault_type) 100 then go to is_ours; 101 end; 102 fault_type = -1; /* not found, not our fault */ 103 104 is_ours: 105 join: 106 if lisp_static_vars_$binding_reversal_flag ^= ""b /* can't interrupt while reversing bindings */ 107 then if fault_type >= 5 then go to continue_signal; /* but do allow bad faults through */ 108 else do; 109 if fault_type < 0 then go to check_mc; /* ?? */ 110 lisp_static_vars_$binding_reversal_flag = lisp_static_vars_$binding_reversal_flag | bit(fixed(fault_type, 36), 36); 111 return; 112 end; 113 if lisp_alloc_$alloc_fault_word ^= "0"b 114 then if fault_type >= 5 then go to continue_signal; /* should never happen anyway */ 115 else do; 116 117 if fault_type < 0 then go to check_mc; 118 call lisp_alloc_$set_fault(fault_type); 119 dcl lisp_alloc_$set_fault entry(fixed bin); 120 return; 121 end; 122 mcp = a_mcp; 123 check_mc: 124 scup = null; /* Just in case */ 125 if mcp = null() then go to no_machine_conditions; 126 sp = mcp -> mc.prs(spx); /* get sp at time of fault */ 127 scup = addr(mcp -> mc.scu); 128 129 130 131 if in_pl1_code_flag = "0"b /* we are executing with ap, and ab|0,x7 */ 132 then do; 133 if baseno(stack_ptr) ^= baseno(mcp->mc.prs(apx)) then go to something_fishy; 134 if stack_base ^= mcp ->mc.prs(abx) then go to something_fishy; 135 unmkd_ptr = addrel(stack_base, mcp -> mc.regs.x(7)); 136 stack_ptr = mcp -> mc.prs(apx); 137 end; 138 139 no_machine_conditions: 140 if lisp_static_vars_$ignore_faults then go to continue_signal; 141 142 if fault_type ^= -1 then go to our_fault; /* if it really was ours */ 143 /* if it wasn't, we wanted to 144* go through the above code to 145* update stack_ptr, unmkd_ptr 146* before going to continue_signal 147* and letting the fault out of lisp */ 148 149 if mcp = null() then go to continue_signal; /* can't do this stuff without machine conditions */ 150 151 /* check for zerodivide and stackoverflow */ 152 153 if cond_name = "zerodivide" 154 then if in_pl1_code_flag then go to continue_signal; /* not lisp */ 155 else go to zerodivide_handler; 156 else if cond_name = "underflow" 157 then if in_pl1_code_flag then go to continue_signal; /* not lisp */ 158 else go to underflow_handler; 159 else if cond_name = "out_of_bounds" 160 then if "000"b || scu.tpr.tsr = baseno(stack_ptr) then go to marked_stack_oob; 161 else if "000"b || scu.tpr.tsr = baseno(unmkd_ptr) then go to unmarked_stack_oob; 162 163 continue_signal: 164 return_tv(2): 165 if fault_type >= 0 then if fault_type < 4 /* can't set continue bit for timer faults */ 166 then do; 167 call ioa_$ioa_switch(iox_$error_output, 168 "lisp: Timer ignored, no lisp environment was present."); /* let user know this happened */ 169 return; 170 end; 171 continue_signal_aa: 172 if lisp_static_vars_$ignore_faults 173 then do; /* we must just pass things through */ 174 /* set continue flag, and restore state, then return to signal_ */ 175 continue = "1"b; 176 stack_base -> stack_seg.in_pl1_code = in_pl1_code_flag; 177 return; 178 end; 179 else do; /* we have to change lisp_static_vars_$ignore_faults, 180* but have to have a stack frame around to to restore 181* it if the ultimate handler chooses to return */ 182 lisp_static_vars_$ignore_faults = (36) "1"b; 183 184 /* now if we resignal the same thing, will get back past lisp's default handler */ 185 186 call signal_ (cond_name, a_mcp, infoptr); 187 lisp_static_vars_$ignore_faults = (36) "0"b; /* restore state back */ 188 stack_base -> stack_seg.in_pl1_code = in_pl1_code_flag; 189 return; 190 end; 191 192 our_fault: 193 stack_base -> stack_seg.in_pl1_code = "1"b; /* set up for lisp_fault_handler_ call */ 194 action = 0; 195 if mcp ^= null() 196 then fault_pbr = addrel(baseptr("000"b||scup->scu.ppr.psr), scup -> scu.ilc); 197 else fault_pbr = null; /* Ah well */ 198 199 /* for fault_tag_3 faults, the fault code comes from the 200* segment number field of the faulted pointer */ 201 202 if fault_type = Car_cdr_fault then do; 203 code = addrel(baseptr("000"b||scup->scu.tpr.tsr), scup->scu.ca) -> fault_tag_3_pointer.fault_code; 204 if code = 1 then fault_type = Old_store_fault; 205 else if code = 2 then fault_type = Array_fault; 206 end; 207 208 call lisp_fault_handler_(fault_type, fault_pbr, action); 209 210 stack_base -> stack_seg.in_pl1_code = in_pl1_code_flag; 211 go to return_tv(action); 212 213 return_tv(1): /* move to new address */ 214 215 scup -> scu.ppr.psr = substr(baseno(fault_pbr),4,15); /* get seg # */ 216 scup -> scu.ilc = rel(fault_pbr); /* force ilc to addr */ 217 scup -> scu.cu.rfi = "1"b; 218 return_tv(0): 219 return; 220 221 return_tv(3): /* old array store kludge - redo the store with new address */ 222 223 fault_pbr -> based_lisp_data = mcp -> mc.a || mcp -> mc.q; /* store aq */ 224 scup -> scu.ilc = bit(fixed(fixed(scup -> scu.ilc, 18)+1, 18), 18); /* skip over staq inst. */ 225 scup -> scu.cu.rfi = "1"b; 226 return; 227 228 program_interrupt: entry; 229 230 lisp_static_vars_$ignore_faults = "0"b; /* considered to be in lisp now */ 231 action = 0; 232 call lisp_fault_handler_ ((Pi_fault), null(), action); 233 go to process_quit_return; 234 235 deferred_quit: entry; 236 237 dcl quit condition; 238 239 handle_defer_quit: 240 lisp_static_vars_$ignore_faults = "0"b; /* if pi, we're back in lisp now */ 241 action = 0; 242 call lisp_fault_handler_((Quit_fault), null(), action); 243 process_quit_return: 244 if action ^= 0 then do; 245 dcl lisp_static_vars_$transparent bit(1) external; 246 247 lisp_static_vars_$ignore_faults = "1"b; 248 lisp_static_vars_$transparent = "1"b; /* to let this one quit get through */ 249 signal quit; /* after a great struggle, this will get you out to command level */ 250 lisp_static_vars_$ignore_faults = "0"b; 251 end; 252 return; 253 254 255 alarm: entry(a_mcp, cond_name); /* called by timer_manager_ for lisp 'alarmclock' function */ 256 257 mcp = a_mcp; 258 stack_base = ptr(unmkd_ptr, "0"b); 259 in_pl1_code_flag = stack_base -> stack_seg.in_pl1_code; 260 261 if cond_name = "alrm" then fault_type = 2; 262 else if cond_name = "cput" then fault_type = 1; 263 else fault_type = 3; /* shouldn't happen, lisp_fault_handler_ will give the err msg */ 264 265 go to join; 266 267 alloc_fault: entry(fault_bits); 268 269 dcl fault_bits bit(36) aligned; 270 271 if fault_bits & alrm_fault then call lisp_fault_handler_(2, null, 0); 272 if fault_bits & cput_fault then call lisp_fault_handler_(1, null, 0); 273 if fault_bits & quit_fault then go to handle_defer_quit; 274 return; 275 276 277 278 /* 279* There's something fishy going on here: 280* in_pl1_code is zero, yet ab is not pointing at the stack. 281* This could because no lisp is around, or because lisp has a bug 282* in it and took some kind of fault and then a timer went off, 283* or because a timer went off while some other fault was being 284* signalled. In the latter case, we want to use the machine conditions 285* of the original fault, i.e. lisp's machine conditions not signal_'s. 286* In the other two cases we go to continue_signal to let default_error_handler_ 287* handle it or else to ignore a timer fault that occurs at an inopportune time. 288* */ 289 290 something_fishy: 291 292 sp = find_condition_frame_(sp); 293 if sp = null then go to continue_signal; /* no fault frame was found */ 294 cond_info.version = 1; /* varsion number of structure I allocate */ 295 call find_condition_info_(sp, addr(cond_info), code); 296 if code ^= 0 then go to continue_signal; /* not of interest */ 297 mcp = cond_info.mcptr; /* machine conditions at previous fault */ 298 if cond_info.condition_name ^= "quit" 299 then if cond_info.condition_name ^= "cput" 300 then if cond_info.condition_name ^= "alrm" 301 then if cond_info.condition_name ^= "mme4" 302 then if cond_info.condition_name ^= "fault_tag_3" 303 then go to continue_signal; /* some bad fault happened - probably a bug in lisp 304* so we don't want to reenter it because that might 305* terminate the process. */ 306 go to check_mc; /*** found a previous fault, so go look at its machine conditions (mcp has been changed) */ 307 308 /* come here to see if we have a stack overflow (oob fault caused by setting max length) */ 309 310 marked_stack_oob: 311 which_stack = 2; 312 go to stack_oob; 313 unmarked_stack_oob: /* for now, assume any oob on these segments is an overflow */ 314 which_stack = 3; 315 316 stack_oob: 317 318 stack_base -> stack_seg.in_pl1_code = "1"b; /* set up for lisp_fault_handler_ call */ 319 call lisp_segment_manager_$grow_stacks(code); /* make stacks big enough to handle fail-act */ 320 if code ^= 0 then do; 321 call convert_status_code_(code, brief_msg, long_msg); 322 call ioa_$ioa_switch(iox_$error_output, "lisp: Stack overflow. (^a)^/^-An automatic ctrl/g occurs.", long_msg); 323 call lisp_fault_handler_$wipe_stack; 324 end; 325 /* take a fail-act. */ 326 327 call lisp_fault_handler_$stack_loss(which_stack); 328 329 /* come here attempting to restart program after stack overflow. 330* assume that a simple rcu is sufficient because max length of stack segs has changed. */ 331 332 stack_base -> stack_seg.in_pl1_code = in_pl1_code_flag; 333 return; 334 335 336 337 /* come here to do (status divov) hack when a zerodivide interrupt occurs */ 338 339 zerodivide_handler: 340 stack_base -> stack_seg.in_pl1_code = "1"b; /* set up for lisp_fault_handler_ call */ 341 342 /* see if user has done (sstatus divov t), which turns on the hackery below */ 343 344 if lisp_static_vars_$divov_flag = nil then go to zerodivide_fail_act; /* no special hackery desired */ 345 zerodivide_hackery: 346 347 /* first get the instruction being executed at the time. 348* Because the 6180 carefully clobbers the instruction 349* register on a zerodivide fault, we have to fetch it ourselves */ 350 351 instruction = ptr(baseptr("000"b || scu.ppr.psr), scu.ilc) -> based_instruction; 352 hack_instruction: 353 354 /* now hack the registers to make the result of the divide be the numerator plus 1 */ 355 356 if instruction.opcode = "1010001100"b /* div */ 357 then do; 358 addr(mc.q) -> fixedb = addr(mc.q) -> fixedb + 1; 359 mc.a = (36)"0"b; 360 end; 361 else if instruction.opcode = "1011101010"b | instruction.opcode = "1011101110"b /* fdv, dfdv */ 362 then do; 363 unspec(flonum) = mc.e || mc.a || mc.q; /* more or less a double-precision floating point number */ 364 hack_flonum: 365 flonum = flonum + 1.0; 366 mc.e = substr(unspec(flonum), 1, 8); 367 mc.a = substr(unspec(flonum), 9, 36); 368 mc.q = substr(unspec(flonum), 45, 28) || (8)"0"b; 369 end; 370 else if instruction.opcode = "1010101010"b /* fdi */ 371 then do; 372 flonum = ptr(baseptr("000"b || scu.tpr.tsr), scu.ca) -> based_flonum_1; 373 go to hack_flonum; 374 end; 375 else if instruction.opcode = "1010101110"b /* dfdi */ 376 then do; 377 flonum = ptr(baseptr("000"b || scu.tpr.tsr), scu.ca) -> based_flonum_2; 378 go to hack_flonum; 379 end; 380 else if instruction.opcode = "1110011100"b /* xec - used by lisp_utils_ */ 381 then do; 382 call compute_effective_address; 383 instruction = temp -> based_instruction; 384 go to hack_instruction; 385 end; 386 else if instruction.opcode = "111001111"b /* xed - used by lisp_utils_ */ 387 then do; 388 call compute_effective_address; 389 if scu.cu.xdo then temp = addrel(temp, 1); /* divide was odd instruction */ 390 else if scu.cu.xde then; /* divide was even instruction */ 391 else go to continue_signal; /* not xed??? - something lost. */ 392 instruction = temp -> based_instruction; 393 go to hack_instruction; 394 end; 395 else go to continue_signal; /* some random instruction we don't know about, 396* such as decimal divide. Let loser see error message */ 397 398 /* resume processing with next instruction after divide, the registers have been hacked */ 399 400 scu.ilc = bit(add(fixed(scu.ilc,18), 1, 18, 0), 18); /* resume with instruction after divide */ 401 scu.cu.rfi = "1"b; 402 stack_base -> stack_seg.in_pl1_code = in_pl1_code_flag; 403 return; 404 405 /* internal proc to compute effective address of instruction. 406* this is simplified version which works with those cases 407* that appear in the LISP arithmetic routines in connection with xec and xed instructions */ 408 409 compute_effective_address: proc; 410 411 dcl modif fixed bin(8); 412 413 temp = baseptr("000"b || scu.ppr.psr); /* -> seg containing instruction */ 414 modif = fixed(instruction.modifiers, 8); 415 if modif >= 16 then go to continue_signal; /* unknown */ 416 417 /* simple r or n modification, no abr */ 418 419 if modif = 0 then temp = ptr(temp, instruction.address); 420 else if modif >= 8 then temp = ptr(temp, fixed(instruction.address, 18) + 421 fixed(mc.regs.x(modif-8), 18)); /* ,x_n */ 422 else go to continue_signal; /* can't hack ,ic ,du etc. */ 423 end; 424 425 426 /* gve (quotient 0) fail-act for zerodivide */ 427 428 zerodivide_fail_act: 429 call lisp_fault_handler_(Zerodivide_fault, (null), (0)); 430 go to zerodivide_hackery; /* if it returns, we are to hack the instruction even though (status divov) was nil */ 431 432 /***** underflow handling - depends on value of zunderflow *****/ 433 434 underflow_handler: 435 stack_base -> stack_seg.in_pl1_code = "1"b; /* set up for lisp_fault_handler_ call */ 436 437 if addr(lisp_static_vars_$zunderflow) -> based_ptr -> atom.value = nil then go to underflow_error; 438 439 hack_underflow: 440 /* magically change underflow into a non-error by setting the eaq to zero and proceeding 441* with the next instruction. */ 442 443 /* declare a name by which we can refer to the opcode field of the current instruction 444* field in the scu data. Note: the name even is a misnomer left over from the 645 */ 445 446 declare 1 current_instruction aligned based(addr(scup -> scu.even_inst)), 447 2 address_part bit(18) unaligned, 448 2 current_op_code bit(10) unaligned, 449 2 inhibit_bit bit(1) unaligned, 450 2 ptr_reg_tab bit(1) unaligned, 451 2 modifier bit(6) unaligned; 452 453 mcp -> mc.regs.a, mcp -> mc.regs.q = (36)"0"b; /* actually the fim does this, but I'm */ 454 mcp -> mc.regs.e = "10000000"b; /* not going to rely on anyone as untrustworthy */ 455 /* as the fim! */ 456 if current_op_code ^= "1001100000"b /* check for store instructions */ 457 then if current_op_code ^= "1001110100"b /* which are retried. Other instructions */ 458 then if current_op_code ^= "1001011010"b 459 then if current_op_code ^= "1001011110"b then 460 scup -> scu.ilc = 461 bit(fixed(fixed(scup -> scu.ilc, 18) /* increment the ilc to skip over the */ 462 + 1, 18), 18); /* instruction that underflew */ 463 scup -> scu.cu.rfi = "1"b; /* set this bit and CPU does everything else */ 464 465 stack_base -> stack_seg.in_pl1_code = in_pl1_code_flag; 466 return; 467 468 underflow_error: 469 470 call lisp_fault_handler_(Underflow_fault, (null), (0)); 471 go to hack_underflow; /* return indicates should go make result zero */ 472 473 end lisp_default_handler_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.2 lisp_default_handler_.pl1 >special_ldd>on>06/27/83>lisp_default_handler_.pl1 82 1 05/06/74 1741.0 cond_info.incl.pl1 >ldd>include>cond_info.incl.pl1 83 2 03/27/82 0437.0 lisp_free_storage.incl.pl1 >ldd>include>lisp_free_storage.incl.pl1 84 3 03/27/82 0437.0 lisp_faults.incl.pl1 >ldd>include>lisp_faults.incl.pl1 86 4 08/12/81 2025.8 mc.incl.pl1 >ldd>include>mc.incl.pl1 87 5 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 88 6 06/29/83 1425.3 lisp_stack_seg.incl.pl1 >ldd>include>lisp_stack_seg.incl.pl1 89 7 03/27/82 0437.1 lisp_atom_fmt.incl.pl1 >ldd>include>lisp_atom_fmt.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) Alarmclock_fault internal static fixed bin(17,0) initial dcl 3-10 Array_fault constant fixed bin(17,0) initial dcl 3-10 ref 205 Car_cdr_fault constant fixed bin(17,0) initial dcl 3-10 ref 202 Cput_fault internal static fixed bin(17,0) initial dcl 3-10 Old_store_fault constant fixed bin(17,0) initial dcl 3-10 ref 204 Pi_fault constant fixed bin(17,0) initial dcl 3-10 ref 232 Quit_fault constant fixed bin(17,0) initial dcl 3-10 ref 242 Underflow_fault 000011 internal static fixed bin(17,0) initial dcl 3-10 set ref 468* Zerodivide_fault 000010 internal static fixed bin(17,0) initial dcl 3-10 set ref 428* a 24 based bit(36) level 3 packed unaligned dcl 4-12 set ref 221 359* 363 367* 453* a_mcp parameter pointer dcl 25 set ref 6 122 186* 255 257 abx constant fixed bin(17,0) initial dcl 4-42 ref 134 action 000150 automatic fixed bin(17,0) dcl 25 set ref 194* 208* 211 231* 232* 241* 242* 243 add builtin function dcl 25 ref 400 addr builtin function dcl 25 ref 127 295 295 358 358 437 456 456 456 456 addrel builtin function dcl 25 ref 135 195 203 389 address 000154 automatic bit(18) level 2 packed unaligned dcl 56 set ref 419 420 alarm 000730 constant entry external dcl 255 alloc_fault 001004 constant entry external dcl 267 alloc_fault_word defined bit(36) unaligned dcl 2-3 alloc_segment based structure level 1 dcl 2-3 alrm_fault constant bit(36) initial unaligned dcl 2-3 ref 271 apx constant fixed bin(17,0) initial dcl 4-42 ref 133 136 array_atom defined fixed bin(71,0) dcl 5-6 atom based structure level 1 dcl 7-5 atom_double_words based structure level 1 dcl 7-5 atom_ptrs based structure level 1 dcl 7-5 based_flonum_1 based float bin(27) dcl 56 ref 372 based_flonum_2 based float bin(63) dcl 56 ref 377 based_instruction based structure level 1 dcl 56 ref 345 383 392 based_lisp_data based bit(72) dcl 25 set ref 221* based_ptr based pointer dcl 25 ref 437 baseno builtin function dcl 25 ref 133 133 159 161 213 baseptr builtin function dcl 25 ref 195 203 345 372 377 413 bbx internal static fixed bin(17,0) initial dcl 4-42 binding_top defined pointer dcl 5-6 bit builtin function dcl 25 ref 110 224 400 456 bpx internal static fixed bin(17,0) initial dcl 4-42 brief_msg 000106 automatic char(8) dcl 25 set ref 321* ca 5 based bit(18) level 2 packed unaligned dcl 4-56 ref 203 372 377 call_array_operator internal static bit(36) initial unaligned dcl 6-68 call_dead_array_operator internal static bit(36) initial unaligned dcl 6-68 catch_frame defined pointer dcl 5-6 check_mc 000233 constant label dcl 123 ref 109 117 306 code 000156 automatic fixed bin(35,0) dcl 56 set ref 203* 204 205 295* 296 319* 320 321* compute_effective_address 001632 constant entry internal dcl 409 ref 382 388 cond_info 000160 automatic structure level 1 dcl 81 set ref 295 295 cond_name parameter char unaligned dcl 25 set ref 6 98 98 153 156 159 186* 255 261 262 condition_name 3 000160 automatic varying char(32) level 2 dcl 81 set ref 298 298 298 298 298 consptr_ovly based structure level 1 dcl 2-3 continue parameter bit(1) dcl 25 set ref 6 175* continue_signal 000402 constant label dcl 163 ref 104 113 139 149 153 156 293 296 298 391 395 415 422 continue_signal_aa 000427 constant label dcl 171 convert_status_code_ 000022 constant entry external dcl 25 ref 321 cput_fault constant bit(36) initial unaligned dcl 2-3 ref 272 cu 5(18) based structure level 2 packed unaligned dcl 4-56 current_instruction based structure level 1 dcl 439 current_op_code 0(18) based bit(10) level 2 packed unaligned dcl 439 ref 456 456 456 456 deferred_interrupt defined bit(1) dcl 3-45 deferred_quit 000660 constant entry external dcl 235 e 26 based bit(8) level 3 packed unaligned dcl 4-12 set ref 363 366* 454* err_frame defined pointer dcl 5-6 err_recp defined pointer dcl 5-6 eval_frame defined pointer dcl 5-6 even_inst 6 based bit(36) level 2 dcl 4-56 set ref 456 456 456 456 fault_bits parameter bit(36) dcl 269 ref 267 271 272 273 fault_code based fixed bin(17,0) level 2 packed unaligned dcl 76 ref 203 fault_mask internal static bit(36) initial unaligned dcl 2-3 fault_pbr 000146 automatic pointer dcl 25 set ref 195* 197* 208* 213 216 221 fault_save based structure level 1 dcl 3-25 fault_tag_3_pointer based structure level 1 dcl 76 fault_type 000100 automatic fixed bin(17,0) dcl 25 set ref 97* 98 98* 102* 104 109 110 113 117 118* 142 163 163 202 204* 205* 208* 261* 262* 263* find_condition_frame_ 000030 constant entry external dcl 25 ref 290 find_condition_info_ 000032 constant entry external dcl 25 ref 295 fixed builtin function dcl 25 ref 110 224 224 400 414 420 420 456 456 fixedb based fixed bin(17,0) dcl 56 set ref 358* 358 flonum 000152 automatic float bin(63) dcl 56 set ref 363* 364* 364 366 367 368 372* 377* full_names 000004 constant char(12) initial array dcl 25 ref 98 gc_inhibit defined bit(1) dcl 3-45 hack_flonum 001355 constant label dcl 364 ref 373 378 hack_instruction 001306 constant label dcl 352 ref 384 393 hack_underflow 001542 constant label dcl 439 ref 471 handle_defer_quit 000666 constant label dcl 239 ref 273 hbound builtin function dcl 25 ref 97 ilc 4 based bit(18) level 2 packed unaligned dcl 4-56 set ref 195 216* 224* 224 345 400* 400 456* 456 in_pl1_code 16 based bit(36) level 2 dcl 6-5 set ref 94 176* 188* 192* 210* 259 316* 332* 339* 402* 434* 465* in_pl1_code_flag 000144 automatic bit(36) unaligned dcl 25 set ref 94* 131 153 156 176 188 210 259* 332 402 465 infoptr parameter pointer dcl 25 set ref 6 186* instruction 000154 automatic structure level 1 dcl 56 set ref 345* 383* 392* insts based bit(36) array dcl 25 ioa_$ioa_switch 000024 constant entry external dcl 25 ref 167 322 iox_$error_output 000026 external static pointer dcl 25 set ref 167* 322* is_ours 000166 constant label dcl 104 ref 98 join 000166 constant label dcl 104 ref 265 lbound builtin function dcl 25 ref 97 lbx internal static fixed bin(17,0) initial dcl 4-42 lisp_alloc_$alloc_fault_word 000046 external static bit(36) dcl 2-3 ref 113 lisp_alloc_$alloc_info external static bit(288) dcl 2-3 lisp_alloc_$consptr external static pointer dcl 2-3 lisp_alloc_$cur_seg external static pointer dcl 2-3 lisp_alloc_$gc_blk_cntr external static fixed bin(17,0) dcl 2-3 lisp_alloc_$seg_blk_cntr external static fixed bin(17,0) dcl 2-3 lisp_alloc_$set_fault 000056 constant entry external dcl 119 ref 118 lisp_default_handler_ 000115 constant entry external dcl 6 lisp_fault_handler_ 000020 constant entry external dcl 25 ref 208 232 242 271 272 428 468 lisp_fault_handler_$set_mask 000000 constant entry external dcl 3-45 lisp_fault_handler_$stack_loss 000036 constant entry external dcl 56 ref 327 lisp_fault_handler_$wipe_stack 000034 constant entry external dcl 56 ref 323 lisp_segment_manager_$grow_stacks 000040 constant entry external dcl 56 ref 319 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 5-6 lisp_static_vars_$binding_reversal_flag 000014 external static bit(36) dcl 25 set ref 104 110* 110 lisp_static_vars_$binding_top external static pointer dcl 5-6 lisp_static_vars_$catch_frame external static pointer dcl 5-6 lisp_static_vars_$deferred_interrupt external static bit(1) dcl 3-45 lisp_static_vars_$divov_flag 000042 external static fixed bin(71,0) dcl 56 ref 344 lisp_static_vars_$err_frame external static pointer dcl 5-6 lisp_static_vars_$err_recp external static pointer dcl 5-6 lisp_static_vars_$eval_frame external static pointer dcl 5-6 lisp_static_vars_$garbage_collect_inhibit external static bit(1) dcl 3-45 lisp_static_vars_$ignore_faults 000012 external static bit(36) dcl 25 set ref 139 171 182* 187* 230* 239* 247* 250* lisp_static_vars_$iochan_list external static pointer dcl 5-6 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 5-6 lisp_static_vars_$masked external static structure level 1 dcl 3-45 lisp_static_vars_$nil 000054 external static fixed bin(71,0) dcl 5-6 ref 344 344 437 437 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 5-6 lisp_static_vars_$pending_ctrl external static bit(1) dcl 3-45 lisp_static_vars_$prog_frame external static pointer dcl 5-6 lisp_static_vars_$rdr_label external static label variable dcl 3-45 lisp_static_vars_$rdr_ptr external static pointer dcl 3-45 lisp_static_vars_$rdr_state external static fixed bin(17,0) dcl 3-45 lisp_static_vars_$stack_ptr 000050 external static pointer dcl 5-6 set ref 133 133 136* 136 159 159 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 5-45 lisp_static_vars_$t_atom external static fixed bin(71,0) dcl 5-6 lisp_static_vars_$top_level external static label variable dcl 5-6 lisp_static_vars_$transparent 000060 external static bit(1) unaligned dcl 245 set ref 248* lisp_static_vars_$tty_input_chan external static pointer dcl 5-6 lisp_static_vars_$tty_output_chan external static pointer dcl 5-6 lisp_static_vars_$unmkd_ptr 000052 external static pointer dcl 5-6 set ref 93 93 135* 135 161 161 258 258 lisp_static_vars_$unwp_frame external static pointer dcl 5-6 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 5-45 lisp_static_vars_$zunderflow 000044 external static fixed bin(71,0) dcl 56 set ref 437 long_msg 000110 automatic char(100) dcl 25 set ref 321* 322* lpx internal static fixed bin(17,0) initial dcl 4-42 marked_stack_oob 001163 constant label dcl 310 ref 159 masked based structure level 1 dcl 3-45 mc based structure level 1 dcl 4-12 mcp 000212 automatic pointer dcl 4-10 set ref 122* 125 126 127 133 134 135 136 149 195 221 221 257* 297* 358 358 359 363 363 363 366 367 368 420 453 453 454 mcptr 000160 automatic pointer level 2 dcl 81 set ref 297 modif 000232 automatic fixed bin(8,0) dcl 411 set ref 414* 415 419 420 420 modifiers 0(28) 000154 automatic bit(8) level 2 packed unaligned dcl 56 set ref 414 nil defined fixed bin(71,0) dcl 5-6 ref 344 437 nil_ptr based pointer dcl 5-6 no_machine_conditions 000305 constant label dcl 139 ref 125 nop_0_du internal static bit(36) initial unaligned dcl 25 null builtin function dcl 25 ref 123 125 149 195 197 232 232 242 242 271 271 272 272 293 428 468 obarray defined fixed bin(71,0) dcl 5-6 opcode 0(18) 000154 automatic bit(10) level 2 packed unaligned dcl 56 set ref 352 361 361 370 375 380 386 our_fault 000472 constant label dcl 192 ref 142 pending_ctrl defined bit(1) dcl 3-45 ppr based structure level 2 packed unaligned dcl 4-56 process_quit_return 000707 constant label dcl 243 ref 233 prog_frame defined pointer dcl 5-6 program_interrupt 000627 constant entry external dcl 228 prs based pointer array level 2 dcl 4-12 ref 126 133 134 136 psr 0(03) based bit(15) level 3 packed unaligned dcl 4-56 set ref 195 213* 345 413 ptr builtin function dcl 25 ref 93 258 345 372 377 419 420 q 25 based bit(36) level 3 packed unaligned dcl 4-12 set ref 221 358 358 363 368* 453* quit 000216 stack reference condition dcl 237 ref 249 quit_fault constant bit(36) initial unaligned dcl 2-3 ref 273 rdr_label defined label variable dcl 3-45 rdr_ptr defined pointer dcl 3-45 rdr_state defined fixed bin(17,0) dcl 3-45 regs 20 based structure level 2 packed unaligned dcl 4-12 rel builtin function dcl 25 ref 216 return_tv 000000 constant label array(0:3) dcl 163 ref 211 rfi 5(27) based bit(1) level 3 packed unaligned dcl 4-56 set ref 217* 225* 401* 463* sbx internal static fixed bin(17,0) initial dcl 4-42 scu based structure level 1 dcl 4-56 in procedure "lisp_default_handler_" scu 30 based bit(36) array level 2 in structure "mc" packed unaligned dcl 4-12 in procedure "lisp_default_handler_" set ref 127 scup 000214 automatic pointer dcl 4-54 set ref 123* 127* 159 161 195 195 203 203 213 216 217 224 224 225 345 345 372 372 377 377 389 390 400 400 401 413 456 456 456 456 456 456 463 scux based structure level 1 dcl 4-206 short_name 000015 constant char(4) initial array dcl 25 ref 97 97 98 signal_ 000016 constant entry external dcl 25 ref 186 something_fishy 001070 constant label dcl 290 ref 133 134 sp 000142 automatic pointer dcl 25 set ref 126* 290* 290* 293 295* spx constant fixed bin(17,0) initial dcl 4-42 ref 126 stack_base 000104 automatic pointer dcl 25 set ref 93* 94 134 135 176 188 192 210 258* 259 316 332 339 402 434 465 stack_oob 001170 constant label dcl 316 ref 312 stack_ptr defined pointer dcl 5-6 set ref 133 136* 159 stack_seg based structure level 1 dcl 6-5 star_rset defined fixed bin(71,0) dcl 5-45 substr builtin function dcl 25 ref 98 213 366 367 368 t_atom defined fixed bin(71,0) dcl 5-6 t_atom_ptr based pointer dcl 5-6 temp 000102 automatic pointer dcl 25 set ref 383 389* 389 392 413* 419* 419 420* 420 temp_rel automatic bit(18) unaligned dcl 25 tpr 2 based structure level 2 packed unaligned dcl 4-56 tsr 2(03) based bit(15) level 3 packed unaligned dcl 4-56 ref 159 161 203 372 377 tty_input_chan defined pointer dcl 5-6 tty_output_chan defined pointer dcl 5-6 underflow_error 001614 constant label dcl 468 ref 437 underflow_handler 001532 constant label dcl 434 ref 158 unm automatic pointer dcl 85 unmarked_stack_oob 001166 constant label dcl 313 ref 161 unmkd_ptr defined pointer dcl 5-6 set ref 93 135* 161 258 unspec builtin function dcl 25 set ref 363* 366 367 368 unwp_frame defined pointer dcl 5-6 user_intr_array defined fixed bin(71,0) array dcl 5-45 value based fixed bin(71,0) level 2 dcl 7-5 ref 437 version 2 000160 automatic fixed bin(17,0) level 2 dcl 81 set ref 294* wcptr parameter pointer dcl 25 ref 6 which_stack 000155 automatic fixed bin(17,0) dcl 56 set ref 310* 313* 327* x 20 based bit(18) array level 3 packed unaligned dcl 4-12 ref 135 420 xde 5(24) based bit(1) level 3 packed unaligned dcl 4-56 ref 390 xdo 5(25) based bit(1) level 3 packed unaligned dcl 4-56 ref 389 zerodivide_fail_act 001514 constant label dcl 428 ref 344 zerodivide_hackery 001271 constant label dcl 345 ref 430 zerodivide_handler 001262 constant label dcl 339 ref 155 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2214 2276 1702 2224 Length 2664 1702 62 352 312 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp_default_handler_ 207 external procedure is an external procedure. compute_effective_address internal procedure shares stack frame of external procedure lisp_default_handler_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 Zerodivide_fault lisp_default_handler_ 000011 Underflow_fault lisp_default_handler_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lisp_default_handler_ 000100 fault_type lisp_default_handler_ 000102 temp lisp_default_handler_ 000104 stack_base lisp_default_handler_ 000106 brief_msg lisp_default_handler_ 000110 long_msg lisp_default_handler_ 000142 sp lisp_default_handler_ 000144 in_pl1_code_flag lisp_default_handler_ 000146 fault_pbr lisp_default_handler_ 000150 action lisp_default_handler_ 000152 flonum lisp_default_handler_ 000154 instruction lisp_default_handler_ 000155 which_stack lisp_default_handler_ 000156 code lisp_default_handler_ 000160 cond_info lisp_default_handler_ 000212 mcp lisp_default_handler_ 000214 scup lisp_default_handler_ 000232 modif compute_effective_address THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_bs call_ext_out_desc call_ext_out return signal shorten_stack ext_entry ext_entry_desc set_support THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. convert_status_code_ find_condition_frame_ find_condition_info_ ioa_$ioa_switch lisp_alloc_$set_fault lisp_fault_handler_ lisp_fault_handler_$stack_loss lisp_fault_handler_$wipe_stack lisp_segment_manager_$grow_stacks signal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. iox_$error_output lisp_alloc_$alloc_fault_word lisp_static_vars_$binding_reversal_flag lisp_static_vars_$divov_flag lisp_static_vars_$ignore_faults lisp_static_vars_$nil lisp_static_vars_$stack_ptr lisp_static_vars_$transparent lisp_static_vars_$unmkd_ptr lisp_static_vars_$zunderflow LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000110 93 000131 94 000134 97 000136 98 000143 101 000162 102 000164 104 000166 109 000175 110 000200 111 000206 113 000207 117 000215 118 000220 120 000226 122 000227 123 000233 125 000235 126 000241 127 000245 131 000250 133 000252 134 000266 135 000275 136 000302 139 000305 142 000311 149 000315 153 000322 155 000334 156 000335 158 000344 159 000345 161 000366 163 000402 167 000406 169 000426 171 000427 175 000432 176 000435 177 000440 182 000441 186 000443 187 000464 188 000466 189 000471 192 000472 194 000475 195 000476 197 000516 202 000520 203 000523 204 000540 205 000545 208 000551 210 000563 211 000566 213 000570 216 000576 217 000601 218 000603 221 000604 224 000612 225 000623 226 000625 228 000626 230 000635 231 000637 232 000640 233 000656 235 000657 239 000666 241 000670 242 000671 243 000707 247 000711 248 000714 249 000716 250 000721 252 000723 255 000724 257 000744 258 000750 259 000754 261 000756 262 000767 263 000776 265 001000 267 001001 271 001012 272 001036 273 001062 274 001067 290 001070 293 001077 294 001104 295 001106 296 001123 297 001126 298 001130 306 001162 310 001163 312 001165 313 001166 316 001170 319 001173 320 001201 321 001203 322 001216 323 001242 327 001247 332 001256 333 001261 339 001262 344 001265 345 001271 352 001306 358 001314 359 001316 360 001317 361 001320 363 001332 364 001355 366 001361 367 001366 368 001371 369 001377 370 001400 372 001405 373 001422 375 001423 377 001425 378 001442 380 001443 382 001445 383 001446 384 001450 386 001451 388 001453 389 001454 390 001464 391 001470 392 001471 393 001473 395 001474 400 001475 401 001506 402 001510 403 001513 428 001514 430 001531 434 001532 437 001535 453 001542 454 001545 456 001551 463 001606 465 001610 466 001613 468 001614 471 001631 409 001632 413 001633 414 001642 415 001645 419 001650 420 001657 422 001677 423 001700 ----------------------------------------------------------- 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