COMPILATION LISTING OF SEGMENT lisp Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0843.2 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 lisp: proc; 7 8 9 10 /* command interface to the Multics LISP subsystem. 11* First coded for the second version of the Multics 12* LISP implementation on 3/15/71. 13* Modified for use of standard Multics linkage mechanism, 7/15/71. 14* D. Reed 15* Changed for new definition of (status toplevel) and to add cleanup 16* handler for new I/O system, 24 Mar 1973, DAM 17* Modified to allow recursive entry of the lisp subsystem, 6/2/73 by DAM 18* Modified 74.11.01 by DAM to remove references to establish_cleanup_proc_ and default_handler_ 19* Modified 74.12.09 by DAM for (sstatus cleanup) feature 20* Modified 78.12.08 by BSG for (sstatus mulpi) feature 21* */ 22 23 24 dcl level static init(0) fixed bin; /* level of recursion */ 25 26 dcl (lisp_static_vars_$template fixed bin, 27 lisp_static_vars_$template_size fixed bin, 28 lisp_static_vars_$cur_stat_seg ptr, 29 lisp_static_vars_$cur_stat_pos fixed bin(19), 30 lisp_static_vars_$subsys_recurse_save_size fixed bin) external static; 31 32 dcl lisp_static_vars_$property_list_of_nil fixed bin(71) external, 33 lisp_error_table_$bad_arg_correctable fixed bin external; 34 35 dcl ioa_$ioa_switch external entry options(variable), 36 iox_$error_output external ptr, 37 lisp_static_vars_$ignore_faults bit(36) ext aligned, 38 lisp_static_vars_$mulpi_state fixed bin (17) ext aligned, 39 lisp_static_vars_$quit_handler_flag bit(1) external, 40 lisp_static_vars_$gc_time fixed bin(71) ext aligned, 41 lisp_static_vars_$emptying_buffers fixed bin external, 42 lisp_static_vars_$hi_random bit(72) ext aligned, 43 saved_ignore_faults bit(36) aligned; 44 dcl cu_$arg_ptr_rel entry(fixed bin,ptr,fixed bin,fixed bin, ptr), 45 lisp_fault_handler_$init entry, 46 1 unmask aligned like masked, 47 lisp_segment_manager_$get_stack entry(ptr), 48 lisp_segment_manager_$free_stack entry(ptr), 49 lisp_segment_manager_$get_lists entry(ptr), 50 lisp_segment_manager_$free_lists entry(ptr), 51 arg_list_ptr ptr, 52 cu_$arg_list_ptr entry(ptr), 53 save_area_size fixed bin, 54 foo fixed bin(71)aligned, 55 tempp ptr, 56 lisp_error_ entry, 57 errcode(2) fixed bin based aligned, 58 lisp_get_atom_ entry(char(*)aligned,fixed bin(71)aligned), 59 condition_ entry (char(*), entry), 60 reversion_ entry(char(*)), 61 program_interrupt condition, 62 lisp_default_handler_$program_interrupt entry, 63 lisp_default_handler_ entry, 64 lisp_io_control_$empty_all_buffers entry, 65 lisp_io_control_$clear_input entry, 66 lisp_io_control_$cleanup entry, 67 lisp_io_control_$init entry, 68 lisp_boot_ entry, 69 lisp_save_$unsave entry(char(*),ptr,fixed bin(18),fixed bin), 70 lisp_save_ entry(char(*) aligned), 71 lisp_reader_$read entry, 72 lisp_print_$type_nl entry, 73 lisp_static_vars_$print_atom fixed bin(71) external, 74 lisp_static_vars_$prin1 ptr external, 75 lisp_special_fns_$ncons entry, 76 lisp_$apply entry, 77 lisp_$eval entry, 78 our_stack ptr, 79 stack ptr, 80 i fixed bin, 81 lisp_get_atom_$init_ht entry, 82 subr_type fixed bin(2) aligned, 83 lisp_static_man_$free_stat_segs entry, 84 finishup label static, 85 (null,ptr,addr,rel,bit,fixed,mod,substr,addrel,string) builtin; 86 87 dcl lisp_static_vars_$evalhook_status bit(36) aligned external, 88 lisp_static_vars_$evalhook_atom fixed bin(71) external, 89 lisp_$evalhook_off_status bit(36) aligned external; 90 91 dcl lisp_oprs_$init entry; 92 93 dcl 1 cclist based, /* overlay for header of compiled constant list block 94* which is a type of internal static storage known to the 95* lisp garbage collector */ 96 2 next_ccl_entry ptr, 97 2 init_flag fixed bin; 98 99 100 101 dcl lisp_static_vars_$cleanup_list_exists bit(1) aligned external, 102 lisp_static_vars_$cleanup_list fixed bin(71) external, 103 lisp_static_vars_$i_am_gcing bit(1) aligned external; 104 105 /* The structure of the lisp stack segment -- as known only to this and one other program */ 106 1 1 /* lisp stack header format */ 1 2 /* Last modified 7/21/72 by Reed for in_pl1 flag */ 1 3 /* Modified 1978 by Greenberg for unwind-protect ops */ 1 4 1 5 declare 1 6 1 7 1 stack_seg based aligned, /* stored in base of unmkd_pdl segment */ 1 8 2 marked_stack_bottom ptr, /* where marked stack begins... */ 1 9 2 unmkd_stack_bottom ptr, /* where unmkd_ stack actually starts */ 1 10 2 stack_ptr_ptr ptr, /* points at lisp_static_vars_$stack_ptr */ 1 11 2 unmkd_ptr_ptr ptr, /* points at lisp_static_vars_$unmkd_ptr's offset word */ 1 12 2 array_pointer ptr, /* obsolete */ 1 13 2 nil fixed bin(71), /* object for nil */ 1 14 2 true fixed bin(71), /* object for t */ 1 15 2 in_pl1_code bit(36), /* flag indicating that we are in pl1 code if non-zero */ 1 16 2 padding0 bit(36), /* double word boundary preservation */ 1 17 2 bind_op ptr, /* pointers to operators for run-time support */ 1 18 2 unbind_op ptr, 1 19 2 errset1_op ptr, 1 20 2 errset2_op ptr, 1 21 2 unerrset_op ptr, 1 22 2 call_op ptr, 1 23 2 catch1_op ptr, 1 24 2 catch2_op ptr, 1 25 2 uncatch_op ptr, 1 26 2 gensym_data (2) bit(36) aligned, /* stuff used by the gensym function */ 1 27 2 system_lp ptr, /* pointer to the system's linkage section */ 1 28 2 iogbind_op ptr, 1 29 2 unseen_go_tag_op ptr, 1 30 2 throw1_op ptr, 1 31 2 throw2_op ptr, 1 32 2 signp_op ptr, 1 33 2 type_fields bit(72) aligned, /* fixnum, flonum type for compiled code */ 1 34 2 return_op ptr, 1 35 2 err_op ptr, 1 36 2 pl1_interface ptr, /* pointer to pl1 interface for type 2 subrs. */ 1 37 2 pl1_lsubr_interface ptr, /* same for type -2 subrs */ 1 38 2 cons_opr ptr, /* cons operator */ 1 39 2 ncons_opr ptr, /* ncons operator */ 1 40 2 xcons_opr ptr, /* xcons operator */ 1 41 2 begin_list_opr ptr, /* operator to make initial cell of list */ 1 42 2 append_list_opr ptr, /* operator to append to last-made cell of list */ 1 43 2 terminate_list_opr ptr, /* opeator to append last cell to next to last cell of list */ 1 44 2 compare_op ptr, /* fixnum/flonum comparison operator */ 1 45 2 link_op ptr, 1 46 2 array_operator pointer, /* accessing operator, invoked by arrays */ 1 47 2 dead_array_operator pointer, /* dead arrays invoke this operator instead */ 1 48 2 store_operator pointer, /* operator to do compiled store */ 1 49 2 floating_store_operator pointer, /* ditto, but operand is in EAQ */ 1 50 2 array_info_for_store pointer, /* -> array_info block of last array referenced */ 1 51 2 array_offset_for_store fixed bin(18), /* offset in array_data block of last array element referenced */ 1 52 2 padding bit(36), 1 53 2 array_link_snap_opr pointer, 1 54 2 create_string_desc_op ptr, 1 55 2 create_array_desc_op ptr, 1 56 2 pl1_call_op ptr, 1 57 2 cons_string_op ptr, 1 58 2 create_varying_string_op ptr, 1 59 2 unwp1_op ptr, 1 60 2 unwp2_op ptr, 1 61 2 ununwp_op ptr, 1 62 2 irest_return_op ptr, 1 63 2 pl1_call_nopop_op ptr, 1 64 2 rcv_char_star_op ptr, 1 65 2 spare2 (7) ptr, 1 66 2 begin_unmkd_stack(16325) fixed bin(71); /* rest of segment is the unmarked pdl */ 1 67 1 68 dcl call_array_operator bit(36) static init("100112273120"b3), /* tspbb ab|112,* */ 1 69 call_dead_array_operator bit(36) static init("100114273120"b3); /* tspbb ab|114,* */ 1 70 1 71 /* end stack segment format */ 107 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 */ 108 3 1 /* INCLUDE FILE lisp_io.incl.pl1 */ 3 2 3 3 /* data structures used by the lisp i/o system */ 3 4 4 1 /* BEGIN INCLUDE FILE lisp_iochan.incl.pl1 */ 4 2 4 3 /* This include file describes the format of the 'iochan' block, 4 4* which is used to implement lisp file-objects. The iochan 4 5* is the central data base of the i/o system. When open 4 6* is used, an iochan is created in lisp static storage. 4 7* When the lisp environment is booted, 2 iochans for input and 4 8* output on the tty are created. Iochans are saved and restored 4 9* by the save mechanism */ 4 10 4 11 /* open i/o channel information */ 4 12 4 13 dcl 1 iochan based aligned, /* format of a file object */ 4 14 2 ioindex fixed bin(24), /* 0-origin character position in block */ 4 15 2 iolength fixed bin(24), /* size of block in chars - actual(in), max(out) */ 4 16 2 ioptr pointer, /* -> block */ 4 17 2 thread pointer, /* list of all iochans open; from lisp_static_vars_$iochan_list */ 4 18 2 fcbp pointer, /* for tssi_ */ 4 19 2 aclinfop pointer, /* .. */ 4 20 2 component fixed bin, /* .. */ 4 21 2 charpos fixed bin, /* 0-origin horizontal position on line */ 4 22 2 linel fixed bin, /* (out) line length, 0 => oo */ 4 23 2 flags unaligned, 4 24 3 seg bit(1), /* 1 => msf, 0 => stream */ 4 25 3 read bit(1), /* 0 => openi, 1 => not */ 4 26 3 write bit(1), /* 0 => openo, 1 => not */ 4 27 3 gc_mark bit(1), /* for use by the garbage collector */ 4 28 3 interactive bit(1), /* 1 => input => this is the tty 4 29* output => flush buff after each op */ 4 30 3 must_reopen bit(1), /* 1 => has been saved and not reopend yet */ 4 31 3 nlsync bit(1), /* 1 => there is a NL in the buffer (output streams only) */ 4 32 3 charmode bit(1), /* enables instant ios_$write */ 4 33 3 extra_nl_done bit(1), /* 1 => last char output was extra NL for chrct */ 4 34 3 fixnum_mode bit(1), /* to be used with in and out functions */ 4 35 3 image_mode bit(1), /* just suppresses auto-cr */ 4 36 3 not_yet_used bit(25), 4 37 2 function fixed bin(71), /* EOF function (input), or endpagefn (output) <<< gc-able >>> */ 4 38 2 namelist fixed bin(71), /* list of names, car is directory pathname <<< gc-able >>> */ 4 39 2 name char(32) unaligned, /* stream name or entry name */ 4 40 2 pagel fixed bin, /* number of lines per page */ 4 41 2 linenum fixed bin, /* current line number, starting from 0 */ 4 42 2 pagenum fixed bin, /* current page number, starting from 0 */ 4 43 4 44 flag_reset_mask bit(36) aligned static init( /* anded into flags with each char */ 4 45 "111011110111111111"b); 4 46 4 47 /* END INCLUDE FILE lisp_iochan.incl.pl1 */ 3 5 3 6 3 7 /* masks for checking iochan.flags, seeing if lisp_io_control_$fix_not_ok_iochan should be called */ 3 8 3 9 dcl not_ok_to_read bit(36) static init("0100010001"b), /* mask for checking iochan.flags on input */ 3 10 not_ok_to_write bit(36) static init("0010010001"b);/* mask for checking iochan.flags on output */ 3 11 dcl not_ok_to_read_fixnum bit(36) static init("0100010000"b), 3 12 not_ok_to_write_fixnum bit(36) static init("0010010000"b); 3 13 3 14 3 15 /* miscellaneous global, static variables and atoms used by the I/O system */ 3 16 3 17 dcl lisp_static_vars_$read_print_nl_sync bit(36) ext, 3 18 read_print_nl_sync bit(36) defined (lisp_static_vars_$read_print_nl_sync), 3 19 lisp_static_vars_$ibase ext fixed bin(71), 3 20 ibase fixed bin(71) defined (lisp_static_vars_$ibase), 3 21 3 22 lisp_static_vars_$quote_atom ext fixed bin (71), 3 23 quote_atom fixed bin(71) defined (lisp_static_vars_$quote_atom), 3 24 3 25 lisp_static_vars_$base ext fixed bin(71), 3 26 base fixed bin(71) defined ( lisp_static_vars_$base), 3 27 3 28 lisp_static_vars_$stnopoint ext fixed bin(71), 3 29 stnopoint fixed bin(71) defined (lisp_static_vars_$stnopoint), 3 30 3 31 lisp_static_vars_$tty_atom ext fixed bin(71), 3 32 tty_atom fixed bin(71) defined (lisp_static_vars_$tty_atom), 3 33 lisp_static_vars_$status_gctwa ext fixed bin(71), 3 34 status_gctwa fixed bin(71) defined (lisp_static_vars_$status_gctwa), 3 35 3 36 lisp_static_vars_$s_atom ext fixed bin(71), 3 37 s_atom fixed bin(71) defined (lisp_static_vars_$s_atom), 3 38 3 39 lisp_static_vars_$readtable ext fixed bin(71), 3 40 readtable fixed bin(71) defined (lisp_static_vars_$readtable), 3 41 3 42 lisp_static_vars_$plus_status ext fixed bin(71), 3 43 plus_status fixed bin(71) defined (lisp_static_vars_$plus_status); 3 44 5 1 /* BEGIN INCLUDE FILE lisp_control_chars.incl.pl1 */ 5 2 5 3 /* Last modified D. Reed 6/29/72 */ 5 4 5 5 dcl lisp_static_vars_$ctrlD ext fixed bin(71), 5 6 ctrlD fixed bin(71) defined (lisp_static_vars_$ctrlD); 5 7 5 8 dcl lisp_static_vars_$ctrlQ ext fixed bin(71), 5 9 ctrlQ fixed bin(71) defined (lisp_static_vars_$ctrlQ); 5 10 5 11 dcl lisp_static_vars_$ctrlR ext fixed bin(71), 5 12 ctrlR fixed bin(71) defined (lisp_static_vars_$ctrlR); 5 13 5 14 dcl lisp_static_vars_$ctrlW ext fixed bin(71), 5 15 ctrlW fixed bin(71) defined (lisp_static_vars_$ctrlW); 5 16 5 17 /* END INCLUDE FILE lisp_control_chars.incl.pl1 */ 5 18 3 45 3 46 /* END INCLUDE FILE lisp_io.incl.pl1 */ 3 47 109 110 6 1 /* include file lisp_stack_fmt.incl.pl1 -- 6 2* describes the format of the pushdown list 6 3* used by the lisp evaluator and lisp subrs 6 4* for passing arguments, saving atom bindings, 6 5* and as temporaries */ 6 6 6 7 dcl 6 8 temp(10000) fixed bin(71) aligned based, 6 9 6 10 temp_ptr(10000) ptr aligned based, 6 11 1 push_down_list_ptr_types(10000) based aligned, 6 12 2 junk bit(21) unaligned, 6 13 2 temp_type bit(9) unaligned, 6 14 2 more_junk bit(42) unaligned, 6 15 6 16 1 pdl_ptr_types36(10000) based aligned, 6 17 2 temp_type36 bit(36), 6 18 2 junk bit(36), 6 19 6 20 1 binding_block aligned based, 6 21 2 top_block bit(18) unaligned, 6 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 6 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 6 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 6 25 6 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 6 27 2 old_val fixed bin(71) aligned, 6 28 2 atom fixed bin(71) aligned; 6 29 6 30 6 31 6 32 /* end include file lisp_stack_fmt.incl.pl1 */ 111 7 1 /* lisp number format -- overlaid on standard its pointer. */ 7 2 7 3 7 4 dcl 1 fixnum_fmt based aligned, 7 5 2 type_info bit(36) aligned, 7 6 2 fixedb fixed bin, 7 7 7 8 1 flonum_fmt based aligned, 7 9 2 type_info bit(36) aligned, 7 10 2 floatb float bin, 7 11 7 12 fixnum_type bit(36) aligned static init("000000000000000000000100000000100111"b), 7 13 flonum_type bit(36) aligned static init("000000000000000000000010000000100111"b); 7 14 7 15 /* end of lisp number format */ 7 16 112 8 1 /* BEGIN INCLUDE FILE lisp_initial_atoms.incl.pl1 */ 8 2 8 3 dcl lisp_static_vars_$toplevel ext fixed bin(71), 8 4 toplevel fixed bin(71) defined (lisp_static_vars_$toplevel), 8 5 8 6 lisp_static_vars_$errlist ext fixed bin(71), 8 7 errlist fixed bin(71) defined (lisp_static_vars_$errlist), 8 8 8 9 lisp_static_vars_$STAR ext fixed bin(71), 8 10 STAR fixed bin(71) defined (lisp_static_vars_$STAR), 8 11 lisp_static_vars_$PLUS fixed bin(71) external, 8 12 PLUS fixed bin(71) defined (lisp_static_vars_$PLUS), 8 13 lisp_static_vars_$MINUS fixed bin(71) external, 8 14 MINUS fixed bin(71) defined (lisp_static_vars_$MINUS), 8 15 lisp_static_vars_$SLASH fixed bin(71) external, 8 16 SLASH fixed bin(71) defined (lisp_static_vars_$SLASH); 8 17 8 18 /* END INCLUDE FILE lisp_initial_atoms.incl.pl1 */ 113 9 1 /* Include file lisp_common_vars.incl.pl1; 9 2* describes the external static variables which may be referenced 9 3* by lisp routines. 9 4* D. Reed 4/1/71 */ 9 5 9 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 9 7 2 cclist_ptr ptr, /* pointer to list of constants kept 9 8* by compiled programs */ 9 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 9 10 9 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 9 12 err_recp ptr defined (lisp_static_vars_$err_recp), 9 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 9 14 lisp_static_vars_$eval_frame ptr ext static, 9 15 lisp_static_vars_$prog_frame ptr ext aligned, 9 16 lisp_static_vars_$err_frame ptr ext aligned, 9 17 lisp_static_vars_$catch_frame ptr ext aligned, 9 18 lisp_static_vars_$unwp_frame ptr ext aligned, 9 19 lisp_static_vars_$stack_ptr ptr ext aligned, 9 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 9 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 9 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 9 23 lisp_static_vars_$binding_top ptr ext aligned, 9 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 9 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 9 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 9 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 9 28 binding_top ptr defined (lisp_static_vars_$binding_top), 9 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 9 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 9 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 9 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 9 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 9 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 9 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 9 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 9 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 9 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 9 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 9 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 9 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 9 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 9 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 9 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 9 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 9 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 9 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 9 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 9 49 9 50 9 51 /* end include file lisp_common_vars.incl.pl1 */ 114 10 1 /* BEGIN INCLUDE FILE lisp_faults.incl.pl1 */ 10 2 10 3 /* 10 4* * Written 14 Aug 72 by D A Moon 10 5* * Fault codes changed 4 Feb 73 by DAM, for user interrupt masking and new alarmclock facility 10 6* * Names changed 16 Dec 1973 by DAM because of a name conflict with lisp_free_storage.incl.pl1 10 7* * Modified 74.06.03 by DAM for new-arrays 10 8* * Modified 74.12.16 by DAM to change meaning of 'masked' 10 9* */ 10 10 dcl (Alarmclock_fault init(2), 10 11 Cput_fault init(1), 10 12 Car_cdr_fault init(6), 10 13 Quit_fault init(4), 10 14 Array_fault init(5), 10 15 Zerodivide_fault init(7), 10 16 Underflow_fault init(8), 10 17 Old_store_fault init(9), /* old/new array compatibility */ 10 18 Pi_fault init(10) /* program_interrupt signal */ 10 19 ) fixed bin static; 10 20 10 21 10 22 /* structure for saving info when a fault or an error ocuurs. 10 23* This structure gets pushed onto the unmkd pdl */ 10 24 10 25 dcl 1 fault_save aligned based (unm), 10 26 2 prev_frame bit(18)unaligned, /* thread */ 10 27 2 stack_ptr bit(18) unaligned, /* rel(stack_ptr) at time frame was created */ 10 28 2 sv_gc_inhibit bit(1) unaligned, /* save lisp_static_vars_$garbage_collect_inhibit */ 10 29 2 sv_masked like masked unaligned, /* save lisp_static_vars_$masked - for err breaks in (nointerrupt t) mode */ 10 30 2 code1 fixed bin, /* error code 1, 0 = not errprintable error */ 10 31 2 code2 fixed bin, /* error code 2, for file system errors */ 10 32 2 sv_array_info ptr, /* save array_info_for_store in stack header */ 10 33 2 sv_rdr_label label, /* -> abnormal return from call to ios_$read */ 10 34 2 sv_rdr_ptr ptr, /* datum used by reader for readlist control */ 10 35 2 sv_rdr_state fixed bin, /* 0=normal, 1=wait for input, 2=readlist */ 10 36 2 sv_array_offset fixed bin(18), /* save array_offset_for_store in stack header */ 10 37 2 padding bit(36), /* make structure an even number of words in size */ 10 38 2 dat_ptr bit(18); /* rel ptr to marked pdl slot containing losing form */ 10 39 /* needed by errprint */ 10 40 /* size(fault_save) must be even */ 10 41 10 42 10 43 /* declarations of the things that get saved here */ 10 44 10 45 dcl lisp_static_vars_$garbage_collect_inhibit bit(1) aligned external, 10 46 1 lisp_static_vars_$masked aligned external like masked, 10 47 lisp_static_vars_$pending_ctrl bit(1) aligned external, /* flag that we are doing stacked-up ctrl chars 10 48* right now, makes sure none get missed if ^G */ 10 49 lisp_static_vars_$deferred_interrupt bit(1) aligned external, /* when we unmask, we test this to */ 10 50 /* see if we must poll interrupts */ 10 51 lisp_static_vars_$rdr_label label external, 10 52 lisp_static_vars_$rdr_ptr ptr external, 10 53 lisp_static_vars_$rdr_state fixed bin external, 10 54 gc_inhibit bit(1) aligned defined(lisp_static_vars_$garbage_collect_inhibit), 10 55 deferred_interrupt bit (1) aligned defined (lisp_static_vars_$deferred_interrupt), 10 56 1 masked aligned based(addr(lisp_static_vars_$masked)), /* defined causes fault in compiler */ 10 57 2 against unaligned, /* things masked against: */ 10 58 3 tty bit(1), /* tty control characters */ 10 59 3 alarm bit(1), /* alarmclock interrupts */ 10 60 pending_ctrl bit(1) aligned defined (lisp_static_vars_$pending_ctrl), 10 61 lisp_fault_handler_$set_mask entry(1 aligned like masked), 10 62 rdr_label label defined (lisp_static_vars_$rdr_label), 10 63 rdr_ptr ptr defined (lisp_static_vars_$rdr_ptr), 10 64 rdr_state fixed bin defined (lisp_static_vars_$rdr_state); 10 65 10 66 10 67 /* END INCLUDE FILE lisp_faults.incl.pl1 */ 10 68 115 116 dcl unm pointer; /* useless */ 11 1 11 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 11 3 11 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 11 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 11 6* are used so that the name of the function which is rejecting its argument 11 7* can be printed. Please note that all these codes are negative. */ 11 8 11 9 dcl ( 11 10 fn_do init (-10), 11 11 fn_arg init (-11), 11 12 fn_setarg init (-12), 11 13 fn_status init (-13), 11 14 fn_sstatus init (-14), 11 15 fn_errprint init (-15), 11 16 fn_errframe init (-16), 11 17 fn_evalframe init (-17), 11 18 fn_defaultf init (-18), 11 19 fn_tyo init (-22), 11 20 fn_ascii init (-23), 11 21 fn_rplaca init (-24), 11 22 fn_definedp init (-25), 11 23 fn_setq init (-26), 11 24 fn_set init (-27), 11 25 fn_delete init (-28), 11 26 fn_delq init (-29), 11 27 fn_stringlength init (-30), 11 28 fn_catenate init (-31), 11 29 fn_array init (-32), 11 30 fn_substr init (-33), 11 31 fn_index init (-34), 11 32 fn_get_pname init (-35), 11 33 fn_make_atom init (-36), 11 34 fn_ItoC init (-37), 11 35 fn_CtoI init (-38), 11 36 fn_defsubr init (-39), 11 37 fn_star_array init (-40), 11 38 fn_args init (-41), 11 39 fn_sysp init (-42), 11 40 fn_get init (-43), 11 41 fn_getl init (-44), 11 42 fn_putprop init (-45), 11 43 fn_remprop init (-46), 11 44 fn_save init (-47), 11 45 fn_add1 init (-48), 11 46 fn_sub1 init (-49), 11 47 fn_greaterp init (-50), 11 48 fn_lessp init (-51), 11 49 fn_minus init (-52), 11 50 fn_plus init (-53), 11 51 fn_times init (-54), 11 52 fn_difference init (-55), 11 53 fn_quotient init (-56), 11 54 fn_abs init (-57), 11 55 fn_expt init (-58), 11 56 fn_boole init (-59), 11 57 fn_rot init (-60), 11 58 fn_lsh init (-61), 11 59 fn_signp init (-62), 11 60 fn_fix init (-63), 11 61 fn_float init (-64), 11 62 fn_remainder init (-65), 11 63 fn_max init (-66), 11 64 fn_min init (-67), 11 65 fn_add1_fix init (-68), 11 66 fn_add1_flo init (-69), 11 67 fn_sub1_fix init (-70), 11 68 fn_sub1_flo init (-71), 11 69 fn_plus_fix init (-72), 11 70 fn_plus_flo init (-73), 11 71 fn_times_fix init (-74), 11 72 fn_times_flo init (-75), 11 73 fn_diff_fix init (-76), 11 74 fn_diff_flo init (-77), 11 75 fn_quot_fix init (-78), 11 76 fn_quot_flo init (-79), 11 77 fn_eval init (-80), 11 78 fn_apply init (-81), 11 79 fn_prog init (-82), 11 80 fn_errset init (-83), 11 81 fn_catch init (-84), 11 82 fn_throw init (-85), 11 83 fn_store init (-86), 11 84 fn_defun init (-87), 11 85 fn_baktrace init (-88), 11 86 fn_bltarray init (-89), 11 87 fn_star_rearray init (-90), 11 88 fn_gensym init (-91), 11 89 fn_makunbound init (-92), 11 90 fn_boundp init (-93), 11 91 fn_star_status init (-94), 11 92 fn_star_sstatus init (-95), 11 93 fn_freturn init (-96), 11 94 fn_cos init (-97), 11 95 fn_sin init (-98), 11 96 fn_exp init (-99), 11 97 fn_log init (-100), 11 98 fn_sqrt init (-101), 11 99 fn_isqrt init (-102), 11 100 fn_atan init (-103), 11 101 fn_sleep init (-104), 11 102 fn_oddp init (-105), 11 103 fn_tyipeek init (-106), 11 104 fn_alarmclock init (-107), 11 105 fn_plusp init (-108), 11 106 fn_minusp init (-109), 11 107 fn_ls init (-110), 11 108 fn_eql init (-111), 11 109 fn_gt init (-112), 11 110 fn_alphalessp init (-113), 11 111 fn_samepnamep init (-114), 11 112 fn_getchar init (-115), 11 113 fn_opena init (-116), 11 114 fn_sxhash init (-117), 11 115 fn_gcd init (-118), 11 116 fn_allfiles init (-119), 11 117 fn_chrct init (-120), 11 118 fn_close init (-121), 11 119 fn_deletef init (-122), 11 120 fn_eoffn init (-123), 11 121 fn_filepos init (-124), 11 122 fn_inpush init (-125), 11 123 fn_linel init (-126), 11 124 fn_mergef init (-127), 11 125 fn_namelist init (-128), 11 126 fn_names init (-129), 11 127 fn_namestring init (-130), 11 128 fn_openi init (-131), 11 129 fn_openo init (-132), 11 130 fn_prin1 init (-133), 11 131 fn_princ init (-134), 11 132 fn_print init (-135), 11 133 fn_read init (-136), 11 134 fn_readch init (-137), 11 135 fn_readstring init (-138), 11 136 fn_rename init (-139), 11 137 fn_shortnamestring init (-140), 11 138 fn_tyi init (-141), 11 139 fn_setsyntax init (-142), 11 140 fn_cursorpos init (-143), 11 141 fn_force_output init (-144), 11 142 fn_clear_input init (-145), 11 143 fn_random init (-146), 11 144 fn_haulong init (-147), 11 145 fn_haipart init (-148), 11 146 fn_cline init (-149), 11 147 fn_fillarray init (-150), 11 148 fn_listarray init (-151), 11 149 fn_sort init (-152), 11 150 fn_sortcar init (-153), 11 151 fn_zerop init (-154), 11 152 fn_listify init (-155), 11 153 fn_charpos init (-156), 11 154 fn_pagel init (-157), 11 155 fn_linenum init (-158), 11 156 fn_pagenum init (-159), 11 157 fn_endpagefn init (-160), 11 158 fn_arraydims init (-161), 11 159 fn_loadarrays init (-162), 11 160 fn_dumparrays init (-163), 11 161 fn_expt_fix init (-164), 11 162 fn_expt_flo init (-165), 11 163 fn_nointerrupt init (-166), 11 164 fn_open init (-167), 11 165 fn_in init (-168), 11 166 fn_out init (-169), 11 167 fn_truename init (-170), 11 168 fn_ifix init (-171), 11 169 fn_fsc init (-172), 11 170 fn_progv init (-173), 11 171 fn_mapatoms init (-174), 11 172 fn_unwind_protect init (-175), 11 173 fn_eval_when init (-176), 11 174 fn_read_from_string init (-177), 11 175 fn_displace init (-178), 11 176 fn_nth init (-179), 11 177 fn_nthcdr init (-180), 11 178 fn_includef init (-181) 11 179 ) fixed bin static; 11 180 11 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 117 12 1 /* Include file lisp_atom_fmt.incl.pl1; 12 2* describes internal format of atoms in the lisp system 12 3* D.Reed 4/1/71 */ 12 4 12 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 12 6 2 value fixed bin(71), /* atom's value */ 12 7 2 plist fixed bin(71), /* property list */ 12 8 2 pnamel fixed bin, /* length of print name */ 12 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 12 10 12 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 12 12 2 value ptr, 12 13 2 plist ptr, 12 14 12 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 12 16 2 value bit(72), 12 17 2 plist bit(72); 12 18 12 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 118 13 1 /* Include file lisp_cons_fmt.incl.pl1; 13 2* defines the format for a cons within the lisp system 13 3* D.Reed 4/1/71 */ 13 4 13 5 dcl consptr ptr, 13 6 1 cons aligned based (consptr), /* structure defining format for cons */ 13 7 2 car fixed bin(71), 13 8 2 cdr fixed bin(71), 13 9 13 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 13 11 2 car ptr, 13 12 2 cdr ptr, 13 13 13 14 13 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 13 16 2 padding bit(21) unaligned, 13 17 2 car bit(9) unaligned, 13 18 2 padding2 bit(63) unaligned, 13 19 2 cdr bit(9) unaligned, 13 20 2 padend bit(42) unaligned; 13 21 13 22 dcl 1 cons_types36 aligned based, 13 23 2 car bit(36), 13 24 2 pada bit(36), 13 25 2 cdr bit(36), 13 26 2 padd bit(36); 13 27 13 28 13 29 /* end include file lisp_cons_fmt.incl.pl1 */ 119 14 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 14 2* describes format of storage for lisp 14 3* character strings. 14 4* D. Reed 4/1/71 */ 14 5 14 6 dcl 1 lisp_string based aligned, 14 7 2 string_length fixed bin, 14 8 2 string char(1 refer(string_length)); 14 9 14 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 120 15 1 /* Include file lisp_ptr_fmt.incl.pl1; 15 2* describes the format of lisp pointers as 15 3* a bit string overlay on the double word ITS pair 15 4* which allows lisp to access some unused bits in 15 5* the standard ITS pointer format. It should be noted that 15 6* this is somewhat of a kludge, since 15 7* it is quite machine dependent. However, to store type 15 8* fields in the pointer, saves 2 words in each cons, 15 9* plus some efficiency problems. 15 10* 15 11* D.Reed 4/1/71 */ 15 12 /* modified to move type field to other half of ptr */ 15 13 /* D.Reed 5/31/72 */ 15 14 15 15 15 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 15 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 15 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 15 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 15 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 15 21 2 type bit(9) unaligned, /* type field */ 15 22 2 itsmod bit(6) unaligned, 15 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 15 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 15 25 15 26 /* manifest constant strings for testing above type field */ 15 27 15 28 ( 15 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 15 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 15 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 15 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 15 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 15 34 Bignum init("000001000"b), /* a multiple-precision number */ 15 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 15 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 15 37* means a special internal uncollectable weird object */ 15 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 15 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 15 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 15 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 15 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 15 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 15 44 ) bit(9) static, 15 45 15 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 15 47 15 48 15 49 ( 15 50 Cons36 init("000000000000000000000000000000"b), 15 51 Fixed36 init("000000000000000000000100000000"b), 15 52 Float36 init("000000000000000000000010000000"b), 15 53 Atsym36 init("000000000000000000000001000000"b), 15 54 Atomic36 init("000000000000000000000111111100"b), 15 55 Bignum36 init("000000000000000000000000001000"b), 15 56 System_Subr36 15 57 init("000000000000000000000000000100"b), 15 58 Bigfix36 init("000000000000000000000000001000"b), 15 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 15 60 NotConsOrAtsym36 15 61 init("000000000000000000000110111111"b), 15 62 SubrNumeric36 15 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 15 64 String36 init("000000000000000000000000100000"b), 15 65 Subr36 init("000000000000000000000000010000"b), 15 66 File36 init("000000000000000000000000000001"b), 15 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 15 68 15 69 /* undefined pointer value is double word of zeros */ 15 70 15 71 Undefined bit(72) static init(""b); 15 72 15 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 121 16 1 /******************** lisp_subr_fmt.incl.pl1 ****************************/ 16 2 16 3 16 4 /* Include file describing the format 16 5* of a lisp subroutine link. This format is designed 16 6* to appear just like a standard ft2 link, so the linker 16 7* can do link snapping for us */ 16 8 16 9 16 10 dcl 1 lisp_subr_ based aligned, 16 11 2 subr_nargs fixed bin(17) unaligned, 16 12 2 flags fixed bin(17) unaligned, 16 13 2 link_ptr, /* the its pointer will be created here */ 16 14 3 header_ptr fixed bin(17) unaligned, /* self relative pointer to definitions 16 15* pointer */ 16 16 3 pad bit(12) unaligned, /* = 0 */ 16 17 3 ft2 bit(6) unaligned, /* = o46 */ 16 18 3 exp_ptr bit(18) unaligned, /* pointer to exp word relative to definitions */ 16 19 3 rest_of_link_ptr bit(18) unaligned, /* = 0 */ 16 20 2 exp_word, 16 21 3 type_pair_ptr bit(18) unaligned, /* offset of type_pair below, from def_ptr */ 16 22 3 expr_word bit(18) unaligned, /* value of offset from symbol, will be ""b */ 16 23 2 type_pair, 16 24 3 type_no bit(18) unaligned, /* type of link - set to 4 for lisp */ 16 25 3 trap_ptr bit(18) unaligned, /* for trapbforlink, set to 0 for lisp */ 16 26 3 segname_ptr bit(18) unaligned, /* relative offset of segname in definitions */ 16 27 3 entname_ptr bit(18) unaligned,/* relative offset of entname in definitions */ 16 28 2 acc_seg_name, 16 29 3 segnamel bit(9) unaligned, /* length of acc string */ 16 30 3 segname char(0 refer(segnamel)) unaligned, 16 31 1 acc_ent_name based aligned, /* entry name overlay */ 16 32 2 entnamel bit(9) unaligned, /* length of acc string */ 16 33 2 entname char(0 refer(entnamel)) unaligned, /* entry name */ 16 34 1 lisp_subr_for_call based aligned, /* used to call through this link */ 16 35 2 subr_entry ptr; /* this is the faulting link noted above */ 16 36 16 37 16 38 /********************** end lisp_subr_fmt.incl.pl1 **********************/ 122 123 /* */ 124 /* for the benefit of losers who use uread, add the reference name lisp_old_io_ to us */ 125 126 call hcs_$fs_get_path_name(addr(lisp$), xdn, 0, xen, 0); 127 call hcs_$initiate(xdn, xen, "lisp_old_io_", 0, 0, null, 0); 128 129 dcl xdn char(168), 130 xen char(32), 131 lisp$ external, 132 hcs_$fs_get_path_name entry(pointer, char(*), fixed bin, char(*), fixed bin(5)), 133 hcs_$initiate entry(char(*), char(*), char(*), fixed bin, fixed bin, pointer, fixed bin(35)); 134 135 136 /* begin by getting arg list ptr and computing size of save area 137* needed. Then enter begin block */ 138 139 call cu_$arg_list_ptr(arg_list_ptr); 140 level = level + 1; 141 if level >= 2 then save_area_size = lisp_static_vars_$subsys_recurse_save_size; 142 else save_area_size = 0; /* if first entry, no need to save anything */ 143 144 first_stack_frame_for_lisp: begin; 145 146 dcl arglen fixed bin, 147 argptr ptr, 148 argname char(arglen) based (argptr), 149 code fixed bin, 150 old_stat_size fixed bin(18), 151 old_stat_ptr ptr, 152 old_alloc_info bit(288) aligned, /* to save lisp_alloc_$allo_info in */ 153 oldfinishup automatic label variable, 154 our_stack pointer, 155 stack pointer; 156 157 dcl save_area bit(36) aligned dimension(save_area_size); 158 dcl words_to_be_moved_sas bit(36) aligned based dimension (save_area_size), 159 words_to_be_moved_ts bit(36) aligned based dimension(lisp_static_vars_$template_size); 160 161 /* save lisp_static_vars_ in our stack frame */ 162 163 if save_area_size ^= 0 then 164 save_area = addr(lisp_static_vars_$lisp_static_vars_) -> words_to_be_moved_sas; 165 166 /* init first part of lisp_static_vars_ from template */ 167 168 addr(lisp_static_vars_$lisp_static_vars_) -> words_to_be_moved_ts = 169 addr(lisp_static_vars_$template) -> words_to_be_moved_ts; 170 171 172 /* make a segment for the push down list */ 173 174 call lisp_segment_manager_$get_stack(our_stack); 175 prog_frame, err_frame, catch_frame, unwp_frame, binding_top, err_recp, eval_frame = our_stack; 176 unmkd_ptr = addr(our_stack->stack_seg.begin_unmkd_stack); 177 call lisp_segment_manager_$get_stack(stack_ptr); 178 stack_ptr = addrel(stack_ptr,2); /* kludge for pdl ptrs */ 179 our_stack->stack_seg.marked_stack_bottom = stack_ptr; 180 our_stack->stack_seg.stack_ptr_ptr = addr(stack_ptr); 181 our_stack->stack_seg.unmkd_stack_bottom = addr(our_stack->begin_unmkd_stack); 182 our_stack->stack_seg.in_pl1_code = "1"b; 183 our_stack->stack_seg.unmkd_ptr_ptr = addrel(addr(unmkd_ptr),1); /* so can store only offset */ 184 185 /* set addresses of lisp operators in the stack header */ 186 187 call lisp_oprs_$init; 188 189 190 old_alloc_info = lisp_alloc_$alloc_info; 191 oldfinishup = finishup; /* just in case we quit out of an old lisp invocation */ 192 finishup = done; /* return for top level return or go to, and return for cleanup handler is"done" */ 193 lisp_static_vars_$top_level = top_level_err; /* error return */ 194 195 /* save ptr to arg list for (status jcl), (status arg _n) */ 196 197 dcl lisp_static_vars_$arg_list_ptr external pointer; 198 199 lisp_static_vars_$arg_list_ptr = arg_list_ptr; 200 201 /* now look at argument, and decide what is to be done about unsaving an environment */ 202 203 call cu_$arg_ptr_rel(1,argptr,arglen,code, arg_list_ptr); 204 if code = 0 then do; 205 if argname = "-boot" then do; /* if we want bootstrap environment generate it */ 206 lisp_static_vars_$cur_stat_seg = null; /* start with no static segs */ 207 lisp_static_vars_$cur_stat_pos = 262144;/* causes immediate allocation of a static seg 208* on first call to lisp_static_man_ */ 209 call lisp_segment_manager_$get_lists(lisp_alloc_$cur_seg); /* get a free storage segment */ 210 lisp_alloc_$cur_seg -> alloc_segment.next_seg = null(); 211 lisp_alloc_$cur_seg -> alloc_segment.tally_word.seg_offset = "000000000000000100"b; 212 lisp_alloc_$cur_seg -> alloc_segment.tally_word.tally = "111100000000"b; 213 lisp_alloc_$cur_seg -> alloc_segment.tally_word.delta = 4; 214 lisp_alloc_$consptr = addr(lisp_alloc_$cur_seg->alloc_segment.tally_word); 215 consptr_ovly.mod = "101011"b; 216 lisp_alloc_$gc_blk_cntr = -1; /* one 16k block before gc */ 217 lisp_alloc_$seg_blk_cntr = -16; /* 16 16k blocks per segment */ 218 /* make sure garbage collect doesn't occur until initialization done */ 219 lisp_static_vars_$garbage_collect_inhibit = "1"b; 220 call lisp_boot_; 221 end; 222 else do; 223 call lisp_save_$unsave(argname,old_stat_ptr, old_stat_size, code); 224 /* unsave indicated saved environment */ 225 go to unsaved; 226 end; 227 end; 228 else do; 229 call lisp_save_$unsave("",old_stat_ptr,old_stat_size,code); 230 /* unsave standard enviroment */ 231 unsaved: if code ^= 0 then return; /* if error then return to caller */ 232 lisp_static_vars_$cur_stat_seg = old_stat_ptr; /* tell lisp_static_man_ about the */ 233 lisp_static_vars_$cur_stat_pos = old_stat_size; /* static segs what were just unsaved */ 234 end; 235 236 call condition_("cleanup", cleanup_handler); 237 238 cleanup_handler: proc; 239 240 if lisp_static_vars_$cleanup_list_exists then do; /* cleanup feature */ 241 if lisp_static_vars_$i_am_gcing 242 then call ioa_$ioa_switch(iox_$error_output, 243 "lisp: Sorry, unable to execute (sstatus cleanup) list."); 244 /* should have been done already by lisp_fault_handler_ and lisp_garbage_collector_ */ 245 else do; 246 dcl stack pointer; 247 lisp_static_vars_$cleanup_list_exists = "0"b; /* once only */ 248 stack = stack_ptr; 249 stack_ptr = addr(stack -> temp(3)); 250 do stack -> temp(1) = lisp_static_vars_$cleanup_list 251 repeat (stack -> temp_ptr(1) -> cons.cdr) 252 while (stack -> temp_type(1) = Cons); 253 stack -> temp(2) = stack -> temp_ptr(1) -> cons.car; 254 call lisp_$eval; 255 end; 256 end; 257 end; 258 259 lisp_static_vars_$ignore_faults = "1"b; /* ignore while throwing away environment */ 260 call lisp_io_control_$cleanup; 261 call lisp_segment_manager_$free_stack(our_stack); /* free push down list segment */ 262 stack = ptr(stack_ptr,0); 263 call lisp_segment_manager_$free_stack(stack); 264 finishup = oldfinishup; /* reset finishup to old value */ 265 do while(lisp_alloc_$cur_seg ^= null()); 266 stack = lisp_alloc_$cur_seg; 267 lisp_alloc_$cur_seg = stack -> alloc_segment.next_seg; 268 call lisp_segment_manager_$free_lists(stack); 269 end; 270 lisp_alloc_$alloc_info = old_alloc_info; 271 call lisp_static_man_$free_stat_segs; /* free any static segs we were using */ 272 if level >= 2 then /* this was recursive entry, restore contents of lisp_static_vars_ */ 273 addr(lisp_static_vars_$lisp_static_vars_) -> words_to_be_moved_sas = save_area; 274 level = level - 1; 275 end cleanup_handler; 276 our_stack -> stack_seg.true = t_atom; 277 our_stack -> stack_seg.nil = nil; 278 lisp_static_vars_$property_list_of_nil = nil; /* clear nil's strange property list */ 279 lisp_static_vars_$cleanup_list = nil; /* clear cleanup list */ 280 281 call lisp_io_control_$init; 282 lisp_static_vars_$emptying_buffers = -1; /* init variable used by lisp_default_handler_ */ 283 284 /* allow garbage collections and initialize the reader */ 285 286 dcl lisp_static_vars_$garbage_collect_inhibit bit(1) aligned external, 287 lisp_static_vars_$rdr_state fixed bin aligned external; 288 289 lisp_static_vars_$garbage_collect_inhibit = "0"b; 290 lisp_static_vars_$rdr_state = 0; 291 292 /* initialize the random number memory */ 293 294 lisp_static_vars_$hi_random = 295 "010110111111110010001001011011011111001101101010101110000111001001001010"b; 296 297 call lisp_fault_handler_$init; /* set up the fault and quit mechanism */ 298 lisp_static_vars_$quit_handler_flag = "0"b; /* allow lisp to handle quits */ 299 call condition_("any_other", lisp_default_handler_); 300 addr(SLASH)->based_ptr -> atom.value = addr(errlist)->based_ptr -> atom.value; /* for auto-start */ 301 lisp_static_vars_$ignore_faults = "0"b; 302 303 /* establish pi handler */ 304 305 on program_interrupt begin; 306 dcl damage bit(1) aligned, 307 lisp_fault_handler_$check_for_damage entry(bit(1)aligned); 308 309 call lisp_fault_handler_$check_for_damage(damage); /* stacks may have been screwed, 310* since we probably took a fault */ 311 312 ask_ctrl: if lisp_static_vars_$masked.against.tty then 313 if damage then call ioa_$ioa_switch(iox_$error_output, "Warning: was in (nointerrupt t) mode at the time"); 314 else if lisp_static_vars_$mulpi_state ^= -1 then; /*Let it get queued */ 315 else do; 316 /* Don't allow pi here, especially since might have been collecting garbage */ 317 call ioa_$ioa_switch(iox_$error_output, "lisp: (nointerrupt t) mode, unable to accept pi."); 318 go to leave_pi; 319 end; 320 lisp_static_vars_$quit_handler_flag = "0"b; 321 if ^lisp_static_vars_$masked.against.tty then 322 string(lisp_static_vars_$masked.against) = ""b; /* so ctrl chars will be accepted */ 323 call lisp_default_handler_$program_interrupt; /* ask for a ctrl char */ 324 /* if fault handler returns, on unit returns and program will restart */ 325 leave_pi: end; 326 327 /* eval supervisor loop */ 328 329 read_print_nl_sync = "1"b; 330 stack = stack_ptr; 331 addr(ctrlR)->based_ptr->atom.value = nil; 332 333 enter_loop: 334 lisp_static_vars_$evalhook_status = lisp_$evalhook_off_status; 335 addr(lisp_static_vars_$evalhook_atom)->based_ptr->atom.value, 336 addr(ctrlQ)->based_ptr->atom.value, 337 addr(ctrlW)->based_ptr->atom.value = nil; /* set i/o switches */ 338 339 stack_ptr = addr(stack->temp(3)); 340 stack -> temp(1) = addr(SLASH)->based_ptr->atom.value; 341 do while(stack->temp(1)^=nil); /* eval all errlist items */ 342 stack->temp(2) = stack->temp_ptr(1)->cons.car; 343 stack->temp(1) = stack->temp_ptr(1)->cons.cdr; 344 call lisp_$eval; 345 end; 346 stack->temp(1) = STAR; 347 loop: stack_ptr = addr(stack->temp(3)); 348 addr(STAR)->based_ptr->atom.value = stack->temp(1); 349 if toplevel ^= nil 350 then stack->temp(1) = toplevel; 351 else do; 352 stack -> temp(2) = stack -> temp(1); /* apply print to it */ 353 if lisp_static_vars_$prin1->atom.value = nil | lisp_static_vars_$prin1->atom.value = 0 354 then stack -> temp(1) = lisp_static_vars_$print_atom; 355 else stack -> temp(1) = lisp_static_vars_$prin1->atom.value; 356 call lisp_special_fns_$ncons; 357 call lisp_$apply; 358 if addr(ctrlQ) -> based_ptr -> atom.value = nil /* if input to be got from console */ 359 then do; 360 tty_loop: call lisp_print_$type_nl; /* so prompt the user */ 361 stack_ptr = addr(stack -> temp(2)); 362 stack -> fixnum_fmt.type_info = fixnum_type; 363 stack -> fixedb = 0; /* tell reader its argcount */ 364 call lisp_reader_$read; 365 end; 366 else do; /* input from file (unless near eof) */ 367 uread_loop: stack_ptr = addr(stack -> temp(3)); 368 addr(stack -> temp(2))->fixnum_fmt.type_info = fixnum_type; 369 addr(stack -> temp(2))->fixedb = -2; /* giving reader one arg, which is */ 370 stack -> flonum_fmt.type_info = flonum_type; 371 stack -> fixedb = 0; /* an impossible flonum */ 372 call lisp_reader_$read; 373 if stack -> flonum_fmt.type_info = flonum_type 374 then if stack -> fixedb = 0 /* this file has come to the end, switch */ 375 then go to tty_loop; /* back to the tty. Prompt user then call 376* read again to close the file, clear ^q, 377* and switch to the tty */ 378 end; 379 addr(PLUS)->based_ptr -> atom.value = addr(MINUS)->based_ptr -> atom.value; 380 addr(MINUS)->based_ptr -> atom.value = stack -> temp(1); 381 end; 382 stack_ptr = addr(stack -> temp(2)); 383 call lisp_$eval; 384 go to loop; 385 386 /*** come here when err'ing all the way back to top level ***/ 387 /*** resets the reader then re-enters the top-level loop ****/ 388 389 top_level_err: 390 stack = stack_ptr; 391 stack_ptr = addr(stack -> temp(2)); 392 stack -> temp(1) = nil; 393 call lisp_io_control_$clear_input; /* flush tty buffer & resetread the stream */ 394 string(unmask.against) = ""b; 395 if lisp_static_vars_$pending_ctrl then call lisp_fault_handler_$set_mask(unmask); 396 go to enter_loop; 397 398 399 400 done: call reversion_("cleanup"); /* don't want cleanup handler executed twice */ 401 lisp_static_vars_$cleanup_list_exists = "0"b; /* don't do user cleanup handler */ 402 call cleanup_handler; 403 return; /* escape out of begin block and proc */ 404 405 406 end first_stack_frame_for_lisp; /* end of big begin block */ 407 408 save: entry; 409 410 /* entry for "save" function, which saves environments */ 411 412 call lisp_io_control_$empty_all_buffers; 413 stack = addrel(stack_ptr,-2); 414 415 stack -> temp(1) = stack -> temp_ptr(1) -> cons.car; /* error trapped by fault here */ 416 retry_save: /* come here to try with better arg */ 417 if stack -> temp_type36(1) & String36 then call lisp_save_(stack -> temp_ptr(1) -> lisp_string.string); 418 else if stack -> temp_type36(1) & Atsym36 then call lisp_save_(stack -> temp_ptr(1) -> atom.pname); 419 else do; 420 our_stack = unmkd_ptr; 421 unmkd_ptr = addrel(our_stack,2); 422 our_stack -> errcode(1) = lisp_error_table_$bad_arg_correctable; 423 our_stack -> errcode(2) = fn_save; 424 call lisp_error_; 425 go to retry_save; 426 end; 427 if lisp_static_vars_$ignore_faults then; 428 else return; /* save crapped out before munging environment, 429* give loser another chance to save */ 430 431 /* otherwise, save won so cleanup and quit */ 432 433 434 lisp$quit: entry; 435 436 /* this is the "quit" function, which causes a return out of the LISP subsystem */ 437 438 439 call lisp_io_control_$empty_all_buffers; 440 goto finishup; /* finishup is set to "done", via non-local go to */ 441 442 443 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.1 lisp.pl1 >special_ldd>on>06/27/83>lisp.pl1 107 1 06/29/83 1425.3 lisp_stack_seg.incl.pl1 >ldd>include>lisp_stack_seg.incl.pl1 108 2 03/27/82 0437.0 lisp_free_storage.incl.pl1 >ldd>include>lisp_free_storage.incl.pl1 109 3 03/27/82 0437.0 lisp_io.incl.pl1 >ldd>include>lisp_io.incl.pl1 3-5 4 03/27/82 0437.0 lisp_iochan.incl.pl1 >ldd>include>lisp_iochan.incl.pl1 3-45 5 03/27/82 0437.0 lisp_control_chars.incl.pl1 >ldd>include>lisp_control_chars.incl.pl1 111 6 03/27/82 0437.0 lisp_stack_fmt.incl.pl1 >ldd>include>lisp_stack_fmt.incl.pl1 112 7 03/27/82 0437.0 lisp_nums.incl.pl1 >ldd>include>lisp_nums.incl.pl1 113 8 03/27/82 0437.0 lisp_initial_atoms.incl.pl1 >ldd>include>lisp_initial_atoms.incl.pl1 114 9 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 115 10 03/27/82 0437.0 lisp_faults.incl.pl1 >ldd>include>lisp_faults.incl.pl1 117 11 06/29/83 1425.3 lisp_name_codes.incl.pl1 >ldd>include>lisp_name_codes.incl.pl1 118 12 03/27/82 0437.1 lisp_atom_fmt.incl.pl1 >ldd>include>lisp_atom_fmt.incl.pl1 119 13 03/27/82 0437.0 lisp_cons_fmt.incl.pl1 >ldd>include>lisp_cons_fmt.incl.pl1 120 14 03/27/82 0436.9 lisp_string_fmt.incl.pl1 >ldd>include>lisp_string_fmt.incl.pl1 121 15 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 122 16 03/27/82 0436.9 lisp_subr_fmt.incl.pl1 >ldd>include>lisp_subr_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 10-10 Array internal static bit(9) initial unaligned dcl 15-17 Array36 internal static bit(36) initial dcl 15-17 Array_fault internal static fixed bin(17,0) initial dcl 10-10 Atomic internal static bit(9) initial unaligned dcl 15-17 Atomic36 internal static bit(36) initial dcl 15-17 Atsym internal static bit(9) initial unaligned dcl 15-17 Atsym36 constant bit(36) initial dcl 15-17 ref 418 Bigfix internal static bit(9) initial unaligned dcl 15-17 Bigfix36 internal static bit(36) initial dcl 15-17 Bignum internal static bit(9) initial unaligned dcl 15-17 Bignum36 internal static bit(36) initial dcl 15-17 Car_cdr_fault internal static fixed bin(17,0) initial dcl 10-10 Cons constant bit(9) initial unaligned dcl 15-17 ref 250 Cons36 internal static bit(36) initial dcl 15-17 Cput_fault internal static fixed bin(17,0) initial dcl 10-10 File internal static bit(9) initial unaligned dcl 15-17 File36 internal static bit(36) initial dcl 15-17 Fixed internal static bit(9) initial unaligned dcl 15-17 Fixed36 internal static bit(36) initial dcl 15-17 Float internal static bit(9) initial unaligned dcl 15-17 Float36 internal static bit(36) initial dcl 15-17 MINUS defined fixed bin(71,0) dcl 8-3 set ref 379 380 NotConsOrAtsym36 internal static bit(36) initial dcl 15-17 Numeric internal static bit(9) initial unaligned dcl 15-17 Numeric36 internal static bit(36) initial dcl 15-17 Old_store_fault internal static fixed bin(17,0) initial dcl 10-10 PLUS defined fixed bin(71,0) dcl 8-3 set ref 379 Pi_fault internal static fixed bin(17,0) initial dcl 10-10 Quit_fault internal static fixed bin(17,0) initial dcl 10-10 SLASH defined fixed bin(71,0) dcl 8-3 set ref 300 340 STAR defined fixed bin(71,0) dcl 8-3 set ref 346 348 String internal static bit(9) initial unaligned dcl 15-17 String36 constant bit(36) initial dcl 15-17 ref 416 Subr internal static bit(9) initial unaligned dcl 15-17 Subr36 internal static bit(36) initial dcl 15-17 SubrNumeric36 internal static bit(36) initial dcl 15-17 System_Subr internal static bit(9) initial unaligned dcl 15-17 System_Subr36 internal static bit(36) initial dcl 15-17 Uncollectable internal static bit(9) initial unaligned dcl 15-17 Undefined internal static bit(72) initial unaligned dcl 15-17 Underflow_fault internal static fixed bin(17,0) initial dcl 10-10 Zerodivide_fault internal static fixed bin(17,0) initial dcl 10-10 acc_ent_name based structure level 1 dcl 16-10 addr builtin function dcl 44 ref 126 126 163 168 168 176 180 181 183 214 215 249 272 300 300 331 335 335 335 339 340 347 348 358 361 367 368 369 379 379 380 382 391 addrel builtin function dcl 44 ref 178 183 413 421 against 000246 external static structure level 2 in structure "lisp_static_vars_$masked" packed unaligned dcl 10-45 in procedure "lisp" set ref 321* against 000100 automatic structure level 2 in structure "unmask" packed unaligned dcl 44 in procedure "lisp" set ref 394* alloc_fault_word defined bit(36) unaligned dcl 2-3 alloc_segment based structure level 1 dcl 2-3 alrm_fault internal static bit(36) initial unaligned dcl 2-3 arg_list_ptr 000102 automatic pointer dcl 44 set ref 139* 199 203* arglen 000100 automatic fixed bin(17,0) dcl 146 set ref 203* 205 223 223 argname based char unaligned dcl 146 set ref 205 223* argptr 000102 automatic pointer dcl 146 set ref 203* 205 223 array_atom defined fixed bin(71,0) dcl 9-6 ask_ctrl 000737 constant label dcl 312 atom based structure level 1 dcl 12-5 atom_double_words based structure level 1 dcl 12-5 atom_ptrs based structure level 1 dcl 12-5 base defined fixed bin(71,0) dcl 3-17 based_ptr based pointer dcl 15-16 ref 300 300 331 335 335 335 340 348 358 379 379 380 begin_unmkd_stack 174 based fixed bin(71,0) array level 2 dcl 1-5 set ref 176 181 binding_block based structure level 1 dcl 6-7 binding_top defined pointer dcl 9-6 set ref 175* bindings based structure array level 1 dcl 6-7 bit builtin function dcl 44 call_array_operator internal static bit(36) initial unaligned dcl 1-68 call_dead_array_operator internal static bit(36) initial unaligned dcl 1-68 car based fixed bin(71,0) level 2 dcl 13-5 ref 253 342 415 catch_frame defined pointer dcl 9-6 set ref 175* cclist based structure level 1 unaligned dcl 93 cdr 2 based fixed bin(71,0) level 2 dcl 13-5 ref 255 343 cleanup_handler 001321 constant entry internal dcl 238 ref 236 236 402 code 000104 automatic fixed bin(17,0) dcl 146 set ref 203* 204 223* 229* 231 condition_ 000072 constant entry external dcl 44 ref 236 299 cons based structure level 1 dcl 13-5 cons_ptrs based structure level 1 dcl 13-5 cons_types based structure level 1 dcl 13-5 cons_types36 based structure level 1 dcl 13-22 consptr automatic pointer dcl 13-5 consptr_ovly based structure level 1 dcl 2-3 cput_fault internal static bit(36) initial unaligned dcl 2-3 ctrlD defined fixed bin(71,0) dcl 5-5 ctrlQ defined fixed bin(71,0) dcl 5-8 set ref 335 358 ctrlR defined fixed bin(71,0) dcl 5-11 set ref 331 ctrlW defined fixed bin(71,0) dcl 5-14 set ref 335 cu_$arg_list_ptr 000066 constant entry external dcl 44 ref 139 cu_$arg_ptr_rel 000052 constant entry external dcl 44 ref 203 damage 000100 automatic bit(1) dcl 306 set ref 309* 312 deferred_interrupt defined bit(1) dcl 10-45 delta 2(30) based fixed bin(5,0) level 3 packed unaligned dcl 2-3 set ref 213* done 001274 constant label dcl 400 ref 192 enter_loop 001037 constant label dcl 333 ref 396 err_frame defined pointer dcl 9-6 set ref 175* err_recp defined pointer dcl 9-6 set ref 175* errcode based fixed bin(17,0) array dcl 44 set ref 422* 423* errlist defined fixed bin(71,0) dcl 8-3 set ref 300 eval_frame defined pointer dcl 9-6 set ref 175* fault_mask internal static bit(36) initial unaligned dcl 2-3 fault_save based structure level 1 dcl 10-25 finishup 000012 internal static label variable dcl 44 set ref 191 192* 264* 440 first_stack_frame_for_lisp 000245 constant label dcl 144 fixed builtin function dcl 44 fixedb 1 based fixed bin(17,0) level 2 dcl 7-4 set ref 363* 369* 371* 373 fixnum_fmt based structure level 1 dcl 7-4 fixnum_type constant bit(36) initial dcl 7-4 ref 362 368 flag_reset_mask internal static bit(36) initial dcl 4-13 flonum_fmt based structure level 1 dcl 7-4 flonum_type constant bit(36) initial dcl 7-4 ref 370 373 fn_CtoI internal static fixed bin(17,0) initial dcl 11-9 fn_ItoC internal static fixed bin(17,0) initial dcl 11-9 fn_abs internal static fixed bin(17,0) initial dcl 11-9 fn_add1 internal static fixed bin(17,0) initial dcl 11-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 11-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 11-9 fn_alarmclock internal static fixed bin(17,0) initial dcl 11-9 fn_allfiles internal static fixed bin(17,0) initial dcl 11-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 11-9 fn_apply internal static fixed bin(17,0) initial dcl 11-9 fn_arg internal static fixed bin(17,0) initial dcl 11-9 fn_args internal static fixed bin(17,0) initial dcl 11-9 fn_array internal static fixed bin(17,0) initial dcl 11-9 fn_arraydims internal static fixed bin(17,0) initial dcl 11-9 fn_ascii internal static fixed bin(17,0) initial dcl 11-9 fn_atan internal static fixed bin(17,0) initial dcl 11-9 fn_baktrace internal static fixed bin(17,0) initial dcl 11-9 fn_bltarray internal static fixed bin(17,0) initial dcl 11-9 fn_boole internal static fixed bin(17,0) initial dcl 11-9 fn_boundp internal static fixed bin(17,0) initial dcl 11-9 fn_catch internal static fixed bin(17,0) initial dcl 11-9 fn_catenate internal static fixed bin(17,0) initial dcl 11-9 fn_charpos internal static fixed bin(17,0) initial dcl 11-9 fn_chrct internal static fixed bin(17,0) initial dcl 11-9 fn_clear_input internal static fixed bin(17,0) initial dcl 11-9 fn_cline internal static fixed bin(17,0) initial dcl 11-9 fn_close internal static fixed bin(17,0) initial dcl 11-9 fn_cos internal static fixed bin(17,0) initial dcl 11-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 11-9 fn_defaultf internal static fixed bin(17,0) initial dcl 11-9 fn_definedp internal static fixed bin(17,0) initial dcl 11-9 fn_defsubr internal static fixed bin(17,0) initial dcl 11-9 fn_defun internal static fixed bin(17,0) initial dcl 11-9 fn_delete internal static fixed bin(17,0) initial dcl 11-9 fn_deletef internal static fixed bin(17,0) initial dcl 11-9 fn_delq internal static fixed bin(17,0) initial dcl 11-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 11-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 11-9 fn_difference internal static fixed bin(17,0) initial dcl 11-9 fn_displace internal static fixed bin(17,0) initial dcl 11-9 fn_do internal static fixed bin(17,0) initial dcl 11-9 fn_dumparrays internal static fixed bin(17,0) initial dcl 11-9 fn_endpagefn internal static fixed bin(17,0) initial dcl 11-9 fn_eoffn internal static fixed bin(17,0) initial dcl 11-9 fn_eql internal static fixed bin(17,0) initial dcl 11-9 fn_errframe internal static fixed bin(17,0) initial dcl 11-9 fn_errprint internal static fixed bin(17,0) initial dcl 11-9 fn_errset internal static fixed bin(17,0) initial dcl 11-9 fn_eval internal static fixed bin(17,0) initial dcl 11-9 fn_eval_when internal static fixed bin(17,0) initial dcl 11-9 fn_evalframe internal static fixed bin(17,0) initial dcl 11-9 fn_exp internal static fixed bin(17,0) initial dcl 11-9 fn_expt internal static fixed bin(17,0) initial dcl 11-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 11-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 11-9 fn_filepos internal static fixed bin(17,0) initial dcl 11-9 fn_fillarray internal static fixed bin(17,0) initial dcl 11-9 fn_fix internal static fixed bin(17,0) initial dcl 11-9 fn_float internal static fixed bin(17,0) initial dcl 11-9 fn_force_output internal static fixed bin(17,0) initial dcl 11-9 fn_freturn internal static fixed bin(17,0) initial dcl 11-9 fn_fsc internal static fixed bin(17,0) initial dcl 11-9 fn_gcd internal static fixed bin(17,0) initial dcl 11-9 fn_gensym internal static fixed bin(17,0) initial dcl 11-9 fn_get internal static fixed bin(17,0) initial dcl 11-9 fn_get_pname internal static fixed bin(17,0) initial dcl 11-9 fn_getchar internal static fixed bin(17,0) initial dcl 11-9 fn_getl internal static fixed bin(17,0) initial dcl 11-9 fn_greaterp internal static fixed bin(17,0) initial dcl 11-9 fn_gt internal static fixed bin(17,0) initial dcl 11-9 fn_haipart internal static fixed bin(17,0) initial dcl 11-9 fn_haulong internal static fixed bin(17,0) initial dcl 11-9 fn_ifix internal static fixed bin(17,0) initial dcl 11-9 fn_in internal static fixed bin(17,0) initial dcl 11-9 fn_includef internal static fixed bin(17,0) initial dcl 11-9 fn_index internal static fixed bin(17,0) initial dcl 11-9 fn_inpush internal static fixed bin(17,0) initial dcl 11-9 fn_isqrt internal static fixed bin(17,0) initial dcl 11-9 fn_lessp internal static fixed bin(17,0) initial dcl 11-9 fn_linel internal static fixed bin(17,0) initial dcl 11-9 fn_linenum internal static fixed bin(17,0) initial dcl 11-9 fn_listarray internal static fixed bin(17,0) initial dcl 11-9 fn_listify internal static fixed bin(17,0) initial dcl 11-9 fn_loadarrays internal static fixed bin(17,0) initial dcl 11-9 fn_log internal static fixed bin(17,0) initial dcl 11-9 fn_ls internal static fixed bin(17,0) initial dcl 11-9 fn_lsh internal static fixed bin(17,0) initial dcl 11-9 fn_make_atom internal static fixed bin(17,0) initial dcl 11-9 fn_makunbound internal static fixed bin(17,0) initial dcl 11-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 11-9 fn_max internal static fixed bin(17,0) initial dcl 11-9 fn_mergef internal static fixed bin(17,0) initial dcl 11-9 fn_min internal static fixed bin(17,0) initial dcl 11-9 fn_minus internal static fixed bin(17,0) initial dcl 11-9 fn_minusp internal static fixed bin(17,0) initial dcl 11-9 fn_namelist internal static fixed bin(17,0) initial dcl 11-9 fn_names internal static fixed bin(17,0) initial dcl 11-9 fn_namestring internal static fixed bin(17,0) initial dcl 11-9 fn_nointerrupt internal static fixed bin(17,0) initial dcl 11-9 fn_nth internal static fixed bin(17,0) initial dcl 11-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 11-9 fn_oddp internal static fixed bin(17,0) initial dcl 11-9 fn_open internal static fixed bin(17,0) initial dcl 11-9 fn_opena internal static fixed bin(17,0) initial dcl 11-9 fn_openi internal static fixed bin(17,0) initial dcl 11-9 fn_openo internal static fixed bin(17,0) initial dcl 11-9 fn_out internal static fixed bin(17,0) initial dcl 11-9 fn_pagel internal static fixed bin(17,0) initial dcl 11-9 fn_pagenum internal static fixed bin(17,0) initial dcl 11-9 fn_plus internal static fixed bin(17,0) initial dcl 11-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 11-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 11-9 fn_plusp internal static fixed bin(17,0) initial dcl 11-9 fn_prin1 internal static fixed bin(17,0) initial dcl 11-9 fn_princ internal static fixed bin(17,0) initial dcl 11-9 fn_print internal static fixed bin(17,0) initial dcl 11-9 fn_prog internal static fixed bin(17,0) initial dcl 11-9 fn_progv internal static fixed bin(17,0) initial dcl 11-9 fn_putprop internal static fixed bin(17,0) initial dcl 11-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 11-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 11-9 fn_quotient internal static fixed bin(17,0) initial dcl 11-9 fn_random internal static fixed bin(17,0) initial dcl 11-9 fn_read internal static fixed bin(17,0) initial dcl 11-9 fn_read_from_string internal static fixed bin(17,0) initial dcl 11-9 fn_readch internal static fixed bin(17,0) initial dcl 11-9 fn_readstring internal static fixed bin(17,0) initial dcl 11-9 fn_remainder internal static fixed bin(17,0) initial dcl 11-9 fn_remprop internal static fixed bin(17,0) initial dcl 11-9 fn_rename internal static fixed bin(17,0) initial dcl 11-9 fn_rot internal static fixed bin(17,0) initial dcl 11-9 fn_rplaca internal static fixed bin(17,0) initial dcl 11-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 11-9 fn_save constant fixed bin(17,0) initial dcl 11-9 ref 423 fn_set internal static fixed bin(17,0) initial dcl 11-9 fn_setarg internal static fixed bin(17,0) initial dcl 11-9 fn_setq internal static fixed bin(17,0) initial dcl 11-9 fn_setsyntax internal static fixed bin(17,0) initial dcl 11-9 fn_shortnamestring internal static fixed bin(17,0) initial dcl 11-9 fn_signp internal static fixed bin(17,0) initial dcl 11-9 fn_sin internal static fixed bin(17,0) initial dcl 11-9 fn_sleep internal static fixed bin(17,0) initial dcl 11-9 fn_sort internal static fixed bin(17,0) initial dcl 11-9 fn_sortcar internal static fixed bin(17,0) initial dcl 11-9 fn_sqrt internal static fixed bin(17,0) initial dcl 11-9 fn_sstatus internal static fixed bin(17,0) initial dcl 11-9 fn_star_array internal static fixed bin(17,0) initial dcl 11-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 11-9 fn_star_sstatus internal static fixed bin(17,0) initial dcl 11-9 fn_star_status internal static fixed bin(17,0) initial dcl 11-9 fn_status internal static fixed bin(17,0) initial dcl 11-9 fn_store internal static fixed bin(17,0) initial dcl 11-9 fn_stringlength internal static fixed bin(17,0) initial dcl 11-9 fn_sub1 internal static fixed bin(17,0) initial dcl 11-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 11-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 11-9 fn_substr internal static fixed bin(17,0) initial dcl 11-9 fn_sxhash internal static fixed bin(17,0) initial dcl 11-9 fn_sysp internal static fixed bin(17,0) initial dcl 11-9 fn_throw internal static fixed bin(17,0) initial dcl 11-9 fn_times internal static fixed bin(17,0) initial dcl 11-9 fn_times_fix internal static fixed bin(17,0) initial dcl 11-9 fn_times_flo internal static fixed bin(17,0) initial dcl 11-9 fn_truename internal static fixed bin(17,0) initial dcl 11-9 fn_tyi internal static fixed bin(17,0) initial dcl 11-9 fn_tyipeek internal static fixed bin(17,0) initial dcl 11-9 fn_tyo internal static fixed bin(17,0) initial dcl 11-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 11-9 fn_zerop internal static fixed bin(17,0) initial dcl 11-9 foo automatic fixed bin(71,0) dcl 44 gc_inhibit defined bit(1) dcl 10-45 hcs_$fs_get_path_name 000256 constant entry external dcl 129 ref 126 hcs_$initiate 000260 constant entry external dcl 129 ref 127 i automatic fixed bin(17,0) dcl 44 ibase defined fixed bin(71,0) dcl 3-17 in_pl1_code 16 based bit(36) level 2 dcl 1-5 set ref 182* ioa_$ioa_switch 000034 constant entry external dcl 35 ref 241 312 317 iochan based structure level 1 dcl 4-13 iox_$error_output 000036 external static pointer dcl 35 set ref 241* 312* 317* leave_pi 001025 constant label dcl 325 ref 318 level 000010 internal static fixed bin(17,0) initial dcl 24 set ref 140* 140 141 272 274* 274 lisp 000112 constant entry external dcl 6 lisp$ 000254 external static fixed bin(17,0) dcl 129 set ref 126 126 lisp$quit 001651 constant entry external dcl 434 lisp_$apply 000132 constant entry external dcl 44 ref 357 lisp_$eval 000134 constant entry external dcl 44 ref 254 344 383 lisp_$evalhook_off_status 000144 external static bit(36) dcl 87 ref 333 lisp_alloc_$alloc_fault_word external static bit(36) dcl 2-3 lisp_alloc_$alloc_info 000156 external static bit(288) dcl 2-3 set ref 190 270* lisp_alloc_$consptr 000164 external static pointer dcl 2-3 set ref 214* 215 lisp_alloc_$cur_seg 000166 external static pointer dcl 2-3 set ref 209* 210 211 212 213 214 265 266 267* lisp_alloc_$gc_blk_cntr 000160 external static fixed bin(17,0) dcl 2-3 set ref 216* lisp_alloc_$seg_blk_cntr 000162 external static fixed bin(17,0) dcl 2-3 set ref 217* lisp_boot_ 000112 constant entry external dcl 44 ref 220 lisp_default_handler_ 000100 constant entry external dcl 44 ref 299 299 lisp_default_handler_$program_interrupt 000076 constant entry external dcl 44 ref 323 lisp_error_ 000070 constant entry external dcl 44 ref 424 lisp_error_table_$bad_arg_correctable 000032 external static fixed bin(17,0) dcl 32 ref 422 lisp_fault_handler_$check_for_damage 000270 constant entry external dcl 306 ref 309 lisp_fault_handler_$init 000054 constant entry external dcl 44 ref 297 lisp_fault_handler_$set_mask 000252 constant entry external dcl 10-45 ref 395 lisp_get_atom_ 000000 constant entry external dcl 44 lisp_get_atom_$init_ht 000000 constant entry external dcl 44 lisp_io_control_$cleanup 000106 constant entry external dcl 44 ref 260 lisp_io_control_$clear_input 000104 constant entry external dcl 44 ref 393 lisp_io_control_$empty_all_buffers 000102 constant entry external dcl 44 ref 412 439 lisp_io_control_$init 000110 constant entry external dcl 44 ref 281 lisp_oprs_$init 000146 constant entry external dcl 91 ref 187 lisp_print_$type_nl 000122 constant entry external dcl 44 ref 360 lisp_ptr based structure level 1 dcl 15-17 lisp_ptr_type based bit(36) dcl 15-17 lisp_reader_$read 000120 constant entry external dcl 44 ref 364 372 lisp_save_ 000116 constant entry external dcl 44 ref 416 418 lisp_save_$unsave 000114 constant entry external dcl 44 ref 223 229 lisp_segment_manager_$free_lists 000064 constant entry external dcl 44 ref 268 lisp_segment_manager_$free_stack 000060 constant entry external dcl 44 ref 261 263 lisp_segment_manager_$get_lists 000062 constant entry external dcl 44 ref 209 lisp_segment_manager_$get_stack 000056 constant entry external dcl 44 ref 174 177 lisp_special_fns_$ncons 000130 constant entry external dcl 44 ref 356 lisp_static_man_$free_stat_segs 000136 constant entry external dcl 44 ref 271 lisp_static_vars_$MINUS 000210 external static fixed bin(71,0) dcl 8-3 ref 379 379 380 380 lisp_static_vars_$PLUS 000206 external static fixed bin(71,0) dcl 8-3 ref 379 379 lisp_static_vars_$SLASH 000212 external static fixed bin(71,0) dcl 8-3 ref 300 300 340 340 lisp_static_vars_$STAR 000204 external static fixed bin(71,0) dcl 8-3 ref 346 346 348 348 lisp_static_vars_$arg_list_ptr 000262 external static pointer dcl 197 set ref 199* lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 9-6 lisp_static_vars_$base external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$binding_top 000242 external static pointer dcl 9-6 set ref 175* 175 lisp_static_vars_$catch_frame 000226 external static pointer dcl 9-6 set ref 175* 175 lisp_static_vars_$cleanup_list 000152 external static fixed bin(71,0) dcl 101 set ref 250 279* lisp_static_vars_$cleanup_list_exists 000150 external static bit(1) dcl 101 set ref 240 247* 401* lisp_static_vars_$ctrlD external static fixed bin(71,0) dcl 5-5 lisp_static_vars_$ctrlQ 000172 external static fixed bin(71,0) dcl 5-8 ref 335 335 358 358 lisp_static_vars_$ctrlR 000174 external static fixed bin(71,0) dcl 5-11 ref 331 331 lisp_static_vars_$ctrlW 000176 external static fixed bin(71,0) dcl 5-14 ref 335 335 lisp_static_vars_$cur_stat_pos 000024 external static fixed bin(19,0) dcl 26 set ref 207* 233* lisp_static_vars_$cur_stat_seg 000022 external static pointer dcl 26 set ref 206* 232* lisp_static_vars_$deferred_interrupt external static bit(1) dcl 10-45 lisp_static_vars_$emptying_buffers 000046 external static fixed bin(17,0) dcl 35 set ref 282* lisp_static_vars_$err_frame 000224 external static pointer dcl 9-6 set ref 175* 175 lisp_static_vars_$err_recp 000216 external static pointer dcl 9-6 set ref 175* 175 lisp_static_vars_$errlist 000202 external static fixed bin(71,0) dcl 8-3 ref 300 300 lisp_static_vars_$eval_frame 000220 external static pointer dcl 9-6 set ref 175* 175 lisp_static_vars_$evalhook_atom 000142 external static fixed bin(71,0) dcl 87 set ref 335 lisp_static_vars_$evalhook_status 000140 external static bit(36) dcl 87 set ref 333* lisp_static_vars_$garbage_collect_inhibit 000264 external static bit(1) dcl 286 in begin block on line 144 set ref 219* 289* lisp_static_vars_$garbage_collect_inhibit external static bit(1) dcl 10-45 in procedure "lisp" lisp_static_vars_$gc_time external static fixed bin(71,0) dcl 35 lisp_static_vars_$hi_random 000050 external static bit(72) dcl 35 set ref 294* lisp_static_vars_$i_am_gcing 000154 external static bit(1) dcl 101 ref 241 lisp_static_vars_$ibase external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$ignore_faults 000040 external static bit(36) dcl 35 set ref 259* 301* 427 lisp_static_vars_$iochan_list external static pointer dcl 9-6 lisp_static_vars_$lisp_static_vars_ 000214 external static structure level 1 unaligned dcl 9-6 set ref 163 168 272 lisp_static_vars_$masked 000246 external static structure level 1 dcl 10-45 lisp_static_vars_$mulpi_state 000042 external static fixed bin(17,0) dcl 35 ref 314 lisp_static_vars_$nil 000244 external static fixed bin(71,0) dcl 9-6 ref 277 277 278 278 279 279 331 331 335 335 341 341 349 349 353 353 358 358 392 392 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 9-6 lisp_static_vars_$pending_ctrl 000250 external static bit(1) dcl 10-45 ref 395 lisp_static_vars_$plus_status external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$prin1 000126 external static pointer dcl 44 ref 353 353 355 lisp_static_vars_$print_atom 000124 external static fixed bin(71,0) dcl 44 ref 353 lisp_static_vars_$prog_frame 000222 external static pointer dcl 9-6 set ref 175* 175 lisp_static_vars_$property_list_of_nil 000030 external static fixed bin(71,0) dcl 32 set ref 278* lisp_static_vars_$quit_handler_flag 000044 external static bit(1) unaligned dcl 35 set ref 298* 320* lisp_static_vars_$quote_atom external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$rdr_label external static label variable dcl 10-45 lisp_static_vars_$rdr_ptr external static pointer dcl 10-45 lisp_static_vars_$rdr_state 000266 external static fixed bin(17,0) dcl 286 in begin block on line 144 set ref 290* lisp_static_vars_$rdr_state external static fixed bin(17,0) dcl 10-45 in procedure "lisp" lisp_static_vars_$read_print_nl_sync 000170 external static bit(36) unaligned dcl 3-17 set ref 329* 329 lisp_static_vars_$readtable external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$s_atom external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$stack_ptr 000232 external static pointer dcl 9-6 set ref 177 177 178* 178 178 178 179 179 180 180 248 248 249* 249 262 262 330 330 339* 339 347* 347 361* 361 367* 367 382* 382 389 389 391* 391 413 413 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 9-45 lisp_static_vars_$status_gctwa external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$stnopoint external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$subsys_recurse_save_size 000026 external static fixed bin(17,0) dcl 26 ref 141 lisp_static_vars_$t_atom 000234 external static fixed bin(71,0) dcl 9-6 ref 276 276 lisp_static_vars_$template 000016 external static fixed bin(17,0) dcl 26 set ref 168 lisp_static_vars_$template_size 000020 external static fixed bin(17,0) dcl 26 ref 168 lisp_static_vars_$top_level 000236 external static label variable dcl 9-6 set ref 193* lisp_static_vars_$toplevel 000200 external static fixed bin(71,0) dcl 8-3 ref 349 349 349 349 lisp_static_vars_$tty_atom external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$tty_input_chan external static pointer dcl 9-6 lisp_static_vars_$tty_output_chan external static pointer dcl 9-6 lisp_static_vars_$unmkd_ptr 000240 external static pointer dcl 9-6 set ref 176* 176 183 183 420 420 421* 421 lisp_static_vars_$unwp_frame 000230 external static pointer dcl 9-6 set ref 175* 175 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 9-45 lisp_string based structure level 1 dcl 14-6 lisp_subr_ based structure level 1 dcl 16-10 lisp_subr_for_call based structure level 1 dcl 16-10 loop 001102 constant label dcl 347 ref 384 marked_stack_bottom based pointer level 2 dcl 1-5 set ref 179* masked based structure level 1 dcl 10-45 mod 1(30) based bit(6) level 2 in structure "consptr_ovly" packed unaligned dcl 2-3 in procedure "lisp" set ref 215* mod builtin function dcl 44 in procedure "lisp" next_seg based pointer level 2 dcl 2-3 set ref 210* 267 nil 12 based fixed bin(71,0) level 2 in structure "stack_seg" dcl 1-5 in procedure "lisp" set ref 277* nil defined fixed bin(71,0) dcl 9-6 in procedure "lisp" ref 277 278 279 331 335 341 349 353 358 392 nil_ptr based pointer dcl 9-6 not_ok_to_read internal static bit(36) initial unaligned dcl 3-9 not_ok_to_read_fixnum internal static bit(36) initial unaligned dcl 3-11 not_ok_to_write internal static bit(36) initial unaligned dcl 3-9 not_ok_to_write_fixnum internal static bit(36) initial unaligned dcl 3-11 null builtin function dcl 44 ref 127 127 206 210 265 obarray defined fixed bin(71,0) dcl 9-6 old_alloc_info 000110 automatic bit(288) dcl 146 set ref 190* 270 old_stat_ptr 000106 automatic pointer dcl 146 set ref 223* 229* 232 old_stat_size 000105 automatic fixed bin(18,0) dcl 146 set ref 223* 229* 233 oldfinishup 000120 automatic label variable dcl 146 set ref 191* 264 our_stack 000106 automatic pointer dcl 44 in procedure "lisp" set ref 420* 421 422 423 our_stack 000124 automatic pointer dcl 146 in begin block on line 144 set ref 174* 175 176 179 180 181 181 182 183 261* 276 277 pdl_ptr_types36 based structure array level 1 dcl 6-7 pending_ctrl defined bit(1) dcl 10-45 plus_status defined fixed bin(71,0) dcl 3-17 pname 5 based char level 2 dcl 12-5 set ref 418* pnamel 4 based fixed bin(17,0) level 2 dcl 12-5 ref 418 418 prog_frame defined pointer dcl 9-6 set ref 175* program_interrupt 000000 stack reference condition dcl 44 ref 305 ptr builtin function dcl 44 ref 262 push_down_list_ptr_types based structure array level 1 dcl 6-7 quit_fault internal static bit(36) initial unaligned dcl 2-3 quote_atom defined fixed bin(71,0) dcl 3-17 rdr_label defined label variable dcl 10-45 rdr_ptr defined pointer dcl 10-45 rdr_state defined fixed bin(17,0) dcl 10-45 read_print_nl_sync defined bit(36) unaligned dcl 3-17 set ref 329* readtable defined fixed bin(71,0) dcl 3-17 rel builtin function dcl 44 retry_save 001556 constant label dcl 416 ref 425 reversion_ 000074 constant entry external dcl 44 ref 400 s_atom defined fixed bin(71,0) dcl 3-17 save 001536 constant entry external dcl 408 save_area 000130 automatic bit(36) array dcl 157 set ref 163* 272 save_area_size 000104 automatic fixed bin(17,0) dcl 44 set ref 141* 142* 157 163 163 272 saved_ignore_faults automatic bit(36) dcl 35 seg_offset 2 based bit(18) level 3 packed unaligned dcl 2-3 set ref 211* stack 000100 automatic pointer dcl 246 in procedure "cleanup_handler" set ref 248* 249 250 250 253 253 255 262* 263* 266* 267 268* stack 000126 automatic pointer dcl 146 in begin block on line 144 set ref 330* 339 340 341 342 342 343 343 346 347 348 349 352 352 353 355 361 362 363 367 368 369 370 371 373 373 380 382 389* 391 392 stack 000110 automatic pointer dcl 44 in procedure "lisp" set ref 413* 415 415 416 416 418 418 stack_ptr defined pointer dcl 9-6 set ref 177* 178* 178 179 180 248 249* 262 330 339* 347* 361* 367* 382* 389 391* 413 stack_ptr_ptr 4 based pointer level 2 dcl 1-5 set ref 180* stack_seg based structure level 1 dcl 1-5 star_rset defined fixed bin(71,0) dcl 9-45 status_gctwa defined fixed bin(71,0) dcl 3-17 stnopoint defined fixed bin(71,0) dcl 3-17 string builtin function dcl 44 in procedure "lisp" set ref 321* 394* string 1 based char level 2 in structure "lisp_string" dcl 14-6 in procedure "lisp" set ref 416* string_length based fixed bin(17,0) level 2 dcl 14-6 ref 416 416 subr_type automatic fixed bin(2,0) dcl 44 substr builtin function dcl 44 t_atom defined fixed bin(71,0) dcl 9-6 ref 276 t_atom_ptr based pointer dcl 9-6 tally 2(18) based bit(12) level 3 packed unaligned dcl 2-3 set ref 212* tally_word 2 based structure level 2 dcl 2-3 set ref 214 temp based fixed bin(71,0) array dcl 6-7 set ref 249 250* 253* 339 340* 341 342* 343* 346* 347 348 349* 352* 352 353* 355* 361 367 368 369 380 382 391 392* 415* temp_ptr based pointer array dcl 6-7 ref 253 255 342 343 415 416 418 temp_type 0(21) based bit(9) array level 2 packed unaligned dcl 6-7 ref 250 temp_type36 based bit(36) array level 2 dcl 6-7 ref 416 418 tempp automatic pointer dcl 44 top_level_err 001243 constant label dcl 389 ref 193 toplevel defined fixed bin(71,0) dcl 8-3 ref 349 349 true 14 based fixed bin(71,0) level 2 dcl 1-5 set ref 276* tty 000246 external static bit(1) level 3 packed unaligned dcl 10-45 set ref 312 321 tty_atom defined fixed bin(71,0) dcl 3-17 tty_input_chan defined pointer dcl 9-6 tty_loop 001155 constant label dcl 360 ref 373 tty_output_chan defined pointer dcl 9-6 type_info based bit(36) level 2 in structure "fixnum_fmt" dcl 7-4 in procedure "lisp" set ref 362* 368* type_info based bit(36) level 2 in structure "flonum_fmt" dcl 7-4 in procedure "lisp" set ref 370* 373 unm automatic pointer dcl 116 unmask 000100 automatic structure level 1 dcl 44 set ref 395* unmkd_ptr defined pointer dcl 9-6 set ref 176* 183 420 421* unmkd_ptr_ptr 6 based pointer level 2 dcl 1-5 set ref 183* unmkd_stack_bottom 2 based pointer level 2 dcl 1-5 set ref 181* unsaved 000573 constant label dcl 231 ref 225 unwp_frame defined pointer dcl 9-6 set ref 175* uread_loop 001176 constant label dcl 367 user_intr_array defined fixed bin(71,0) array dcl 9-45 value based fixed bin(71,0) level 2 dcl 12-5 set ref 300* 300 331* 335* 335* 335* 340 348* 353 353 355 358 379* 379 380* words_to_be_moved_sas based bit(36) array dcl 158 set ref 163 272* words_to_be_moved_ts based bit(36) array dcl 158 set ref 168* 168 xdn 000112 automatic char(168) unaligned dcl 129 set ref 126* 127* xen 000164 automatic char(32) unaligned dcl 129 set ref 126* 127* STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3060 3352 1671 3070 Length 4264 1671 272 676 1167 6 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lisp 182 external procedure is an external procedure. begin block on line 144 136 begin block uses auto adjustable storage, and enables or reverts conditions. cleanup_handler 94 internal procedure is assigned to an entry variable. on unit on line 305 92 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 level lisp 000012 finishup lisp STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 144 000100 arglen begin block on line 144 000102 argptr begin block on line 144 000104 code begin block on line 144 000105 old_stat_size begin block on line 144 000106 old_stat_ptr begin block on line 144 000110 old_alloc_info begin block on line 144 000120 oldfinishup begin block on line 144 000124 our_stack begin block on line 144 000126 stack begin block on line 144 000130 save_area begin block on line 144 cleanup_handler 000100 stack cleanup_handler lisp 000100 unmask lisp 000102 arg_list_ptr lisp 000104 save_area_size lisp 000106 our_stack lisp 000110 stack lisp 000112 xdn lisp 000164 xen lisp on unit on line 305 000100 damage on unit on line 305 THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as enter_begin call_ext_out_desc call_ext_out call_int_this begin_return return tra_label_var alloc_auto_adj bound_check_signal enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. condition_ cu_$arg_list_ptr cu_$arg_ptr_rel hcs_$fs_get_path_name hcs_$initiate ioa_$ioa_switch lisp_$apply lisp_$eval lisp_boot_ lisp_default_handler_ lisp_default_handler_$program_interrupt lisp_error_ lisp_fault_handler_$check_for_damage lisp_fault_handler_$init lisp_fault_handler_$set_mask lisp_io_control_$cleanup lisp_io_control_$clear_input lisp_io_control_$empty_all_buffers lisp_io_control_$init lisp_oprs_$init lisp_print_$type_nl lisp_reader_$read lisp_save_ lisp_save_$unsave lisp_segment_manager_$free_lists lisp_segment_manager_$free_stack lisp_segment_manager_$get_lists lisp_segment_manager_$get_stack lisp_special_fns_$ncons lisp_static_man_$free_stat_segs reversion_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. iox_$error_output lisp$ lisp_$evalhook_off_status lisp_alloc_$alloc_info lisp_alloc_$consptr lisp_alloc_$cur_seg lisp_alloc_$gc_blk_cntr lisp_alloc_$seg_blk_cntr lisp_error_table_$bad_arg_correctable lisp_static_vars_$MINUS lisp_static_vars_$PLUS lisp_static_vars_$SLASH lisp_static_vars_$STAR lisp_static_vars_$arg_list_ptr lisp_static_vars_$binding_top lisp_static_vars_$catch_frame lisp_static_vars_$cleanup_list lisp_static_vars_$cleanup_list_exists lisp_static_vars_$ctrlQ lisp_static_vars_$ctrlR lisp_static_vars_$ctrlW lisp_static_vars_$cur_stat_pos lisp_static_vars_$cur_stat_seg lisp_static_vars_$emptying_buffers lisp_static_vars_$err_frame lisp_static_vars_$err_recp lisp_static_vars_$errlist lisp_static_vars_$eval_frame lisp_static_vars_$evalhook_atom lisp_static_vars_$evalhook_status lisp_static_vars_$garbage_collect_inhibit lisp_static_vars_$hi_random lisp_static_vars_$i_am_gcing lisp_static_vars_$ignore_faults lisp_static_vars_$lisp_static_vars_ lisp_static_vars_$masked lisp_static_vars_$mulpi_state lisp_static_vars_$nil lisp_static_vars_$pending_ctrl lisp_static_vars_$prin1 lisp_static_vars_$print_atom lisp_static_vars_$prog_frame lisp_static_vars_$property_list_of_nil lisp_static_vars_$quit_handler_flag lisp_static_vars_$rdr_state lisp_static_vars_$read_print_nl_sync lisp_static_vars_$stack_ptr lisp_static_vars_$subsys_recurse_save_size lisp_static_vars_$t_atom lisp_static_vars_$template lisp_static_vars_$template_size lisp_static_vars_$top_level lisp_static_vars_$toplevel lisp_static_vars_$unmkd_ptr lisp_static_vars_$unwp_frame LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000111 126 000117 127 000153 139 000225 140 000234 141 000236 142 000244 144 000245 157 000250 163 000256 168 000304 174 000314 175 000322 176 000333 177 000336 178 000344 179 000351 180 000354 181 000357 182 000361 183 000363 187 000366 190 000372 191 000377 192 000403 193 000406 199 000412 203 000415 204 000436 205 000440 206 000446 207 000451 209 000453 210 000461 211 000465 212 000470 213 000472 214 000474 215 000476 216 000501 217 000503 219 000505 220 000507 221 000513 223 000514 225 000544 227 000545 229 000546 231 000573 232 000577 233 000602 236 000604 276 000626 277 000632 278 000634 279 000636 281 000640 282 000644 289 000647 290 000650 294 000651 297 000655 298 000661 299 000663 300 000707 301 000714 305 000715 309 000731 312 000737 314 000766 317 000772 318 001011 320 001012 321 001014 323 001021 325 001025 329 001026 330 001031 331 001034 333 001037 335 001042 339 001051 340 001054 341 001057 342 001064 343 001070 344 001073 345 001077 346 001100 347 001102 348 001106 349 001111 352 001117 353 001121 355 001135 356 001137 357 001143 358 001150 360 001155 361 001162 362 001166 363 001170 364 001171 365 001175 367 001176 368 001201 369 001203 370 001205 371 001207 372 001210 373 001214 379 001223 380 001230 382 001233 383 001236 384 001242 389 001243 391 001247 392 001251 393 001253 394 001257 395 001262 396 001273 400 001274 401 001307 402 001311 403 001315 406 001317 238 001320 240 001326 241 001330 247 001352 248 001353 249 001356 250 001360 253 001367 254 001373 255 001400 259 001405 260 001410 261 001414 262 001424 263 001430 264 001436 265 001444 266 001451 267 001454 268 001457 269 001465 270 001466 271 001473 272 001477 274 001531 275 001533 408 001534 412 001543 413 001547 415 001554 416 001556 418 001600 420 001622 421 001626 422 001631 423 001633 424 001635 425 001641 427 001642 428 001646 434 001647 439 001656 440 001662 ----------------------------------------------------------- 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