COMPILATION LISTING OF SEGMENT lisp_defsubr_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0845.1 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 defsubr: proc; 7 8 /* LISP subroutine definition subroutine. Makes a SUBR block in the 9* lisp environment. 10* Modified by Alex Sunguroff, 6/21/72, to add the subr, store. 11* Modified by Dave Reed, 6/13/72, for the new lisp 12* environment structure 13* Modified 10 AUG 72 by D. Moon for new lisp_error_ 14* Modified 1 Dec 1973 by D. A. Moon to make stuff in lisp_old_io_ be sysp again 15* Modified 74.05.17 by DAM to take out array stuff and obsolete defsubr type 3. 16* Also make_lisp_subr_block_ was made an internal procedure since no one else uses it now. 17* */ 18 19 dcl stack ptr, 20 (sw, lsubrsw, fsubrsw) bit(1), 21 (pointer, baseno) builtin, 22 arg_index fixed bin, 23 number_args fixed bin, 24 flags fixed bin aligned, 25 type fixed bin(2) aligned, 26 nargs fixed bin aligned, 27 subr_offsets(-2:2) fixed bin static init(4,0,2,6,4), 28 1 subr_info_stuff based aligned, 29 2 nargs fixed bin(17) unal, 30 2 subr_type fixed bin(17) unal, 31 lisp$ external fixed bin, 32 lisp_linker_ entry(pointer), 33 lisp_linkage_error condition, 34 subr_ptr ptr, 35 data_ptr ptr, 36 link_ptr ptr, 37 data_object based aligned fixed bin(71), /* lisp object for defsubr copy of type 3 data */ 38 1 lisp_fixnum_ovly_lk based aligned, 39 2 pad bit(45) unal, 40 2 lk_info bit(27) unal, /* stuff generated by lisp compiler */ 41 1 link_info based aligned, 42 2 base bit(3) unal, /* itp base */ 43 2 info bit(27) unal, /* from defsubr's arguments */ 44 2 mod bit(6) unal, 45 2 word2 bit(36), 46 47 lisp_error_ entry, 48 unm ptr, 49 1 args_to_lisp_error_ based (unm) aligned, 50 2 ercode fixed bin, 51 2 fcn_name fixed bin, 52 myname fixed bin, /* copy of fcn_name */ 53 err fixed bin, 54 copy_block (nwords) based aligned fixed bin(35); 55 56 dcl 1 subr_head based aligned, 57 2 maxnum bit(9) unaligned, 58 2 minnum bit(9) unaligned; 59 60 dcl lisp_special_fns_$cons entry; 61 62 dcl (lisp_static_vars_$subr, lisp_static_vars_$lsubr, lisp_static_vars_$fsubr, lisp_static_vars_$array) fixed bin(71) external, 63 (array defined lisp_static_vars_$array, 64 subr defined lisp_static_vars_$subr, 65 lsubr defined lisp_static_vars_$lsubr, 66 fsubr defined lisp_static_vars_$fsubr) fixed bin(71); 67 1 1 1 2 /* BEGIN INCLUDE FILE lisp_error_codes.incl.pl1 */ 1 3 1 4 /* This contains codes to be stored on the unmkd pdl before calling 1 5* lisp_error_. These codes, at ab|-2,x7, are used by lisp_error_ 1 6* as an index into lisp_error_table_. */ 1 7 1 8 dcl ( 1 9 undefined_atom init(100), /* - correctable */ 1 10 undefined_function init(101), /* - correctable */ 1 11 too_many_args init(102), /* uncorrectable */ 1 12 too_few_args init(103), /* .. */ 1 13 file_system_error init(104), /* (obsolete) */ 1 14 bad_argument init(105), /* uncorrectable arg reject */ 1 15 undefined_subr init(106), 1 16 bad_function init(107), /* "bad functional form" */ 1 17 bad_bv init(108), /* attempt to bind non-variable */ 1 18 unseen_go_tag init(109), /* correctable -> unevaled new tag */ 1 19 throw_to_no_catch init(110), /* .. */ 1 20 nonfixedarg init(111), /* correctable */ 1 21 parenmissing init(112), /* uncorr reader error */ 1 22 doterror init(113), /* .. */ 1 23 illobj init(114), /* .. */ 1 24 badmacro init(115), /* .. */ 1 25 shortreadlist init(116), /* .. */ 1 26 badreadlist init(117), /* .. */ 1 27 array_bound_error init(118), /* corr -> (array sub1 sub2...) */ 1 28 car_cdr_error init(119), /* uncorr - car or cdr of number */ 1 29 bad_arg_correctable init(120), /* correctable arg reject */ 1 30 bad_prog_op init(121), /* uncorr fail-act: go or return */ 1 31 no_lexpr init(122), /* uncorr fail-act: args or setarg */ 1 32 wrong_no_args init(123), /* correctable wna -> new expr value */ 1 33 bad_ibase init(124), /* corr */ 1 34 bad_base init(125), /* corr */ 1 35 bad_input_source init(126), /* corr - retry i/o */ 1 36 bad_output_dest init(127), /* .. */ 1 37 nihil_ex_nihile init(128), /* uncorr - attempt to setq nil */ 1 38 not_pdl_ptr init(131), /* corr arg reject - for pdl ptr args */ 1 39 bad_f_fcn init(134), /* compiled call to fsubr with evaled args */ 1 40 overflow_err init(135), /* arithmetic overflow. */ 1 41 mismatch_super_parens init(136), /* uncorr reader error */ 1 42 no_left_super_paren init(137), /* .. */ 1 43 flonum_too_big init(138), /* .. */ 1 44 quoterror init(139), /* .. */ 1 45 badreadtable init(140), /* .. */ 1 46 badobarray init(141), /* .. */ 1 47 atan_0_0_err init(142), /* (atan 0 0) doesn't work */ 1 48 unable_to_float init(143), /* corr arg reject - (float x) */ 1 49 division_by_zero init(144), /* uncorr (should really be corr) */ 1 50 eof_in_object init(145), /* corr fail-act -> keep reading anyway */ 1 51 cant_filepos init(146), /* corr fail-act -> new expr value */ 1 52 filepos_oob init(147), /* .. */ 1 53 file_sys_fun_err init(148), /* corr f.s. err -> new expr value */ 1 54 stars_left_in_name init(149), /* .. */ 1 55 io_wrong_direction init(150), /* .. */ 1 56 file_is_closed init(151), /* .. */ 1 57 reopen_inconsistent init(152), /* .. */ 1 58 bad_entry_name init(153), /* .. */ 1 59 bad_do_format init(154), /* bad do format in interp. */ 1 60 not_an_array init(155), /* bad array-type arg */ 1 61 not_alpha_array init(156), /* bad all-alphabetic array */ 1 62 include_file_error init(157), /* %include barfed */ 1 63 stack_loss_error init(158), /* stack overflew */ 1 64 underflow_fault init(159), 1 65 zerodivide_fault init(160), 1 66 bad_array_subscript init(161), 1 67 store_not_allowed init(162), 1 68 dead_array_reference init(163), 1 69 cant_subscript_readtable init(164), 1 70 not_same_type init(165), 1 71 special_array_type init(166), 1 72 array_too_big init(167), 1 73 argument_must_be_array init(168), 1 74 store_function_misused init(169) 1 75 ) fixed bin static; 1 76 1 77 /* END INCLUDE FILE lisp_error_codes.incl.pl1 */ 68 2 1 2 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 2 3 2 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 2 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 2 6* are used so that the name of the function which is rejecting its argument 2 7* can be printed. Please note that all these codes are negative. */ 2 8 2 9 dcl ( 2 10 fn_do init (-10), 2 11 fn_arg init (-11), 2 12 fn_setarg init (-12), 2 13 fn_status init (-13), 2 14 fn_sstatus init (-14), 2 15 fn_errprint init (-15), 2 16 fn_errframe init (-16), 2 17 fn_evalframe init (-17), 2 18 fn_defaultf init (-18), 2 19 fn_tyo init (-22), 2 20 fn_ascii init (-23), 2 21 fn_rplaca init (-24), 2 22 fn_definedp init (-25), 2 23 fn_setq init (-26), 2 24 fn_set init (-27), 2 25 fn_delete init (-28), 2 26 fn_delq init (-29), 2 27 fn_stringlength init (-30), 2 28 fn_catenate init (-31), 2 29 fn_array init (-32), 2 30 fn_substr init (-33), 2 31 fn_index init (-34), 2 32 fn_get_pname init (-35), 2 33 fn_make_atom init (-36), 2 34 fn_ItoC init (-37), 2 35 fn_CtoI init (-38), 2 36 fn_defsubr init (-39), 2 37 fn_star_array init (-40), 2 38 fn_args init (-41), 2 39 fn_sysp init (-42), 2 40 fn_get init (-43), 2 41 fn_getl init (-44), 2 42 fn_putprop init (-45), 2 43 fn_remprop init (-46), 2 44 fn_save init (-47), 2 45 fn_add1 init (-48), 2 46 fn_sub1 init (-49), 2 47 fn_greaterp init (-50), 2 48 fn_lessp init (-51), 2 49 fn_minus init (-52), 2 50 fn_plus init (-53), 2 51 fn_times init (-54), 2 52 fn_difference init (-55), 2 53 fn_quotient init (-56), 2 54 fn_abs init (-57), 2 55 fn_expt init (-58), 2 56 fn_boole init (-59), 2 57 fn_rot init (-60), 2 58 fn_lsh init (-61), 2 59 fn_signp init (-62), 2 60 fn_fix init (-63), 2 61 fn_float init (-64), 2 62 fn_remainder init (-65), 2 63 fn_max init (-66), 2 64 fn_min init (-67), 2 65 fn_add1_fix init (-68), 2 66 fn_add1_flo init (-69), 2 67 fn_sub1_fix init (-70), 2 68 fn_sub1_flo init (-71), 2 69 fn_plus_fix init (-72), 2 70 fn_plus_flo init (-73), 2 71 fn_times_fix init (-74), 2 72 fn_times_flo init (-75), 2 73 fn_diff_fix init (-76), 2 74 fn_diff_flo init (-77), 2 75 fn_quot_fix init (-78), 2 76 fn_quot_flo init (-79), 2 77 fn_eval init (-80), 2 78 fn_apply init (-81), 2 79 fn_prog init (-82), 2 80 fn_errset init (-83), 2 81 fn_catch init (-84), 2 82 fn_throw init (-85), 2 83 fn_store init (-86), 2 84 fn_defun init (-87), 2 85 fn_baktrace init (-88), 2 86 fn_bltarray init (-89), 2 87 fn_star_rearray init (-90), 2 88 fn_gensym init (-91), 2 89 fn_makunbound init (-92), 2 90 fn_boundp init (-93), 2 91 fn_star_status init (-94), 2 92 fn_star_sstatus init (-95), 2 93 fn_freturn init (-96), 2 94 fn_cos init (-97), 2 95 fn_sin init (-98), 2 96 fn_exp init (-99), 2 97 fn_log init (-100), 2 98 fn_sqrt init (-101), 2 99 fn_isqrt init (-102), 2 100 fn_atan init (-103), 2 101 fn_sleep init (-104), 2 102 fn_oddp init (-105), 2 103 fn_tyipeek init (-106), 2 104 fn_alarmclock init (-107), 2 105 fn_plusp init (-108), 2 106 fn_minusp init (-109), 2 107 fn_ls init (-110), 2 108 fn_eql init (-111), 2 109 fn_gt init (-112), 2 110 fn_alphalessp init (-113), 2 111 fn_samepnamep init (-114), 2 112 fn_getchar init (-115), 2 113 fn_opena init (-116), 2 114 fn_sxhash init (-117), 2 115 fn_gcd init (-118), 2 116 fn_allfiles init (-119), 2 117 fn_chrct init (-120), 2 118 fn_close init (-121), 2 119 fn_deletef init (-122), 2 120 fn_eoffn init (-123), 2 121 fn_filepos init (-124), 2 122 fn_inpush init (-125), 2 123 fn_linel init (-126), 2 124 fn_mergef init (-127), 2 125 fn_namelist init (-128), 2 126 fn_names init (-129), 2 127 fn_namestring init (-130), 2 128 fn_openi init (-131), 2 129 fn_openo init (-132), 2 130 fn_prin1 init (-133), 2 131 fn_princ init (-134), 2 132 fn_print init (-135), 2 133 fn_read init (-136), 2 134 fn_readch init (-137), 2 135 fn_readstring init (-138), 2 136 fn_rename init (-139), 2 137 fn_shortnamestring init (-140), 2 138 fn_tyi init (-141), 2 139 fn_setsyntax init (-142), 2 140 fn_cursorpos init (-143), 2 141 fn_force_output init (-144), 2 142 fn_clear_input init (-145), 2 143 fn_random init (-146), 2 144 fn_haulong init (-147), 2 145 fn_haipart init (-148), 2 146 fn_cline init (-149), 2 147 fn_fillarray init (-150), 2 148 fn_listarray init (-151), 2 149 fn_sort init (-152), 2 150 fn_sortcar init (-153), 2 151 fn_zerop init (-154), 2 152 fn_listify init (-155), 2 153 fn_charpos init (-156), 2 154 fn_pagel init (-157), 2 155 fn_linenum init (-158), 2 156 fn_pagenum init (-159), 2 157 fn_endpagefn init (-160), 2 158 fn_arraydims init (-161), 2 159 fn_loadarrays init (-162), 2 160 fn_dumparrays init (-163), 2 161 fn_expt_fix init (-164), 2 162 fn_expt_flo init (-165), 2 163 fn_nointerrupt init (-166), 2 164 fn_open init (-167), 2 165 fn_in init (-168), 2 166 fn_out init (-169), 2 167 fn_truename init (-170), 2 168 fn_ifix init (-171), 2 169 fn_fsc init (-172), 2 170 fn_progv init (-173), 2 171 fn_mapatoms init (-174), 2 172 fn_unwind_protect init (-175), 2 173 fn_eval_when init (-176), 2 174 fn_read_from_string init (-177), 2 175 fn_displace init (-178), 2 176 fn_nth init (-179), 2 177 fn_nthcdr init (-180), 2 178 fn_includef init (-181) 2 179 ) fixed bin static; 2 180 2 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 69 3 1 /* lisp stack header format */ 3 2 /* Last modified 7/21/72 by Reed for in_pl1 flag */ 3 3 /* Modified 1978 by Greenberg for unwind-protect ops */ 3 4 3 5 declare 3 6 3 7 1 stack_seg based aligned, /* stored in base of unmkd_pdl segment */ 3 8 2 marked_stack_bottom ptr, /* where marked stack begins... */ 3 9 2 unmkd_stack_bottom ptr, /* where unmkd_ stack actually starts */ 3 10 2 stack_ptr_ptr ptr, /* points at lisp_static_vars_$stack_ptr */ 3 11 2 unmkd_ptr_ptr ptr, /* points at lisp_static_vars_$unmkd_ptr's offset word */ 3 12 2 array_pointer ptr, /* obsolete */ 3 13 2 nil fixed bin(71), /* object for nil */ 3 14 2 true fixed bin(71), /* object for t */ 3 15 2 in_pl1_code bit(36), /* flag indicating that we are in pl1 code if non-zero */ 3 16 2 padding0 bit(36), /* double word boundary preservation */ 3 17 2 bind_op ptr, /* pointers to operators for run-time support */ 3 18 2 unbind_op ptr, 3 19 2 errset1_op ptr, 3 20 2 errset2_op ptr, 3 21 2 unerrset_op ptr, 3 22 2 call_op ptr, 3 23 2 catch1_op ptr, 3 24 2 catch2_op ptr, 3 25 2 uncatch_op ptr, 3 26 2 gensym_data (2) bit(36) aligned, /* stuff used by the gensym function */ 3 27 2 system_lp ptr, /* pointer to the system's linkage section */ 3 28 2 iogbind_op ptr, 3 29 2 unseen_go_tag_op ptr, 3 30 2 throw1_op ptr, 3 31 2 throw2_op ptr, 3 32 2 signp_op ptr, 3 33 2 type_fields bit(72) aligned, /* fixnum, flonum type for compiled code */ 3 34 2 return_op ptr, 3 35 2 err_op ptr, 3 36 2 pl1_interface ptr, /* pointer to pl1 interface for type 2 subrs. */ 3 37 2 pl1_lsubr_interface ptr, /* same for type -2 subrs */ 3 38 2 cons_opr ptr, /* cons operator */ 3 39 2 ncons_opr ptr, /* ncons operator */ 3 40 2 xcons_opr ptr, /* xcons operator */ 3 41 2 begin_list_opr ptr, /* operator to make initial cell of list */ 3 42 2 append_list_opr ptr, /* operator to append to last-made cell of list */ 3 43 2 terminate_list_opr ptr, /* opeator to append last cell to next to last cell of list */ 3 44 2 compare_op ptr, /* fixnum/flonum comparison operator */ 3 45 2 link_op ptr, 3 46 2 array_operator pointer, /* accessing operator, invoked by arrays */ 3 47 2 dead_array_operator pointer, /* dead arrays invoke this operator instead */ 3 48 2 store_operator pointer, /* operator to do compiled store */ 3 49 2 floating_store_operator pointer, /* ditto, but operand is in EAQ */ 3 50 2 array_info_for_store pointer, /* -> array_info block of last array referenced */ 3 51 2 array_offset_for_store fixed bin(18), /* offset in array_data block of last array element referenced */ 3 52 2 padding bit(36), 3 53 2 array_link_snap_opr pointer, 3 54 2 create_string_desc_op ptr, 3 55 2 create_array_desc_op ptr, 3 56 2 pl1_call_op ptr, 3 57 2 cons_string_op ptr, 3 58 2 create_varying_string_op ptr, 3 59 2 unwp1_op ptr, 3 60 2 unwp2_op ptr, 3 61 2 ununwp_op ptr, 3 62 2 irest_return_op ptr, 3 63 2 pl1_call_nopop_op ptr, 3 64 2 rcv_char_star_op ptr, 3 65 2 spare2 (7) ptr, 3 66 2 begin_unmkd_stack(16325) fixed bin(71); /* rest of segment is the unmarked pdl */ 3 67 3 68 dcl call_array_operator bit(36) static init("100112273120"b3), /* tspbb ab|112,* */ 3 69 call_dead_array_operator bit(36) static init("100114273120"b3); /* tspbb ab|114,* */ 3 70 3 71 /* end stack segment format */ 70 4 1 /* Include file lisp_cons_fmt.incl.pl1; 4 2* defines the format for a cons within the lisp system 4 3* D.Reed 4/1/71 */ 4 4 4 5 dcl consptr ptr, 4 6 1 cons aligned based (consptr), /* structure defining format for cons */ 4 7 2 car fixed bin(71), 4 8 2 cdr fixed bin(71), 4 9 4 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 4 11 2 car ptr, 4 12 2 cdr ptr, 4 13 4 14 4 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 4 16 2 padding bit(21) unaligned, 4 17 2 car bit(9) unaligned, 4 18 2 padding2 bit(63) unaligned, 4 19 2 cdr bit(9) unaligned, 4 20 2 padend bit(42) unaligned; 4 21 4 22 dcl 1 cons_types36 aligned based, 4 23 2 car bit(36), 4 24 2 pada bit(36), 4 25 2 cdr bit(36), 4 26 2 padd bit(36); 4 27 4 28 4 29 /* end include file lisp_cons_fmt.incl.pl1 */ 71 5 1 /* MACLISP Compiled SUBR Block */ 5 2 5 3 dcl 1 subr_block_head based aligned, /* this is the first part of the subr block */ 5 4 2 next_compiled_block ptr, /* for xctblt */ 5 5 2 instructions(4) bit(36), /* the common entry code */ 5 6 2 subr_code_link_offset bin(17) unal, /* points to subr code link */ 5 7 2 rest_of_tsplp bit(18) unal, /* tsplp ,ic* */ 5 8 2 gcmark bit(18) unal, /* for garbage collector to remember seeing this block */ 5 9 2 gc_length fixed bin(17) unal, /* number garbage collectable objects */ 5 10 2 constants(1000) fixed bin(71); /* the compiled constants */ 5 11 5 12 /* alternate declaration of above */ 5 13 5 14 dcl 1 subr_block_head_overlay based aligned, 5 15 2 first_word bit(36), 5 16 2 second_word aligned, 5 17 3 padding bit(28) unaligned, 5 18 3 no_links_are_snapped bit(1) unaligned, /* "1"b if no itp links in this block have been snapped */ 5 19 3 more_padding bit(7) unaligned; 5 20 5 21 5 22 5 23 dcl 1 lisp_subr_links(1000) based aligned, /* the subr links follow the constants, and are the last gc'ed items */ 5 24 2 itp_base bit(3) unal, 5 25 2 itp_info bit(27) unal, /* produced by compiler */ 5 26 2 itp_mod bit(6) unal, 5 27 2 link_opr_tv_offset bit(18) unal, 5 28 2 mbz bit(12) unal, 5 29 2 further_mod bit(6) unal; /* when itp; this is indirect */ 5 30 5 31 5 32 dcl 1 subr_entries(1000) based aligned, /* these are next in block, not gc'able */ 5 33 2 nargs bit(18) unal, 5 34 2 code_offset bit(18) unal, /* offset of entrypoint in object segment */ 5 35 2 head_offset bin(17) unal, /* offset to common entry sequence in subr_block_head */ 5 36 2 rest_of_tsx0 bit(18) unal; /* tsx0 ,ic */ 5 37 5 38 5 39 dcl 1 link_to_subr_code based aligned, /* used by lisp_linker_ to find object segment */ 5 40 2 itp_to_linker ptr, /* points to linker, reset by linker to point to base of object seg */ 5 41 2 compilation_time fixed bin(71), /* used to verify linking to correct segment */ 5 42 2 name_length fixed bin(24), /* length of subroutines name...both segname and ename */ 5 43 2 name char(0 refer(link_to_subr_code.name_length)) unal; 5 44 5 45 dcl instructions_for_subr (4) bit(36) static init("000000000000000100110010111000001111"b, 5 46 "001111111111111100110101000001001111"b, 5 47 "001111111111111110010101010001001111"b, 5 48 "111111111111111110111010000000001000"b), 5 49 tsplp_ic_ind bit(18) static init("110111000000010100"b), 5 50 tsx0_ic bit(18) static init("111000000000000100"b); 5 51 5 52 dcl 1 array_links (1000) aligned based, /* come after entries, before link_to_subr_code */ 5 53 2 instruction bit(36) aligned, /* tspbp to array_link_snap operator 5 54* or eppbb *+2,* when snapped */ 5 55 2 control_word unaligned, /* controls what to snap to */ 5 56 3 type fixed bin(8), /* 0=S-expr, 2=fixnum, 3=flonum */ 5 57 3 ndims fixed bin(8), 5 58 3 atomic_symbol fixed bin(17), /* offset in constants to symbol which names array */ 5 59 2 pointer pointer; /* -> array_info block when snapped */ 5 60 5 61 dcl 1 array_link_count aligned based, /* comes after array_links, before link_to_subr_code */ 5 62 2 unused bit(36), 5 63 2 number_of_array_links fixed bin(17) unaligned, 5 64 2 must_be_zero bit(18) unaligned; /* 0 to distinguish from tsx0 in subr block with no array links */ 5 65 5 66 /* End of description of Compiled SUBR Block */ 72 73 6 1 /* Include file lisp_ptr_fmt.incl.pl1; 6 2* describes the format of lisp pointers as 6 3* a bit string overlay on the double word ITS pair 6 4* which allows lisp to access some unused bits in 6 5* the standard ITS pointer format. It should be noted that 6 6* this is somewhat of a kludge, since 6 7* it is quite machine dependent. However, to store type 6 8* fields in the pointer, saves 2 words in each cons, 6 9* plus some efficiency problems. 6 10* 6 11* D.Reed 4/1/71 */ 6 12 /* modified to move type field to other half of ptr */ 6 13 /* D.Reed 5/31/72 */ 6 14 6 15 6 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 6 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 6 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 6 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 6 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 6 21 2 type bit(9) unaligned, /* type field */ 6 22 2 itsmod bit(6) unaligned, 6 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 6 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 6 25 6 26 /* manifest constant strings for testing above type field */ 6 27 6 28 ( 6 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 6 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 6 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 6 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 6 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 6 34 Bignum init("000001000"b), /* a multiple-precision number */ 6 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 6 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 6 37* means a special internal uncollectable weird object */ 6 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 6 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 6 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 6 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 6 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 6 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 6 44 ) bit(9) static, 6 45 6 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 6 47 6 48 6 49 ( 6 50 Cons36 init("000000000000000000000000000000"b), 6 51 Fixed36 init("000000000000000000000100000000"b), 6 52 Float36 init("000000000000000000000010000000"b), 6 53 Atsym36 init("000000000000000000000001000000"b), 6 54 Atomic36 init("000000000000000000000111111100"b), 6 55 Bignum36 init("000000000000000000000000001000"b), 6 56 System_Subr36 6 57 init("000000000000000000000000000100"b), 6 58 Bigfix36 init("000000000000000000000000001000"b), 6 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 6 60 NotConsOrAtsym36 6 61 init("000000000000000000000110111111"b), 6 62 SubrNumeric36 6 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 6 64 String36 init("000000000000000000000000100000"b), 6 65 Subr36 init("000000000000000000000000010000"b), 6 66 File36 init("000000000000000000000000000001"b), 6 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 6 68 6 69 /* undefined pointer value is double word of zeros */ 6 70 6 71 Undefined bit(72) static init(""b); 6 72 6 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 74 7 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 7 2* describes format of storage for lisp 7 3* character strings. 7 4* D. Reed 4/1/71 */ 7 5 7 6 dcl 1 lisp_string based aligned, 7 7 2 string_length fixed bin, 7 8 2 string char(1 refer(string_length)); 7 9 7 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 75 8 1 /* lisp number format -- overlaid on standard its pointer. */ 8 2 8 3 8 4 dcl 1 fixnum_fmt based aligned, 8 5 2 type_info bit(36) aligned, 8 6 2 fixedb fixed bin, 8 7 8 8 1 flonum_fmt based aligned, 8 9 2 type_info bit(36) aligned, 8 10 2 floatb float bin, 8 11 8 12 fixnum_type bit(36) aligned static init("000000000000000000000100000000100111"b), 8 13 flonum_type bit(36) aligned static init("000000000000000000000010000000100111"b); 8 14 8 15 /* end of lisp number format */ 8 16 76 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 */ 77 10 1 /* include file lisp_stack_fmt.incl.pl1 -- 10 2* describes the format of the pushdown list 10 3* used by the lisp evaluator and lisp subrs 10 4* for passing arguments, saving atom bindings, 10 5* and as temporaries */ 10 6 10 7 dcl 10 8 temp(10000) fixed bin(71) aligned based, 10 9 10 10 temp_ptr(10000) ptr aligned based, 10 11 1 push_down_list_ptr_types(10000) based aligned, 10 12 2 junk bit(21) unaligned, 10 13 2 temp_type bit(9) unaligned, 10 14 2 more_junk bit(42) unaligned, 10 15 10 16 1 pdl_ptr_types36(10000) based aligned, 10 17 2 temp_type36 bit(36), 10 18 2 junk bit(36), 10 19 10 20 1 binding_block aligned based, 10 21 2 top_block bit(18) unaligned, 10 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 10 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 10 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 10 25 10 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 10 27 2 old_val fixed bin(71) aligned, 10 28 2 atom fixed bin(71) aligned; 10 29 10 30 10 31 10 32 /* end include file lisp_stack_fmt.incl.pl1 */ 78 11 1 /* Include file lisp_atom_fmt.incl.pl1; 11 2* describes internal format of atoms in the lisp system 11 3* D.Reed 4/1/71 */ 11 4 11 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 11 6 2 value fixed bin(71), /* atom's value */ 11 7 2 plist fixed bin(71), /* property list */ 11 8 2 pnamel fixed bin, /* length of print name */ 11 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 11 10 11 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 11 12 2 value ptr, 11 13 2 plist ptr, 11 14 11 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 11 16 2 value bit(72), 11 17 2 plist bit(72); 11 18 11 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 79 80 81 82 83 myname = fn_defsubr; /* in case of error */ 84 stack = addrel(stack_ptr,-2); /* get addr of arg count */ 85 number_args = -divide(stack -> fixedb,2,35,0); /* get real arg count */ 86 stack = addrel(stack,stack->fixedb); /* make stack point at begin of args */ 87 88 defsubr_5: 89 if number_args < 5 then flags = 0; /* default flags */ 90 else if stack -> temp_type(5) & Fixed 91 then flags = addr(stack->temp(5))->fixedb; 92 else go to bad_argument_5; 93 94 defsubr_4: 95 if number_args < 4 then type = 2; /* default type is PL/I */ 96 else if stack -> temp_type(4) & Fixed 97 then type = addr(stack -> temp(4))->fixedb; 98 else go to bad_argument_4; 99 if type ^= 2 then if type ^= -2 then go to bad_argument_4; /* only PL/I subrs still work here */ 100 101 defsubr_3: 102 if stack -> temp_type(3) & Fixed 103 then nargs = addr(stack -> temp(3)) -> fixedb; 104 else go to bad_argument_3; 105 106 defsubr_2: 107 if stack -> temp_type(2) & String then; 108 else go to bad_argument_2; 109 110 defsubr_1: 111 if stack -> temp_type(1) & String then; 112 else go to bad_argument_1; 113 114 call make_lisp_subr_block_(stack->temp_ptr(1), type, stack->temp_ptr(1)->string, stack->temp_ptr(2)->string, 115 nargs, flags); 116 stack_ptr = addr(stack->temp(2)); 117 return; 118 119 /* error handlers */ 120 121 too_few: err = too_few_args; 122 go to fatal; 123 124 too_many: err = too_many_args; 125 fatal: 126 stack_ptr = stack; 127 call error; 128 return; 129 130 bad_argument_5: 131 addrel(stack_ptr, -2) -> temp(1) = stack -> temp(5); 132 err = bad_arg_correctable; 133 call error; 134 stack -> temp(5) = addrel(stack_ptr, -2) -> temp(1); 135 go to defsubr_5; 136 137 bad_argument_4: 138 addrel(stack_ptr, -2) -> temp(1) = stack -> temp(4); 139 err = bad_arg_correctable; 140 call error; 141 stack -> temp(4) = addrel(stack_ptr, -2) -> temp(1); 142 go to defsubr_4; 143 144 bad_argument_3: 145 addrel(stack_ptr, -2) -> temp(1) = stack -> temp(3); 146 err = bad_arg_correctable; 147 call error; 148 stack -> temp(3) = addrel(stack_ptr, -2) -> temp(1); 149 go to defsubr_3; 150 151 bad_argument_2: 152 addrel(stack_ptr, -2) -> temp(1) = stack -> temp(2); 153 err = bad_arg_correctable; 154 call error; 155 stack -> temp(2) = addrel(stack_ptr, -2) -> temp(1); 156 go to defsubr_2; 157 158 bad_argument_1: 159 addrel(stack_ptr, -2) -> temp(1) = stack -> temp(1); 160 err = bad_arg_correctable; 161 call error; 162 stack -> temp(1) = addrel(stack_ptr, -2) -> temp(1); 163 go to defsubr_1; 164 165 /* interface to lisp_error_, called with ercode in vraiable err */ 166 167 error: proc; 168 169 unm = unmkd_ptr; /* push err code onto unmkd pdl */ 170 unmkd_ptr = addrel(unm, 2); 171 unm -> ercode = err; 172 unm -> fcn_name = myname; 173 call lisp_error_; 174 return; 175 end; 176 177 args: entry; /* lsubr to tell how many args a subr expects or to put that there*/ 178 179 stack = addrel(stack_ptr,-2); 180 if addr(stack -> temp(1)) -> fixedb = -2 then sw = "1"b; 181 else sw = ""b; 182 stack = addrel(stack, addr(stack -> temp(1)) -> fixedb); 183 args_01: 184 stack_ptr = addr(stack -> temp(5)); 185 if stack -> temp_type36(1) & Atsym36 then; else do; 186 err = bad_arg_correctable; 187 myname = fn_args; 188 stack_ptr = addr(stack -> temp(6)); 189 stack -> temp(5) = stack -> temp(1); /* put losing arg at top of pdl */ 190 call error; 191 stack -> temp(1) = stack -> temp(5); /* put corrected value back */ 192 go to args_01; /* reset stack_ptr & retry */ 193 end; 194 stack -> temp(3) = stack -> temp_ptr(1) -> atom.plist; 195 do while (stack -> temp_type(3) = Cons); 196 if stack -> temp_ptr(3) -> cons.car = lsubr then do; 197 lsubrsw = "1"b; 198 fsubrsw = "0"b; 199 go to common_in_args; 200 end; 201 if stack -> temp_ptr(3) -> cons.car = fsubr then do; 202 fsubrsw = "1"b; 203 lsubrsw = "0"b; 204 go to common_in_args; 205 end; 206 if stack -> temp_ptr(3) -> cons.car = subr then do; 207 lsubrsw = ""b; 208 fsubrsw = "0"b; 209 common_in_args: 210 stack -> temp(3) = stack -> temp_ptr(3) -> cons_ptrs.cdr -> cons.car; 211 if stack -> temp_type36(3) & Subr36 then go to Subr_pointer_is_found; 212 /* if not really a subr, skip to next property */ 213 end; 214 stack -> temp(3) = stack -> temp_ptr(3) -> cons.cdr; 215 if stack -> temp_type(3) = Cons then 216 stack -> temp(3) = stack -> temp_ptr(3) -> cons.cdr; 217 end; 218 stack -> temp(1) = nil; 219 stack_ptr = addr(stack -> temp(2)); 220 return; /*it could not filnd a function definition*/ 221 222 Subr_pointer_is_found: 223 subr_ptr = stack -> temp_ptr(3); 224 if sw then do; /*if we're going to give back the value*/ 225 if fsubrsw then do; 226 stack -> temp(3) = nil; 227 go to args_return; 228 end; 229 else if lsubrsw then do; 230 addr(stack -> temp(3)) -> fixnum_fmt.type_info = fixnum_type; 231 addr(stack -> temp(3)) -> fixedb = binary(subr_ptr -> minnum, 9); 232 addr(stack -> temp(4)) -> fixnum_fmt.type_info = fixnum_type; 233 addr(stack -> temp(4)) -> fixedb = binary(subr_ptr -> maxnum, 9); 234 end; 235 else do; 236 stack -> temp(3) = nil; 237 addr(stack -> temp(4)) -> fixnum_fmt.type_info = fixnum_type; 238 addr(stack -> temp(4)) -> fixedb = binary(subr_ptr -> minnum, 9); /* get nargs */ 239 end; 240 call lisp_special_fns_$cons; 241 args_return: stack -> temp(1) = stack -> temp(3); 242 stack_ptr = addr(stack -> temp(2)); 243 return; /*and so we return*/ 244 end; 245 246 stack -> temp(3) = stack -> temp_ptr(2) -> cons.car; 247 stack -> temp(4) = stack -> temp_ptr(2) -> cons.cdr; 248 if stack -> temp(3) = nil then do; 249 subr_ptr -> maxnum = bit(binary(0, 9)); 250 subr_ptr -> minnum = bit(fixed(addr(stack -> temp(4)) -> fixedb,9)); 251 end; 252 else do; 253 subr_ptr -> minnum = bit(fixed(addr(stack -> temp(3)) -> fixedb, 9)); 254 subr_ptr -> maxnum = bit(fixed(addr(stack -> temp(4)) -> fixedb, 9)); 255 end; 256 stack -> temp(1) = stack -> temp(2); 257 stack_ptr = addr(stack -> temp(2)); 258 return; 259 260 sysp: entry; /*subr predicate to tell if a subr is a system subr*/ 261 262 stack = addrel(stack_ptr, -2); 263 sysp_01: 264 stack_ptr = addr(stack -> temp(4)); 265 if stack -> temp_type36(1) & Atsym36 then; else do; /*must be an atom*/ 266 sysp_bad_1: 267 stack_ptr = addr(stack -> temp(2)); 268 err = bad_arg_correctable; 269 myname = fn_sysp; 270 call error; 271 go to sysp_01; 272 end; 273 stack -> temp(2) = stack -> temp_ptr(1) -> atom.plist; /*get the p-list*/ 274 do while(stack -> temp_type(2) = Cons); /*search down the p-list*/ 275 if stack -> temp_ptr(2) -> cons.car = lsubr | 276 stack -> temp_ptr(2) -> cons.car = subr | 277 stack -> temp_ptr(2) -> cons.car = fsubr then do; /*if the indicator is found then ...*/ 278 stack -> temp(3) = stack -> temp_ptr(2) -> cons_ptrs.cdr -> cons.car; /*getptr*/ 279 if stack -> temp_type36(3) & System_Subr36 280 then do; 281 stack -> temp(1) = stack -> temp_ptr(2) -> cons.car; 282 stack_ptr = addr(stack -> temp(2)); 283 return; 284 end; 285 if stack -> temp_type36(3) & Subr36 then do; /*must be Subr ptr*/ 286 data_ptr = stack -> temp_ptr(3); 287 if data_ptr -> subr_entries(1).rest_of_tsx0 = tsx0_ic then go to new_type_subr; 288 /* compiled subr */ 289 if data_ptr -> subr_info_stuff.subr_type = 3 then do; 290 data_ptr = addrel(data_ptr, 4); /* -> tsplp n,ic* instruction */ 291 data_ptr = addrel(data_ptr, data_ptr -> subr_info_stuff.nargs); /* get addr of link */ 292 end; 293 else data_ptr = addrel(data_ptr, subr_offsets(data_ptr -> subr_info_stuff.subr_type)); 294 number_args = data_ptr -> based_ptr -> fixedb; 295 /* this is just a dummy operation to snap pointer_to_subr*/ 296 if baseno(data_ptr -> based_ptr) = 297 baseno(addr(lisp$)) then 298 stack -> temp(1) = stack -> temp_ptr(2) -> cons.car;/*will return thee, indicator*/ 299 else 300 ret_nilll: stack -> temp(1) = nil; /*return nil*/ 301 stack_ptr = addr(stack -> temp(2)); 302 return; 303 end; 304 end; 305 stack -> temp(2) = stack -> temp_ptr(2) -> cons.cdr; 306 if stack -> temp_type(2) = Cons then 307 stack -> temp(2) = stack -> temp_ptr(2) -> cons.cdr; /*cdr down farther*/ 308 end; 309 stack -> temp(1) = nil; /*return nil*/ 310 stack_ptr = addr(stack -> temp(2)); 311 return; 312 313 /* come here for sysp of a new (fasload) subr */ 314 315 new_type_subr: 316 317 data_ptr = addrel(addr(data_ptr -> subr_entries(1).head_offset), data_ptr -> subr_entries(1).head_offset - 2); /* -> subr block */ 318 /* the -2 is to allow for the fact that the instructions start 2 words into the subr block */ 319 link_ptr = addrel(addr(data_ptr -> subr_block_head.subr_code_link_offset), data_ptr -> subr_block_head.subr_code_link_offset); 320 if link_ptr -> link_info.mod ^= "100011"b then do; /* if necessary, snap link */ 321 on condition(lisp_linkage_error) go to ret_nilll; 322 call lisp_linker_(link_ptr); 323 revert condition(lisp_linkage_error); 324 end; 325 if baseno(link_ptr -> based_ptr) ^= baseno(addr(lisp$)) then go to ret_nilll; 326 /* yes, it really is bound in with us. Must be sysp */ 327 328 stack -> temp(1) = stack -> temp_ptr(2) -> cons.car; /* will reeturn thee, indicator. */ 329 stack_ptr = addr(stack -> temp(2)); 330 return; 331 332 /** internal procedure to generate a PL/I type subr for defsubr **/ 333 334 make_lisp_subr_block_: proc(block_ptr, subr_type, seg_name, entrypoint, num_args, flags); 335 336 /* Routine to make a standard form SUBR block in the lisp static 337* data segment. Takes as arguments: 338* 339* block_ptr -- return pointer to allocated block. 340* subr_type -- 0, fast call LISP subroutine which needs no save lp or bp. 341* 1, fast call LISP subroutine which needs save of lp and bp 342* 2, PL/I routine called with args on LISP stacks, through interface. 343* 3, lisp compiled function, with static data in its block. 344* seg_name -- name of segment containing code for SUBR 345* entrypoint-- name of entry in segment. 346* num_args -- number of args expected by SUBR 347* flags -- number of words to be allocated for type 3 static data block. 348* if not type 3 subr; should be zero! 349* 350* Coded by D. Reed 6/8/72 */ 351 /* modified 6/2/73 by DAM for recursive lisp - stat_top and 352* cur_stat_seg moved to lisp_static_vars_ */ 353 354 355 dcl block_ptr ptr, 356 subr_type fixed bin(2) aligned, 357 seg_name char(*) aligned, 358 entrypoint char(*) aligned, 359 num_args fixed bin(17) aligned, 360 flags fixed bin(17) aligned; 361 362 dcl delta_size(-2:3) fixed bin(4) aligned static init(11,0,9,13,11,13), /* number words over space for strings needed by block */ 363 364 space pointer, 365 segnamel fixed bin, 366 entryl fixed bin, 367 1 basic_block based aligned, 368 2 no_args fixed bin(17) unaligned, 369 2 stype fixed bin(17) unaligned, 370 2 entry_instructions(5) bit(36) aligned, 371 372 tra_1_ic_ind bit(36) aligned static init("000000000000000001111001000000010100"b), 373 eaplp_ab_sys_lp bit(36) aligned static init("001000000000100100011111000001010000"b), 374 tsblp_ic_ind bit(18) aligned static init("110111000000010100"b), 375 eax7_2 bit(36) aligned static init("000000000000000010110010111000001111"b), 376 eax7_4 bit(36) aligned static init("000000000000000100110010111000001111"b), 377 stpbp_ab_back_2 bit(36) aligned static init("001111111111111110010101010001001111"b), 378 stplp_ab_back_4 bit(36) aligned static init("001111111111111100110101000001001111"b), 379 tsbbp_ab_pl1_int bit(36) aligned static init("001000000000110110010111010001010000"b), 380 tsbbp_ab_lsubr_int bit(36) aligned static init("001000000000111000010111010001010000"b), 381 1 linkage_block based aligned, /* appears after allocated space for random data */ 382 2 link, 383 3 header_rel fixed bin(17) unaligned, /* back offset to header at word 2 of segment */ 384 3 fault_tag fixed bin(17) unaligned, /* set to 100110b */ 385 3 exp_word bit(18) unaligned, 386 3 more_mod bit(18) unaligned, /* should be zero */ 387 2 exp_offset bit(18) unaligned, /* rel of next word in segment */ 388 2 expression bit(18) unaligned, /* zero this */ 389 2 class fixed bin(17) unaligned, /* should be 4 */ 390 2 trap fixed bin(17) unaligned, /* should be zero */ 391 2 segname_rel bit(18) unaligned, 392 2 entry_rel bit(18) unaligned, 393 2 start_of_strings fixed bin, /* where first string goes */ 394 1 acc based aligned, 395 2 len fixed bin(8) unaligned, /* just never greater than 32 */ 396 2 string char(262144) unaligned, /* filled in with len chars */ 397 398 size fixed bin(18), 399 lisp_static_man_$allocate entry(pointer, fixed bin(18)), 400 (addrel,rel,addr,null,substr,length,divide) builtin; 401 402 segnamel = length(seg_name); /* compute storage for acc strings */ 403 entryl = length(entrypoint); 404 size = divide(segnamel,4,17,0)+divide(entryl,4,17,0); /* the extra two words are in the deltas */ 405 406 size = size + delta_size(subr_type) + flags; 407 408 size = 2*divide(size+1,2,17,0); /* round to mod2 bound */ 409 410 call lisp_static_man_$allocate(block_ptr, size); 411 412 space = block_ptr; 413 addr(block_ptr)->lisp_ptr.type = Subr; 414 415 space -> basic_block.no_args = num_args;/* fill in block */ 416 space -> basic_block.stype = subr_type; 417 go to make_entry(subr_type); /* branch on type */ 418 make_entry(-2): 419 space -> basic_block.entry_instructions(3) = tsbbp_ab_lsubr_int; /* this is an LSUBR */ 420 go to make_type_2; 421 make_entry(2): 422 space -> basic_block.entry_instructions(3) = tsbbp_ab_pl1_int; 423 make_type_2: 424 space -> basic_block.entry_instructions(1) = eax7_2; 425 space -> basic_block.entry_instructions(2) = stpbp_ab_back_2; 426 space = addrel(space,4); 427 make_link: 428 space -> linkage_block.header_rel = 2 - binary(rel(space),18,0); 429 space -> linkage_block.fault_tag = 100110b; /* 46(8) */ 430 431 space -> linkage_block.more_mod = "0"b; 432 space -> linkage_block.link.exp_word = rel(addr(space->linkage_block.exp_offset)); 433 space -> linkage_block.exp_offset = rel(addr(space->linkage_block.class)); 434 space -> linkage_block.expression = "0"b; 435 space -> linkage_block.class = 4; 436 space -> linkage_block.trap = 0; 437 space -> linkage_block.segname_rel = rel(addr(space->linkage_block.start_of_strings)); 438 space -> linkage_block.entry_rel = rel(addrel(addr(space->linkage_block.start_of_strings),divide(segnamel,4,17,0)+1)); 439 space = addr(space->linkage_block.start_of_strings); 440 space -> acc.len = segnamel; 441 substr(space->acc.string,1,segnamel) = substr(seg_name,1,segnamel); 442 space = addrel(space,divide(segnamel,4,17,0)+1); 443 space -> acc.len = entryl; 444 substr(space->acc.string,1,entryl) = substr(entrypoint,1,entryl); 445 446 return; 447 448 449 end make_lisp_subr_block_; 450 451 452 end defsubr; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.2 lisp_defsubr_.pl1 >special_ldd>on>06/27/83>lisp_defsubr_.pl1 68 1 03/27/82 0437.0 lisp_error_codes.incl.pl1 >ldd>include>lisp_error_codes.incl.pl1 69 2 06/29/83 1425.3 lisp_name_codes.incl.pl1 >ldd>include>lisp_name_codes.incl.pl1 70 3 06/29/83 1425.3 lisp_stack_seg.incl.pl1 >ldd>include>lisp_stack_seg.incl.pl1 71 4 03/27/82 0437.0 lisp_cons_fmt.incl.pl1 >ldd>include>lisp_cons_fmt.incl.pl1 72 5 03/27/82 0437.0 lisp_comp_subr_block.incl.pl1 >ldd>include>lisp_comp_subr_block.incl.pl1 74 6 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 75 7 03/27/82 0436.9 lisp_string_fmt.incl.pl1 >ldd>include>lisp_string_fmt.incl.pl1 76 8 03/27/82 0437.0 lisp_nums.incl.pl1 >ldd>include>lisp_nums.incl.pl1 77 9 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 78 10 03/27/82 0437.0 lisp_stack_fmt.incl.pl1 >ldd>include>lisp_stack_fmt.incl.pl1 79 11 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) Array internal static bit(9) initial unaligned dcl 6-17 Array36 internal static bit(36) initial dcl 6-17 Atomic internal static bit(9) initial unaligned dcl 6-17 Atomic36 internal static bit(36) initial dcl 6-17 Atsym internal static bit(9) initial unaligned dcl 6-17 Atsym36 constant bit(36) initial dcl 6-17 ref 185 265 Bigfix internal static bit(9) initial unaligned dcl 6-17 Bigfix36 internal static bit(36) initial dcl 6-17 Bignum internal static bit(9) initial unaligned dcl 6-17 Bignum36 internal static bit(36) initial dcl 6-17 Cons constant bit(9) initial unaligned dcl 6-17 ref 195 215 274 306 Cons36 internal static bit(36) initial dcl 6-17 File internal static bit(9) initial unaligned dcl 6-17 File36 internal static bit(36) initial dcl 6-17 Fixed constant bit(9) initial unaligned dcl 6-17 ref 90 96 101 Fixed36 internal static bit(36) initial dcl 6-17 Float internal static bit(9) initial unaligned dcl 6-17 Float36 internal static bit(36) initial dcl 6-17 NotConsOrAtsym36 internal static bit(36) initial dcl 6-17 Numeric internal static bit(9) initial unaligned dcl 6-17 Numeric36 internal static bit(36) initial dcl 6-17 String constant bit(9) initial unaligned dcl 6-17 ref 106 110 String36 internal static bit(36) initial dcl 6-17 Subr constant bit(9) initial unaligned dcl 6-17 ref 413 Subr36 constant bit(36) initial dcl 6-17 ref 211 285 SubrNumeric36 internal static bit(36) initial dcl 6-17 Subr_pointer_is_found 000525 constant label dcl 222 ref 211 System_Subr internal static bit(9) initial unaligned dcl 6-17 System_Subr36 constant bit(36) initial dcl 6-17 ref 279 Uncollectable internal static bit(9) initial unaligned dcl 6-17 Undefined internal static bit(72) initial unaligned dcl 6-17 acc based structure level 1 dcl 362 addr builtin function dcl 362 in procedure "make_lisp_subr_block_" ref 413 432 433 437 438 439 addr builtin function ref 90 96 101 116 180 182 183 188 219 230 231 232 233 237 238 242 250 253 254 257 263 266 282 296 301 310 315 319 325 329 addrel builtin function ref 84 86 130 134 137 141 144 148 151 155 158 162 170 179 182 262 290 291 293 315 319 addrel builtin function dcl 362 in procedure "make_lisp_subr_block_" ref 426 438 442 arg_index automatic fixed bin(17,0) dcl 19 args 000371 constant entry external dcl 177 args_01 000415 constant label dcl 183 ref 192 args_return 000570 constant label dcl 241 ref 227 args_to_lisp_error_ based structure level 1 dcl 19 argument_must_be_array internal static fixed bin(17,0) initial dcl 1-8 array defined fixed bin(71,0) dcl 62 array_atom defined fixed bin(71,0) dcl 9-6 array_bound_error internal static fixed bin(17,0) initial dcl 1-8 array_link_count based structure level 1 dcl 5-61 array_links based structure array level 1 dcl 5-52 array_too_big internal static fixed bin(17,0) initial dcl 1-8 atan_0_0_err internal static fixed bin(17,0) initial dcl 1-8 atom based structure level 1 dcl 11-5 atom_double_words based structure level 1 dcl 11-5 atom_ptrs based structure level 1 dcl 11-5 bad_arg_correctable constant fixed bin(17,0) initial dcl 1-8 ref 132 139 146 153 160 186 268 bad_argument internal static fixed bin(17,0) initial dcl 1-8 bad_argument_1 000350 constant label dcl 158 ref 112 bad_argument_2 000327 constant label dcl 151 ref 108 bad_argument_3 000306 constant label dcl 144 ref 104 bad_argument_4 000264 constant label dcl 137 ref 98 99 bad_argument_5 000243 constant label dcl 130 ref 92 bad_array_subscript internal static fixed bin(17,0) initial dcl 1-8 bad_base internal static fixed bin(17,0) initial dcl 1-8 bad_bv internal static fixed bin(17,0) initial dcl 1-8 bad_do_format internal static fixed bin(17,0) initial dcl 1-8 bad_entry_name internal static fixed bin(17,0) initial dcl 1-8 bad_f_fcn internal static fixed bin(17,0) initial dcl 1-8 bad_function internal static fixed bin(17,0) initial dcl 1-8 bad_ibase internal static fixed bin(17,0) initial dcl 1-8 bad_input_source internal static fixed bin(17,0) initial dcl 1-8 bad_output_dest internal static fixed bin(17,0) initial dcl 1-8 bad_prog_op internal static fixed bin(17,0) initial dcl 1-8 badmacro internal static fixed bin(17,0) initial dcl 1-8 badobarray internal static fixed bin(17,0) initial dcl 1-8 badreadlist internal static fixed bin(17,0) initial dcl 1-8 badreadtable internal static fixed bin(17,0) initial dcl 1-8 based_ptr based pointer dcl 6-16 ref 294 296 325 baseno builtin function dcl 19 ref 296 296 325 325 basic_block based structure level 1 dcl 362 binary builtin function ref 231 233 238 249 427 binding_block based structure level 1 dcl 10-7 binding_top defined pointer dcl 9-6 bindings based structure array level 1 dcl 10-7 bit builtin function ref 249 250 253 254 block_ptr parameter pointer dcl 355 set ref 334 410* 412 413 call_array_operator internal static bit(36) initial unaligned dcl 3-68 call_dead_array_operator internal static bit(36) initial unaligned dcl 3-68 cant_filepos internal static fixed bin(17,0) initial dcl 1-8 cant_subscript_readtable internal static fixed bin(17,0) initial dcl 1-8 car based fixed bin(71,0) level 2 dcl 4-5 ref 196 201 206 209 246 275 275 275 278 281 296 328 car_cdr_error internal static fixed bin(17,0) initial dcl 1-8 catch_frame defined pointer dcl 9-6 cdr 2 based pointer level 2 in structure "cons_ptrs" dcl 4-5 in procedure "defsubr" ref 209 278 cdr 2 based fixed bin(71,0) level 2 in structure "cons" dcl 4-5 in procedure "defsubr" ref 214 215 247 305 306 class 3 based fixed bin(17,0) level 2 packed unaligned dcl 362 set ref 433 435* common_in_args 000476 constant label dcl 209 ref 199 204 cons based structure level 1 dcl 4-5 cons_ptrs based structure level 1 dcl 4-5 cons_types based structure level 1 dcl 4-5 cons_types36 based structure level 1 dcl 4-22 consptr automatic pointer dcl 4-5 copy_block based fixed bin(35,0) array dcl 19 data_object based fixed bin(71,0) dcl 19 data_ptr 000122 automatic pointer dcl 19 set ref 286* 287 289 290* 290 291* 291 291 293* 293 293 294 296 315* 315 315 319 319 dead_array_reference internal static fixed bin(17,0) initial dcl 1-8 defsubr 000037 constant entry external dcl 6 defsubr_1 000150 constant label dcl 110 ref 163 defsubr_2 000140 constant label dcl 106 ref 156 defsubr_3 000126 constant label dcl 101 ref 149 defsubr_4 000101 constant label dcl 94 ref 142 defsubr_5 000062 constant label dcl 88 ref 135 delta_size 000011 constant fixed bin(4,0) initial array dcl 362 ref 406 divide builtin function ref 85 divide builtin function dcl 362 in procedure "make_lisp_subr_block_" ref 404 404 408 438 442 division_by_zero internal static fixed bin(17,0) initial dcl 1-8 doterror internal static fixed bin(17,0) initial dcl 1-8 eaplp_ab_sys_lp internal static bit(36) initial dcl 362 eax7_2 000010 constant bit(36) initial dcl 362 ref 423 eax7_4 internal static bit(36) initial dcl 362 entry_instructions 1 based bit(36) array level 2 dcl 362 set ref 418* 421* 423* 425* entry_rel 4(18) based bit(18) level 2 packed unaligned dcl 362 set ref 438* entryl 000151 automatic fixed bin(17,0) dcl 362 set ref 403* 404 443 444 444 entrypoint parameter char dcl 355 ref 334 403 444 eof_in_object internal static fixed bin(17,0) initial dcl 1-8 ercode based fixed bin(17,0) level 2 dcl 19 set ref 171* err 000131 automatic fixed bin(17,0) dcl 19 set ref 121* 124* 132* 139* 146* 153* 160* 171 186* 268* err_frame defined pointer dcl 9-6 err_recp defined pointer dcl 9-6 error 001132 constant entry internal dcl 167 ref 127 133 140 147 154 161 190 270 eval_frame defined pointer dcl 9-6 exp_offset 2 based bit(18) level 2 packed unaligned dcl 362 set ref 432 433* exp_word 1 based bit(18) level 3 packed unaligned dcl 362 set ref 432* expression 2(18) based bit(18) level 2 packed unaligned dcl 362 set ref 434* fatal 000236 constant label dcl 125 ref 122 fault_tag 0(18) based fixed bin(17,0) level 3 packed unaligned dcl 362 set ref 429* fcn_name 1 based fixed bin(17,0) level 2 dcl 19 set ref 172* file_is_closed internal static fixed bin(17,0) initial dcl 1-8 file_sys_fun_err internal static fixed bin(17,0) initial dcl 1-8 file_system_error internal static fixed bin(17,0) initial dcl 1-8 filepos_oob internal static fixed bin(17,0) initial dcl 1-8 fixed builtin function ref 250 253 254 fixedb 1 based fixed bin(17,0) level 2 dcl 8-4 set ref 85 86 90 96 101 180 182 231* 233* 238* 250 253 254 294 fixnum_fmt based structure level 1 dcl 8-4 fixnum_type constant bit(36) initial dcl 8-4 ref 230 232 237 flags parameter fixed bin(17,0) dcl 355 in procedure "make_lisp_subr_block_" ref 334 406 flags 000106 automatic fixed bin(17,0) dcl 19 in procedure "defsubr" set ref 88* 90* 114* flonum_fmt based structure level 1 dcl 8-4 flonum_too_big internal static fixed bin(17,0) initial dcl 1-8 flonum_type internal static bit(36) initial dcl 8-4 fn_CtoI internal static fixed bin(17,0) initial dcl 2-9 fn_ItoC internal static fixed bin(17,0) initial dcl 2-9 fn_abs internal static fixed bin(17,0) initial dcl 2-9 fn_add1 internal static fixed bin(17,0) initial dcl 2-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 2-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 2-9 fn_alarmclock internal static fixed bin(17,0) initial dcl 2-9 fn_allfiles internal static fixed bin(17,0) initial dcl 2-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 2-9 fn_apply internal static fixed bin(17,0) initial dcl 2-9 fn_arg internal static fixed bin(17,0) initial dcl 2-9 fn_args constant fixed bin(17,0) initial dcl 2-9 ref 187 fn_array internal static fixed bin(17,0) initial dcl 2-9 fn_arraydims internal static fixed bin(17,0) initial dcl 2-9 fn_ascii internal static fixed bin(17,0) initial dcl 2-9 fn_atan internal static fixed bin(17,0) initial dcl 2-9 fn_baktrace internal static fixed bin(17,0) initial dcl 2-9 fn_bltarray internal static fixed bin(17,0) initial dcl 2-9 fn_boole internal static fixed bin(17,0) initial dcl 2-9 fn_boundp internal static fixed bin(17,0) initial dcl 2-9 fn_catch internal static fixed bin(17,0) initial dcl 2-9 fn_catenate internal static fixed bin(17,0) initial dcl 2-9 fn_charpos internal static fixed bin(17,0) initial dcl 2-9 fn_chrct internal static fixed bin(17,0) initial dcl 2-9 fn_clear_input internal static fixed bin(17,0) initial dcl 2-9 fn_cline internal static fixed bin(17,0) initial dcl 2-9 fn_close internal static fixed bin(17,0) initial dcl 2-9 fn_cos internal static fixed bin(17,0) initial dcl 2-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 2-9 fn_defaultf internal static fixed bin(17,0) initial dcl 2-9 fn_definedp internal static fixed bin(17,0) initial dcl 2-9 fn_defsubr constant fixed bin(17,0) initial dcl 2-9 ref 83 fn_defun internal static fixed bin(17,0) initial dcl 2-9 fn_delete internal static fixed bin(17,0) initial dcl 2-9 fn_deletef internal static fixed bin(17,0) initial dcl 2-9 fn_delq internal static fixed bin(17,0) initial dcl 2-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 2-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 2-9 fn_difference internal static fixed bin(17,0) initial dcl 2-9 fn_displace internal static fixed bin(17,0) initial dcl 2-9 fn_do internal static fixed bin(17,0) initial dcl 2-9 fn_dumparrays internal static fixed bin(17,0) initial dcl 2-9 fn_endpagefn internal static fixed bin(17,0) initial dcl 2-9 fn_eoffn internal static fixed bin(17,0) initial dcl 2-9 fn_eql internal static fixed bin(17,0) initial dcl 2-9 fn_errframe internal static fixed bin(17,0) initial dcl 2-9 fn_errprint internal static fixed bin(17,0) initial dcl 2-9 fn_errset internal static fixed bin(17,0) initial dcl 2-9 fn_eval internal static fixed bin(17,0) initial dcl 2-9 fn_eval_when internal static fixed bin(17,0) initial dcl 2-9 fn_evalframe internal static fixed bin(17,0) initial dcl 2-9 fn_exp internal static fixed bin(17,0) initial dcl 2-9 fn_expt internal static fixed bin(17,0) initial dcl 2-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 2-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 2-9 fn_filepos internal static fixed bin(17,0) initial dcl 2-9 fn_fillarray internal static fixed bin(17,0) initial dcl 2-9 fn_fix internal static fixed bin(17,0) initial dcl 2-9 fn_float internal static fixed bin(17,0) initial dcl 2-9 fn_force_output internal static fixed bin(17,0) initial dcl 2-9 fn_freturn internal static fixed bin(17,0) initial dcl 2-9 fn_fsc internal static fixed bin(17,0) initial dcl 2-9 fn_gcd internal static fixed bin(17,0) initial dcl 2-9 fn_gensym internal static fixed bin(17,0) initial dcl 2-9 fn_get internal static fixed bin(17,0) initial dcl 2-9 fn_get_pname internal static fixed bin(17,0) initial dcl 2-9 fn_getchar internal static fixed bin(17,0) initial dcl 2-9 fn_getl internal static fixed bin(17,0) initial dcl 2-9 fn_greaterp internal static fixed bin(17,0) initial dcl 2-9 fn_gt internal static fixed bin(17,0) initial dcl 2-9 fn_haipart internal static fixed bin(17,0) initial dcl 2-9 fn_haulong internal static fixed bin(17,0) initial dcl 2-9 fn_ifix internal static fixed bin(17,0) initial dcl 2-9 fn_in internal static fixed bin(17,0) initial dcl 2-9 fn_includef internal static fixed bin(17,0) initial dcl 2-9 fn_index internal static fixed bin(17,0) initial dcl 2-9 fn_inpush internal static fixed bin(17,0) initial dcl 2-9 fn_isqrt internal static fixed bin(17,0) initial dcl 2-9 fn_lessp internal static fixed bin(17,0) initial dcl 2-9 fn_linel internal static fixed bin(17,0) initial dcl 2-9 fn_linenum internal static fixed bin(17,0) initial dcl 2-9 fn_listarray internal static fixed bin(17,0) initial dcl 2-9 fn_listify internal static fixed bin(17,0) initial dcl 2-9 fn_loadarrays internal static fixed bin(17,0) initial dcl 2-9 fn_log internal static fixed bin(17,0) initial dcl 2-9 fn_ls internal static fixed bin(17,0) initial dcl 2-9 fn_lsh internal static fixed bin(17,0) initial dcl 2-9 fn_make_atom internal static fixed bin(17,0) initial dcl 2-9 fn_makunbound internal static fixed bin(17,0) initial dcl 2-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 2-9 fn_max internal static fixed bin(17,0) initial dcl 2-9 fn_mergef internal static fixed bin(17,0) initial dcl 2-9 fn_min internal static fixed bin(17,0) initial dcl 2-9 fn_minus internal static fixed bin(17,0) initial dcl 2-9 fn_minusp internal static fixed bin(17,0) initial dcl 2-9 fn_namelist internal static fixed bin(17,0) initial dcl 2-9 fn_names internal static fixed bin(17,0) initial dcl 2-9 fn_namestring internal static fixed bin(17,0) initial dcl 2-9 fn_nointerrupt internal static fixed bin(17,0) initial dcl 2-9 fn_nth internal static fixed bin(17,0) initial dcl 2-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 2-9 fn_oddp internal static fixed bin(17,0) initial dcl 2-9 fn_open internal static fixed bin(17,0) initial dcl 2-9 fn_opena internal static fixed bin(17,0) initial dcl 2-9 fn_openi internal static fixed bin(17,0) initial dcl 2-9 fn_openo internal static fixed bin(17,0) initial dcl 2-9 fn_out internal static fixed bin(17,0) initial dcl 2-9 fn_pagel internal static fixed bin(17,0) initial dcl 2-9 fn_pagenum internal static fixed bin(17,0) initial dcl 2-9 fn_plus internal static fixed bin(17,0) initial dcl 2-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 2-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 2-9 fn_plusp internal static fixed bin(17,0) initial dcl 2-9 fn_prin1 internal static fixed bin(17,0) initial dcl 2-9 fn_princ internal static fixed bin(17,0) initial dcl 2-9 fn_print internal static fixed bin(17,0) initial dcl 2-9 fn_prog internal static fixed bin(17,0) initial dcl 2-9 fn_progv internal static fixed bin(17,0) initial dcl 2-9 fn_putprop internal static fixed bin(17,0) initial dcl 2-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 2-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 2-9 fn_quotient internal static fixed bin(17,0) initial dcl 2-9 fn_random internal static fixed bin(17,0) initial dcl 2-9 fn_read internal static fixed bin(17,0) initial dcl 2-9 fn_read_from_string internal static fixed bin(17,0) initial dcl 2-9 fn_readch internal static fixed bin(17,0) initial dcl 2-9 fn_readstring internal static fixed bin(17,0) initial dcl 2-9 fn_remainder internal static fixed bin(17,0) initial dcl 2-9 fn_remprop internal static fixed bin(17,0) initial dcl 2-9 fn_rename internal static fixed bin(17,0) initial dcl 2-9 fn_rot internal static fixed bin(17,0) initial dcl 2-9 fn_rplaca internal static fixed bin(17,0) initial dcl 2-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 2-9 fn_save internal static fixed bin(17,0) initial dcl 2-9 fn_set internal static fixed bin(17,0) initial dcl 2-9 fn_setarg internal static fixed bin(17,0) initial dcl 2-9 fn_setq internal static fixed bin(17,0) initial dcl 2-9 fn_setsyntax internal static fixed bin(17,0) initial dcl 2-9 fn_shortnamestring internal static fixed bin(17,0) initial dcl 2-9 fn_signp internal static fixed bin(17,0) initial dcl 2-9 fn_sin internal static fixed bin(17,0) initial dcl 2-9 fn_sleep internal static fixed bin(17,0) initial dcl 2-9 fn_sort internal static fixed bin(17,0) initial dcl 2-9 fn_sortcar internal static fixed bin(17,0) initial dcl 2-9 fn_sqrt internal static fixed bin(17,0) initial dcl 2-9 fn_sstatus internal static fixed bin(17,0) initial dcl 2-9 fn_star_array internal static fixed bin(17,0) initial dcl 2-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 2-9 fn_star_sstatus internal static fixed bin(17,0) initial dcl 2-9 fn_star_status internal static fixed bin(17,0) initial dcl 2-9 fn_status internal static fixed bin(17,0) initial dcl 2-9 fn_store internal static fixed bin(17,0) initial dcl 2-9 fn_stringlength internal static fixed bin(17,0) initial dcl 2-9 fn_sub1 internal static fixed bin(17,0) initial dcl 2-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 2-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 2-9 fn_substr internal static fixed bin(17,0) initial dcl 2-9 fn_sxhash internal static fixed bin(17,0) initial dcl 2-9 fn_sysp constant fixed bin(17,0) initial dcl 2-9 ref 269 fn_throw internal static fixed bin(17,0) initial dcl 2-9 fn_times internal static fixed bin(17,0) initial dcl 2-9 fn_times_fix internal static fixed bin(17,0) initial dcl 2-9 fn_times_flo internal static fixed bin(17,0) initial dcl 2-9 fn_truename internal static fixed bin(17,0) initial dcl 2-9 fn_tyi internal static fixed bin(17,0) initial dcl 2-9 fn_tyipeek internal static fixed bin(17,0) initial dcl 2-9 fn_tyo internal static fixed bin(17,0) initial dcl 2-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 2-9 fn_zerop internal static fixed bin(17,0) initial dcl 2-9 fsubr defined fixed bin(71,0) dcl 62 ref 201 275 fsubrsw 000104 automatic bit(1) unaligned dcl 19 set ref 198* 202* 208* 225 head_offset 1 based fixed bin(17,0) array level 2 packed unaligned dcl 5-32 set ref 315 315 header_rel based fixed bin(17,0) level 3 packed unaligned dcl 362 set ref 427* illobj internal static fixed bin(17,0) initial dcl 1-8 include_file_error internal static fixed bin(17,0) initial dcl 1-8 instructions_for_subr internal static bit(36) initial array unaligned dcl 5-45 io_wrong_direction internal static fixed bin(17,0) initial dcl 1-8 len based fixed bin(8,0) level 2 packed unaligned dcl 362 set ref 440* 443* length builtin function dcl 362 ref 402 403 link based structure level 2 dcl 362 link_info based structure level 1 dcl 19 link_ptr 000124 automatic pointer dcl 19 set ref 319* 320 322* 325 link_to_subr_code based structure level 1 dcl 5-39 linkage_block based structure level 1 dcl 362 lisp$ 000010 external static fixed bin(17,0) dcl 19 set ref 296 325 lisp_error_ 000014 constant entry external dcl 19 ref 173 lisp_fixnum_ovly_lk based structure level 1 dcl 19 lisp_linkage_error 000112 stack reference condition dcl 19 ref 321 323 lisp_linker_ 000012 constant entry external dcl 19 ref 322 lisp_ptr based structure level 1 dcl 6-17 lisp_ptr_type based bit(36) dcl 6-17 lisp_special_fns_$cons 000016 constant entry external dcl 60 ref 240 lisp_static_man_$allocate 000034 constant entry external dcl 362 ref 410 lisp_static_vars_$array external static fixed bin(71,0) dcl 62 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 9-6 lisp_static_vars_$binding_top external static pointer dcl 9-6 lisp_static_vars_$catch_frame external static pointer dcl 9-6 lisp_static_vars_$err_frame external static pointer dcl 9-6 lisp_static_vars_$err_recp external static pointer dcl 9-6 lisp_static_vars_$eval_frame external static pointer dcl 9-6 lisp_static_vars_$fsubr 000024 external static fixed bin(71,0) dcl 62 ref 201 201 275 275 lisp_static_vars_$iochan_list external static pointer dcl 9-6 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 9-6 lisp_static_vars_$lsubr 000022 external static fixed bin(71,0) dcl 62 ref 196 196 275 275 lisp_static_vars_$nil 000032 external static fixed bin(71,0) dcl 9-6 ref 218 218 226 226 236 236 248 248 299 299 309 309 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 9-6 lisp_static_vars_$prog_frame external static pointer dcl 9-6 lisp_static_vars_$stack_ptr 000026 external static pointer dcl 9-6 set ref 84 84 116* 116 125* 125 130 130 134 134 137 137 141 141 144 144 148 148 151 151 155 155 158 158 162 162 179 179 183* 183 188* 188 219* 219 242* 242 257* 257 262 262 263* 263 266* 266 282* 282 301* 301 310* 310 329* 329 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 9-45 lisp_static_vars_$subr 000020 external static fixed bin(71,0) dcl 62 ref 206 206 275 275 lisp_static_vars_$t_atom external static fixed bin(71,0) dcl 9-6 lisp_static_vars_$top_level external static label variable dcl 9-6 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 000030 external static pointer dcl 9-6 set ref 169 169 170* 170 lisp_static_vars_$unwp_frame external static pointer dcl 9-6 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 9-45 lisp_string based structure level 1 dcl 7-6 lisp_subr_links based structure array level 1 dcl 5-23 lsubr defined fixed bin(71,0) dcl 62 ref 196 275 lsubrsw 000103 automatic bit(1) unaligned dcl 19 set ref 197* 203* 207* 229 make_entry 000000 constant label array(-2:2) dcl 418 ref 417 make_link 001257 constant label dcl 427 make_lisp_subr_block_ 001153 constant entry internal dcl 334 ref 114 make_type_2 001251 constant label dcl 423 ref 420 maxnum based bit(9) level 2 packed unaligned dcl 56 set ref 233 249* 254* minnum 0(09) based bit(9) level 2 packed unaligned dcl 56 set ref 231 238 250* 253* mismatch_super_parens internal static fixed bin(17,0) initial dcl 1-8 mod 0(30) based bit(6) level 2 packed unaligned dcl 19 ref 320 more_mod 1(18) based bit(18) level 3 packed unaligned dcl 362 set ref 431* myname 000130 automatic fixed bin(17,0) dcl 19 set ref 83* 172 187* 269* nargs 000110 automatic fixed bin(17,0) dcl 19 in procedure "defsubr" set ref 101* 114* nargs based fixed bin(17,0) level 2 in structure "subr_info_stuff" packed unaligned dcl 19 in procedure "defsubr" ref 291 new_type_subr 001042 constant label dcl 315 ref 287 nihil_ex_nihile internal static fixed bin(17,0) initial dcl 1-8 nil defined fixed bin(71,0) dcl 9-6 ref 218 226 236 248 299 309 nil_ptr based pointer dcl 9-6 no_args based fixed bin(17,0) level 2 packed unaligned dcl 362 set ref 415* no_left_super_paren internal static fixed bin(17,0) initial dcl 1-8 no_lexpr internal static fixed bin(17,0) initial dcl 1-8 nonfixedarg internal static fixed bin(17,0) initial dcl 1-8 not_alpha_array internal static fixed bin(17,0) initial dcl 1-8 not_an_array internal static fixed bin(17,0) initial dcl 1-8 not_pdl_ptr internal static fixed bin(17,0) initial dcl 1-8 not_same_type internal static fixed bin(17,0) initial dcl 1-8 null builtin function dcl 362 num_args parameter fixed bin(17,0) dcl 355 ref 334 415 number_args 000105 automatic fixed bin(17,0) dcl 19 set ref 85* 88 94 294* obarray defined fixed bin(71,0) dcl 9-6 overflow_err internal static fixed bin(17,0) initial dcl 1-8 parenmissing internal static fixed bin(17,0) initial dcl 1-8 pdl_ptr_types36 based structure array level 1 dcl 10-7 plist 2 based fixed bin(71,0) level 2 dcl 11-5 ref 194 273 pointer builtin function dcl 19 prog_frame defined pointer dcl 9-6 push_down_list_ptr_types based structure array level 1 dcl 10-7 quoterror internal static fixed bin(17,0) initial dcl 1-8 rel builtin function dcl 362 ref 427 432 433 437 438 reopen_inconsistent internal static fixed bin(17,0) initial dcl 1-8 rest_of_tsx0 1(18) based bit(18) array level 2 packed unaligned dcl 5-32 ref 287 ret_nilll 001012 constant label dcl 299 ref 321 325 seg_name parameter char dcl 355 ref 334 402 441 segname_rel 4 based bit(18) level 2 packed unaligned dcl 362 set ref 437* segnamel 000150 automatic fixed bin(17,0) dcl 362 set ref 402* 404 438 440 441 441 442 shortreadlist internal static fixed bin(17,0) initial dcl 1-8 size 000152 automatic fixed bin(18,0) dcl 362 set ref 404* 406* 406 408* 408 410* space 000146 automatic pointer dcl 362 set ref 412* 415 416 418 421 423 425 426* 426 427 427 429 431 432 432 433 433 434 435 436 437 437 438 438 439* 439 440 441 442* 442 443 444 special_array_type internal static fixed bin(17,0) initial dcl 1-8 stack 000100 automatic pointer dcl 19 set ref 84* 85 86* 86 86 90 90 96 96 101 101 106 110 114 114 114 116 125 130 134 137 141 144 148 151 155 158 162 179* 180 182* 182 182 183 185 188 189 189 191 191 194 194 195 196 201 206 209 209 211 214 214 215 215 215 218 219 222 226 230 231 232 233 236 237 238 241 241 242 246 246 247 247 248 250 253 254 256 256 257 262* 263 265 266 273 273 274 275 275 275 278 278 279 281 281 282 285 286 296 296 299 301 305 305 306 306 306 309 310 328 328 329 stack_loss_error internal static fixed bin(17,0) initial dcl 1-8 stack_ptr defined pointer dcl 9-6 set ref 84 116* 125* 130 134 137 141 144 148 151 155 158 162 179 183* 188* 219* 242* 257* 262 263* 266* 282* 301* 310* 329* stack_seg based structure level 1 dcl 3-5 star_rset defined fixed bin(71,0) dcl 9-45 stars_left_in_name internal static fixed bin(17,0) initial dcl 1-8 start_of_strings 5 based fixed bin(17,0) level 2 dcl 362 set ref 437 438 439 store_function_misused internal static fixed bin(17,0) initial dcl 1-8 store_not_allowed internal static fixed bin(17,0) initial dcl 1-8 stpbp_ab_back_2 000007 constant bit(36) initial dcl 362 ref 425 stplp_ab_back_4 internal static bit(36) initial dcl 362 string 1 based char level 2 in structure "lisp_string" dcl 7-6 in procedure "defsubr" set ref 114* 114* string 0(09) based char(262144) level 2 in structure "acc" packed unaligned dcl 362 in procedure "make_lisp_subr_block_" set ref 441* 444* string_length based fixed bin(17,0) level 2 dcl 7-6 ref 114 114 114 114 stype 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 362 set ref 416* subr defined fixed bin(71,0) dcl 62 ref 206 275 subr_block_head based structure level 1 dcl 5-3 subr_block_head_overlay based structure level 1 dcl 5-14 subr_code_link_offset 6 based fixed bin(17,0) level 2 packed unaligned dcl 5-3 set ref 319 319 subr_entries based structure array level 1 dcl 5-32 subr_head based structure level 1 dcl 56 subr_info_stuff based structure level 1 dcl 19 subr_offsets 000017 constant fixed bin(17,0) initial array dcl 19 ref 293 subr_ptr 000120 automatic pointer dcl 19 set ref 222* 231 233 238 249 250 253 254 subr_type 0(18) based fixed bin(17,0) level 2 in structure "subr_info_stuff" packed unaligned dcl 19 in procedure "defsubr" ref 289 293 subr_type parameter fixed bin(2,0) dcl 355 in procedure "make_lisp_subr_block_" ref 334 406 416 417 substr builtin function dcl 362 set ref 441* 441 444* 444 sw 000102 automatic bit(1) unaligned dcl 19 set ref 180* 181* 224 sysp 000644 constant entry external dcl 260 sysp_01 000656 constant label dcl 263 ref 271 sysp_bad_1 000666 constant label dcl 266 t_atom defined fixed bin(71,0) dcl 9-6 t_atom_ptr based pointer dcl 9-6 temp based fixed bin(71,0) array dcl 10-7 set ref 90 96 101 116 130* 130 134* 134 137* 137 141* 141 144* 144 148* 148 151* 151 155* 155 158* 158 162* 162 180 182 183 188 189* 189 191* 191 194* 209* 214* 215* 218* 219 226* 230 231 232 233 236* 237 238 241* 241 242 246* 247* 248 250 253 254 256* 256 257 263 266 273* 278* 281* 282 296* 299* 301 305* 306* 309* 310 328* 329 temp_ptr based pointer array dcl 10-7 set ref 114* 114 114 194 196 201 206 209 214 215 222 246 247 273 275 275 275 278 281 286 296 305 306 328 temp_type 0(21) based bit(9) array level 2 packed unaligned dcl 10-7 ref 90 96 101 106 110 195 215 274 306 temp_type36 based bit(36) array level 2 dcl 10-7 ref 185 211 265 279 285 throw_to_no_catch internal static fixed bin(17,0) initial dcl 1-8 too_few 000231 constant label dcl 121 too_few_args constant fixed bin(17,0) initial dcl 1-8 ref 121 too_many 000234 constant label dcl 124 too_many_args constant fixed bin(17,0) initial dcl 1-8 ref 124 tra_1_ic_ind internal static bit(36) initial dcl 362 trap 3(18) based fixed bin(17,0) level 2 packed unaligned dcl 362 set ref 436* tsbbp_ab_lsubr_int 000005 constant bit(36) initial dcl 362 ref 418 tsbbp_ab_pl1_int 000006 constant bit(36) initial dcl 362 ref 421 tsblp_ic_ind internal static bit(18) initial dcl 362 tsplp_ic_ind internal static bit(18) initial unaligned dcl 5-45 tsx0_ic constant bit(18) initial unaligned dcl 5-45 ref 287 tty_input_chan defined pointer dcl 9-6 tty_output_chan defined pointer dcl 9-6 type 000107 automatic fixed bin(2,0) dcl 19 in procedure "defsubr" set ref 94* 96* 99 99 114* type 0(21) based bit(9) level 2 in structure "lisp_ptr" packed unaligned dcl 6-17 in procedure "defsubr" set ref 413* type_info based bit(36) level 2 dcl 8-4 set ref 230* 232* 237* unable_to_float internal static fixed bin(17,0) initial dcl 1-8 undefined_atom internal static fixed bin(17,0) initial dcl 1-8 undefined_function internal static fixed bin(17,0) initial dcl 1-8 undefined_subr internal static fixed bin(17,0) initial dcl 1-8 underflow_fault internal static fixed bin(17,0) initial dcl 1-8 unm 000126 automatic pointer dcl 19 set ref 169* 170 171 172 unmkd_ptr defined pointer dcl 9-6 set ref 169 170* unseen_go_tag internal static fixed bin(17,0) initial dcl 1-8 unwp_frame defined pointer dcl 9-6 user_intr_array defined fixed bin(71,0) array dcl 9-45 wrong_no_args internal static fixed bin(17,0) initial dcl 1-8 zerodivide_fault internal static fixed bin(17,0) initial dcl 1-8 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1542 1600 1354 1552 Length 2242 1354 36 426 165 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME defsubr 154 external procedure is an external procedure. error internal procedure shares stack frame of external procedure defsubr. on unit on line 321 64 on unit make_lisp_subr_block_ internal procedure shares stack frame of external procedure defsubr. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME defsubr 000100 stack defsubr 000102 sw defsubr 000103 lsubrsw defsubr 000104 fsubrsw defsubr 000105 number_args defsubr 000106 flags defsubr 000107 type defsubr 000110 nargs defsubr 000120 subr_ptr defsubr 000122 data_ptr defsubr 000124 link_ptr defsubr 000126 unm defsubr 000130 myname defsubr 000131 err defsubr 000146 space make_lisp_subr_block_ 000150 segnamel make_lisp_subr_block_ 000151 entryl make_lisp_subr_block_ 000152 size make_lisp_subr_block_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ext_out return tra_ext enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. lisp_error_ lisp_linker_ lisp_special_fns_$cons lisp_static_man_$allocate THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lisp$ lisp_static_vars_$fsubr lisp_static_vars_$lsubr lisp_static_vars_$nil lisp_static_vars_$stack_ptr lisp_static_vars_$subr lisp_static_vars_$unmkd_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000036 83 000044 84 000046 85 000052 86 000057 88 000062 90 000067 92 000100 94 000101 96 000107 98 000120 99 000121 101 000126 104 000137 106 000140 108 000147 110 000150 112 000156 114 000157 116 000224 117 000230 121 000231 122 000233 124 000234 125 000236 127 000241 128 000242 130 000243 132 000251 133 000253 134 000254 135 000263 137 000264 139 000273 140 000275 141 000276 142 000305 144 000306 146 000314 147 000316 148 000317 149 000326 151 000327 153 000335 154 000337 155 000340 156 000347 158 000350 160 000356 161 000360 162 000361 163 000367 177 000370 179 000376 180 000403 181 000411 182 000412 183 000415 185 000421 186 000425 187 000427 188 000431 189 000433 190 000435 191 000436 192 000441 194 000442 195 000445 196 000452 197 000456 198 000460 199 000461 201 000462 202 000465 203 000467 204 000470 206 000471 207 000474 208 000475 209 000476 211 000501 214 000505 215 000510 217 000516 218 000517 219 000522 220 000524 222 000525 224 000527 225 000531 226 000533 227 000535 229 000536 230 000540 231 000542 232 000546 233 000550 234 000553 236 000554 237 000556 238 000560 240 000564 241 000570 242 000573 243 000576 246 000577 247 000601 248 000604 249 000607 250 000614 251 000622 253 000623 254 000631 256 000636 257 000640 258 000642 260 000643 262 000651 263 000656 265 000662 266 000666 268 000670 269 000672 270 000674 271 000675 273 000676 274 000701 275 000706 278 000725 279 000730 281 000733 282 000735 283 000737 285 000740 286 000743 287 000745 289 000752 290 000757 291 000761 292 000765 293 000766 294 000774 296 000777 299 001012 301 001016 302 001021 305 001022 306 001025 308 001033 309 001034 310 001037 311 001041 315 001042 319 001050 320 001055 321 001061 322 001100 323 001107 325 001110 328 001124 329 001127 330 001131 167 001132 169 001133 170 001137 171 001142 172 001144 173 001146 174 001152 334 001153 402 001171 403 001173 404 001175 406 001203 408 001210 410 001214 412 001225 413 001231 415 001235 416 001240 417 001242 418 001244 420 001246 421 001247 423 001251 425 001253 426 001255 427 001257 429 001266 431 001270 432 001272 433 001275 434 001300 435 001302 436 001304 437 001306 438 001311 439 001322 440 001325 441 001330 442 001335 443 001342 444 001345 446 001352 ----------------------------------------------------------- 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