COMPILATION LISTING OF SEGMENT lisp_define_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0844.9 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 defun: proc; /* fsubr for defining functions */ 7 8 /* 9* * originally coded by David Reed 10* * recoded by D. Moon 6-JUN-72, for v2pl1 and new lisp_ptr format 11* * modified 7-JUN-72 for new stack discipline. DAM 12* * converted to correctable error scheme; 13* * constants moved to lisp_static_vars_ DAM 8 Aug 72 14** Fixed defprop to return its first argument. AS 10/4/72 15* */ 16 17 /* lisp constants */ 18 19 dcl ( lisp_static_vars_$lambda, 20 lisp_static_vars_$expr_hash, 21 lisp_static_vars_$expr, 22 lisp_static_vars_$fexpr, 23 lisp_static_vars_$macro 24 ) fixed bin(71) aligned external, 25 lisp_static_vars_$defun external ptr, 26 27 (lambda def (lisp_static_vars_$lambda), 28 expr def (lisp_static_vars_$expr), 29 fexpr def (lisp_static_vars_$fexpr), 30 macro def (lisp_static_vars_$macro) 31 ) fixed bin(71) aligned, 32 33 /* temporaries on the stack -- used by define */ 34 35 argl ptr, 36 r_ptr ptr based (addr(stack -> temp(2))), 37 Aptr ptr based (addr(stack -> temp(3))), 38 Bptr ptr based (addr(stack -> temp(4))), 39 Nptr ptr based (addr(stack -> temp(5))), 40 A fixed bin (71) aligned based (addr(stack -> temp(3))), 41 B fixed bin (71) aligned based (addr(stack -> temp(4))), 42 N fixed bin (71) aligned based (addr(stack -> temp(5))), 43 44 /* declarations for defun and defprop */ 45 46 47 args ptr def (stack -> temp_ptr(1)), /* to list of args of fsubr */ 48 stack ptr, /* copy of stack_ptr */ 49 foo fixed bin(71) aligned; /* a lisp-object holder */ 50 51 /* ENTRY POINTS CALLED */ 52 53 dcl lisp_error_ ext entry, 54 lisp_utils_$pl1_sxhash ext entry, 55 unm ptr, 56 ercode(2) fixed bin aligned based(unm); 57 dcl lisp_alloc_ entry(fixed bin, ptr); 58 dcl lisp_get_atom_ ext entry (char(*), fixed bin(71) aligned); 59 dcl lisp_special_fns_$cons ext entry; 60 dcl lisp_property_fns_$get ext entry; 61 dcl lisp_property_fns_$putprop ext entry; 62 dcl lisp_property_fns_$remprop ext entry; 63 1 1 /* Include file lisp_atom_fmt.incl.pl1; 1 2* describes internal format of atoms in the lisp system 1 3* D.Reed 4/1/71 */ 1 4 1 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 1 6 2 value fixed bin(71), /* atom's value */ 1 7 2 plist fixed bin(71), /* property list */ 1 8 2 pnamel fixed bin, /* length of print name */ 1 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 1 10 1 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 1 12 2 value ptr, 1 13 2 plist ptr, 1 14 1 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 1 16 2 value bit(72), 1 17 2 plist bit(72); 1 18 1 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 64 2 1 2 2 /* BEGIN INCLUDE FILE lisp_error_codes.incl.pl1 */ 2 3 2 4 /* This contains codes to be stored on the unmkd pdl before calling 2 5* lisp_error_. These codes, at ab|-2,x7, are used by lisp_error_ 2 6* as an index into lisp_error_table_. */ 2 7 2 8 dcl ( 2 9 undefined_atom init(100), /* - correctable */ 2 10 undefined_function init(101), /* - correctable */ 2 11 too_many_args init(102), /* uncorrectable */ 2 12 too_few_args init(103), /* .. */ 2 13 file_system_error init(104), /* (obsolete) */ 2 14 bad_argument init(105), /* uncorrectable arg reject */ 2 15 undefined_subr init(106), 2 16 bad_function init(107), /* "bad functional form" */ 2 17 bad_bv init(108), /* attempt to bind non-variable */ 2 18 unseen_go_tag init(109), /* correctable -> unevaled new tag */ 2 19 throw_to_no_catch init(110), /* .. */ 2 20 nonfixedarg init(111), /* correctable */ 2 21 parenmissing init(112), /* uncorr reader error */ 2 22 doterror init(113), /* .. */ 2 23 illobj init(114), /* .. */ 2 24 badmacro init(115), /* .. */ 2 25 shortreadlist init(116), /* .. */ 2 26 badreadlist init(117), /* .. */ 2 27 array_bound_error init(118), /* corr -> (array sub1 sub2...) */ 2 28 car_cdr_error init(119), /* uncorr - car or cdr of number */ 2 29 bad_arg_correctable init(120), /* correctable arg reject */ 2 30 bad_prog_op init(121), /* uncorr fail-act: go or return */ 2 31 no_lexpr init(122), /* uncorr fail-act: args or setarg */ 2 32 wrong_no_args init(123), /* correctable wna -> new expr value */ 2 33 bad_ibase init(124), /* corr */ 2 34 bad_base init(125), /* corr */ 2 35 bad_input_source init(126), /* corr - retry i/o */ 2 36 bad_output_dest init(127), /* .. */ 2 37 nihil_ex_nihile init(128), /* uncorr - attempt to setq nil */ 2 38 not_pdl_ptr init(131), /* corr arg reject - for pdl ptr args */ 2 39 bad_f_fcn init(134), /* compiled call to fsubr with evaled args */ 2 40 overflow_err init(135), /* arithmetic overflow. */ 2 41 mismatch_super_parens init(136), /* uncorr reader error */ 2 42 no_left_super_paren init(137), /* .. */ 2 43 flonum_too_big init(138), /* .. */ 2 44 quoterror init(139), /* .. */ 2 45 badreadtable init(140), /* .. */ 2 46 badobarray init(141), /* .. */ 2 47 atan_0_0_err init(142), /* (atan 0 0) doesn't work */ 2 48 unable_to_float init(143), /* corr arg reject - (float x) */ 2 49 division_by_zero init(144), /* uncorr (should really be corr) */ 2 50 eof_in_object init(145), /* corr fail-act -> keep reading anyway */ 2 51 cant_filepos init(146), /* corr fail-act -> new expr value */ 2 52 filepos_oob init(147), /* .. */ 2 53 file_sys_fun_err init(148), /* corr f.s. err -> new expr value */ 2 54 stars_left_in_name init(149), /* .. */ 2 55 io_wrong_direction init(150), /* .. */ 2 56 file_is_closed init(151), /* .. */ 2 57 reopen_inconsistent init(152), /* .. */ 2 58 bad_entry_name init(153), /* .. */ 2 59 bad_do_format init(154), /* bad do format in interp. */ 2 60 not_an_array init(155), /* bad array-type arg */ 2 61 not_alpha_array init(156), /* bad all-alphabetic array */ 2 62 include_file_error init(157), /* %include barfed */ 2 63 stack_loss_error init(158), /* stack overflew */ 2 64 underflow_fault init(159), 2 65 zerodivide_fault init(160), 2 66 bad_array_subscript init(161), 2 67 store_not_allowed init(162), 2 68 dead_array_reference init(163), 2 69 cant_subscript_readtable init(164), 2 70 not_same_type init(165), 2 71 special_array_type init(166), 2 72 array_too_big init(167), 2 73 argument_must_be_array init(168), 2 74 store_function_misused init(169) 2 75 ) fixed bin static; 2 76 2 77 /* END INCLUDE FILE lisp_error_codes.incl.pl1 */ 65 3 1 3 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 3 3 3 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 3 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 3 6* are used so that the name of the function which is rejecting its argument 3 7* can be printed. Please note that all these codes are negative. */ 3 8 3 9 dcl ( 3 10 fn_do init (-10), 3 11 fn_arg init (-11), 3 12 fn_setarg init (-12), 3 13 fn_status init (-13), 3 14 fn_sstatus init (-14), 3 15 fn_errprint init (-15), 3 16 fn_errframe init (-16), 3 17 fn_evalframe init (-17), 3 18 fn_defaultf init (-18), 3 19 fn_tyo init (-22), 3 20 fn_ascii init (-23), 3 21 fn_rplaca init (-24), 3 22 fn_definedp init (-25), 3 23 fn_setq init (-26), 3 24 fn_set init (-27), 3 25 fn_delete init (-28), 3 26 fn_delq init (-29), 3 27 fn_stringlength init (-30), 3 28 fn_catenate init (-31), 3 29 fn_array init (-32), 3 30 fn_substr init (-33), 3 31 fn_index init (-34), 3 32 fn_get_pname init (-35), 3 33 fn_make_atom init (-36), 3 34 fn_ItoC init (-37), 3 35 fn_CtoI init (-38), 3 36 fn_defsubr init (-39), 3 37 fn_star_array init (-40), 3 38 fn_args init (-41), 3 39 fn_sysp init (-42), 3 40 fn_get init (-43), 3 41 fn_getl init (-44), 3 42 fn_putprop init (-45), 3 43 fn_remprop init (-46), 3 44 fn_save init (-47), 3 45 fn_add1 init (-48), 3 46 fn_sub1 init (-49), 3 47 fn_greaterp init (-50), 3 48 fn_lessp init (-51), 3 49 fn_minus init (-52), 3 50 fn_plus init (-53), 3 51 fn_times init (-54), 3 52 fn_difference init (-55), 3 53 fn_quotient init (-56), 3 54 fn_abs init (-57), 3 55 fn_expt init (-58), 3 56 fn_boole init (-59), 3 57 fn_rot init (-60), 3 58 fn_lsh init (-61), 3 59 fn_signp init (-62), 3 60 fn_fix init (-63), 3 61 fn_float init (-64), 3 62 fn_remainder init (-65), 3 63 fn_max init (-66), 3 64 fn_min init (-67), 3 65 fn_add1_fix init (-68), 3 66 fn_add1_flo init (-69), 3 67 fn_sub1_fix init (-70), 3 68 fn_sub1_flo init (-71), 3 69 fn_plus_fix init (-72), 3 70 fn_plus_flo init (-73), 3 71 fn_times_fix init (-74), 3 72 fn_times_flo init (-75), 3 73 fn_diff_fix init (-76), 3 74 fn_diff_flo init (-77), 3 75 fn_quot_fix init (-78), 3 76 fn_quot_flo init (-79), 3 77 fn_eval init (-80), 3 78 fn_apply init (-81), 3 79 fn_prog init (-82), 3 80 fn_errset init (-83), 3 81 fn_catch init (-84), 3 82 fn_throw init (-85), 3 83 fn_store init (-86), 3 84 fn_defun init (-87), 3 85 fn_baktrace init (-88), 3 86 fn_bltarray init (-89), 3 87 fn_star_rearray init (-90), 3 88 fn_gensym init (-91), 3 89 fn_makunbound init (-92), 3 90 fn_boundp init (-93), 3 91 fn_star_status init (-94), 3 92 fn_star_sstatus init (-95), 3 93 fn_freturn init (-96), 3 94 fn_cos init (-97), 3 95 fn_sin init (-98), 3 96 fn_exp init (-99), 3 97 fn_log init (-100), 3 98 fn_sqrt init (-101), 3 99 fn_isqrt init (-102), 3 100 fn_atan init (-103), 3 101 fn_sleep init (-104), 3 102 fn_oddp init (-105), 3 103 fn_tyipeek init (-106), 3 104 fn_alarmclock init (-107), 3 105 fn_plusp init (-108), 3 106 fn_minusp init (-109), 3 107 fn_ls init (-110), 3 108 fn_eql init (-111), 3 109 fn_gt init (-112), 3 110 fn_alphalessp init (-113), 3 111 fn_samepnamep init (-114), 3 112 fn_getchar init (-115), 3 113 fn_opena init (-116), 3 114 fn_sxhash init (-117), 3 115 fn_gcd init (-118), 3 116 fn_allfiles init (-119), 3 117 fn_chrct init (-120), 3 118 fn_close init (-121), 3 119 fn_deletef init (-122), 3 120 fn_eoffn init (-123), 3 121 fn_filepos init (-124), 3 122 fn_inpush init (-125), 3 123 fn_linel init (-126), 3 124 fn_mergef init (-127), 3 125 fn_namelist init (-128), 3 126 fn_names init (-129), 3 127 fn_namestring init (-130), 3 128 fn_openi init (-131), 3 129 fn_openo init (-132), 3 130 fn_prin1 init (-133), 3 131 fn_princ init (-134), 3 132 fn_print init (-135), 3 133 fn_read init (-136), 3 134 fn_readch init (-137), 3 135 fn_readstring init (-138), 3 136 fn_rename init (-139), 3 137 fn_shortnamestring init (-140), 3 138 fn_tyi init (-141), 3 139 fn_setsyntax init (-142), 3 140 fn_cursorpos init (-143), 3 141 fn_force_output init (-144), 3 142 fn_clear_input init (-145), 3 143 fn_random init (-146), 3 144 fn_haulong init (-147), 3 145 fn_haipart init (-148), 3 146 fn_cline init (-149), 3 147 fn_fillarray init (-150), 3 148 fn_listarray init (-151), 3 149 fn_sort init (-152), 3 150 fn_sortcar init (-153), 3 151 fn_zerop init (-154), 3 152 fn_listify init (-155), 3 153 fn_charpos init (-156), 3 154 fn_pagel init (-157), 3 155 fn_linenum init (-158), 3 156 fn_pagenum init (-159), 3 157 fn_endpagefn init (-160), 3 158 fn_arraydims init (-161), 3 159 fn_loadarrays init (-162), 3 160 fn_dumparrays init (-163), 3 161 fn_expt_fix init (-164), 3 162 fn_expt_flo init (-165), 3 163 fn_nointerrupt init (-166), 3 164 fn_open init (-167), 3 165 fn_in init (-168), 3 166 fn_out init (-169), 3 167 fn_truename init (-170), 3 168 fn_ifix init (-171), 3 169 fn_fsc init (-172), 3 170 fn_progv init (-173), 3 171 fn_mapatoms init (-174), 3 172 fn_unwind_protect init (-175), 3 173 fn_eval_when init (-176), 3 174 fn_read_from_string init (-177), 3 175 fn_displace init (-178), 3 176 fn_nth init (-179), 3 177 fn_nthcdr init (-180), 3 178 fn_includef init (-181) 3 179 ) fixed bin static; 3 180 3 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 66 4 1 /* Include file lisp_common_vars.incl.pl1; 4 2* describes the external static variables which may be referenced 4 3* by lisp routines. 4 4* D. Reed 4/1/71 */ 4 5 4 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 4 7 2 cclist_ptr ptr, /* pointer to list of constants kept 4 8* by compiled programs */ 4 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 4 10 4 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 4 12 err_recp ptr defined (lisp_static_vars_$err_recp), 4 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 4 14 lisp_static_vars_$eval_frame ptr ext static, 4 15 lisp_static_vars_$prog_frame ptr ext aligned, 4 16 lisp_static_vars_$err_frame ptr ext aligned, 4 17 lisp_static_vars_$catch_frame ptr ext aligned, 4 18 lisp_static_vars_$unwp_frame ptr ext aligned, 4 19 lisp_static_vars_$stack_ptr ptr ext aligned, 4 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 4 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 4 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 4 23 lisp_static_vars_$binding_top ptr ext aligned, 4 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 4 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 4 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 4 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 4 28 binding_top ptr defined (lisp_static_vars_$binding_top), 4 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 4 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 4 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 4 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 4 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 4 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 4 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 4 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 4 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 4 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 4 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 4 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 4 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 4 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 4 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 4 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 4 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 4 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 4 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 4 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 4 49 4 50 4 51 /* end include file lisp_common_vars.incl.pl1 */ 67 5 1 /* Include file lisp_cons_fmt.incl.pl1; 5 2* defines the format for a cons within the lisp system 5 3* D.Reed 4/1/71 */ 5 4 5 5 dcl consptr ptr, 5 6 1 cons aligned based (consptr), /* structure defining format for cons */ 5 7 2 car fixed bin(71), 5 8 2 cdr fixed bin(71), 5 9 5 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 5 11 2 car ptr, 5 12 2 cdr ptr, 5 13 5 14 5 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 5 16 2 padding bit(21) unaligned, 5 17 2 car bit(9) unaligned, 5 18 2 padding2 bit(63) unaligned, 5 19 2 cdr bit(9) unaligned, 5 20 2 padend bit(42) unaligned; 5 21 5 22 dcl 1 cons_types36 aligned based, 5 23 2 car bit(36), 5 24 2 pada bit(36), 5 25 2 cdr bit(36), 5 26 2 padd bit(36); 5 27 5 28 5 29 /* end include file lisp_cons_fmt.incl.pl1 */ 68 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 */ 69 7 1 /* include file lisp_stack_fmt.incl.pl1 -- 7 2* describes the format of the pushdown list 7 3* used by the lisp evaluator and lisp subrs 7 4* for passing arguments, saving atom bindings, 7 5* and as temporaries */ 7 6 7 7 dcl 7 8 temp(10000) fixed bin(71) aligned based, 7 9 7 10 temp_ptr(10000) ptr aligned based, 7 11 1 push_down_list_ptr_types(10000) based aligned, 7 12 2 junk bit(21) unaligned, 7 13 2 temp_type bit(9) unaligned, 7 14 2 more_junk bit(42) unaligned, 7 15 7 16 1 pdl_ptr_types36(10000) based aligned, 7 17 2 temp_type36 bit(36), 7 18 2 junk bit(36), 7 19 7 20 1 binding_block aligned based, 7 21 2 top_block bit(18) unaligned, 7 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 7 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 7 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 7 25 7 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 7 27 2 old_val fixed bin(71) aligned, 7 28 2 atom fixed bin(71) aligned; 7 29 7 30 7 31 7 32 /* end include file lisp_stack_fmt.incl.pl1 */ 70 71 72 /* DEFUN FSUBR */ 73 74 /* works by generating args on the stack for a call to putprop */ 75 76 stack = addrel(stack_ptr, -2); /* for efficiency */ 77 stack_ptr = addr(stack -> temp(6)); /* room for temp's */ 78 79 if stack -> temp_type(1) then 80 /* ensure there is a list of args */ 81 too_few: do; 82 /* too few args correctable error */ 83 84 stack_ptr = stack; 85 unm = unmkd_ptr; 86 unmkd_ptr = addrel(unm, 2); 87 unm -> ercode(1) = too_few_args; 88 unm -> ercode(2) = fn_defun; 89 call lisp_error_; 90 return; /* lisp_error_ pushes a suitable return value onto marked pdl */ 91 end; 92 93 stack -> temp(2) = args -> cons.car; /* atom to get fcn property */ 94 95 /* see if there is a 2nd arg */ 96 97 if args -> cons_types.cdr then go to too_few; 98 99 /* check for indicator as first arg */ 100 101 if stack -> temp(2) ^= expr 102 then if stack -> temp(2) ^= fexpr 103 then if stack -> temp(2) ^= macro 104 then go to check_second; /* normal case */ 105 106 stack -> temp(3) = stack -> temp(2); 107 stack -> temp(2) = args -> cons_ptrs.cdr -> cons.car; 108 go to get_body; 109 110 check_second: 111 112 /* see whether 2nd arg is lambda-list or a p-list indicator (expr, fexpr, macro) */ 113 114 stack -> temp(3) = args -> cons_ptrs.cdr -> cons.car; 115 if stack -> temp(3) ^= expr 116 then if stack -> temp(3) ^= fexpr 117 then if stack -> temp(3) ^= macro 118 then do; 119 stack -> temp(3) = expr; 120 stack -> temp(5) = args -> cons.cdr; 121 go to make_lambda_exp; 122 end; 123 get_body: stack -> temp(5) = args -> cons_ptrs.cdr -> cons.cdr; 124 make_lambda_exp: 125 stack -> temp(4) = lambda; /* cons up a lambda - expression */ 126 call lisp_special_fns_$cons; 127 128 if stack -> temp_type(2) = Cons /* (defun (foo bar baz) ...) */ 129 then do; 130 stack -> temp(3) = stack -> temp_ptr(2) -> cons_ptrs.cdr -> cons.car; 131 stack -> temp(2) = stack -> temp_ptr(2) -> cons.car; 132 end; 133 134 /* do expr-hash feature */ 135 136 if lisp_static_vars_$defun -> atom.value ^= 0 137 & lisp_static_vars_$defun -> atom.value ^= nil 138 then do; 139 stack_ptr = addr(stack->temp(7)); 140 stack->temp(5) = stack->temp(2); 141 stack->temp(6) = lisp_static_vars_$expr_hash; 142 call lisp_property_fns_$get; 143 if stack->temp(5) ^= nil 144 then do; 145 stack_ptr = addr(stack->temp(7)); 146 stack -> temp(6) = stack -> temp(4); /* lambda expression */ 147 call lisp_utils_$pl1_sxhash; 148 if stack -> temp(6) = stack->temp(5) 149 then go to done_defun; 150 stack->temp(5) = stack->temp(2); 151 stack->temp(6) = lisp_static_vars_$expr_hash; 152 call lisp_property_fns_$remprop; 153 end; 154 end; 155 156 /* put args in right order for putprop */ 157 158 stack_ptr = addr(stack -> temp(8)); /* lisp_special_fns_$cons has randomized stack_ptr */ 159 stack -> temp(5), stack -> temp(7) = stack -> temp(3); /* the indicator is third arg */ 160 /* the property is second arg */ 161 stack -> temp(3), stack -> temp(6) = stack -> temp(2); /* the atom is first arg */ 162 dremprop: 163 call lisp_property_fns_$remprop; 164 if stack->temp(6) ^= nil /* more to remprop? */ 165 then do; 166 stack_ptr = addr(stack->temp(8)); 167 stack -> temp(6) = stack->temp(2); 168 stack -> temp(7) = stack->temp(3); 169 go to dremprop; 170 end; 171 stack_ptr = addr(stack -> temp(6)); 172 call lisp_property_fns_$putprop; 173 done_defun: 174 stack -> temp(1) = stack -> temp(2); /* return the atom that was defun'ed */ 175 stack_ptr = addr(stack -> temp(2)); /* clear the stack - return the atom that was defun'ed */ 176 return; 177 178 /* defprop is unevaluated form of putprop. 179* This is just an interface to putprop */ 180 181 defprop: entry; 182 stack = addrel(stack_ptr, -2);; 183 stack_ptr = addr(stack -> temp(7)); /* so can pass 3 args to putprop, 2 to remprop. */ 184 /* and also save the first argument */ 185 if stack -> temp(1) = nil | stack -> temp_type(1) then go to too_few; 186 if stack -> temp_ptr(1) -> cons.cdr = nil | stack -> temp_ptr(1) -> cons_types.cdr then go to too_few; 187 if stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons.cdr = nil | 188 stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons_types.cdr then go to too_few; 189 190 191 /* arguments validated (at least that there are 3 ), so set up call to putprop */ 192 193 stack -> temp(4), stack -> temp(6) = stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons_ptrs.cdr -> cons.car; 194 stack -> temp(3) = stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons.car; 195 stack -> temp(1), 196 stack -> temp(5), 197 stack -> temp(2) = stack -> temp_ptr(1) -> cons.car; 198 dfremprop: 199 call lisp_property_fns_$remprop; 200 if stack->temp(5) ^= nil 201 then do; 202 stack_ptr =addr(stack->temp(7)); 203 stack->temp(5) = stack->temp(2); 204 stack->temp(6) = stack->temp(4); 205 go to dfremprop; 206 end; 207 stack_ptr = addr(stack->temp(5)); 208 call lisp_property_fns_$putprop; 209 stack_ptr = addr(stack -> temp(2)); /* clear the stack */ 210 return; 211 212 213 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.2 lisp_define_.pl1 >special_ldd>on>06/27/83>lisp_define_.pl1 64 1 03/27/82 0437.1 lisp_atom_fmt.incl.pl1 >ldd>include>lisp_atom_fmt.incl.pl1 65 2 03/27/82 0437.0 lisp_error_codes.incl.pl1 >ldd>include>lisp_error_codes.incl.pl1 66 3 06/29/83 1425.3 lisp_name_codes.incl.pl1 >ldd>include>lisp_name_codes.incl.pl1 67 4 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 68 5 03/27/82 0437.0 lisp_cons_fmt.incl.pl1 >ldd>include>lisp_cons_fmt.incl.pl1 69 6 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 70 7 03/27/82 0437.0 lisp_stack_fmt.incl.pl1 >ldd>include>lisp_stack_fmt.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) A based fixed bin(71,0) dcl 19 Aptr based pointer dcl 19 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 internal static bit(36) initial dcl 6-17 B based fixed bin(71,0) dcl 19 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 Bptr based pointer dcl 19 Cons constant bit(9) initial unaligned dcl 6-17 ref 128 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 internal static bit(9) initial unaligned dcl 6-17 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 N based fixed bin(71,0) dcl 19 NotConsOrAtsym36 internal static bit(36) initial dcl 6-17 Nptr based pointer dcl 19 Numeric internal static bit(9) initial unaligned dcl 6-17 Numeric36 internal static bit(36) initial dcl 6-17 String internal static bit(9) initial unaligned dcl 6-17 String36 internal static bit(36) initial dcl 6-17 Subr internal static bit(9) initial unaligned dcl 6-17 Subr36 internal static bit(36) initial dcl 6-17 SubrNumeric36 internal static bit(36) initial dcl 6-17 System_Subr internal static bit(9) initial unaligned dcl 6-17 System_Subr36 internal static bit(36) initial dcl 6-17 Uncollectable internal static bit(9) initial unaligned dcl 6-17 Undefined internal static bit(72) initial unaligned dcl 6-17 addr builtin function ref 77 139 145 158 166 171 175 183 202 207 209 addrel builtin function ref 76 86 182 argl automatic pointer dcl 19 args defined pointer dcl 19 ref 93 97 107 110 120 123 argument_must_be_array internal static fixed bin(17,0) initial dcl 2-8 array_atom defined fixed bin(71,0) dcl 4-6 array_bound_error internal static fixed bin(17,0) initial dcl 2-8 array_too_big internal static fixed bin(17,0) initial dcl 2-8 atan_0_0_err internal static fixed bin(17,0) initial dcl 2-8 atom based structure level 1 dcl 1-5 atom_double_words based structure level 1 dcl 1-5 atom_ptrs based structure level 1 dcl 1-5 bad_arg_correctable internal static fixed bin(17,0) initial dcl 2-8 bad_argument internal static fixed bin(17,0) initial dcl 2-8 bad_array_subscript internal static fixed bin(17,0) initial dcl 2-8 bad_base internal static fixed bin(17,0) initial dcl 2-8 bad_bv internal static fixed bin(17,0) initial dcl 2-8 bad_do_format internal static fixed bin(17,0) initial dcl 2-8 bad_entry_name internal static fixed bin(17,0) initial dcl 2-8 bad_f_fcn internal static fixed bin(17,0) initial dcl 2-8 bad_function internal static fixed bin(17,0) initial dcl 2-8 bad_ibase internal static fixed bin(17,0) initial dcl 2-8 bad_input_source internal static fixed bin(17,0) initial dcl 2-8 bad_output_dest internal static fixed bin(17,0) initial dcl 2-8 bad_prog_op internal static fixed bin(17,0) initial dcl 2-8 badmacro internal static fixed bin(17,0) initial dcl 2-8 badobarray internal static fixed bin(17,0) initial dcl 2-8 badreadlist internal static fixed bin(17,0) initial dcl 2-8 badreadtable internal static fixed bin(17,0) initial dcl 2-8 based_ptr based pointer dcl 6-16 binding_block based structure level 1 dcl 7-7 binding_top defined pointer dcl 4-6 bindings based structure array level 1 dcl 7-7 cant_filepos internal static fixed bin(17,0) initial dcl 2-8 cant_subscript_readtable internal static fixed bin(17,0) initial dcl 2-8 car based fixed bin(71,0) level 2 dcl 5-5 ref 93 107 110 130 131 193 194 195 car_cdr_error internal static fixed bin(17,0) initial dcl 2-8 catch_frame defined pointer dcl 4-6 cdr 2 based pointer level 2 in structure "cons_ptrs" dcl 5-5 in procedure "defun" ref 107 110 123 130 187 187 193 193 194 cdr 2(21) based bit(9) level 2 in structure "cons_types" packed unaligned dcl 5-5 in procedure "defun" ref 97 186 187 cdr 2 based fixed bin(71,0) level 2 in structure "cons" dcl 5-5 in procedure "defun" ref 120 123 186 187 check_second 000070 constant label dcl 110 ref 101 cons based structure level 1 dcl 5-5 cons_ptrs based structure level 1 dcl 5-5 cons_types based structure level 1 dcl 5-5 cons_types36 based structure level 1 dcl 5-22 consptr automatic pointer dcl 5-5 dead_array_reference internal static fixed bin(17,0) initial dcl 2-8 defprop 000265 constant entry external dcl 181 defun 000001 constant entry external dcl 6 dfremprop 000361 constant label dcl 198 ref 205 division_by_zero internal static fixed bin(17,0) initial dcl 2-8 done_defun 000255 constant label dcl 173 ref 148 doterror internal static fixed bin(17,0) initial dcl 2-8 dremprop 000226 constant label dcl 162 ref 169 eof_in_object internal static fixed bin(17,0) initial dcl 2-8 ercode based fixed bin(17,0) array dcl 53 set ref 87* 88* err_frame defined pointer dcl 4-6 err_recp defined pointer dcl 4-6 eval_frame defined pointer dcl 4-6 expr defined fixed bin(71,0) dcl 19 ref 101 115 119 fexpr defined fixed bin(71,0) dcl 19 ref 101 115 file_is_closed internal static fixed bin(17,0) initial dcl 2-8 file_sys_fun_err internal static fixed bin(17,0) initial dcl 2-8 file_system_error internal static fixed bin(17,0) initial dcl 2-8 filepos_oob internal static fixed bin(17,0) initial dcl 2-8 flonum_too_big internal static fixed bin(17,0) initial dcl 2-8 fn_CtoI internal static fixed bin(17,0) initial dcl 3-9 fn_ItoC internal static fixed bin(17,0) initial dcl 3-9 fn_abs internal static fixed bin(17,0) initial dcl 3-9 fn_add1 internal static fixed bin(17,0) initial dcl 3-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 3-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 3-9 fn_alarmclock internal static fixed bin(17,0) initial dcl 3-9 fn_allfiles internal static fixed bin(17,0) initial dcl 3-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 3-9 fn_apply internal static fixed bin(17,0) initial dcl 3-9 fn_arg internal static fixed bin(17,0) initial dcl 3-9 fn_args internal static fixed bin(17,0) initial dcl 3-9 fn_array internal static fixed bin(17,0) initial dcl 3-9 fn_arraydims internal static fixed bin(17,0) initial dcl 3-9 fn_ascii internal static fixed bin(17,0) initial dcl 3-9 fn_atan internal static fixed bin(17,0) initial dcl 3-9 fn_baktrace internal static fixed bin(17,0) initial dcl 3-9 fn_bltarray internal static fixed bin(17,0) initial dcl 3-9 fn_boole internal static fixed bin(17,0) initial dcl 3-9 fn_boundp internal static fixed bin(17,0) initial dcl 3-9 fn_catch internal static fixed bin(17,0) initial dcl 3-9 fn_catenate internal static fixed bin(17,0) initial dcl 3-9 fn_charpos internal static fixed bin(17,0) initial dcl 3-9 fn_chrct internal static fixed bin(17,0) initial dcl 3-9 fn_clear_input internal static fixed bin(17,0) initial dcl 3-9 fn_cline internal static fixed bin(17,0) initial dcl 3-9 fn_close internal static fixed bin(17,0) initial dcl 3-9 fn_cos internal static fixed bin(17,0) initial dcl 3-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 3-9 fn_defaultf internal static fixed bin(17,0) initial dcl 3-9 fn_definedp internal static fixed bin(17,0) initial dcl 3-9 fn_defsubr internal static fixed bin(17,0) initial dcl 3-9 fn_defun constant fixed bin(17,0) initial dcl 3-9 ref 88 fn_delete internal static fixed bin(17,0) initial dcl 3-9 fn_deletef internal static fixed bin(17,0) initial dcl 3-9 fn_delq internal static fixed bin(17,0) initial dcl 3-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 3-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 3-9 fn_difference internal static fixed bin(17,0) initial dcl 3-9 fn_displace internal static fixed bin(17,0) initial dcl 3-9 fn_do internal static fixed bin(17,0) initial dcl 3-9 fn_dumparrays internal static fixed bin(17,0) initial dcl 3-9 fn_endpagefn internal static fixed bin(17,0) initial dcl 3-9 fn_eoffn internal static fixed bin(17,0) initial dcl 3-9 fn_eql internal static fixed bin(17,0) initial dcl 3-9 fn_errframe internal static fixed bin(17,0) initial dcl 3-9 fn_errprint internal static fixed bin(17,0) initial dcl 3-9 fn_errset internal static fixed bin(17,0) initial dcl 3-9 fn_eval internal static fixed bin(17,0) initial dcl 3-9 fn_eval_when internal static fixed bin(17,0) initial dcl 3-9 fn_evalframe internal static fixed bin(17,0) initial dcl 3-9 fn_exp internal static fixed bin(17,0) initial dcl 3-9 fn_expt internal static fixed bin(17,0) initial dcl 3-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 3-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 3-9 fn_filepos internal static fixed bin(17,0) initial dcl 3-9 fn_fillarray internal static fixed bin(17,0) initial dcl 3-9 fn_fix internal static fixed bin(17,0) initial dcl 3-9 fn_float internal static fixed bin(17,0) initial dcl 3-9 fn_force_output internal static fixed bin(17,0) initial dcl 3-9 fn_freturn internal static fixed bin(17,0) initial dcl 3-9 fn_fsc internal static fixed bin(17,0) initial dcl 3-9 fn_gcd internal static fixed bin(17,0) initial dcl 3-9 fn_gensym internal static fixed bin(17,0) initial dcl 3-9 fn_get internal static fixed bin(17,0) initial dcl 3-9 fn_get_pname internal static fixed bin(17,0) initial dcl 3-9 fn_getchar internal static fixed bin(17,0) initial dcl 3-9 fn_getl internal static fixed bin(17,0) initial dcl 3-9 fn_greaterp internal static fixed bin(17,0) initial dcl 3-9 fn_gt internal static fixed bin(17,0) initial dcl 3-9 fn_haipart internal static fixed bin(17,0) initial dcl 3-9 fn_haulong internal static fixed bin(17,0) initial dcl 3-9 fn_ifix internal static fixed bin(17,0) initial dcl 3-9 fn_in internal static fixed bin(17,0) initial dcl 3-9 fn_includef internal static fixed bin(17,0) initial dcl 3-9 fn_index internal static fixed bin(17,0) initial dcl 3-9 fn_inpush internal static fixed bin(17,0) initial dcl 3-9 fn_isqrt internal static fixed bin(17,0) initial dcl 3-9 fn_lessp internal static fixed bin(17,0) initial dcl 3-9 fn_linel internal static fixed bin(17,0) initial dcl 3-9 fn_linenum internal static fixed bin(17,0) initial dcl 3-9 fn_listarray internal static fixed bin(17,0) initial dcl 3-9 fn_listify internal static fixed bin(17,0) initial dcl 3-9 fn_loadarrays internal static fixed bin(17,0) initial dcl 3-9 fn_log internal static fixed bin(17,0) initial dcl 3-9 fn_ls internal static fixed bin(17,0) initial dcl 3-9 fn_lsh internal static fixed bin(17,0) initial dcl 3-9 fn_make_atom internal static fixed bin(17,0) initial dcl 3-9 fn_makunbound internal static fixed bin(17,0) initial dcl 3-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 3-9 fn_max internal static fixed bin(17,0) initial dcl 3-9 fn_mergef internal static fixed bin(17,0) initial dcl 3-9 fn_min internal static fixed bin(17,0) initial dcl 3-9 fn_minus internal static fixed bin(17,0) initial dcl 3-9 fn_minusp internal static fixed bin(17,0) initial dcl 3-9 fn_namelist internal static fixed bin(17,0) initial dcl 3-9 fn_names internal static fixed bin(17,0) initial dcl 3-9 fn_namestring internal static fixed bin(17,0) initial dcl 3-9 fn_nointerrupt internal static fixed bin(17,0) initial dcl 3-9 fn_nth internal static fixed bin(17,0) initial dcl 3-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 3-9 fn_oddp internal static fixed bin(17,0) initial dcl 3-9 fn_open internal static fixed bin(17,0) initial dcl 3-9 fn_opena internal static fixed bin(17,0) initial dcl 3-9 fn_openi internal static fixed bin(17,0) initial dcl 3-9 fn_openo internal static fixed bin(17,0) initial dcl 3-9 fn_out internal static fixed bin(17,0) initial dcl 3-9 fn_pagel internal static fixed bin(17,0) initial dcl 3-9 fn_pagenum internal static fixed bin(17,0) initial dcl 3-9 fn_plus internal static fixed bin(17,0) initial dcl 3-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 3-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 3-9 fn_plusp internal static fixed bin(17,0) initial dcl 3-9 fn_prin1 internal static fixed bin(17,0) initial dcl 3-9 fn_princ internal static fixed bin(17,0) initial dcl 3-9 fn_print internal static fixed bin(17,0) initial dcl 3-9 fn_prog internal static fixed bin(17,0) initial dcl 3-9 fn_progv internal static fixed bin(17,0) initial dcl 3-9 fn_putprop internal static fixed bin(17,0) initial dcl 3-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 3-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 3-9 fn_quotient internal static fixed bin(17,0) initial dcl 3-9 fn_random internal static fixed bin(17,0) initial dcl 3-9 fn_read internal static fixed bin(17,0) initial dcl 3-9 fn_read_from_string internal static fixed bin(17,0) initial dcl 3-9 fn_readch internal static fixed bin(17,0) initial dcl 3-9 fn_readstring internal static fixed bin(17,0) initial dcl 3-9 fn_remainder internal static fixed bin(17,0) initial dcl 3-9 fn_remprop internal static fixed bin(17,0) initial dcl 3-9 fn_rename internal static fixed bin(17,0) initial dcl 3-9 fn_rot internal static fixed bin(17,0) initial dcl 3-9 fn_rplaca internal static fixed bin(17,0) initial dcl 3-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 3-9 fn_save internal static fixed bin(17,0) initial dcl 3-9 fn_set internal static fixed bin(17,0) initial dcl 3-9 fn_setarg internal static fixed bin(17,0) initial dcl 3-9 fn_setq internal static fixed bin(17,0) initial dcl 3-9 fn_setsyntax internal static fixed bin(17,0) initial dcl 3-9 fn_shortnamestring internal static fixed bin(17,0) initial dcl 3-9 fn_signp internal static fixed bin(17,0) initial dcl 3-9 fn_sin internal static fixed bin(17,0) initial dcl 3-9 fn_sleep internal static fixed bin(17,0) initial dcl 3-9 fn_sort internal static fixed bin(17,0) initial dcl 3-9 fn_sortcar internal static fixed bin(17,0) initial dcl 3-9 fn_sqrt internal static fixed bin(17,0) initial dcl 3-9 fn_sstatus internal static fixed bin(17,0) initial dcl 3-9 fn_star_array internal static fixed bin(17,0) initial dcl 3-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 3-9 fn_star_sstatus internal static fixed bin(17,0) initial dcl 3-9 fn_star_status internal static fixed bin(17,0) initial dcl 3-9 fn_status internal static fixed bin(17,0) initial dcl 3-9 fn_store internal static fixed bin(17,0) initial dcl 3-9 fn_stringlength internal static fixed bin(17,0) initial dcl 3-9 fn_sub1 internal static fixed bin(17,0) initial dcl 3-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 3-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 3-9 fn_substr internal static fixed bin(17,0) initial dcl 3-9 fn_sxhash internal static fixed bin(17,0) initial dcl 3-9 fn_sysp internal static fixed bin(17,0) initial dcl 3-9 fn_throw internal static fixed bin(17,0) initial dcl 3-9 fn_times internal static fixed bin(17,0) initial dcl 3-9 fn_times_fix internal static fixed bin(17,0) initial dcl 3-9 fn_times_flo internal static fixed bin(17,0) initial dcl 3-9 fn_truename internal static fixed bin(17,0) initial dcl 3-9 fn_tyi internal static fixed bin(17,0) initial dcl 3-9 fn_tyipeek internal static fixed bin(17,0) initial dcl 3-9 fn_tyo internal static fixed bin(17,0) initial dcl 3-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 3-9 fn_zerop internal static fixed bin(17,0) initial dcl 3-9 foo automatic fixed bin(71,0) dcl 19 get_body 000112 constant label dcl 123 ref 108 illobj internal static fixed bin(17,0) initial dcl 2-8 include_file_error internal static fixed bin(17,0) initial dcl 2-8 io_wrong_direction internal static fixed bin(17,0) initial dcl 2-8 lambda defined fixed bin(71,0) dcl 19 ref 124 lisp_alloc_ 000000 constant entry external dcl 57 lisp_error_ 000024 constant entry external dcl 53 ref 89 lisp_get_atom_ 000000 constant entry external dcl 58 lisp_property_fns_$get 000032 constant entry external dcl 60 ref 142 lisp_property_fns_$putprop 000034 constant entry external dcl 61 ref 172 208 lisp_property_fns_$remprop 000036 constant entry external dcl 62 ref 152 162 198 lisp_ptr based structure level 1 dcl 6-17 lisp_ptr_type based bit(36) dcl 6-17 lisp_special_fns_$cons 000030 constant entry external dcl 59 ref 126 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 4-6 lisp_static_vars_$binding_top external static pointer dcl 4-6 lisp_static_vars_$catch_frame external static pointer dcl 4-6 lisp_static_vars_$defun 000022 external static pointer dcl 19 ref 136 136 lisp_static_vars_$err_frame external static pointer dcl 4-6 lisp_static_vars_$err_recp external static pointer dcl 4-6 lisp_static_vars_$eval_frame external static pointer dcl 4-6 lisp_static_vars_$expr 000014 external static fixed bin(71,0) dcl 19 ref 101 101 115 115 119 119 lisp_static_vars_$expr_hash 000012 external static fixed bin(71,0) dcl 19 ref 141 151 lisp_static_vars_$fexpr 000016 external static fixed bin(71,0) dcl 19 ref 101 101 115 115 lisp_static_vars_$iochan_list external static pointer dcl 4-6 lisp_static_vars_$lambda 000010 external static fixed bin(71,0) dcl 19 ref 124 124 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 4-6 lisp_static_vars_$macro 000020 external static fixed bin(71,0) dcl 19 ref 101 101 115 115 lisp_static_vars_$nil 000044 external static fixed bin(71,0) dcl 4-6 ref 136 136 143 143 164 164 185 185 186 186 187 187 200 200 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 4-6 lisp_static_vars_$prog_frame external static pointer dcl 4-6 lisp_static_vars_$stack_ptr 000040 external static pointer dcl 4-6 set ref 76 76 77* 77 84* 84 139* 139 145* 145 158* 158 166* 166 171* 171 175* 175 182 182 183* 183 202* 202 207* 207 209* 209 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 4-45 lisp_static_vars_$t_atom external static fixed bin(71,0) dcl 4-6 lisp_static_vars_$top_level external static label variable dcl 4-6 lisp_static_vars_$tty_input_chan external static pointer dcl 4-6 lisp_static_vars_$tty_output_chan external static pointer dcl 4-6 lisp_static_vars_$unmkd_ptr 000042 external static pointer dcl 4-6 set ref 85 85 86* 86 lisp_static_vars_$unwp_frame external static pointer dcl 4-6 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 4-45 lisp_utils_$pl1_sxhash 000026 constant entry external dcl 53 ref 147 macro defined fixed bin(71,0) dcl 19 ref 101 115 make_lambda_exp 000116 constant label dcl 124 ref 121 mismatch_super_parens internal static fixed bin(17,0) initial dcl 2-8 nihil_ex_nihile internal static fixed bin(17,0) initial dcl 2-8 nil defined fixed bin(71,0) dcl 4-6 ref 136 143 164 185 186 187 200 nil_ptr based pointer dcl 4-6 no_left_super_paren internal static fixed bin(17,0) initial dcl 2-8 no_lexpr internal static fixed bin(17,0) initial dcl 2-8 nonfixedarg internal static fixed bin(17,0) initial dcl 2-8 not_alpha_array internal static fixed bin(17,0) initial dcl 2-8 not_an_array internal static fixed bin(17,0) initial dcl 2-8 not_pdl_ptr internal static fixed bin(17,0) initial dcl 2-8 not_same_type internal static fixed bin(17,0) initial dcl 2-8 obarray defined fixed bin(71,0) dcl 4-6 overflow_err internal static fixed bin(17,0) initial dcl 2-8 parenmissing internal static fixed bin(17,0) initial dcl 2-8 pdl_ptr_types36 based structure array level 1 dcl 7-7 prog_frame defined pointer dcl 4-6 push_down_list_ptr_types based structure array level 1 dcl 7-7 quoterror internal static fixed bin(17,0) initial dcl 2-8 r_ptr based pointer dcl 19 reopen_inconsistent internal static fixed bin(17,0) initial dcl 2-8 shortreadlist internal static fixed bin(17,0) initial dcl 2-8 special_array_type internal static fixed bin(17,0) initial dcl 2-8 stack 000100 automatic pointer dcl 19 set ref 76* 77 79 84 93 93 97 101 101 101 106 106 107 107 110 110 115 115 115 119 120 120 123 123 124 128 130 130 131 131 139 140 140 141 143 145 146 146 148 148 150 150 151 158 159 159 159 161 161 161 164 166 167 167 168 168 171 173 173 175 182* 183 185 185 186 186 187 187 193 193 193 194 194 195 195 195 195 200 202 203 203 204 204 207 209 stack_loss_error internal static fixed bin(17,0) initial dcl 2-8 stack_ptr defined pointer dcl 4-6 set ref 76 77* 84* 139* 145* 158* 166* 171* 175* 182 183* 202* 207* 209* star_rset defined fixed bin(71,0) dcl 4-45 stars_left_in_name internal static fixed bin(17,0) initial dcl 2-8 store_function_misused internal static fixed bin(17,0) initial dcl 2-8 store_not_allowed internal static fixed bin(17,0) initial dcl 2-8 t_atom defined fixed bin(71,0) dcl 4-6 t_atom_ptr based pointer dcl 4-6 temp based fixed bin(71,0) array dcl 7-7 set ref 77 93* 101 101 101 106* 106 107* 110* 115 115 115 119* 120* 123* 124* 130* 131* 139 140* 140 141* 143 145 146* 146 148 148 150* 150 151* 158 159 159* 159* 161 161* 161* 164 166 167* 167 168* 168 171 173* 173 175 183 185 193* 193* 194* 195* 195* 195* 200 202 203* 203 204* 204 207 209 temp_ptr based pointer array dcl 7-7 ref 93 93 97 97 107 107 110 110 120 120 123 123 130 131 186 186 187 187 193 194 195 temp_type 0(21) based bit(9) array level 2 packed unaligned dcl 7-7 ref 79 128 185 throw_to_no_catch internal static fixed bin(17,0) initial dcl 2-8 too_few 000017 constant label dcl 79 ref 97 185 186 187 too_few_args constant fixed bin(17,0) initial dcl 2-8 ref 87 too_many_args internal static fixed bin(17,0) initial dcl 2-8 tty_input_chan defined pointer dcl 4-6 tty_output_chan defined pointer dcl 4-6 unable_to_float internal static fixed bin(17,0) initial dcl 2-8 undefined_atom internal static fixed bin(17,0) initial dcl 2-8 undefined_function internal static fixed bin(17,0) initial dcl 2-8 undefined_subr internal static fixed bin(17,0) initial dcl 2-8 underflow_fault internal static fixed bin(17,0) initial dcl 2-8 unm 000102 automatic pointer dcl 53 set ref 85* 86 87 88 unmkd_ptr defined pointer dcl 4-6 set ref 85 86* unseen_go_tag internal static fixed bin(17,0) initial dcl 2-8 unwp_frame defined pointer dcl 4-6 user_intr_array defined fixed bin(71,0) array dcl 4-45 value based fixed bin(71,0) level 2 dcl 1-5 ref 136 136 wrong_no_args internal static fixed bin(17,0) initial dcl 2-8 zerodivide_fault internal static fixed bin(17,0) initial dcl 2-8 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 610 656 415 620 Length 1222 415 46 330 172 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME defun 72 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME defun 000100 stack defun 000102 unm defun THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. lisp_error_ lisp_property_fns_$get lisp_property_fns_$putprop lisp_property_fns_$remprop lisp_special_fns_$cons lisp_utils_$pl1_sxhash THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lisp_static_vars_$defun lisp_static_vars_$expr lisp_static_vars_$expr_hash lisp_static_vars_$fexpr lisp_static_vars_$lambda lisp_static_vars_$macro lisp_static_vars_$nil lisp_static_vars_$stack_ptr lisp_static_vars_$unmkd_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000000 76 000006 77 000012 79 000014 84 000017 85 000022 86 000025 87 000030 88 000032 89 000034 90 000040 93 000041 97 000043 101 000050 106 000062 107 000064 108 000067 110 000070 115 000073 119 000104 120 000106 121 000111 123 000112 124 000116 126 000120 128 000124 130 000130 131 000133 136 000135 139 000147 140 000151 141 000153 142 000155 143 000161 145 000166 146 000170 147 000172 148 000176 150 000203 151 000205 152 000210 158 000214 159 000220 161 000223 162 000226 164 000233 166 000240 167 000242 168 000244 169 000246 171 000247 172 000251 173 000255 175 000260 176 000263 181 000264 182 000272 183 000277 185 000301 186 000313 187 000327 193 000345 194 000352 195 000355 198 000361 200 000366 202 000373 203 000375 204 000377 205 000401 207 000402 208 000404 209 000410 210 000414 ----------------------------------------------------------- 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