ASSEMBLY LISTING OF SEGMENT >special_ldd>install>MR12.0-1206>lisp_.alm ASSEMBLED ON: 11/05/86 1100.9 mst Wed OPTIONS USED: list ASSEMBLED BY: ALM Version 6.7 October 1986 ASSEMBLER CREATED: 10/08/86 1557.5 mst Wed  1 " **************************************************************  2 " * *  3 " * Copyright, (C) Massachusetts Institute of Technology, 1973 *  4 " * *  5 " **************************************************************  6 " lisp_.alm -- evaluator for Multics MACLISP  7 "  8 " David Moon, 17 July 1972  9 " cleaned up and "map" functions added, 1 Aug 72 DAM  10 " pdl ptr format changed for pdp-10 compatible, 5 Aug 72 DAM  11 " bug in evaluated functions fixed, 7 Aug 72, DPR  12 " bug in eval_funarg fixed, 7 Aug 72, DPR  13 " go, return, eval_list (for prog) added 19 Aug 72, DAM 14 " call1, callf added 22 Aug 1972 DAM  15 " nouuo function added 24 Aug 72 DAM  16 " freturn_real added, meaning of frame.dat1 changed, 24 Jan 73 DAM  17 " changed to make *rset a variable, 24 May 1973 18 "  19 " modified 74.2.07 by DAM to fix bugs in apply of 3 args  20 " modified 74.04.15 by DAM to make an evalframe for an unbnd vrbl and to ignore 21 " macro properties when snapping subr links.  22 " Modified 74.09.18 by DAM to use the new binding-reversal scheme for funargs and  23 " calls to eval or apply with a binding-context-pointer  24 " Modified 75.03.31 by DAM for evalhook + bug fixes 25 " Modified 78.09.12 by BSG for "let" fsubr. 26  27 "flag bits in x2  28  000001 29 equ macrobit,1 distinguish macros from fexprs  000004 30 equ exprbit,4 distinguish expr/lexpr from subr/lsubr  000010 31 equ framebit,8 an evalframe was created and must be destroyed  000020 32 equ lsubrbit,16 distinguish lexpr/lsubr from expr/subr 000040 33 equ noteval,32 spread_args should not evaluate args (for apply)  002000 34 equ already_spread,1024 args are already spread, beginning at ap|qsrac+2,x4  000002 35 equ applybit,2 entered by apply rather than eval  000100 36 equ bbf,64 pseudo-binding-block exists because of label or funarg 000200 37 equ fbb,128 flag for a reversal block needed  38 " used by eval_funarg  000400 39 equ ignore_macros,256 find_type should ignore macro properties 001000 40 equ went_through_value_cell,512  004000 41 equ already_autoloaded_once,2048  010000 42 equ entered_by_funcall,4096 " to distinguish between funcall and call1  43  44 " temporaries on marked pdl 45  777777 777770 46 equ form,-8 form being evaled. Inviolable since pdlframe uses it.  47 " for apply, is name of fcn being applied  777777 777772 48 equ fcn,-6 function being applied 777777 777774 49 equ argl,-4 argument list. Inviolable since used to construct "form"  50 "also handy temporary, contains result of fcn, etc. 51 " in case of error during apply  777777 777776 52 equ qsrac,-2 all kinds of random things go here  53  54  55 " temporaries on unmarked pdl  56  57 " -2, -1 regular binding block  777777 777774 58 equ pdlptr,-4 a temporary  777777 777774 59 equ svx5u,-4 register save area  777777 777774 60 equ svx2l,-4 ..  777777 777775 61 equ svx0u,-3 ..  777777 777775 62 equ svx4l,-3 ..  777777 777773 63 equ svx3l,-5 since no one uses frame.dat2, save a reg here  777777 777771 64 equ funarg_pdlptr,-7 holds pdl ptr for a funarg  65 " -6, -5 evalframe goes here  66 " -8, -7 if a funarg is used, its reversal bb is put here 67 " -10, -9 random cruft is put here by map, if not map these don't exist  68  69 "use of index registers 70  71 " x0 calls to recurse,error,... 72 " x1 scan through stack during binding, random data 73 " x2 flag bits escribed above)  74 " x3 number of arguments  75 " x4 offset from top of marked pdl to get to above-mentioned temporaries,  76 "sometimes random data preserved through a recursion. 77 " x5 call evalu by tsx5 78 " x6 random data  79 " x7 unmarked pdl pointer  80  81 "use of base registers  82  83 " ab points to stack header, together with x7 points to unmarked pdl  84 " ap points to marked pdl  85 " bp random pointer 86 " bb temporary  87 " lp untouchable  88 " lb temporary  89 " sp sacred 90 " sb sacred 91  92  93 "  94 " Use of pdls  95  96 " the unmarked pdl contains space for an eval frame (2 words),  97 " a register save area for recursing and random temps (2 words),  98 " 2 words for a funarg binding block, 2 words that only exist for map,  99 " and a binding_block (2 words). The binding block starts out  100 " containing no bindings and grows whenever an atom needs to be 101 " bound. Since the binding block is created and then added to, the 102 " same atom may appear more than once and all routines that can unwind  103 " eval - created binding blocks _m_u_s_t do so from the top down.  104  105 " The eval frame is only created in *rset-t mode, but the space for 106 " it is always allocated since that is easier. The contents of 107 " the eval frame are:  108 " frame.prev_frame thread  109 " frame.stack_ptr -> form being evaled (on marked pdl) 110 " frame.dat1 rel(sp) at time frame was created. Low order 111 " bit is 1 if this frame is due to apply or map, 112 " in which case form is really = fcn, you can cons  113 " on argl if you want.  114 " frame.dat2 no useful information. recurse saves x3 here 115  116 " the marked pdl:  117 " ap|form form being evaled or function being applied 118 " ap|fcn functional property of function being applied/evaluated  119 " ap|argl argument list  120 " ap|qsrac temp., holds property lits amung other things  121  122 " the above 4 are often referenced with the aid of x4, since the binding block  123 " is above them on the marked pdl. x4 contains (almost always) the negative size  124 " of the binding block (and any other cruft that may be there) so that"ap|form,x4" works.  125  126 """ FORMAT OF BINDING BLOCKS  127  128 " Normal Binding Block  129  130 " top_block bot_block -> top & bottom of marked pdl cells  131 " containing atom,value pairs  132 " back_ptr rev_ptr --- points at reversal block which reversed this one. 133 " A  134 " points at previous b.b.  135  136  137 " Reversal Binding Block (set up when a binding-context-pointer is used)  138  139 " PDLP 0 -> lowest b.b. in range, flag for this type  140 " back_ptr rev_ptr same back_ptr, pointer to reversal 141 " block whose range overlaps this one  142 " in such a way as to require re-reversing  143 " part of the range of this one.  144 "  145 " use of "pseudo-binding-blocks"  146  147 " a pseudo binding block is a record that at some later time bindings  148 " are to be made. labels and funargs create pseudo-binding-blocks  149 " because they can't do their binding until after the arguments 150 " have been evaluated, and you can't evaluate the arguments until  151 " the real functional property being applied is found.  152 " a pseudo-binding-block exists on the marked pdl above 153 " the regular binding block. It has the same format, except that  154 " where a binding block would have "saved old value", in the  155 " pseudo binding block a new value is saved. After the args 156 " have been evaluated, the pseudo binding block is converted  157 " into a regular binding block (actually the one just below it  158 " on the pdl is extended, since they are always contiguous) 159 " The old value of the atom is put in the binding block, and the  160 " new-value that was saved in the pseudo binding block is assigned  161 " to the atomic symbol. 162 " expr's and lexpr's use variants of the  163 " pseudo binding block: they can't bind their lambda atoms until  164 " after the args have been evaluated, since one of the args 165 " might be a setq, so they just figure out how much pdl space it  166 " will take to bind their lambda atoms and leave room for  167 " that before evaluating the args.  168  169 "  170  171 include lisp_unmkd_pdl  1-1  1-2 " BEGIN INCLUDE FILE: lisp_unmkd_pdl.incl.alm  1-3 "  1-4 " D.A.Moon 14 July 72  1-5  1-6 "offsets within the frame structure used to put control info on the unmarked pdl  1-7  000000 1-8 equ frame.prev_frame,0 left half rel ptr to previous frame same type  000000 1-9 equ frame.stack_ptr,0 right half rel(stack_ptr) when frame created 000001 1-10 equ frame.dat1,1 left half 000001 1-11 equ frame.dat2,1 right half  000002 1-12 equ frame.ret,2 4-word pl1 label variable, where to return to on event.  1-13  1-14 " END INCLUDE FILE lisp_unmkd_pdl.incl.alm  172 include lisp_iochan  2-1  2-2 """ BEGIN INCLUDE FILE lisp_iochan.incl.alm 2-3  2-4 """ This is the format of the iochan block, which is used to control i/o operations 2-5 """ There is one iochan block for each logical channel. 2-6 """ A logical channel converses with a sequence of blocks,  2-7 """ which are buffers for a stream or segments for a(multi-seg)file.  2-8  000000 2-9 equ iochan.ioindex,0 current character position in buffer or segment  000001 2-10 equ iochan.iolength,1 number of characters in buffer or segment  000002 2-11 equ iochan.ioptr,2 -> buffer or base of segment  000004 2-12 equ iochan.thread,4 threaded list of all open iochans 000006 2-13 equ iochan.fcbp,6 for tssi_  000010 2-14 equ iochan.aclinfop,8 ..  000012 2-15 equ iochan.component,10 0 for stream, comp no for msf  000013 2-16 equ iochan.charpos,11  000014 2-17 equ iochan.linel,12  000015 2-18 equ iochan.flags,13  400000 2-19 bool iochan.seg,400000 1 => msf, 0 => stream  200000 2-20 bool iochan.read,200000 0 => openi, 1 => not  100000 2-21 bool iochan.write,100000 0 => openo, 1 => not 040000 2-22 bool iochan.gc_mark,40000 for the garbage collector  020000 2-23 bool iochan.interactive,20000 1 => input => this is the tty  2-24 " output => flush buff after each operation  010000 2-25 bool iochan.must_reopen,10000 1 => saved iochan, must re-open before use  004000 2-26 bool iochan.nlsync,4000 1 => there is a NL in the buffer. 002000 2-27 bool iochan.charmode,2000 enables "instant" ios_$write 001000 2-28 bool iochan.extra_nl_done,1000 last char output was extra NL for chrct 000400 2-29 bool iochan.fixnum_mode,400 for use with in and out functions  000200 2-30 bool iochan.image_mode,200 just suppress auto-nl  210400 2-31 bool not_ok_to_read,210400 mask for checking input chan  110400 2-32 bool not_ok_to_write,110400 mask for checking output chan  2-33  000016 2-34 equ iochan.function,14 ** gc-able ** eoffn (input) or endpagefn (output) 000020 2-35 equ iochan.namelist,16 ** gc-able ** list of names, car is directory pathname  000022 2-36 equ iochan.name,18 stream name or entry name  000032 2-37 equ iochan.pagel,26  000033 2-38 equ iochan.linenum,27  000034 2-39 equ iochan.pagenum,28  000035 2-40 equ iochan.End,29 size of this structure. 2-41  736777 2-42 bool flag_reset_mask,736777 anded into flags after each char  2-43  2-44 """ END INCLUDE FILE lisp_iochan.incl.alm  173 include lisp_stack_seg 3-1 " BEGIN INCLUDE FILE lisp_stack_seg.incl.alm  3-2  3-3 " lisp stack segment header format  3-4 " Last modified by Reed 6/21/72 3-5 "  000000 3-6 equ marked_stack_bottom,0 offset of ptr to bottom of marked stack  000002 3-7 equ unmkd_stack_bottom,2 offset of ptr to bottom of unmkd_stack  000004 3-8 equ stack_ptr_ptr,4 offset of ptr to lisp_static_vars_$stack_ptr  000006 3-9 equ unmkd_ptr_ptr,6 offset of ptr to lisp_static_vars_$unmkd_ptr's offset word  000010 3-10 equ array_pointer,8 points at cell of array most recently referenced  000012 3-11 equ nil,10 offset of cell containing pointer to nil...  000014 3-12 equ true,12 offset of cell containing pointer to t...  000016 3-13 equ in_pl1_code,14 offset of flag saying whether stack_ptr  3-14 " & unmkd_ptr or ap and ab|.,x7 are valid...if zero, ap,ab arevalid.  3-15 " table of pointers to operators  3-16  000020 3-17 equ bind_op,16 000022 3-18 equ unbind_op,18  000024 3-19 equ errset1_op,20  000026 3-20 equ errset2_op,22  000030 3-21 equ unerrset_op,24 000032 3-22 equ call_op,26 000034 3-23 equ catch1_op,28  000036 3-24 equ catch2_op,30  000040 3-25 equ uncatch_op,32  000042 3-26 equ gensym_data,34 " data for gensym function  3-27  000044 3-28 equ system_lp,36 pointer to common linkage section for bound segment. 000046 3-29 equ iogbind_op,38 operator to help out with compiled iog. 000050 3-30 equ unseen_go_tag_op,40  000052 3-31 equ throw1_op,42  000054 3-32 equ throw2_op,44  000056 3-33 equ signp_op,46  000060 3-34 equ type_fields,48 000062 3-35 equ return_op,50  000064 3-36 equ err_op,52  000066 3-37 equ pl1_interface,54  000070 3-38 equ pl1_lsubr_interface,56 000072 3-39 equ cons_op,58 operator for compiled cons 000074 3-40 equ ncons_op,60 opeator for compiled cons with nil  000076 3-41 equ xcons_op,62 operator for compiled xcons  000100 3-42 equ begin_list_op,64 operator to begin compiled list code 000102 3-43 equ append_list_op,66 operator to get new list cell and hook on end  000104 3-44 equ terminate_list_op,68 operator to finish off list.  000106 3-45 equ compare_op,70  000110 3-46 equ link_opr,72  000112 3-47 equ array_operator,74  000114 3-48 equ dead_array_operator,76 000116 3-49 equ store_operator,78  000120 3-50 equ floating_store_operator,80 000122 3-51 equ array_info_for_store,82  000124 3-52 equ array_offset_for_store,84  000126 3-53 equ array_link_snap_opr,86 000130 3-54 equ create_string_desc_op,88 string desc for PL/I call 000132 3-55 equ create_array_desc_op,90 array desc for PL/I call  000134 3-56 equ pl1_call_op,92 PL/I call operator 000136 3-57 equ cons_string_op,94 operator to cons up a string  000140 3-58 equ create_varying_string_op,96  000142 3-59 equ unwp1_op,98 unwind-protect start  000144 3-60 equ unwp2_op,100 ditto, for compat.  000146 3-61 equ ununwp_op,102 End unwind-protect. 000150 3-62 equ irest_return_op,104 Interrupt restore return  000152 3-63 equ pl1_call_nopop_op,106 PL1 call, dont pop PL1 frame 000154 3-64 equ rcv_char_star_op,108 Receive char * result, pop pl1frame  3-65 " spare 110  000174 3-66 equ begin_unmkd_stack,124 beginning of unmkd_stack 3-67  3-68 " END INCLUDE FILE lisp_stack_seg.incl.alm  3-69  174 include lisp_object_types  4-1  4-2 " BEGIN INCLUDE FILE lisp_object_types.incl.alm 4-3 "  4-4 " D.A.Moon 14 July 72  4-5  4-6 "These are bit masks used to check or set the type bits in lisp pointers  4-7 "they should be used with cana instructions in the dl mode. 4-8 "  4-9 " Modified 1 Oct 1972 by Dan Bricklin to add bignum types.  4-10  4-11  4-12  077700 4-13 bool lisp_ptr.type,077700 "the whole type field  4-14  040000 4-15 bool Fixed,040000 "fixed number, stored in second word of ptr 020000 4-16 bool Float,020000 "floating number, stored in second word of ptr  061400 4-17 bool Numeric,061400 "fixed or float, big or little  010000 4-18 bool Atsym,010000 "Atomic symbol pointed at by ptr  077700 4-19 bool Atomic,077700 "any of these bits indicates an atom (non-list)  001000 4-20 bool Bignum,001000 "points to a bignum - fixed  060000 4-21 bool Uncollectable,060000 "not a pointer, also both bits on = "pdl_ptr"  004000 4-22 bool String,004000 "points at a lisp character string 002000 4-23 bool Subr,002000 "points at subr link 000400 4-24 bool System_Subr,000400 "marks a subr as being in the text of lisp bound seg. 000200 4-25 bool Array,000200 "points at an array,  4-26 " which is a special kind of subr  067500 4-27 bool Unevalable,067500 "any of these bits means  4-28 " does not have car and cdr  001000 4-29 bool Big_fixed,001000 "points to fixed bignum 000100 4-30 bool File,000100 "points to a file object (i.e. an iochan)  4-31  4-32 "fields for making numbers, a fault tag is included in case someone takes the car or cdr of it  4-33  040047 4-34 bool fixnum_type,040047  020047 4-35 bool flonum_type,020047  4-36  4-37 " END INCLUDE FILE: lisp_object_types.incl.alm  175 include lisp_name_codes  5-1  5-2 " BEGIN INCLUDE FILE lisp_name_codes.incl.alm  5-3  5-4 " These are codes for the names of functions which are stored into ab|-1,x7 before  5-5 " calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 5-6 " are used so that the name of the function which is rejecting its argument 5-7 " can be printed. Please note that all these codes are negative.  5-8  777777 777766 5-9 equ fn_do,-10  777777 777765 5-10 equ fn_arg,-11 777777 777764 5-11 equ fn_setarg,-12  777777 777763 5-12 equ fn_status,-13  777777 777762 5-13 equ fn_sstatus,-14 777777 777761 5-14 equ fn_errprint,-15  777777 777760 5-15 equ fn_errframe,-16  777777 777757 5-16 equ fn_evalframe,-17  777777 777756 5-17 equ fn_defaultf,-18  777777 777752 5-18 equ fn_tyo,-22 777777 777751 5-19 equ fn_ascii,-23  777777 777750 5-20 equ fn_rplaca,-24  777777 777747 5-21 equ fn_definedp,-25  777777 777746 5-22 equ fn_setq,-26  777777 777745 5-23 equ fn_set,-27 777777 777744 5-24 equ fn_delete,-28  777777 777743 5-25 equ fn_delq,-29  777777 777742 5-26 equ fn_stringlength,-30  777777 777741 5-27 equ fn_catenate,-31  777777 777740 5-28 equ fn_array,-32  777777 777737 5-29 equ fn_substr,-33  777777 777736 5-30 equ fn_index,-34  777777 777735 5-31 equ fn_get_pname,-35  777777 777734 5-32 equ fn_make_atom,-36  777777 777733 5-33 equ fn_ItoC,-37  777777 777732 5-34 equ fn_CtoI,-38  777777 777731 5-35 equ fn_defsubr,-39 777777 777730 5-36 equ fn_star_array,-40  777777 777727 5-37 equ fn_args,-41  777777 777726 5-38 equ fn_sysp,-42  777777 777725 5-39 equ fn_get,-43 777777 777724 5-40 equ fn_getl,-44  777777 777723 5-41 equ fn_putprop,-45 777777 777722 5-42 equ fn_remprop,-46 777777 777721 5-43 equ fn_save,-47  777777 777720 5-44 equ fn_add1,-48  777777 777717 5-45 equ fn_sub1,-49  777777 777716 5-46 equ fn_greaterp,-50  777777 777715 5-47 equ fn_lessp,-51  777777 777714 5-48 equ fn_minus,-52  777777 777713 5-49 equ fn_plus,-53  777777 777712 5-50 equ fn_times,-54  777777 777711 5-51 equ fn_difference,-55  777777 777710 5-52 equ fn_quotient,-56  777777 777707 5-53 equ fn_abs,-57 777777 777706 5-54 equ fn_expt,-58  777777 777705 5-55 equ fn_boole,-59  777777 777704 5-56 equ fn_rot,-60 777777 777703 5-57 equ fn_lsh,-61 777777 777702 5-58 equ fn_signp,-62  777777 777701 5-59 equ fn_fix,-63 777777 777700 5-60 equ fn_float,-64  777777 777677 5-61 equ fn_remainder,-65  777777 777676 5-62 equ fn_max,-66 777777 777675 5-63 equ fn_min,-67 777777 777674 5-64 equ fn_add1_fix,-68  777777 777673 5-65 equ fn_add1_flo,-69  777777 777672 5-66 equ fn_sub1_fix,-70  777777 777671 5-67 equ fn_sub1_flo,-71  777777 777670 5-68 equ fn_plus_fix,-72  777777 777667 5-69 equ fn_plus_flo,-73  777777 777666 5-70 equ fn_times_fix,-74  777777 777665 5-71 equ fn_times_flo,-75  777777 777664 5-72 equ fn_diff_fix,-76  777777 777663 5-73 equ fn_diff_flo,-77  777777 777662 5-74 equ fn_quot_fix,-78  777777 777661 5-75 equ fn_quot_flo,-79  777777 777660 5-76 equ fn_eval,-80  777777 777657 5-77 equ fn_apply,-81  777777 777656 5-78 equ fn_prog,-82  777777 777655 5-79 equ fn_errset,-83  777777 777654 5-80 equ fn_catch,-84  777777 777653 5-81 equ fn_throw,-85  777777 777652 5-82 equ fn_store,-86  777777 777651 5-83 equ fn_defun,-87  777777 777650 5-84 equ fn_baktrace,-88  777777 777647 5-85 equ fn_bltarray,-89  777777 777646 5-86 equ fn_star_rearray,-90  777777 777645 5-87 equ fn_gensym,-91  777777 777644 5-88 equ fn_makunbound,-92  777777 777643 5-89 equ fn_boundp,-93  777777 777642 5-90 equ fn_star_status,-94 777777 777641 5-91 equ fn_star_sstatus,-95  777777 777640 5-92 equ fn_freturn,-96 777777 777637 5-93 equ fn_cos,-97 777777 777636 5-94 equ fn_sin,-98 777777 777635 5-95 equ fn_exp,-99 777777 777634 5-96 equ fn_log,-100  777777 777633 5-97 equ fn_sqrt,-101  777777 777632 5-98 equ fn_isqrt,-102  777777 777631 5-99 equ fn_atan,-103  777777 777630 5-100 equ fn_sleep,-104  777777 777627 5-101 equ fn_oddp,-105  777777 777626 5-102 equ fn_tyipeek,-106  777777 777625 5-103 equ fn_alarmclock,-107 777777 777624 5-104 equ fn_plusp,-108  777777 777623 5-105 equ fn_minusp,-109 777777 777622 5-106 equ fn_ls,-110 777777 777621 5-107 equ fn_eql,-111  777777 777620 5-108 equ fn_gt,-112 777777 777617 5-109 equ fn_alphalessp,-113 777777 777616 5-110 equ fn_samepnamep,-114 777777 777615 5-111 equ fn_getchar,-115  777777 777614 5-112 equ fn_opena,-116  777777 777613 5-113 equ fn_sxhash,-117 777777 777612 5-114 equ fn_gcd,-118  777777 777611 5-115 equ fn_allfiles,-119  777777 777610 5-116 equ fn_chrct,-120  777777 777607 5-117 equ fn_close,-121  777777 777606 5-118 equ fn_deletef,-122  777777 777605 5-119 equ fn_eoffn,-123  777777 777604 5-120 equ fn_filepos,-124  777777 777603 5-121 equ fn_inpush,-125 777777 777602 5-122 equ fn_linel,-126  777777 777601 5-123 equ fn_mergef,-127 777777 777600 5-124 equ fn_namelist,-128  777777 777577 5-125 equ fn_names,-129  777777 777576 5-126 equ fn_namestring,-130 777777 777575 5-127 equ fn_openi,-131  777777 777574 5-128 equ fn_openo,-132  777777 777573 5-129 equ fn_prin1,-133  777777 777572 5-130 equ fn_princ,-134  777777 777571 5-131 equ fn_print,-135  777777 777570 5-132 equ fn_read,-136  777777 777567 5-133 equ fn_readch,-137 777777 777566 5-134 equ fn_readstring,-138 777777 777565 5-135 equ fn_rename,-139 777777 777564 5-136 equ fn_shortnamestring,-140  777777 777563 5-137 equ fn_tyi,-141  777777 777562 5-138 equ fn_setsyntax,-142  777777 777561 5-139 equ fn_cursorpos,-143  777777 777560 5-140 equ fn_force_output,-144  777777 777557 5-141 equ fn_clear_input,-145  777777 777556 5-142 equ fn_random,-146 777777 777555 5-143 equ fn_haulong,-147  777777 777554 5-144 equ fn_haipart,-148  777777 777553 5-145 equ fn_cline,-149  777777 777552 5-146 equ fn_fillarray,-150  777777 777551 5-147 equ fn_listarray,-151  777777 777550 5-148 equ fn_sort,-152  777777 777547 5-149 equ fn_sortcar,-153  777777 777546 5-150 equ fn_zerop,-154  777777 777545 5-151 equ fn_listify,-155  777777 777544 5-152 equ fn_charpos,-156  777777 777543 5-153 equ fn_pagel,-157  777777 777542 5-154 equ fn_linenum,-158  777777 777541 5-155 equ fn_pagenum,-159  777777 777540 5-156 equ fn_endpagefn,-160  777777 777537 5-157 equ fn_arraydims,-161  777777 777536 5-158 equ fn_loadarrays,-162 777777 777535 5-159 equ fn_dumparrays,-163 777777 777534 5-160 equ fn_expt_fix,-164  777777 777533 5-161 equ fn_expt_flo,-165  777777 777532 5-162 equ fn_nointerrupt,-166  777777 777531 5-163 equ fn_open,-167  777777 777530 5-164 equ fn_in,-168 777777 777527 5-165 equ fn_out,-169  777777 777526 5-166 equ fn_truename,-170  777777 777525 5-167 equ fn_ifix,-171  777777 777524 5-168 equ fn_fsc,-172  777777 777523 5-169 equ fn_progv,-173  777777 777522 5-170 equ fn_mapatoms,-174  777777 777521 5-171 equ fn_unwind_protect,-175 777777 777520 5-172 equ fn_eval_when,-176  777777 777517 5-173 equ fn_read_from_string,-177  777777 777516 5-174 equ fn_displace,-178  777777 777515 5-175 equ fn_nth,-179  777777 777514 5-176 equ fn_nthcdr,-180 777777 777513 5-177 equ fn_includef,-181  5-178  5-179 " END INCLUDE FILE lisp_name_codes.incl.alm 176 "  177 " entry point for calling eval by pl1 subrs 178  000000 179 entry eval 000000 aa 000010 7000 04 180 eval: tsx0 pl1_entry-*,ic  000001 aa 000441 7050 04 181 tsx5 evalu-*,ic enter common code 000002 182 pl1_return: 000002 aa 0 77770 7571 00 183 staq ap|form  000003 aa 0 77772 3501 00 184 eppap ap|form+2  000004 4a 4 00012 2501 20 185 pl1_exit: spriap lisp_static_vars_$stack_ptr  000005 4a 4 00014 7471 20 186 stx7 lisp_static_vars_$unmkd_ptr+1 000006 aa 1 00016 5541 00 187 stc1 ab|in_pl1_code  000007 aa 7 00044 7101 20 188 short_return  189  190 " routine to set up ap, ab, x7 on entry from pl1 code  191  000010 192 pl1_entry:  000010 4a 4 00016 3511 20 193 epbpab lisp_static_vars_$unmkd_ptr,*  000011 4a 4 00020 3501 20 194 eppap lisp_static_vars_$stack_ptr,*  000012 4a 4 00014 2271 20 195 ldx7 lisp_static_vars_$unmkd_ptr+1 000013 aa 1 00016 4501 00 196 stz ab|in_pl1_code 000014 aa 000000 7100 10 197 tra 0,0  198  199  200 " entry point for the lisp lsubr "eval" Fast call but with lp  201  000015 202 segdef eval_ & no prologue  203  000015 aa 777776 1050 03 204 eval_: cmpx5 -2,du 1 argument? 000016 aa 000163 6010 04 205 tnz eval_with_2_args-*,ic no, go do a-list hack.  000017 aa 000423 7050 04 206 tsx5 evalu-*,ic yes, so enter common code. 000020 207 lisp_retn: " deliver us from eval.  000020 aa 0 77770 3501 00 208 eppap ap|form  000021 209 lisp_rtn_1: 000021 aa 1 77776 3521 37 210 eppbp ab|-2,x7*  000022 aa 1 77774 3701 37 211 epplp ab|-4,x7*  000023 aa 777774 6270 17 212 eax7 -4,x7 (popj)  000024 aa 2 00000 7101 00 213 tra bp|0  214  215  216 " Routine called by lisp_prog_fns_ to unwind a reversal bb  217  000025 218 segdef unwind_reversal 219  000025 220 unwind_reversal:  000025 aa 777763 7000 04 221 tsx0 pl1_entry-*,ic  000026 4a 4 00022 3715 20 222 epplb lisp_static_vars_$binding_top,* -> bb to unwind  000027 aa 000356 7030 04 223 tsx3 unwind_reversal_bb-*,ic  000030 aa 777754 7100 04 224 tra pl1_exit-*,ic  225 "  226 " internal entry point for recursive calls to eval (by tsx0)  227 " on entry object to be evaluated is at ap|-2  228 " if the object is not a list, its value is immediately found.  229 " if it is a list, registers are saved on the unmkd pdl  230 " and evalu is called.  231 " on return, x4,x2,x5,x3 are undisturbed,  232 " aq = ap|-2 = evaluated object, and ap and x7 are unchanged.  233  000031 aa 000000 7100 10 234 tra 0,0 exit used by evalhook  235  000032 4a 4 00024 7161 20 236 recurse: xec lisp_static_vars_$evalhook_status  000033 aa 0 77776 2371 00 237 ldaq ap|-2 check for easy cases and do them quickly  000034 aa 067500 3150 07 238 cana Unevalable,dl 000035 aa 000000 6010 10 239 tnz 0,0  000036 aa 1 00012 1171 00 240 cmpaq ab|nil  000037 aa 000000 6000 10 241 tze 0,0  000040 aa 010000 3150 07 242 cana Atsym,dl  000041 aa 000041 6000 04 243 tze full_recurse-*,ic list -- hard case -- have to really recurse 000042 aa 0 77776 2371 20 244 ldaq ap|-2,* atomic symbol -- get its value  000043 aa 000003 6000 04 245 tze 3,ic undefined?  000044 aa 0 77776 7571 00 246 staq ap|-2 no, return it.  000045 aa 000000 7100 10 247 tra 0,0  248  000046 249 undefined_atom_error:  250 " undefined atomic symbol -- error 251  252 " atomic symbol which was undef is at ap|-2  253 " returns by tra 0,0 with new value in aq and ap|-2  254 " if necessary, pushes an evalframe  255  000046 4a 4 00026 2371 20 256 ldaq lisp_static_vars_$star_rset,* 000047 aa 1 00012 1171 00 257 cmpaq ab|nil  000050 aa 000003 6010 04 258 tnz undefined_atom_error_hard-*,ic 259  000051 4a 4 00030 2351 20 260 lda lisp_error_table_$undefined_atom  000052 aa 000075 7100 04 261 tra error-*,ic error must return value in aq and ap|-2  262  000053 263 undefined_atom_error_hard: " push evalframe 264  000053 aa 000010 6270 17 265 eax7 8,x7  000054 aa 0 00002 3501 00 266 eppap ap|2 copy atom to avoid destroying evalframe during error proc  000055 aa 0 77774 2371 00 267 ldaq ap|-4 000056 aa 0 77776 7571 00 268 staq ap|-2 000057 aa 0 77774 6261 00 269 eax6 ap|-4 000060 aa 1 77772 4461 17 270 sxl6 ab|frame.stack_ptr-6,x7  000061 aa 6 00000 6261 00 271 eax6 sp|0  000062 aa 1 77773 7461 17 272 stx6 ab|frame.dat1-6,x7  000063 4a 4 00032 2261 20 273 ldx6 lisp_static_vars_$eval_frame+1  000064 aa 1 77772 7461 17 274 stx6 ab|frame.prev_frame-6,x7  000065 aa 1 77772 6261 17 275 eax6 ab|-6,x7  000066 4a 4 00032 7461 20 276 stx6 lisp_static_vars_$eval_frame+1  277  000067 aa 1 77774 7401 17 278 stx0 ab|frame.ret-6,x7 save return address  000070 4a 4 00030 2351 20 279 lda lisp_error_table_$undefined_atom  000071 aa 000056 7000 04 280 tsx0 error-*,ic go signal the error  281  282 " now pop this evalframe  283  000072 aa 1 77772 2261 17 284 ldx6 ab|frame.prev_frame-6,x7  000073 4a 4 00032 7461 20 285 stx6 lisp_static_vars_$eval_frame+1  000074 aa 1 77774 2201 17 286 ldx0 ab|frame.ret-6,x7 return addr saved 000075 aa 777770 6270 17 287 eax7 -8,x7 000076 aa 0 77776 2371 00 288 ldaq ap|-2 000077 aa 0 77776 3501 00 289 eppap ap|-2 undo push above  000100 aa 0 77776 7571 00 290 staq ap|-2 some callers want it in stack  000101 aa 000000 7100 10 291 tra 0,0  292  000102 293 full_recurse:  000102 aa 1 77774 7451 17 294 stx5 ab|svx5u,x7  000103 aa 1 77774 4421 17 295 sxl2 ab|svx2l,x7  000104 aa 1 77775 4441 17 296 sxl4 ab|svx4l,x7  000105 aa 1 77775 7401 17 297 stx0 ab|svx0u,x7  000106 aa 1 77773 4431 17 298 sxl3 ab|svx3l,x7  000107 aa 0 00006 3501 00 299 eppap ap|6 get new work area on marked pdl  000110 aa 000351 7050 04 300 tsx5 eval_fcn-*,ic 000111 aa 1 77775 7241 17 301 lxl4 ab|svx4l,x7  000112 aa 1 77775 2201 17 302 ldx0 ab|svx0u,x7  000113 aa 1 77774 7221 17 303 lxl2 ab|svx2l,x7  000114 aa 1 77774 2251 17 304 ldx5 ab|svx5u,x7  000115 aa 1 77773 7231 17 305 lxl3 ab|svx3l,x7  000116 aa 0 77770 7571 00 306 staq ap|form return result in both aq and stack  000117 aa 0 77772 3501 00 307 eppap ap|form+2 restore caller's ap  000120 aa 000000 7100 10 308 tra 0,0 return to caller of recurse  309  310  311 " symeval SUBR 1 arg - evaluate a symbol. used for compiled efficiency 312  000121 313 segdef symeval 314  000121 aa 0 77776 2371 00 315 symeval: ldaq ap|-2 fetch argument 000122 aa 010000 3150 07 316 cana Atsym,dl is it an atomic symbol? 000123 aa 000005 6000 04 317 tze symeval_loss-*,ic no, error (if compiled, would be bug)  000124 aa 0 77776 2371 20 318 ldaq ap|-2,* yes, get its value  000125 aa 000003 6000 04 319 tze symeval_loss-*,ic and err if unbound  000126 320 symeval_ret:  000126 aa 0 77776 3501 00 321 eppap ap|-2 pop argument  000127 aa 777672 7100 04 322 tra lisp_rtn_1-*,ic and return 323  000130 324 symeval_loss:  000130 aa 777716 7000 04 325 tsx0 undefined_atom_error-*,ic 000131 aa 777775 7100 04 326 tra symeval_ret-*,ic  327 "  328 "pl1 - callable apply function  329  000132 330 entry apply  000132 aa 777656 7000 04 331 apply: tsx0 pl1_entry-*,ic  000133 aa 000005 7050 04 332 tsx5 apply_com-*,ic  333  000134 aa 777646 7100 04 334 tra pl1_return-*,ic  335  336  337 "lisp - callable apply lsubr  338  000135 339 segdef apply_  340  000135 aa 777774 1050 03 341 apply_: cmpx5 -4,du 2 args?  000136 aa 000056 6010 04 342 tnz apply_with_3_args-*,ic 000137 aa 777661 6250 04 343 eax5 lisp_retn-*,ic  344  345 " set up the pdl with form, fcn, argl as when evaling a fcn.  346 " set applybit to indicate that ap|form = fcn instead of full form  347 " go to common code with eval  348  000140 349 apply_com:  000140 aa 000042 6220 00 350 eax2 noteval+applybit  000141 aa 0 77776 2371 00 351 ldaq ap|-2 000142 aa 0 00004 3501 00 352 eppap ap|4 000143 aa 0 77774 7571 00 353 staq ap|argl  000144 aa 0 77770 2371 00 354 ldaq ap|form  000145 aa 0 77772 7571 00 355 staq ap|fcn  000146 aa 000321 7100 04 356 tra evaler-*,ic return addr is in x5 357  358  359  360 "  361 " interface to lisp_error_  362  363 " called by tsx0, preserves x0,x5,x2,x4 364 " error code must be in the a.  365  000147 aa 000002 6270 17 366 error: eax7 2,x7 going to push error code onto unmkd pdl  000150 aa 1 77776 7571 17 367 staq ab|-2,x7 errcode(1) from a, errcode(2) from q.  000151 aa 000002 7060 04 368 tsx6 call_ext_out-*,ic -- now call lisp_error_, which 000152 4a 4 00034 3521 20 369 eppbp lisp_error_$lisp_error_ will clear the unmkd pdl for us  370  371 " come here to call out to a pl1 program.  372 " x6 -> an eppbp instruction to get address of entry being called  373 " x0 = return address  374 " x1,x2,x3,x4,x5 are saved (by the call macro)  375 "  376 " on return aq is loaded with value on top of marked pdl  377 " on entry, a is zeroed unless from error, where it is pushed onto unmkd pdl  378 "  379 " this code just saves things, updates the pl1 copies of  380 " the two stack pointers, and builds a stack frame from which to call out  381 "  382 " ***** this piece of code relies on the knowledge that the save macro does 383 " ***** not change any index registers except x7  384  000153 385 call_ext_out:  000153 4a 4 00012 2501 20 386 spriap lisp_static_vars_$stack_ptr 000154 4a 4 00014 7471 20 387 stx7 lisp_static_vars_$unmkd_ptr+1 000155 aa 1 00016 5541 00 388 stc1 ab|in_pl1_code  000156 aa 000100 6270 00 389 push " ** this is where x6 must not change  000157 aa 7 00040 2721 20 000160 aa 000000 7160 16 390 xec 0,x6 an eppbp instruction.  391 " *** here we rely on the new call macro doing an sreg and an lreg to save x0,x2,x4,x5  000161 aa 6 00000 2541 00 392 call bp|0(=v18/0,18/4,18/0,18/0) no args arg list 000162 0a 003636 3500 00 000163 aa 2 00000 3521 00 000164 aa 6 00040 7531 00 000165 aa 7 00036 6701 20 000166 aa 6 00000 1731 00 000167 aa 6 00040 0731 00 000170 aa 6 00020 6351 20 393 eaa sp|16,* pop stack frame  000171 aa 7 00024 6521 00 394 sprisp sb|stack_header.stack_end_ptr  000172 aa 7 00000 3721 01 395 eppsp sb|0,au  396  000173 4a 4 00020 3501 20 397 eppap lisp_static_vars_$stack_ptr,*  000174 4a 4 00016 3511 20 398 epbpab lisp_static_vars_$unmkd_ptr,*  000175 4a 4 00014 2271 20 399 ldx7 lisp_static_vars_$unmkd_ptr+1 000176 aa 1 00016 4501 00 400 stz ab|in_pl1_code 000177 aa 0 77776 2371 00 401 ldaq ap|-2 needed when unbnd-vrbl in recurse.  000200 aa 000000 7100 10 402 tra 0,0  403  404 "  405  406 " eval with an a-list 2nd argument (actually a pdl pointer) 407  000201 408 eval_with_2_args:  000201 aa 000002 6270 17 409 eax7 2,x7  000202 aa 000025 7030 04 410 tsx3 fetch_binding_context_ptr-*,ic sets x4 to bcp to a bb 000203 aa 1 77776 3715 17 411 epplb ab|-2,x7 set up ptr to bb 000204 aa 000135 7030 04 412 tsx3 reverse_binding_context-*,ic reverse context to there  000205 aa 000235 7050 04 413 tsx5 evalu-*,ic now eval 1st arg in that context 000206 aa 0 77770 7571 00 414 staq ap|form save result  000207 aa 1 77776 3715 17 415 epplb ab|-2,x7 set up ptr to bb 000210 aa 000175 7030 04 416 tsx3 unwind_reversal_bb-*,ic restore to calling context  000211 aa 777776 6270 17 417 eax7 -2,x7 restore unmarked pdl 000212 aa 0 77770 2371 00 418 ldaq ap|form put result in AQ  000213 aa 777605 7100 04 419 tra lisp_retn-*,ic and return from type 1 subr  420  421  422 " hack for apply with 3rd arg a pseudo-a-list (pdl ptr) 423 " have to neutralize all the binding blocks between the top of  424 " the pdl and the pdl ptr.  425  000214 426 apply_with_3_args:  000214 aa 000002 6270 17 427 eax7 2,x7  000215 428 apply_tsx3: 000215 aa 000012 7030 04 429 tsx3 fetch_binding_context_ptr-*,ic  000216 aa 1 77776 3715 17 430 epplb ab|-2,x7 000217 aa 000122 7030 04 431 tsx3 reverse_binding_context-*,ic  000220 aa 777720 7050 04 432 tsx5 apply_com-*,ic now do the apply  000221 aa 0 77770 7571 00 433 staq ap|form  000222 aa 1 77776 3715 17 434 epplb ab|-2,x7 000223 aa 000162 7030 04 435 tsx3 unwind_reversal_bb-*,ic  000224 aa 0 77770 2371 00 436 ldaq ap|form  000225 aa 777776 6270 17 437 eax7 -2,x7 000226 aa 777572 7100 04 438 tra lisp_retn-*,ic 439  440 " Routine to accept a lisp a-list-ptr (or binding-context-ptr), and 441 " convert it into a pointer to the lowest binding block on the unmarked 442 " pdl which is affected. the input is in ap|-2 and is popped.  443 " the output is in x4.  444 " called by tsx3  445 " the pointer input to this routine has -2 in its left half and 446 " a pointer to the unmarked pdl in its right half. NOTE that this  447 " is a change from the previous version in which it pointed at the marked pdl.  448 " The pointer to the unmarked pdl need not point exactly at a bb.  449 " ab|-2,x7 and ab|-1,x7 are used for temporary storage. 450  000227 451 fetch_binding_context_ptr:  000227 aa 0 77776 2371 00 452 ldaq ap|-2 000230 aa 1 00012 1171 00 453 cmpaq ab|nil nil means zero level context  000231 aa 000027 6000 04 454 tze fetch_bcp_nil-*,ic which has to be special cased  455  000232 aa 040000 3150 07 456 cana Fixed,dl make sure it is a fixnum  000233 aa 000014 6000 04 457 tze fetch_bcp_error-*,ic  000234 aa 000000 6210 02 458 eax1 0,qu make sure left half is -2  000235 aa 777776 1010 03 459 cmpx1 -2,du  000236 aa 000011 6010 04 460 tnz fetch_bcp_error-*,ic  000237 aa 000000 6240 06 461 eax4 0,ql make a few other useless checks  000240 aa 1 77776 7471 17 462 stx7 ab|-2,x7  000241 aa 1 77776 1041 17 463 cmpx4 ab|-2,x7 000242 aa 000005 6030 04 464 trc fetch_bcp_error-*,ic too high  000243 aa 1 00001 1041 00 465 cmpx4 ab|marked_stack_bottom+1 000244 aa 000003 6020 04 466 tnc fetch_bcp_error-*,ic too low  467  000245 468 fetch_bcp_ret:  000245 aa 0 77776 3501 00 469 eppap ap|-2 pop argument 000246 aa 000000 7100 13 470 tra 0,x3 and return  471  000247 472 fetch_bcp_error:  000247 aa 000120 3360 07 473 lcq -fn_eval,dl assume called by eval 000250 0a 000216 1030 03 474 cmpx3 apply_tsx3+1,du  000251 aa 000002 6010 04 475 tnz 2,ic  000252 aa 000121 3360 07 476 lcq -fn_apply,dl no, called by apply  477  000253 4a 4 00036 2351 20 478 lda lisp_error_table_$not_pdl_ptr  000254 aa 1 77776 7431 17 479 stx3 ab|-2,x7  000255 aa 777672 7000 04 480 tsx0 error-*,ic call error routine  000256 aa 1 77776 2231 17 481 ldx3 ab|-2,x7 which returns with new data in ap|-2  000257 aa 777750 7100 04 482 tra fetch_binding_context_ptr-*,ic so retry  483  000260 484 fetch_bcp_nil:  000260 aa 1 00003 2241 00 485 ldx4 ab|unmkd_stack_bottom+1  000261 aa 777764 7100 04 486 tra fetch_bcp_ret-*,ic 487 "  488 " reverse one binding block 489 " x6 -> block to be reversed  490 " x5 what to set its rev_ptr to  491 " x0 calling reg  492 " lp -> lisp static  493 " aq, x1, all pointers are clobbered except lb  494  000262 4a 4 00040 5541 20 495 reversal: stc1 lisp_static_vars_$binding_reversal_flag lock interrupts  000263 aa 0 00000 3531 00 496 epbpbb ap|0 -> marked pdl 000264 aa 0 00002 3501 00 497 eppap ap|2 get temp on stack  000265 aa 1 00000 7211 16 498 lxl1 ab|0,x6 pick up binding_block.bot_block  000266 499 reverse_1_binding:  000266 aa 1 00000 1011 16 500 cmpx1 ab|0,x6 reached top of block?  000267 aa 000011 6000 04 501 tze reverse_1_binding_aa-*,ic yes, stop  000270 aa 3 00000 2371 11 502 ldaq bb|0,x1 pick up saved value  000271 aa 0 77776 7571 00 503 staq ap|-2 save it for a moment  000272 aa 3 00002 2371 31 504 ldaq bb|2,x1* pick up current value of symbol bound  000273 aa 3 00000 7571 11 505 staq bb|0,x1 set as saved value  000274 aa 0 77776 2371 00 506 ldaq ap|-2 and set saved value as current value  000275 aa 3 00002 7571 31 507 staq bb|2,x1* ..  000276 aa 000004 6210 11 508 eax1 4,x1 proceed to the next binding in this block  000277 aa 777767 7100 04 509 tra reverse_1_binding-*,ic 510  000300 511 reverse_1_binding_aa:  000300 aa 1 00001 4451 16 512 sxl5 ab|1,x6 yes, set this block's rev_ptr  000301 aa 0 77776 3501 00 513 eppap ap|-2 police area  000302 4a 4 00040 0341 20 514 ldac lisp_static_vars_$binding_reversal_flag test & clear intr lock  000303 aa 000007 3750 07 515 ana =o7,dl mask to just interrupt bits  000304 aa 000000 6000 10 516 tze 0,x0 none set, return 517  518 " interrupt happened and was deferred - signal it now.  519 " the following code is copied from lisp_alloc_ 520  000305 aa 000002 6270 17 521 eax7 2,x7 store interrupt bits  000306 aa 1 77776 7551 17 522 sta ab|-2,x7  000307 4a 4 00012 2501 20 523 spriap lisp_static_vars_$stack_ptr save environment  000310 4a 4 00014 7471 20 524 stx7 lisp_static_vars_$unmkd_ptr+1 000311 aa 1 00016 5541 00 525 stc1 ab|in_pl1_code  526 tempd arglist(4)  000312 aa 000100 6270 00 527 push  000313 aa 7 00040 2721 20 000314 4a 4 00016 3521 20 528 eppbp lisp_static_vars_$unmkd_ptr,* get address of intr code  000315 aa 2 77776 3521 00 529 eppbp bp|-2  000316 aa 6 00052 2521 00 530 spribp arglist+2  000317 aa 002663 2370 04 531 ldaq arg_list_1_hdr-*,ic  000320 aa 6 00050 7571 00 532 staq arglist  000321 aa 6 00000 2541 00 533 call lisp_default_handler_$alloc_fault(arglist) saves all xr's, lb 000322 aa 6 00050 3501 00 000323 4a 4 00010 3521 20 000324 aa 6 00040 7531 00 000325 aa 7 00036 6701 20 000326 aa 6 00000 1731 00 000327 aa 6 00040 0731 00 000330 aa 6 00020 6351 20 534 eaa sp|16,* now pop back to lisp 000331 aa 7 00024 6521 00 535 sprisp sb|20  000332 aa 7 00000 3721 01 536 eppsp sb|0,au  000333 4a 4 00016 3511 20 537 epbpab lisp_static_vars_$unmkd_ptr,*  000334 4a 4 00020 3501 20 538 eppap lisp_static_vars_$stack_ptr,*  000335 4a 4 00014 2271 20 539 ldx7 lisp_static_vars_$unmkd_ptr+1 000336 aa 1 00016 4501 00 540 stz ab|in_pl1_code 000337 aa 777776 6270 17 541 eax7 -2,x7 flush arg loc pushed earlier  000340 aa 000000 7100 10 542 tra 0,x0 now return from reversal  543  544 " Procedure to reverse binding context down to a specified binding context pointer  545 " x4 -> the bb which is last to reverse down to  546 " x3 call reg  547 " lp -> lisp static  548 " lb -> 2 words on unmkd pdl to put the bb in  549 " uses  550 " x6 -> current binding block  551 " x5 -> newly-constructed reversal bb, (used to set rev_ptr's) 552 " x1 temp  553 " aq, bb, bp clobbered  554 " x2 is guaranteed untouched  555 " NOTE: the 2 words on unmkd pdl for the bb constructed are assumed already pushed 556  000341 557 reverse_binding_context:  000341 aa 5 00000 6251 00 558 eax5 lb|0 -> reversal bb to construct  000342 aa 000000 6260 15 559 eax6 0,x5 init scan ptr  000343 aa 5 00000 4501 00 560 stz lb|0 set reversal-bb flag in dl  561 " stx4 lb|0 set PDLP in du  000344 4a 4 00042 2361 20 562 ldq lisp_static_vars_$binding_top+1 set thread, clearing rev_ptr  000345 aa 5 00001 7561 00 563 stq lb|1  000346 4a 4 00042 7451 20 564 stx5 lisp_static_vars_$binding_top+1 thread into bindings list  565  000347 566 rbc00: " trace thread of binding blocks until the pdl ptr is reached... 567  000347 aa 1 00001 1041 16 568 cmpx4 ab|1,x6 gone down far enough?  000350 aa 000033 6054 04 569 tpnz rbc_ret-*,ic yes, return (RELIES ON STACK = 64K) 000351 aa 1 00001 2261 16 570 ldx6 ab|1,x6 no - chase thread to a block  000352 aa 1 00000 7211 16 571 lxl1 ab|0,x6 check type of block 000353 aa 000003 6000 04 572 tze rbc01-*,ic tra if a reversal block  000354 aa 777706 7000 04 573 tsx0 reversal-*,ic normal block - reverse it and set rev_ptr  000355 aa 777772 7100 04 574 tra rbc00-*,ic and continue scanning pdl  575  000356 aa 1 00000 1041 16 576 rbc01: cmpx4 ab|0,x6 reversal block - compare its PDLP to ours  000357 aa 000003 6054 04 577 tpnz rbc02-*,ic *** KLUDGE *** relies on lisp stacks limited to 64K  578 "its range is contained in ours. skip over it since it has already 579 "done the reversals that we want  000360 aa 1 00000 2261 16 580 ldx6 ab|0,x6 skip down to its PDLP  000361 aa 777766 7100 04 581 tra rbc00-*,ic and look at next block below that  582  000362 583 rbc02: "its range exceeds ours - take the part of its range we want, and  584 "reverse the rest, because it did the opposite of what we want.  585 "this is referred to as the "extended range."  586  000362 aa 1 00001 4451 16 587 sxl5 ab|1,x6 set rev_ptr to us to mark end of range  000363 aa 000000 6210 14 588 eax1 0,x4  000364 aa 1 00000 2241 16 589 ldx4 ab|0,x6 set scan limit to its PDLP  000365 aa 1 00001 1011 16 590 rbc03a: cmpx1 ab|1,x6 set scan position to our PDLP, also 000366 aa 000003 6054 04 591 tpnz rbc03b-*,ic setting our PDLP to really point at a bb 000367 aa 1 00001 2261 16 592 ldx6 ab|1,x6  000370 aa 777775 7100 04 593 tra rbc03a-*,ic  594  000371 aa 5 00000 7461 00 595 rbc03b: stx6 lb|0 set our pdlp  000372 aa 1 00001 2261 16 596 rbc03: ldx6 ab|1,x6 and go down one more block  000373 aa 000000 6000 13 597 tze 0,x3 return if no more  000374 aa 1 00000 7211 16 598 lxl1 ab|0,x6 what type BB is this?  000375 aa 000003 6000 04 599 tze rbc04-*,ic reversal - skip it 000376 aa 1 00001 7251 16 600 lxl5 ab|1,x6 normal - reverse it but 000377 aa 777663 7000 04 601 tsx0 reversal-*,ic don't change its rev_ptr  000400 aa 1 00001 1041 16 602 rbc04: cmpx4 ab|1,x6 done?  000401 aa 000000 6054 13 603 tpnz 0,x3 *** KLUDGE *** relies on lisp stacks 64K  000402 aa 777770 7100 04 604 tra rbc03-*,ic 605  606 " come here to return from reverse_binding_context. 607 " the PDLP field is changed to be an accurate pointer to a binding block  608  000403 aa 5 00000 7461 00 609 rbc_ret: stx6 lb|0 bb.pdlp := addr of lowest bb in range  000404 aa 000000 7100 13 610 tra 0,x3  611  612 " Procedure to unwind a reversal bb 613 " called by tsx3 with the reversal bb at lb|0  614 " uses all the registers  615  000405 616 unwind_reversal_bb: 000405 aa 000000 6250 00 617 eax5 0 for clearing rev_ptr's 000406 aa 5 00000 6261 00 618 eax6 lb|0 and begin scanning down stack  000407 aa 5 00000 2241 00 619 ldx4 lb|0 pick up pdl ptr of this reversal bb 000410 aa 5 00000 6351 00 620 urbre: eaa lb|0 prepare to do r-r arithmetic in pointer register  000411 aa 000000 5310 00 621 neg 0  000412 aa 000000 3534 01 622 eppbb 0,au 000413 aa 1 00001 1041 16 623 urb00: cmpx4 ab|1,x6 done? 000414 aa 000022 6054 04 624 tpnz urbxx-*,ic yes (RELIES ON STACK BEING 64K)  000415 aa 1 00001 2261 16 625 ldx6 ab|1,x6 no, thread through back_ptr  000416 aa 1 00001 7211 16 626 lxl1 ab|1,x6 pick up its rev_ptr  000417 aa 3 00000 6211 11 627 eax1 bb|0,x1 does it point at the block being reversed?  000420 aa 777773 6010 04 628 tnz urb00-*,ic no - this block didn't change it so don't change back  000421 aa 1 00000 7211 16 629 lxl1 ab|0,x6 yes - check type 000422 aa 000003 6000 04 630 tze urb01-*,ic reversal bb - tra  000423 aa 777637 7000 04 631 tsx0 reversal-*,ic normal - reverse it and zero its rev_ptr  000424 aa 777764 7100 04 632 tra urbre-*,ic and chain to next, fixing bb  633  634 " here the extended range begins, reverse everything without touching its rev_ptr  635  000425 aa 1 00000 2241 16 636 urb01: ldx4 ab|0,x6 pick up its PDLP hwich limits our range  000426 aa 1 00001 1041 16 637 urb02: cmpx4 ab|1,x6 done? 000427 aa 000007 6054 04 638 tpnz urbxx-*,ic yes  000430 aa 1 00001 2261 16 639 ldx6 ab|1,x6 no, thread through back_ptr  000431 aa 1 00000 7211 16 640 lxl1 ab|0,x6 check its type  000432 aa 777774 6000 04 641 tze urb02-*,ic ignore reversal bb's  000433 aa 1 00001 7251 16 642 lxl5 ab|1,x6 normal bb's get reversed but rev_ptr left alone  000434 aa 777626 7000 04 643 tsx0 reversal-*,ic 000435 aa 777771 7100 04 644 tra urb02-*,ic 645  000436 aa 5 00001 2211 00 646 urbxx: ldx1 lb|1 now unthread this bb from bindings list  000437 4a 4 00042 7411 20 647 stx1 lisp_static_vars_$binding_top+1  000440 aa 000000 7100 13 648 tra 0,x3 and return  649 "  650 " this is the actual evaluator  651 " it is called by tsx5 with ap|-2 the object to be evaled.  652 " it returns with ap bumped by 6, the result in the aq, 653 " x7 the same, and the contents of the other regs randomized.  654  000441 aa 000016 7100 04 655 tra evalu_exit-*,ic used by evalhook  656  000442 4a 4 00024 7161 20 657 evalu: xec lisp_static_vars_$evalhook_status  000443 aa 0 00006 3501 00 658 eppap ap|6 room to work  000444 aa 0 77770 2371 00 659 ldaq ap|form object to be evaled 000445 aa 067500 3150 07 660 cana Unevalable,dl 000446 aa 000000 6010 15 661 tnz 0,5 if number or string, just return it  000447 aa 010000 3150 07 662 cana Atsym,dl  000450 aa 000011 6000 04 663 tze eval_fcn-*,ic  664 "Atomic symbol. Return its value. Error if undefined  000451 aa 0 77770 2371 20 665 ldaq ap|form,* get value of atom 000452 aa 000000 6010 15 666 tnz 0,5  000453 aa 0 77772 3501 00 667 eppap ap|form+2 undefined - give correctable error  000454 aa 777372 7000 04 668 tsx0 undefined_atom_error-*,ic 000455 aa 0 00006 3501 00 669 eppap ap|-form-2  670 "ldaq ap|form replacement value.(already in aq)  000456 aa 000000 7100 15 671 tra 0,5  672  000457 673 evalu_exit: 000457 aa 0 00006 3501 00 674 eppap ap|6 exit routine for evalhook 000460 aa 000000 7100 15 675 tra 0,5  676  677 " evaluate a non-atomic expression  678  000461 aa 000000 6220 00 679 eval_fcn: eax2 0 clear all flags  000462 aa 0 77770 3521 20 680 eppbp ap|form,*  000463 aa 2 00002 2371 00 681 ldaq bp|2 cdr = args 000464 aa 0 77774 7571 00 682 staq ap|argl  000465 aa 2 00000 2371 00 683 ldaq bp|0 car = fcn  000466 aa 0 77772 7571 00 684 staq ap|fcn  685  686 " apply, label, and funarg join us here. (by tsx5, with 687 " x2, ap|form, ap|fcn, ap|argl properly set up.)  688  000467 689 evaler: 000467 aa 000026 6230 04 690 eax3 find_type_tv-*,ic 691  000470 692 evaler1:  693  694 " set up the unified binding block, initially empty of bindings 695  000470 aa 000010 6270 17 696 eax7 8,x7  000471 aa 0 00000 6261 00 697 eax6 ap|0 = bot_block, for now = top_block too  000472 aa 1 77776 7461 17 698 stx6 ab|-2,x7  000473 aa 1 77776 4461 17 699 sxl6 ab|-2,x7  000474 aa 000000 6240 00 700 eax4 0 -- binding block takes 0 words right now  701  702 " in *rset t mode, make an evalframe for baktrace & pdlframe  703  000475 704 set_eval_frame: set_eval_frame_1:  000475 4a 4 00026 2371 20 705 ldaq lisp_static_vars_$star_rset,* 000476 aa 1 00012 1171 00 706 cmpaq ab|nil  000477 aa 000015 6000 04 707 tze make_no_frame-*,ic 000500 aa 1 77772 3521 17 708 eppbp ab|-6,x7  000501 aa 6 00000 6261 00 709 eax6 sp|0 make frame.dat1, which = rel(sp),  000502 aa 000002 3020 03 710 canx2 applybit,du  000503 aa 000002 6000 04 711 tze 2,ic 000504 aa 000001 2660 03 712 orx6 1,du +1 if in apply or map  000505 aa 2 00001 7461 00 713 stx6 bp|frame.dat1  000506 aa 0 77770 6261 14 714 eax6 ap|form,x4 -> form for pdlframe to get  000507 aa 2 00000 4461 00 715 sxl6 bp|frame.stack_ptr  000510 4a 4 00032 2261 20 716 ldx6 lisp_static_vars_$eval_frame+1  000511 aa 2 00000 7461 00 717 stx6 bp|frame.prev_frame 000512 4a 4 00044 2521 20 718 spribp lisp_static_vars_$eval_frame  000513 aa 000010 2620 03 719 orx2 framebit,du 720  000514 721 make_no_frame:  000514 aa 000532 7100 04 722 tra find_type-*,ic 000515 723 find_type_tv:  724 "return transfer vector for find_type  000515 aa 000345 7100 04 725 tra eval_subrs_and_arrays-*,ic "array 000516 aa 000344 7100 04 726 tra eval_subrs_and_arrays-*,ic "subr  000517 aa 000342 7100 04 727 tra eval_lsubr-*,ic  000520 aa 000060 7100 04 728 tra eval_expr-*,ic 000521 aa 000030 7100 04 729 tra eval_fexpr-*,ic  000522 aa 000377 7100 04 730 tra eval_fsubr-*,ic  000523 aa 000051 7100 04 731 tra eval_lexpr-*,ic  732 "  733 " routine to bind all the atomic symbols in a lambda list  734 " ap|fcn,x4 is cons lambdalist body, as returned by find_type  735 " uses pre-existing binding_block  736 " called by tsx0. Uses x1, bb. 737 " updates x4, ap, returns number of variables bound in x6  738 " just binds the variables - does not assign them to new values.  739  000524 740 lambda_bind:  000524 aa 000000 6260 00 741 eax6 0 init counter  000525 aa 0 77772 2371 34 742 ldaq ap|fcn,x4*  000526 743 lambda_bind_1:  000526 aa 077700 3150 07 744 cana lisp_ptr.type,dl  000527 aa 000000 6010 10 745 tnz 0,0 ... end of the lambda - list 000530 aa 0 00004 3501 00 746 eppap ap|4 000531 aa 777774 6240 14 747 eax4 -4,x4 000532 aa 000001 6260 16 748 eax6 1,x6  000533 aa 0 77776 7571 00 749 staq ap|-2 000534 aa 0 77776 3521 20 750 eppbp ap|-2,*  000535 aa 2 00000 2371 00 751 ldaq bp|0 a lambda var  000536 aa 0 77776 7571 00 752 staq ap|-2 000537 aa 010000 3150 07 753 cana Atsym,dl ok to bind?  000540 aa 001235 6000 04 754 tze bad_bound_var-*,ic nope.  000541 aa 1 00012 1171 00 755 cmpaq ab|nil  000542 aa 000716 6000 04 756 tze loser_binding_nil-*,ic 000543 aa 0 77776 2371 20 757 ldaq ap|-2,* yes, ok to bind.  000544 aa 0 77774 7571 00 758 staq ap|-4 000545 aa 0 00000 6211 00 759 eax1 ap|0  000546 aa 1 77776 7411 17 760 stx1 ab|-2,x7 update binding_block.top_block 000547 aa 2 00002 2371 00 761 ldaq bp|2 (cdr of the lambda list)  000550 aa 777756 7100 04 762 tra lambda_bind_1-*,ic 763 "  764 " evaluator of fexpr's and macros  765 "  766 " binds the lambda-atom to the argument list.  767 " if a second lambda atom is present, binds it to a pdl ptr 768 " so that it can be used with eval or apply as an a-list.  769 " then joins with expr code to eval lambda body.  770  000551 771 eval_fexpr: 000551 aa 000100 3020 03 772 canx2 bbf,du  000552 aa 000003 6000 04 773 tze 3,ic no pseudo bb, skip...  000553 aa 0 00000 6211 00 774 eax1 ap|0  000554 aa 000717 7000 04 775 tsx0 finish_bindings-*,ic  000555 aa 777747 7000 04 776 tsx0 lambda_bind-*,ic  000556 aa 000001 1060 03 777 cmpx6 1,du just 1 lambda variable?  000557 aa 001160 6020 04 778 tnc bad_fcnl-*,ic "fexpr (lambda nil ...  000560 aa 000011 6000 04 779 tze fexpr_1_arg-*,ic yes, easy.  000561 aa 1 77776 6361 17 780 eaq ab|-2,x7 -> binding block  000562 aa 000022 7720 00 781 qrl 18 000563 aa 777776 2760 03 782 orq -2,du  000564 aa 040047 2350 07 783 lda fixnum_type,dl 000565 aa 0 77776 7571 20 784 staq ap|-2,* rebind 2nd arg  000566 aa 0 77774 2371 14 785 ldaq ap|argl,x4  000567 aa 0 77772 7571 20 786 staq ap|-6,* rebind 1st arg  000570 aa 000122 7100 04 787 tra eval_lambda_body-*,ic  788  000571 789 fexpr_1_arg:  000571 aa 0 77774 2371 14 790 ldaq ap|argl,x4  000572 aa 0 77776 7571 20 791 staq ap|-2,* rebind 1st (only) arg  000573 aa 000117 7100 04 792 tra eval_lambda_body-*,ic 793  794 "  795  000574 796 eval_lexpr: 000574 aa 000024 2620 03 797 orx2 exprbit+lsubrbit,du  000575 aa 0 00010 3501 00 798 eppap ap|8 reserve space for binding block  000576 aa 777770 6240 14 799 eax4 -8,x4 but don't update binding_block.top_block yet.  000577 aa 000351 7100 04 800 tra arg_spreader-*,ic comes back to args_spread_for_lexpr 801  000600 802 eval_expr:  803  000600 aa 000004 2620 03 804 orx2 exprbit,du  805  806 " before spreading args, allocate enough space to bind 807 " the lambda variables, but don't bind them until  808 " after the args are spread because one of the args  809 " might be a setq or something 810  000601 aa 0 77772 2371 34 811 ldaq ap|fcn,x4*  000602 aa 0 00000 6211 00 812 eax1 ap|0 where first lambda var will be bound  000603 aa 1 77774 7441 17 813 stx4 ab|-4,x7  000604 814 expr_bb_alloc:  000604 aa 077700 3150 07 815 cana lisp_ptr.type,dl end of lambda-list? 000605 aa 000007 6010 04 816 tnz expr_bb_fin-*,ic yes.  000606 aa 0 00004 3501 00 817 eppap ap|4 no, 1 more binding (at least) 000607 aa 777774 6240 14 818 eax4 -4,x4 000610 aa 0 77776 7571 00 819 staq ap|-2 000611 aa 0 77776 3521 20 820 eppbp ap|-2,*  000612 aa 2 00002 2371 00 821 ldaq bp|2 cdr lambda-list  000613 aa 777771 7100 04 822 tra expr_bb_alloc-*,ic 823  000614 824 expr_bb_fin: " in last binding slot, save addr of first binding slot for lambda vars  825 " (because there might be a label pseudo bb too)  826  000614 aa 1 77774 1041 17 827 cmpx4 ab|-4,x7 anything in lambda list?  000615 aa 000005 6000 04 828 tze expr_nil-*,ic no.  000616 aa 000000 6360 11 829 eaq 0,x1 yes, save ptr to first 000617 aa 060000 2350 07 830 lda Uncollectable,dl  000620 aa 0 77774 7571 00 831 staq ap|-4 000621 aa 000327 7100 04 832 tra arg_spreader-*,ic  833  834 " expr with no lambda vars - still have to use arg_spreader for wrong_no_args check 835  000622 836 expr_nil:  000622 aa 000326 7100 04 837 tra arg_spreader-*,ic  838  839  840  000623 841 args_spread_for_expr:  000623 aa 000020 3020 03 842 canx2 lsubrbit,du  000624 aa 000205 6010 04 843 tnz args_spread_for_lexpr-*,ic 000625 aa 0 77772 2371 34 844 ldaq ap|fcn,x4* which kind of expr?  000626 aa 077700 3150 07 845 cana lisp_ptr.type,dl  000627 aa 000010 6000 04 846 tze expr_bind-*,ic the kind with args  000630 aa 000100 3020 03 847 canx2 bbf,du the kind with no args.  000631 aa 000003 6000 04 848 tze 3,ic  000632 aa 0 00000 6211 00 849 eax1 ap|0 if necc., do pseudo-bb stuff  000633 aa 000640 7000 04 850 tsx0 finish_bindings-*,ic  851  000634 aa 000000 1030 03 852 cmpx3 0,du we want no args. have we none?  000635 aa 001142 6010 04 853 tnz too_many_args_expr-*,ic no, barf. 000636 aa 000054 7100 04 854 tra eval_lambda_body-*,ic yes, go eval fcn 855  000637 856 expr_bind:  857  858 "ok, bind the lambda variables...  859 "  860 " finish making the binding block then pop the args off of the marked  861 " pdl and assign them to the lambda variables.  862  000637 aa 0 00000 3531 00 863 epbpbb ap|0  000640 aa 002000 3020 03 864 canx2 already_spread,du  000641 aa 000004 6000 04 865 tze expr_bind_1-*,ic  866  867 " args are at bottom of pdl, pseudo binding block is at top 868  000642 aa 0 77774 2201 14 869 ldx0 ap|argl,x4  000643 aa 0 00000 6211 00 870 eax1 ap|0  000644 aa 000003 7100 04 871 tra expr_bind_0-*,ic  872  873 " args are at top of pdl, pseudo binding block is right below them. 874  000645 875 expr_bind_1:  000645 aa 000672 7000 04 876 tsx0 set_x1_args-*,ic  000646 aa 000000 6200 11 877 eax0 0,x1 top of pseudo bb = base of args  000647 878 expr_bind_0:  000647 aa 1 77774 4411 17 879 sxl1 ab|-4,x7 save top of pseudo bb for later  000650 aa 3 77775 2211 11 880 ldx1 bb|-3,x1 -> start of lambda var bindings  881  882 " at this point x0 -> args and x1 -> top of future binding block of lambda vars (pseudo bb) 883  000651 aa 0 77772 2371 34 884 ldaq ap|fcn,x4* scan through lambda-list again  000652 aa 000000 6260 00 885 eax6 0 init counter  000653 886 expr_binder:  000653 aa 077700 3150 07 887 cana lisp_ptr.type,dl done?  000654 aa 000021 6010 04 888 tnz expr_assign_0-*,ic yes 000655 aa 3 00000 7571 11 889 staq bb|0,x1  000656 aa 3 00000 3715 31 890 epplb bb|0,x1* 000657 aa 5 00000 2371 00 891 ldaq lb|0 = the lambda-atom  000660 aa 3 00002 7571 11 892 staq bb|2,x1  000661 aa 010000 3150 07 893 cana Atsym,dl make sure it is bindable  000662 aa 001111 6000 04 894 tze bad_bound_var_sp-*,ic  000663 aa 1 00012 1171 00 895 cmpaq ab|nil  000664 aa 000010 6000 04 896 tze loser_bind_nil-*,ic  000665 aa 3 00000 2371 10 897 ldaq bb|0,x0 get value of arg  000666 aa 3 00000 7571 11 898 staq bb|0,x1 store into pseudo binding block 899 " lambda var will be bound to it later 000667 aa 000002 6200 10 900 eax0 2,x0  000670 aa 000001 6260 16 901 eax6 1,x6 count lambda vars  000671 aa 000004 6210 11 902 eax1 4,x1  000672 aa 5 00002 2371 00 903 ldaq lb|2 cdr lamda-list 000673 aa 777760 7100 04 904 tra expr_binder-*,ic  905  000674 906 loser_bind_nil: 000674 aa 000564 7100 04 907 tra loser_binding_nil-*,ic 908  909  000675 910 expr_assign_0:  000675 aa 1 77774 7461 17 911 stx6 ab|pdlptr,x7 check for right number of args  000676 aa 1 77774 1031 17 912 cmpx3 ab|pdlptr,x7 000677 aa 000003 6000 04 913 tze 3,ic  000700 aa 001077 6040 04 914 tmi too_few_args_expr-*,ic 000701 aa 001076 7100 04 915 tra too_many_args_expr-*,ic  916  917 " now that we have made a pseudo binding block out of the  918 " lambda variables and the values of the arguments, pop the args  919 " (no longer needed) off the pdl and call finish_bindings which 920 " will change the pseudo bb into a real bb bind thr lambda  921 " vars to the args. 922  000702 aa 1 77774 7211 17 923 lxl1 ab|-4,x7 saved top of pseudo bb 000703 aa 000570 7000 04 924 tsx0 finish_bindings-*,ic  000704 aa 1 77776 2211 17 925 ldx1 ab|-2,x7 = binding_block.top_block  000705 aa 0 00000 6201 14 926 eax0 ap|0,x4 so can adjust x4  000706 aa 1 77774 7401 17 927 stx0 ab|-4,x7  000707 aa 3 00000 3501 11 928 eppap bb|0,x1 clear the spread args off the pdl  929 " (finish_bindings sets bb)  000710 aa 1 77774 2241 17 930 ldx4 ab|-4,x7 adjust x4  000711 aa 1 77776 1641 17 931 sbx4 ab|-2,x7  932 "tra eval_lambda_body-*,ic *** fall into eval_lambda_body  933 "  934 " come here to evaluate a lambda body which is the cdr of ap|fcn,  935 " and consists of a list of 0 or more objects to be evaluated, 936 " the value of the last of which is returned as the value of the lambda.  937 " After evaluating the lambda body, the topmost binding block is  938 " unwound, restoring the lambda atoms to thwir former values.  939  000712 940 eval_lambda_body:  000712 aa 0 00002 3501 00 941 eppap ap|2 place for return value  000713 aa 777776 6240 14 942 eax4 -2,x4 000714 aa 1 00012 2371 00 943 ldaq ab|nil  000715 aa 0 77776 7571 00 944 staq ap|-2 initial value nil in case empty body  945  000716 946 eval_lambda_body_loop:  000716 aa 0 77772 3521 34 947 eppbp ap|fcn,x4* cdr down lambda body, first time is list of  948 " lambda list and lambda body 000717 aa 2 00002 2371 00 949 ldaq bp|2  000720 aa 0 77772 7571 14 950 staq ap|fcn,x4 000721 aa 077700 3150 07 951 cana lisp_ptr.type,dl  000722 aa 000005 6010 04 952 tnz end_eval_lambda_body-*,ic  000723 aa 0 77772 2371 34 953 ldaq ap|fcn,x4*  000724 aa 0 77776 7571 00 954 staq ap|-2 thing to pass to eval 000725 aa 777105 7000 04 955 tsx0 recurse-*,ic  000726 aa 777770 7100 04 956 tra eval_lambda_body_loop-*,ic 957  000727 958 end_eval_lambda_body:  000727 aa 0 77776 2371 00 959 ldaq ap|-2 move result down  000730 aa 0 77776 3501 00 960 eppap ap|-2  000731 aa 000002 6240 14 961 eax4 2,x4  962  963 " come here to unwind & exit  964  000732 aa 0 77776 7571 14 965 fcn_fin: staq ap|qsrac,x4 save result of fcn  000733 aa 020000 3020 03 966 canx2 mapf,du from a map fcn?  000734 aa 001772 6010 04 967 tnz map_fcn_fin-*,ic yes, go loop.  000735 aa 000030 7000 04 968 tsx0 unbinder-*,ic 969  970 " if macro bit is set, send the macro around for another evaluation 971 " else return  972  000736 973 freturn_join:  000736 aa 0 77776 2371 00 974 ldaq ap|qsrac get result 000737 aa 000001 3020 03 975 canx2 macrobit,du  000740 aa 000000 6000 15 976 tze 0,5 return with result in aq,  977 " and our 4 temp.'s on stack  978  979  980  000741 aa 0 77770 7571 00 981 staq ap|form allowed since frame has been destroyed  000742 aa 0 77772 3501 00 982 eppap ap|form+2  000743 aa 777477 7100 04 983 tra evalu-*,ic ...and go around again 984  985 " this is code to finish up an freturn  986 " entered with the binding block already unwound, but the eval_frame still present  987 " there is nothing on either pdl except the usual 3 unmkd and 4 marked words - huh? 988 " we restore the index registers, get rid of the eval frame, and join up with fcn_fin  989  000744 990 segdef freturn_real  991  000744 992 freturn_real:  000744 aa 7 00046 2721 20 993 getlp  000745 4a 4 00016 3511 20 994 epbpab lisp_static_vars_$unmkd_ptr,* switch to lisp mode from pl1 mode 000746 4a 4 00020 3501 20 995 eppap lisp_static_vars_$stack_ptr,*  000747 4a 4 00014 2271 20 996 ldx7 lisp_static_vars_$unmkd_ptr+1 000750 aa 1 00016 4501 00 997 stz ab|in_pl1_code 998  999 " back in lisp mode -- restore index regs  1000  000751 aa 1 77774 2251 17 1001 ldx5 ab|svx5u,x7  000752 aa 1 77774 7221 17 1002 lxl2 ab|svx2l,x7  1003  1004 " ap|qsrac has the return value in it  1005  000753 aa 1 77776 2371 17 1006 ldaq ab|-2,x7 restore return_ptr in our caller's stack frame  000754 aa 6 00024 7571 00 1007 staq sp|20 ***** stack_frame.return_ptr 000755 aa 020000 3020 03 1008 canx2 mapf,du  000756 0a 003031 6010 00 1009 tnz map_freturn freturn to mapped fcn - go fix it up. 1010  1011 " get rid of the stupid eval_frame 1012  000757 aa 000010 3020 03 1013 canx2 framebit,du  000760 aa 000003 6000 04 1014 tze 3,ic  000761 aa 1 77772 2211 17 1015 ldx1 ab|frame.prev_frame-6,x7  000762 4a 4 00032 7411 20 1016 stx1 lisp_static_vars_$eval_frame+1  000763 aa 777770 6270 17 1017 eax7 -8,x7 flush the unmkd pdl  000764 0a 000736 7100 00 1018 tra freturn_join go join in with fcn_fin 1019 "  1020  1021 " this routine is called to unwind the binding block,  1022 " and the eval frame (if there is one). It clears  1023 " the unmarked pdl and clears the binding block off 1024 " of the marked pdl. It must not change x3 (for map).  1025 " also unwinds the funarg reversal binding block if fbb flag is on  1026  000765 1027 unbinder: " called by tsx0  1028  000765 aa 1 77776 7211 17 1029 lxl1 ab|-2,x7 binding_block.bot_block  000766 aa 1 77776 1011 17 1030 cmpx1 ab|-2,x7 binding_block.top_block  000767 0a 001000 6000 00 1031 tze lambda_completion no bindings at all  1032  000770 aa 0 00000 3525 00 1033 epbpbp ap|0  000771 aa 1 77776 0521 17 1034 adwpbp ab|-2,x7 binding_block.top_block  1035 " used to scan top - down  000772 1036 unwind_bindings:  000772 aa 2 77774 3521 00 1037 eppbp bp|-4 -> next binding  000773 aa 2 00000 2371 00 1038 ldaq bp|0 old value  000774 aa 2 00002 7571 20 1039 staq bp|2,* put back in atom.value  000775 aa 000004 6210 11 1040 eax1 4,x1 next binding  000776 aa 1 77776 1011 17 1041 cmpx1 ab|-2,x7 done? - check with binding_block.top_block  000777 aa 777773 6010 04 1042 tnz unwind_bindings-*,ic  1043  001000 1044 lambda_completion:  001000 aa 1 77776 6211 17 1045 eax1 ab|-2,x7 this bb may not have been threaded in (subr)  001001 4a 4 00042 1011 20 1046 cmpx1 lisp_static_vars_$binding_top+1  001002 aa 000003 6010 04 1047 tnz 3,ic  001003 aa 1 77777 2211 17 1048 ldx1 ab|-1,x7 binding_block.back_ptr  001004 4a 4 00042 7411 20 1049 stx1 lisp_static_vars_$binding_top+1 1050  1051 "if an evalframe was made, destroy it  1052  001005 aa 000010 3020 03 1053 canx2 framebit,du  001006 0a 001026 6010 00 1054 tnz destroy_evalframe  001007 1055 lambda_completion_1:  001007 aa 000200 3020 03 1056 canx2 fbb,du funarg bb?  001010 aa 000013 6000 04 1057 tze lambda_completion_2-*,ic no, don't have to unwind it  001011 aa 1 77774 7451 17 1058 stx5 ab|svx5u,x7 stash registers  001012 aa 1 77775 7401 17 1059 stx0 ab|svx0u,x7  001013 aa 1 77773 4431 17 1060 sxl3 ab|svx3l,x7  001014 aa 1 77775 4441 17 1061 sxl4 ab|svx4l,x7  001015 aa 1 77770 3715 17 1062 epplb ab|-8,x7 and unwind the funarg reversal bb 001016 aa 777367 7030 04 1063 tsx3 unwind_reversal_bb-*,ic  001017 aa 1 77775 7241 17 1064 lxl4 ab|svx4l,x7 now reload the regs  001020 aa 1 77773 7231 17 1065 lxl3 ab|svx3l,x7  001021 aa 1 77775 2201 17 1066 ldx0 ab|svx0u,x7  001022 aa 1 77774 2251 17 1067 ldx5 ab|svx5u,x7  001023 1068 lambda_completion_2:  001023 aa 0 00000 3501 14 1069 eppap ap|0,x4 remove cruft from marked pdl  001024 aa 777770 6270 17 1070 eax7 -8,x7 remove cruft from unmarked pdl  001025 aa 000000 7100 10 1071 tra 0,0 & return.  1072  001026 1073 destroy_evalframe:  001026 aa 1 77772 2211 17 1074 ldx1 ab|frame.prev_frame-6,x7  001027 4a 4 00032 7411 20 1075 stx1 lisp_static_vars_$eval_frame+1  001030 0a 001007 7100 00 1076 tra lambda_completion_1  1077 "  1078 " the arguments are spread on the marked pdl where the arg function 1079 " can get at them. The atomic symbol that was used as a lambda-list  1080 " is assigned to the number of arguments. The pseudo-atom "argatom"  1081 " in lisp_static_vars_ is assigned to an uncollectable structure  1082 " representing the location and number of the stacked up args. 1083 " then common code with expr is entered to eval the lambda  1084 " body, unwind the bindings, and return.  1085  001031 1086 args_spread_for_lexpr:  1087  001031 aa 0 00000 3531 00 1088 epbpbb ap|0  001032 aa 0 00000 6211 00 1089 eax1 ap|0  001033 aa 002000 3020 03 1090 canx2 already_spread,du args not at top of pdl?  001034 aa 000002 6010 04 1091 tnz 2,ic yes, leave x1 = ap  001035 aa 000502 7000 04 1092 tsx0 set_x1_args-*,ic -> spread arguments 001036 aa 0 77772 2371 34 1093 ldaq ap|fcn,x4* bind the atomic lambda list  001037 aa 3 77776 7571 11 1094 staq bb|-2,x1  001040 4a 4 00046 3521 20 1095 eppbp lisp_static_vars_$argatom and the "argatom" used by arg function  001041 aa 1 77774 2521 17 1096 spribp ab|-4,x7 - not really an atom, so have to set 001042 aa 1 77774 2371 17 1097 ldaq ab|-4,x7 Uncollectable type-bits.  001043 aa 060000 2750 07 1098 ora Uncollectable,dl  001044 aa 3 77772 7571 11 1099 staq bb|-6,x1  001045 aa 0 77774 2361 14 1100 ldq ap|argl,x4 find args. 001046 aa 002000 3020 03 1101 canx2 already_spread,du are they below binding block? 001047 aa 000002 6010 04 1102 tnz 2,ic yes 001050 aa 000000 6360 11 1103 eaq 0,x1 no, args are above binding block  001051 aa 000000 6350 13 1104 eaa 0,x3 number of arguments 001052 aa 060000 2750 07 1105 ora Uncollectable,dl  001053 aa 3 77770 7571 11 1106 staq bb|-8,x1  001054 aa 000066 7730 00 1107 lrl 54 shift number of args into ql  001055 aa 040047 2350 07 1108 lda fixnum_type,dl 001056 aa 3 77774 7571 11 1109 staq bb|-4,x1  001057 aa 000414 7000 04 1110 tsx0 finish_bindings-*,ic  001060 aa 777632 7100 04 1111 tra eval_lambda_body-*,ic  1112 "  001061 1113 eval_lsubr: 001061 aa 000020 2620 03 1114 orx2 lsubrbit,du  1115 " and fall into eval_subrs_and_arrays  1116  001062 1117 eval_subrs_and_arrays:  001062 aa 000066 7100 04 1118 tra arg_spreader-*,ic  1119  001063 1120 args_spread_for_subr:  001063 aa 000020 3020 03 1121 canx2 lsubrbit,du  001064 aa 000023 6010 04 1122 tnz args_spread_for_lsubr-*,ic 1123  1124 " subr - check arg count  1125  001065 aa 0 77772 1031 34 1126 cmpx3 ap|fcn,x4* compare number args to number in subr pointer  001066 aa 000003 6000 04 1127 tze 3,ic  001067 aa 000743 6020 04 1128 tnc too_few_args_subr-*,ic 001070 aa 000742 6030 04 1129 trc too_many_args_subr-*,ic  1130  001071 1131 call_subr_bbf:  001071 aa 000100 3020 03 1132 canx2 bbf,du  001072 aa 000003 6000 04 1133 tze call_subroutine-*,ic  001073 aa 000444 7000 04 1134 tsx0 set_x1_args-*,ic do funarg stuff before calling subr 001074 aa 000377 7000 04 1135 tsx0 finish_bindings-*,ic  1136  1137 " to call a subr, etc.  1138 " with the args spread on the marked pdl.  1139 " For lsubrs, x6 contains -2*the number of arguments,  1140 " which is moved into x5 just before the call. 1141 " ap|fcn,x4 points to the subr-link block which contains  1142 " a Multics dynamic link to the subr and an interface procedure.  1143  001075 1144 call_subroutine:  001075 aa 0 77772 3521 34 1145 eppbp ap|fcn,x4* -> subr pointer  001076 aa 1 77774 7451 17 1146 stx5 ab|svx5u,x7 save regs through the call  001077 aa 1 77774 4421 17 1147 sxl2 ab|svx2l,x7  001100 aa 000000 6250 16 1148 eax5 0,x6 in case of lsubr, get arg count into x5  001101 aa 2 00001 2721 00 1149 tspbp bp|1 001102 1150 returned_from_subroutine:  001102 aa 1 77774 2251 17 1151 ldx5 ab|svx5u,x7  001103 aa 1 77774 7221 17 1152 lxl2 ab|svx2l,x7  001104 aa 1 77776 7241 17 1153 lxl4 ab|-2,x7 since only the binding blocks is there now (the subr  001105 aa 1 77776 1641 17 1154 sbx4 ab|-2,x7 has popped its args), restore proper x4  001106 aa 777624 7100 04 1155 tra fcn_fin-*,ic go finish up 1156 " 1157 " args are spread out on stack just like for subr,  1158 " but -2 * argcount is passed in x5 so that first arg will be at ap|0,x5  1159  001107 1160 args_spread_for_lsubr:  1161  001107 aa 000100 3020 03 1162 canx2 bbf,du  001110 aa 000003 6000 04 1163 tze 3,ic  001111 aa 000426 7000 04 1164 tsx0 set_x1_args-*,ic  001112 aa 000361 7000 04 1165 tsx0 finish_bindings-*,ic  001113 aa 000013 7000 04 1166 tsx0 ck_lsubr_nargs-*,ic  001114 aa 000000 6360 13 1167 eaq 0,x3 get arg count...  001115 aa 000021 7720 00 1168 qrl 17 ...times -2  001116 aa 000000 5330 03 1169 negl 0,du  001117 aa 000000 6260 06 1170 eax6 0,ql will be moved into x5 ...  001120 aa 777755 7100 04 1171 tra call_subroutine-*,ic and go call it.  1172  1173  1174  1175 " like a subr with one argument, which is the unevaluated list of args  1176  001121 1177 eval_fsubr: 001121 aa 0 77774 2371 14 1178 ldaq ap|argl,x4 move arg list up to 1st arg position 001122 aa 0 00002 3501 00 1179 eppap ap|2 001123 aa 777776 6240 14 1180 eax4 -2,x4 001124 aa 0 77776 7571 00 1181 staq ap|-2 001125 aa 777744 7100 04 1182 tra call_subr_bbf-*,ic and go call it.  1183  1184 " routine to check number of arguments on an lsubr  1185 " called with x3 containing number of args  1186 " and ap|fcn,x4 being the subr ptr  1187 " called by tsx0. Does not return if number of args is wrong  1188  001126 1189 ck_lsubr_nargs: 1190  1191 " only check number of arguments in *rset t mode  1192  001126 4a 4 00026 2371 20 1193 ldaq lisp_static_vars_$star_rset,* 001127 aa 1 00012 1171 00 1194 cmpaq ab|nil  001130 aa 000000 6000 10 1195 tze 0,0  1196  1197 " check against max & min number of args stored in subr ptr 1198  001131 aa 0 77772 2351 34 1199 lda ap|fcn,x4* first word of subr pointer has max,min 001132 aa 000777 3750 03 1200 ana =o000777,du get min  001133 aa 1 77774 7551 17 1201 sta ab|-4,x7  001134 aa 0 77772 2351 34 1202 lda ap|fcn,x4* 001135 aa 777000 3750 03 1203 ana =o777000,du get max  001136 aa 000011 7710 00 1204 arl 9  001137 aa 000002 6010 04 1205 tnz 2,ic  001140 aa 777777 2350 03 1206 lda =o777777,du if 0, substitute a big number 001141 aa 1 77775 7551 17 1207 sta ab|-3,x7  001142 aa 1 77774 1031 17 1208 cmpx3 ab|-4,x7 001143 aa 000700 6020 04 1209 tnc too_few_args_lsubr-*,ic  001144 aa 1 77775 1031 17 1210 cmpx3 ab|-3,x7 001145 aa 000002 6000 04 1211 tze 2,ic  001146 aa 000675 6030 04 1212 trc too_many_args_lsubr-*,ic  001147 aa 000000 7100 10 1213 tra 0,0  1214 "  1215 " routine to spread arguments  1216  1217 " entered with ap|argl,x4 pointing to argument list 1218  1219 " returns with arguments spread out on marked pdl  1220 " x3 number of arguments  1221 " x4 offset from new top of marked pdl to old top of marked pdl  1222 " action is controlled by bits in x2  1223 " noteval 0 - arguments are evaluated  1224 " 1 - arguments not evaluated  1225 " exprbit controls where arg_spreader returns to  1226 " (NB: arg_spreader is called by tra, not tsx) 1227 " on return, ap|argl,x4 is unchanged  1228 " uses ap|qsrac,x4 to avoid modifying ap|argl,x4  1229  001150 1230 arg_spreader:  001150 aa 000000 6230 00 1231 eax3 0 start with no args 001151 aa 002000 3020 03 1232 canx2 already_spread,du  001152 aa 000024 6010 04 1233 tnz spread_adj-*,ic  001153 aa 0 77774 2371 14 1234 ldaq ap|argl,x4 copy arg list  001154 aa 0 77776 7571 14 1235 staq ap|qsrac,x4  001155 1236 spread1:  001155 aa 077700 3150 07 1237 cana lisp_ptr.type,dl any arguments left? 001156 aa 000015 6010 04 1238 tnz spread_no_more-*,ic no.  001157 aa 0 77776 2371 34 1239 ldaq ap|qsrac,x4* yes, get one 001160 aa 0 00002 3501 00 1240 eppap ap|2 room to eval it  001161 aa 0 77776 7571 00 1241 staq ap|-2 001162 aa 000001 6230 13 1242 eax3 1,x3 count arguments 001163 aa 777776 6240 14 1243 eax4 -2,x4 keep x4 pointing back below arguments  001164 aa 000040 3020 03 1244 canx2 noteval,du should it be evaled?  001165 aa 000002 6010 04 1245 tnz 2,ic no.  001166 aa 776644 7000 04 1246 tsx0 recurse-*,ic yes, so do it.  001167 aa 0 77776 3521 34 1247 eppbp ap|qsrac,x4* cdr-ize argument list  001170 aa 2 00002 2371 00 1248 ldaq bp|2  001171 aa 0 77776 7571 14 1249 staq ap|qsrac,x4  001172 aa 777763 7100 04 1250 tra spread1-*,ic  1251  001173 1252 spread_no_more: 001173 aa 000004 3020 03 1253 canx2 exprbit,du  001174 aa 777427 6010 04 1254 tnz args_spread_for_expr-*,ic  001175 aa 777666 6000 04 1255 tze args_spread_for_subr-*,ic  1256  1257  1258  1259  1260 " come here when spreading args that are already spread 1261  1262 " for subr, lsubr have to move them to top of pdl  1263 " for expr, lexpr, can leave them where they are  1264  001176 1265 spread_adj: 001176 aa 0 77775 2231 14 1266 ldx3 ap|argl+1,x4 get number of args  001177 aa 000004 3020 03 1267 canx2 exprbit,du expr or subr?  001200 aa 777423 6010 04 1268 tnz args_spread_for_expr-*,ic expr, no problem 1269 " subr, make sure args are at top of pdl  1270 " they will be unless we had to create a binding block  1271  1272  001201 aa 000000 1040 03 1273 cmpx4 0,du is there a binding block? 001202 aa 000015 6000 04 1274 tze spread_adj_aa-*,ic no, can use args where they stand  1275  1276 " have to move args up to top of pdl  1277  001203 1278 spread_adj_0:  001203 aa 0 77774 2351 14 1279 lda ap|argl,x4 au -> start of args  001204 aa 0 00000 3531 00 1280 epbpbb ap|0  001205 aa 3 00000 3521 01 1281 eppbp bb|0,au bp -> start of args  001206 aa 000000 6200 13 1282 eax0 0,x3 number of args 001207 1283 spread_up:  001207 aa 777654 6000 04 1284 tze args_spread_for_subr-*,ic all done when x0 = 0 001210 aa 0 00002 3501 00 1285 eppap ap|2 001211 aa 777776 6240 14 1286 eax4 -2,x4 001212 aa 2 00000 2371 00 1287 ldaq bp|0  001213 aa 0 77776 7571 00 1288 staq ap|-2 001214 aa 2 00002 3521 00 1289 eppbp bp|2 001215 aa 777777 6200 10 1290 eax0 -1,x0 001216 aa 777771 7100 04 1291 tra spread_up-*,ic 1292  1293  1294 " nothing above the args but this ap|form, etc. 1295 " so we can remove the eval frame and call the  1296 " subr with the args in place  1297  001217 1298 spread_adj_aa:  001217 aa 000200 3020 03 1299 canx2 fbb,du can't do this if a funarg  001220 aa 777763 6010 04 1300 tnz spread_adj_0-*,ic  1301  001221 4a 4 00026 2371 20 1302 ldaq lisp_static_vars_$star_rset,* 001222 aa 1 00012 1171 00 1303 cmpaq ab|nil - in *rset t mode must keep eval frame for baktrace 001223 aa 777760 6010 04 1304 tnz spread_adj_0-*,ic  001224 aa 000010 3020 03 1305 canx2 framebit,du  001225 aa 000003 6000 04 1306 tze 3,ic  001226 aa 1 77772 2211 17 1307 ldx1 ab|frame.prev_frame-6,x7  001227 4a 4 00032 7411 20 1308 stx1 lisp_static_vars_$eval_frame+1  001230 aa 000020 3020 03 1309 canx2 lsubrbit,du  001231 aa 000012 6010 04 1310 tnz spread_for_lsubr-*,ic  001232 aa 0 77772 1031 20 1311 cmpx3 ap|fcn,* check number of args  001233 aa 000003 6000 04 1312 tze 3,ic  001234 aa 000576 6020 04 1313 tnc too_few_args_subr-*,ic 001235 aa 000575 6030 04 1314 trc too_many_args_subr-*,ic  001236 1315 call1_call: 001236 aa 0 77772 3521 20 1316 eppbp ap|fcn,* 001237 aa 0 77770 3501 00 1317 eppap ap|form  001240 aa 777770 6270 17 1318 eax7 -8,x7 get rid of junk on unmkd pdl  001241 aa 2 00001 2721 00 1319 tspbp bp|1 001242 aa 002253 7100 04 1320 tra call1_rtn_1-*,ic  1321  001243 1322 spread_for_lsubr:  001243 aa 777663 7000 04 1323 tsx0 ck_lsubr_nargs-*,ic  001244 aa 0 77775 7251 00 1324 lxl5 ap|argl+1 001245 aa 777771 7100 04 1325 tra call1_call-*,ic  1326 " 1327 " routine to determine type of function being used. 1328  1329 " on entry ap|fcn,x4 is original function -- usually atom.  1330 " on exit, ap|fcn,x4 is function actually to be used, ass follows:  1331 " subr,array,fsubr,lsubr: pointer to subr-link block  1332 " expr,fexpr,lexpr,macro,lambda:  1333 " cdr of lambda-expression,  1334 " i.e. cons of lambda-list and body  1335  1336  1337 " register usage  1338 " ap|qsrac,x4 points to property list  1339 " ap|fcn,x4 comes in with function, returns with real function, dep on type 1340 " ap|argl,x4 comes in with args, is reset to ap|form if macro  1341 " bp "  1342 " x3 points to return transfer vector  1343 " x6 temporary, + fexpr indicator in ck_lambda 1344 " aq in property - list searching loop, contains current  1345 " indicator (= bp|0).  1346 " x4 offset from top of marked pdl of ap|form, etc.  1347 " the bits in x2 exprbit,lsubrbit are NOT set by find_type. 1348 " however, macrobit is set (a macro looks like a fexpr  1349 " except that this bit is turned on, causing re-evaluation later)  1350  1351  001246 1352 find_type: " x3 points to return transfer vector, entries in the following order:  1353 " array,subr,lsubr,expr,fexpr,fsubr,lexpr 1354  000000 1355 equ array_offset,0 000001 1356 equ subr_offset,1  000002 1357 equ lsubr_offset,2 000003 1358 equ expr_offset,3  000004 1359 equ fexpr_offset,4 000005 1360 equ fsubr_offset,5 000006 1361 equ lexpr_offset,6 1362  1363 " NOTE: nil can never be a function because this code doesn't 1364 " know how to get at the property list of nil.  1365  001246 aa 773777 3620 03 1366 anx2 -already_autoloaded_once-1,du " turn off the already autoloaded bit  001247 1367 find_type_reenter:  001247 aa 0 77772 2371 14 1368 ldaq ap|fcn,x4 001250 aa 010000 3150 07 1369 cana Atsym,dl check for symbol...most common case  001251 0a 001411 6000 00 1370 tze unsymbolic_function  001252 aa 0 77772 3521 34 1371 eppbp ap|fcn,x4*  001253 4a 4 00050 3715 20 1372 epplb lisp_static_vars_$function_properties for rpt loop.  001254 1373 find_type_1:  001254 aa 2 00002 2371 00 1374 ldaq bp|2 -> plist  001255 aa 077700 3150 07 1375 cana lisp_ptr.type,dl  001256 aa 000124 6010 04 1376 tnz end_of_plist-*,ic  001257 aa 2 00002 3521 20 1377 eppbp bp|2,*  001260 aa 2 00000 2371 00 1378 ldaq bp|0 get the indicator  001261 aa 000000 6260 00 1379 eax6 0 free index register used in rpt loop  001262 aa 020300 5202 02 1380 rpt 8,2,tze scan all 8 indicators, and skip if equal  001263 aa 5 00000 1171 16 1381 cmpaq lb|0,x6  001264 0a 001265 6070 16 1382 ttf fn_checks-2,x6 rpt leaves x6 2 too high.  001265 1383 skip_autoload:  001265 aa 2 00002 3521 20 1384 eppbp bp|2,* " try again on next property.  001266 0a 001254 7100 00 1385 tra find_type_1  001267 1386 fn_checks:  001267 aa 000001 6200 13 1387 eax0 subr_offset,x3  001270 0a 001445 7100 00 1388 tra cksubr " subr 1389  001271 aa 000002 6200 13 1390 eax0 lsubr_offset,x3  001272 0a 001445 7100 00 1391 tra cksubr " lsubr  1392  001273 aa 000005 6200 13 1393 eax0 fsubr_offset,x3  001274 0a 001445 7100 00 1394 tra cksubr " fsubr  1395  001275 aa 000000 6260 00 1396 eax6 0 " set x6 0 for ck_lambda  001276 0a 001307 7100 00 1397 tra ck_lambda " expr .. doesn't return  1398  001277 0a 001307 7060 00 1399 tsx6 ck_lambda " fexpr .. doesn't return(sets x6 non-zero too)  001300 aa 000000 0020 00 1400 drl 0  1401  001301 aa 000000 6200 13 1402 eax0 array_offset,x3 " return for array  001302 0a 001445 7100 00 1403 tra cksubr " array  1404  001303 0a 001333 7100 00 1405 tra ck_macro " macro  001304 aa 000000 0020 00 1406 drl 0 " doesn't return  1407  001305 0a 001344 7100 00 1408 tra ck_autoload " autoload 001306 aa 000000 0020 00 1409 drl 0 " doesn't return  1410  1411 " Routine to check for lambda forms (or symbols - synonym hack) 1412 " Exits to appropriate transfer vector entry  1413 " called with x6 non zero for fexprs and macros.  1414  001307 1415 ck_lambda:  001307 aa 2 00002 2371 20 1416 ldaq bp|2,* make sure is lambda expression  001310 aa 0 77772 7571 14 1417 staq ap|fcn,x4 001311 aa 010000 3150 07 1418 cana Atsym,dl Atomic symbol instead of list as fcnl property  001312 aa 777734 6010 04 1419 tnz find_type-*,ic 001313 aa 0 77772 3521 34 1420 eppbp ap|fcn,x4* lambda expression, get cdr which is lambda-list & body  001314 aa 2 00000 2371 00 1421 ldaq bp|0  001315 4a 4 00052 1171 20 1422 cmpaq lisp_static_vars_$lambda 001316 aa 000414 6010 04 1423 tnz bad_fcnl_form-*,ic 001317 aa 2 00002 2371 00 1424 ldaq bp|2  001320 aa 0 77772 7571 14 1425 xx_lambda: staq ap|fcn,x4  001321 aa 000000 1060 03 1426 cmpx6 0,du fexpr or macro?  001322 aa 000004 6010 13 1427 tnz fexpr_offset,x3 yes, appropriate exit 001323 aa 000001 3020 03 1428 canx2 macrobit,du Is this a linked macro def? 001324 aa 000004 6010 13 1429 tnz fexpr_offset,x3 Yup, fexpr/macroize it.  001325 aa 0 77772 2371 34 1430 ldaq ap|fcn,x4* check for lexpr  001326 aa 1 00012 1171 00 1431 cmpaq ab|nil  001327 aa 000003 6000 13 1432 tze expr_offset,x3 001330 aa 010000 3150 07 1433 cana Atsym,dl  001331 aa 000006 6010 13 1434 tnz lexpr_offset,x3 yes.  001332 aa 000003 7100 13 1435 tra expr_offset,x3 1436  001333 1437 ck_macro:  001333 aa 000002 3020 03 1438 canx2 applybit,du macros may not be applied!  001334 aa 000005 6010 04 1439 tnz illegal_use_of_a_macro-*,ic  001335 aa 000001 2620 03 1440 orx2 macrobit,du  001336 aa 0 77770 2371 14 1441 ldaq ap|form,x4 arg to macro is whole body 001337 aa 0 77774 7571 14 1442 staq ap|argl,x4  001340 aa 777747 7060 04 1443 tsx6 ck_lambda-*,ic  1444  001341 1445 illegal_use_of_a_macro: 001341 aa 000400 3020 03 1446 canx2 ignore_macros,du is this an error?  001342 aa 777723 6010 04 1447 tnz skip_autoload-*,ic no, just ignore the macro prop 001343 aa 000367 7100 04 1448 tra bad_fcnl_form-*,ic yes, barf  1449  001344 1450 ck_autoload:  001344 aa 004000 3020 03 1451 canx2 already_autoloaded_once,du  001345 0a 001265 6010 00 1452 tnz skip_autoload " if already autoloaded, try next indicator 001346 aa 004000 2620 03 1453 orx2 already_autoloaded_once,du remember that we did  001347 4a 4 00054 2371 20 1454 ldaq lisp_static_vars_$user_intr_array+2*(18-1),* user interrupt 18.  001350 aa 1 00012 1171 00 1455 cmpaq ab|nil  001351 0a 001265 6000 00 1456 tze skip_autoload if autoload interrupt not enabled.  001352 aa 0 00006 3501 00 1457 eppap ap|6 001353 aa 0 77772 7571 00 1458 staq ap|-6 001354 aa 2 00002 2371 20 1459 ldaq bp|2,* load value under property  001355 aa 0 77776 7571 00 1460 staq ap|-2 001356 aa 0 77764 2371 14 1461 ldaq ap|fcn-6,x4 " remember we have pushed 6 words on 001357 aa 0 77774 7571 00 1462 staq ap|-4 " pass cons of name and autoload prop.  001360 0a 002337 7000 00 1463 tsx0 call_cons 001361 aa 000012 6270 17 1464 eax7 10,x7 001362 aa 1 77766 7411 17 1465 stx1 ab|-10,x7 001363 aa 1 77767 7421 17 1466 stx2 ab|-9,x7  001364 aa 1 77770 7431 17 1467 stx3 ab|-8,x7  001365 aa 1 77771 7441 17 1468 stx4 ab|-7,x7  001366 aa 1 77772 7451 17 1469 stx5 ab|-6,x7  001367 aa 777774 6250 00 1470 eax5 -4  001370 aa 1 77774 6501 17 1471 sprilp ab|-4,x7  001371 aa 1 77776 3571 17 1472 stcd ab|-2,x7  001372 0a 003256 7100 00 1473 tra funcall  001373 aa 1 77772 2211 17 1474 ldx1 ab|-6,x7  001374 aa 1 77773 2221 17 1475 ldx2 ab|-5,x7  001375 aa 1 77774 2231 17 1476 ldx3 ab|-4,x7  001376 aa 1 77775 2241 17 1477 ldx4 ab|-3,x7  001377 aa 1 77776 2251 17 1478 ldx5 ab|-2,x7  001400 aa 777772 6270 17 1479 eax7 -6,x7 001401 0a 001247 7100 00 1480 tra find_type_reenter and try again to get function  1481  1482  1483  001402 1484 end_of_plist: " atom has no functional properties, eval its value  001402 aa 001000 2620 03 1485 orx2 went_through_value_cell,du  001403 aa 0 77772 2371 34 1486 ldaq ap|fcn,x4* atom.value  001404 aa 000336 6000 04 1487 tze undef_fcn-*,ic if undefined. 001405 aa 0 77772 1171 14 1488 cmpaq ap|fcn,x4 Is it bound to itself (e.g. nil)?  001406 aa 000334 6000 04 1489 tze undef_fcn-*,ic yes, avoid embarrassing loop.  001407 aa 0 77772 7571 14 1490 staq ap|fcn,x4 001410 aa 777636 7100 04 1491 tra find_type-*,ic 1492  001411 1493 unsymbolic_function:  001411 aa 077700 3150 07 1494 cana lisp_ptr.type,dl  001412 0a 001416 6000 00 1495 tze non_atom_fcn  001413 aa 002000 3150 07 1496 cana Subr,dl  001414 aa 000001 6010 13 1497 tnz subr_offset,x3 a direct subr pointer. 001415 0a 001742 7100 00 1498 tra undef_fcn  1499  001416 1500 non_atom_fcn: " non-functional function, so eval it.  1501  1502  1503 " check for lambda expression or label expression, since we now know it's a list  1504  001416 aa 0 77772 3521 34 1505 eppbp ap|fcn,x4*  001417 aa 2 00000 2371 00 1506 ldaq bp|0 car of the list 001420 aa 000000 6260 00 1507 eax6 0 001421 4a 4 00052 3715 20 1508 epplb lisp_static_vars_$lambda 001422 aa 006300 5202 02 1509 rpt 3,2,tze  001423 aa 5 00000 1171 16 1510 cmpaq lb|0,x6 " lambda, label, and funarg are together.  001424 0a 001435 6064 00 1511 ttn x13  001425 aa 2 00002 2371 00 1512 ldaq bp|2  001426 0a 001425 7100 16 1513 tra *+1-2,x6 x6 is set 2 too high on successful compare  1514  001427 aa 000000 6260 00 1515 eax6 0 001430 0a 001320 7100 00 1516 tra xx_lambda jump to lambda code 1517  001431 aa 0 77772 7571 14 1518 staq ap|fcn,x4 set fcn  001432 0a 001576 7100 00 1519 tra eval_label 1520  001433 aa 0 77772 7571 14 1521 staq ap|fcn,x4 001434 0a 001462 7100 00 1522 tra eval_funarg  1523  1524 " just a random list, eval it and use its value as the function 1525  001435 aa 0 77772 2371 14 1526 x13: ldaq ap|fcn,x4 001436 aa 001000 2620 03 1527 orx2 went_through_value_cell,du  001437 aa 0 00002 3501 00 1528 eppap ap|2 001440 aa 0 77776 7571 00 1529 staq ap|-2 001441 aa 776371 7000 04 1530 tsx0 recurse-*,ic  1531 "ldaq ap|-2 (the result is really already in aq, also)  001442 aa 0 77776 3501 00 1532 eppap ap|-2 back up ap, from call.  001443 aa 0 77772 7571 14 1533 staq ap|fcn,x4 and restore new function.  001444 aa 777602 7100 04 1534 tra find_type-*,ic 1535  1536  001445 aa 2 00002 2371 20 1537 cksubr: ldaq bp|2,* get the supposed subr pointer 001446 aa 002000 3150 07 1538 cana Subr,dl  001447 aa 000273 6000 04 1539 tze undef_fcn-*,ic not a subr ptr -- barf.  001450 aa 0 77772 7571 14 1540 staq ap|fcn,x4 yes, subr ptr is fcn we are applying  001451 aa 000001 3020 03 1541 canx2 macrobit,du Is this a subr-macro?  001452 aa 000005 6010 13 1542 tnz fsubr_offset,x3 Treat like fsubr  001453 aa 000000 7100 10 1543 tra 0,0  1544  001454 1545 ck_bound_var: " procedure to check if aq contains 1546 " something that can legally be bound.  1547 " the object being checked must be in both aq & ap|-2  001454 aa 010000 3150 07 1548 cana Atsym,dl  001455 aa 000320 6000 04 1549 tze bad_bound_var-*,ic if not even an atomic symbol, barf. 001456 aa 1 00012 1171 00 1550 cmpaq ab|nil  001457 aa 000000 6010 10 1551 tnz 0,0 ok.  1552  1553 " loser trying to bind nil. Give him a nihil ex nihile message 1554  001460 1555 loser_binding_nil:  001460 4a 4 00056 2351 20 1556 lda lisp_error_table_$nihil_ex_nihile  001461 aa 776466 7100 04 1557 tra error-*,ic ...never returns  1558  1559 " eval a funarg, which is generated by *function  1560 " and looks like: (funarg . )  1561  1562 " stashes the pdl_ptr and sets bbf and fbb flags  1563 " so that finish_bindings will reverse context back to this pdl ptr,  1564 " after the arguments have been evaled. 1565 " substitutes the function from the funarg for the funarg and goes  1566 " back into find_type to handle the substituted fnction 1567  001462 1568 eval_funarg:  001462 aa 0 77772 3521 34 1569 eppbp ap|fcn,x4* -> cdr of the funarg list  001463 aa 2 00000 2371 00 1570 ldaq bp|0 ... the function  001464 aa 0 77772 7571 14 1571 staq ap|fcn,x4 001465 aa 001300 2620 03 1572 orx2 bbf+fbb+went_through_value_cell,du  001466 aa 2 00003 7211 00 1573 lxl1 bp|3 assume proper pdl ptr put by *function 001467 aa 000002 6010 04 1574 tnz 2,ic 0 cuases lossage so check...  001470 aa 000001 6210 00 1575 eax1 1  001471 aa 1 77771 7411 17 1576 stx1 ab|funarg_pdlptr,x7  001472 aa 777554 7100 04 1577 tra find_type-*,ic 1578 "  1579 " routine to make a pseudo binding block into a real binding block  1580 " this is called after argument evaluation, when it safe to make bindings  1581 " for funarg, label.  1582  1583 " called by tsx0  1584 " changes only registers x0, x1, x6, aq, lb, bb 1585 " sets bb to segment number of marked pdl  1586  1587 " when called by tsx0, pseudo bb extends from binding_block.top_block to bb|0,x1  1588  001473 1589 finish_bindings:  001473 aa 000200 3020 03 1590 canx2 fbb,du need a reversal bb? 001474 aa 000016 6000 04 1591 tze finish_bindings_aa-*,ic no 001475 aa 1 77774 7451 17 1592 stx5 ab|svx5u,x7 save registers  001476 aa 1 77775 7401 17 1593 stx0 ab|svx0u,x7  001477 aa 1 77773 4431 17 1594 sxl3 ab|svx3l,x7  001500 aa 1 77775 4441 17 1595 sxl4 ab|svx4l,x7  001501 aa 1 77774 4411 17 1596 sxl1 ab|svx2l,x7  001502 aa 1 77771 2241 17 1597 ldx4 ab|funarg_pdlptr,x7 pick up pdl ptr to be used  001503 aa 1 77770 3715 17 1598 epplb ab|-8,x7 set ptr to where to put bb  001504 aa 776635 7030 04 1599 tsx3 reverse_binding_context-*,ic switch worlds  001505 aa 1 77774 7211 17 1600 lxl1 ab|svx2l,x7  001506 aa 1 77775 7241 17 1601 lxl4 ab|svx4l,x7 and get registers back  001507 aa 1 77773 7231 17 1602 lxl3 ab|svx3l,x7  001510 aa 1 77775 2201 17 1603 ldx0 ab|svx0u,x7  001511 aa 1 77774 2251 17 1604 ldx5 ab|svx5u,x7  1605  001512 1606 finish_bindings_aa: 001512 aa 1 77774 7411 17 1607 stx1 ab|pdlptr,x7 save top of pseudo bb for compare  001513 aa 1 77776 2211 17 1608 ldx1 ab|-2,x7 binding_block.top_block, = bottom of pseudo bb 001514 aa 0 00000 3531 00 1609 epbpbb ap|0  001515 aa 0 00002 3501 00 1610 eppap ap|2 temp. 1611 "that gets garbage collected  1612  001516 4a 4 00042 2361 20 1613 ldq lisp_static_vars_$binding_top+1  001517 aa 1 77777 7561 17 1614 stq ab|-1,x7 now thread in this block  001520 aa 1 77776 6361 17 1615 eaq ab|-2,x7  001521 4a 4 00042 7561 20 1616 stq lisp_static_vars_$binding_top+1  1617  001522 aa 1 77774 1011 17 1618 fin_loop: cmpx1 ab|pdlptr,x7 done whole pseudo bb? 001523 aa 000012 6000 04 1619 tze fin_xx-*,ic yes, return.  001524 aa 3 00000 2371 11 1620 ldaq bb|0,x1 no, get new value  001525 aa 0 77776 7571 00 1621 staq ap|-2 save it  001526 aa 3 00002 2371 31 1622 ldaq bb|2,x1* get old value  001527 aa 3 00000 7571 11 1623 staq bb|0,x1 put it in binding block 001530 aa 000004 6210 11 1624 eax1 4,x1  001531 aa 1 77776 7411 17 1625 stx1 ab|-2,x7 update binding_block.top_block 001532 aa 0 77776 2371 00 1626 ldaq ap|-2 assign new value to the atom  001533 aa 3 77776 7571 31 1627 staq bb|2-4,x1*  001534 aa 777766 7100 04 1628 tra fin_loop-*,ic  1629  001535 aa 0 77776 3501 00 1630 fin_xx: eppap ap|-2 pop off our temp  001536 aa 000000 7100 10 1631 tra 0,0  1632  1633  1634  1635 " proc to set x1 and bb to point at the spread args 1636 " called by tsx0  1637 " uses the arg count in x3  1638 " also sets au to offset from top of pdl to 1st arg 1639 " thus return values are bb|,x1=abs loc, au=rel loc 1640  001537 1641 set_x1_args:  001537 aa 0 00000 3531 00 1642 epbpbb ap|0  001540 aa 000000 6350 13 1643 eaa 0,x3 get arg count  001541 aa 000001 7350 00 1644 als 1 - each arg takes 2 words  001542 aa 000000 5310 00 1645 neg 0  001543 aa 0 00000 6211 01 1646 eax1 ap|0,au  001544 aa 000000 7100 10 1647 tra 0,0  1648 "  001545 1649 segdef stfunction - the lisp *function fsubr, which makes funargs  1650  001545 1651 stfunction: 1652  1653 " on entry ap|-2 is arg list, i.e. ( . nil)  1654 " we want to return the list (funarg . ) 1655  1656 " this function is equivalent to:  1657 " (defun *function fexpr (x y) (cons 'funarg (cons (car x) y))) 1658 " modified 73.11.02 by DAM to get rid of bug of assuming that there is a binding  1659 " block for our own invocation  1660  001545 aa 0 00004 3501 00 1661 eppap ap|4 room for 3 things  001546 aa 0 77772 2371 20 1662 ldaq ap|-6,* get our first (and only) arg - the function  001547 aa 0 77774 7571 00 1663 staq ap|-4 001550 4a 4 00042 2211 20 1664 ldx1 lisp_static_vars_$binding_top+1 -> most recent binding_block  001551 aa 000007 6000 04 1665 tze stfunction_00-*,ic if no bb at all, don't give 0 pdl ptr  001552 aa 1 00000 7201 11 1666 lxl0 ab|0,x1 Kludgey way to check if we have own binding block.  001553 aa 1 00000 1001 11 1667 cmpx0 ab|0,x1 empty binding blocks are only generated by evaluator,  001554 aa 000002 6010 04 1668 tnz 2,ic plus it doesn't hurt to skip over an empty b.b. 001555 aa 1 00001 2211 11 1669 ldx1 ab|1,x1 this is empty, prob. our own - skip over it 001556 aa 000000 6360 11 1670 eaq 0,x1 -> binding block itself 001557 aa 000002 6010 04 1671 tnz 2,ic  001560 1672 stfunction_00:  001560 aa 1 00002 6361 20 1673 eaq ab|unmkd_stack_bottom,* no binding_blocks, use stack base addr 001561 aa 000022 7720 00 1674 qrl 18 001562 aa 777776 2760 03 1675 orq -2,du  001563 aa 040047 2350 07 1676 lda fixnum_type,dl 001564 aa 0 77776 7571 00 1677 staq ap|-2 001565 4a 4 00060 2371 20 1678 ldaq lisp_static_vars_$funarg  001566 aa 0 77772 7571 00 1679 staq ap|-6 001567 aa 000006 6270 17 1680 eax7 6,x7  001570 aa 000547 7000 04 1681 tsx0 call_cons-*,ic  001571 aa 000546 7000 04 1682 tsx0 call_cons-*,ic  001572 aa 777772 6270 17 1683 eax7 -6,x7 001573 aa 0 77776 2371 00 1684 ldaq ap|-2 001574 aa 0 77776 3501 00 1685 eppap ap|-2  001575 aa 776224 7100 04 1686 tra lisp_rtn_1-*,ic  1687 "  1688 " handle functional forms such as (label foo (cruft))  1689  1690 " pseudo binds the function name to the function, then substitutes  1691 " the new function for the label-expression and goes back to find_type. 1692  1693 " NB: atoms with functional properties cannot be successfully  1694 " labelled to a recursive function since the property list  1695 " is checked before the value. However, this is compatible  1696 " since MACLISP has this same bug (or feature). 1697  001576 1698 eval_label: 001576 aa 0 77772 3521 34 1699 eppbp ap|fcn,x4*  001577 aa 2 00000 2371 00 1700 ldaq bp|0 function name  001600 aa 0 00004 3501 00 1701 eppap ap|4 001601 aa 777774 6240 14 1702 eax4 -4,x4 001602 aa 0 77776 7571 00 1703 staq ap|-2 001603 aa 777651 7000 04 1704 tsx0 ck_bound_var-*,ic 001604 aa 001100 2620 03 1705 orx2 bbf+went_through_value_cell,du set flag for pseudo bb existence  001605 aa 2 00002 2371 20 1706 ldaq bp|2,* 2nd arg to label is function 001606 aa 0 77774 7571 00 1707 staq ap|-4 rebind it.  001607 aa 0 77772 7571 14 1708 staq ap|fcn,x4 001610 aa 777436 7100 04 1709 tra find_type-*,ic now proceed with the labelled function 1710 "  1711 " Evalhook stuff  1712  1713 " lisp_static_vars_$evalhook_status contains one  1714 " of the following two instructions:  1715  001611 1716 segdef evalhook_on_status,evalhook_off_status  1717  001611 1718 evalhook_off_status:  001611 aa 000000 0110 00 1719 nop 0 evalhook checking disabled  1720  001612 1721 evalhook_on_status: 001612 0a 001613 7060 00 1722 tsx6 evalhook_check  1723  1724 " Come here if evalhook checking is enabled.  1725 " ap|-2 contains the item being evaluated.  1726 " x1 and x6 are usable but all other registers are to be preserved  1727 " if the value of evalhook is non-null it is applied  1728 " in place of the evaluation that was to be done  1729  1730  001613 1731 evalhook_check: 001613 4a 4 00062 2371 20 1732 ldaq lisp_static_vars_$evalhook_atom,* 001614 aa 1 00012 1171 00 1733 cmpaq ab|nil evalhook on? 001615 aa 000000 6000 16 1734 tze 0,x6 no, go on evaling  1735  001616 1736 evalhook_trap:  001616 aa 000000 6210 17 1737 eax1 0,x7  001617 aa 000057 6270 17 1738 eax7 15+32,x7  001620 aa 777760 3670 03 1739 anx7 -16,du  001621 aa 1 77740 2541 17 1740 spri ab|-32,x7 001622 aa 1 77760 7531 17 1741 sreg ab|-16,x7 1742  001623 aa 0 00010 3501 00 1743 eppap ap|8 generate call to apply 001624 aa 0 77770 7571 00 1744 staq ap|-8 saved value of evalhook  001625 aa 0 77774 7571 00 1745 staq ap|-4 function to be applied 001626 4a 4 00064 2371 20 1746 ldaq lisp_static_vars_$evalhook_atom  001627 aa 0 77772 7571 00 1747 staq ap|-6 atom to be bound  001630 aa 0 77766 2371 00 1748 ldaq ap|-10 form being evaled 001631 aa 0 77776 7571 00 1749 staq ap|-2 001632 aa 0 77774 6211 00 1750 eax1 ap|-4 top  001633 aa 1 77764 7411 17 1751 stx1 ab|-12,x7 001634 aa 0 77770 6211 00 1752 eax1 ap|-8 bottom 001635 aa 1 77764 4411 17 1753 sxl1 ab|-12,x7 001636 4a 4 00042 2351 20 1754 lda lisp_static_vars_$binding_top+1  001637 aa 1 77765 7551 17 1755 sta ab|-11,x7  001640 aa 1 77764 6211 17 1756 eax1 ab|-12,x7 001641 4a 4 00042 7411 20 1757 stx1 lisp_static_vars_$binding_top+1  001642 aa 1 00012 2371 00 1758 ldaq ab|nil evalhook is bound, turn off  001643 aa 0 77772 7571 20 1759 staq ap|-6,*  1760  001644 aa 1 77770 6501 17 1761 sprilp ab|-8,x7 prime return blocks  001645 aa 1 77774 6501 17 1762 sprilp ab|-4,x7  1763  001646 aa 1 77776 3571 17 1764 stcd ab|-2,x7 ncons the 2nd arg to apply  001647 4a 4 00066 7101 20 1765 tra lisp_alloc_$ncons_ 001650 aa 0 00002 3501 00 1766 eppap ap|2 push result back on stack  001651 aa 0 77776 7571 00 1767 staq ap|-2 1768  001652 aa 777774 6250 00 1769 eax5 -4  001653 aa 1 77776 3571 17 1770 stcd ab|-2,x7 now apply the evalhooker  001654 aa 776261 7100 04 1771 tra apply_-*,ic  1772  001655 aa 0 77772 7571 00 1773 staq ap|-6 returned value is new form to eval 001656 aa 0 77774 2371 00 1774 ldaq ap|-4 restore evalhook value 001657 aa 0 77776 7571 20 1775 staq ap|-2,*  001660 aa 1 77775 2211 17 1776 ldx1 ab|-3,x7 unbind  001661 4a 4 00042 7411 20 1777 stx1 lisp_static_vars_$binding_top+1  001662 aa 1 77770 0731 17 1778 lreg ab|-8,x7 restore state  001663 aa 1 77750 1731 17 1779 lpri ab|-24,x7 001664 aa 000000 6270 11 1780 eax7 0,x1  001665 aa 0 77776 2371 00 1781 ldaq ap|-2 get result in aq  001666 aa 777776 7100 16 1782 tra -2,x6 and return from the evaluation  1783  1784  1785 " The evalhook function 1786  001667 1787 segdef evalhook  1788  001667 aa 000004 6270 17 1789 evalhook: eax7 4,x7 save evalhook_status, bind evalhook_atom  001670 4a 4 00024 2351 20 1790 lda lisp_static_vars_$evalhook_status  001671 aa 1 77774 7551 17 1791 sta ab|-4,x7  001672 aa 777720 2350 04 1792 lda evalhook_on_status-*,ic  001673 4a 4 00024 7551 20 1793 sta lisp_static_vars_$evalhook_status  001674 aa 0 00006 3501 00 1794 eppap ap|6 001675 4a 4 00064 2371 20 1795 ldaq lisp_static_vars_$evalhook_atom  001676 aa 0 77774 7571 00 1796 staq ap|-4 001677 aa 0 77774 2371 20 1797 ldaq ap|-4,*  001700 aa 0 77772 7571 00 1798 staq ap|-6 001701 aa 0 77776 6211 00 1799 eax1 ap|-2 001702 aa 1 77776 7411 17 1800 stx1 ab|-2,x7  001703 aa 0 77772 6211 00 1801 eax1 ap|-6 001704 aa 1 77776 4411 17 1802 sxl1 ab|-2,x7  001705 4a 4 00042 2351 20 1803 lda lisp_static_vars_$binding_top+1  001706 aa 1 77777 7551 17 1804 sta ab|-1,x7  001707 aa 1 77776 6211 17 1805 eax1 ab|-2,x7  001710 4a 4 00042 7411 20 1806 stx1 lisp_static_vars_$binding_top+1  1807  001711 aa 0 77770 2371 00 1808 ldaq ap|-8 bind evalhook to 2nd arg  001712 aa 0 77774 7571 20 1809 staq ap|-4,*  001713 aa 0 77766 2371 00 1810 ldaq ap|-10 eval first arg  001714 aa 0 77776 7571 00 1811 staq ap|-2 001715 aa 776526 7050 04 1812 tsx5 evalu+1-*,ic go join evaluator after evalhook test  001716 aa 0 77772 3501 00 1813 eppap ap|-6  1814  001717 aa 0 77770 7571 00 1815 staq ap|-8 store result back over first arg  001720 aa 0 77774 2371 00 1816 ldaq ap|-4 unbind evalhook  001721 aa 0 77776 7571 20 1817 staq ap|-2,*  001722 aa 1 77777 2211 17 1818 ldx1 ab|-1,x7 undo binding block  001723 4a 4 00042 7411 20 1819 stx1 lisp_static_vars_$binding_top+1  001724 aa 1 77774 2351 17 1820 lda ab|-4,x7 restore evalhook_status  001725 4a 4 00024 7551 20 1821 sta lisp_static_vars_$evalhook_status  001726 aa 1 77774 6271 17 1822 eax7 ab|-4,x7 clear one pdl  001727 aa 0 77770 2371 00 1823 ldaq ap|-8 get return value  001730 aa 0 77770 3501 00 1824 eppap ap|-8 clear other pdl  001731 aa 776070 7100 04 1825 tra lisp_rtn_1-*,ic and return 1826  1827 " error handlers.  1828  001732 1829 bad_fcnl_form:  1830 " uncorrectable error!  001732 aa 0 77772 2371 14 1831 ldaq ap|fcn,x4 001733 aa 0 00002 3501 00 1832 eppap ap|2 001734 aa 0 77776 7571 00 1833 staq ap|-2 001735 4a 4 00070 2351 20 1834 lda lisp_error_table_$bad_function 001736 aa 776211 7000 04 1835 tsx0 error-*,ic  1836  1837  001737 1838 bad_fcnl:  1839  001737 aa 0 77770 2371 34 1840 ldaq ap|form,x4* the fnc name 001740 aa 0 77772 7571 14 1841 staq ap|fcn,x4 001741 aa 777771 7100 04 1842 tra bad_fcnl_form-*,ic 1843  1844  001742 1845 undef_fcn:  001742 aa 0 77772 2371 14 1846 ldaq ap|fcn,x4 001743 aa 0 00002 3501 00 1847 eppap ap|2 001744 aa 0 77776 7571 00 1848 staq ap|-2 001745 4a 4 00072 2351 20 1849 lda lisp_error_table_$undefined_function  001746 aa 776201 7000 04 1850 tsx0 error-*,ic  1851 "ldaq ap|-2  001747 aa 0 77776 3501 00 1852 eppap ap|-2  001750 aa 0 77772 7571 14 1853 staq ap|fcn,x4 001751 aa 777275 7100 04 1854 tra find_type-*,ic 1855  001752 1856 subrcall_error: 001752 aa 000010 7000 04 1857 tsx0 foocall_error-*,ic  001753 4a 4 00074 2351 20 1858 lda lisp_error_table_$subrcall_bad_ptr 1859  001754 1860 lsubrcall_error:  001754 aa 000006 7000 04 1861 tsx0 foocall_error-*,ic  001755 4a 4 00076 2351 20 1862 lda lisp_error_table_$lsubrcall_bad_ptr  1863  001756 1864 arraycall_error:  001756 aa 000004 7000 04 1865 tsx0 foocall_error-*,ic  001757 4a 4 00100 2351 20 1866 lda lisp_error_table_$arraycall_bad_ptr  1867  001760 1868 arraycall_mismatch: 001760 aa 000002 7000 04 1869 tsx0 foocall_error-*,ic  001761 4a 4 00102 2351 20 1870 lda lisp_error_table_$arraycall_wrong_type 1871  001762 1872 foocall_error:  001762 aa 0 77772 2371 00 1873 ldaq ap|fcn the faulty argument  001763 aa 0 77776 7571 00 1874 staq ap|-2 error is uncorrectable 001764 aa 000000 7160 10 1875 xec 0,x0 lda the error code  001765 aa 776162 7000 04 1876 tsx0 error-*,ic never returns. 1877  1878  001766 1879 illegal_f_fcn: " call from compiled code to fsubr/fexpr with args already evaled  1880  001766 aa 0 00002 3501 00 1881 eppap ap|2 001767 aa 0 77766 2371 14 1882 ldaq ap|form-2,x4  001770 aa 0 77776 7571 00 1883 staq ap|-2 001771 4a 4 00104 2351 20 1884 lda lisp_error_table_$bad_f_fcn  001772 aa 776155 7000 04 1885 tsx0 error-*,ic never returns - uncorrectable  1886  1887  001773 1888 bad_bound_var_sp:  001773 aa 1 77774 3701 37 1889 epplp ab|-4,x7* get back our lp  001774 aa 3 00004 3501 11 1890 eppap bb|4,x1 from expr_binder, make sure that bad bv  1891 " is really located at ap|-2  1892  001775 1893 bad_bound_var: " uncorrectable  1894  1895 " the non-atomic symbol trying to be bound is in ap|-2 1896 " callers of ck_bound_var, be sure of this!!!! 1897  001775 4a 4 00106 2351 20 1898 lda lisp_error_table_$bad_bv  001776 aa 776151 7000 04 1899 tsx0 error-*,ic  1900  001777 1901 wrong_no_args_expr: 001777 1902 too_many_args_expr: " correctable - by substituting a whole new form  001777 1903 too_few_args_expr:  001777 aa 0 77772 2371 34 1904 ldaq ap|fcn,x4* -> the lambda list  002000 aa 0 00004 3501 00 1905 eppap ap|4 002001 aa 0 77776 7571 00 1906 staq ap|-2 and fall into wna_com  1907  1908 " make list of form and its lambda list 1909  1910  002002 1911 wna_com:  002002 aa 0 00002 3501 00 1912 eppap ap|2 total of 6. up  002003 aa 0 77762 2371 14 1913 ldaq ap|form-6,x4  002004 aa 000002 3020 03 1914 canx2 applybit,du need to construct fake form?  002005 aa 000011 6000 04 1915 tze wna_com_1-*,ic no.  002006 aa 002000 3020 03 1916 canx2 already_spread,du is there an argl? 002007 aa 000007 6010 04 1917 tnz wna_com_1-*,ic no, can't make fake form so use(atomic)  1918 " function name in place of form.  002010 aa 0 77776 7571 00 1919 staq ap|-2 002011 aa 0 00002 3501 00 1920 eppap ap|2 002012 aa 0 77764 2371 14 1921 ldaq ap|argl-8,x4  002013 aa 0 77776 7571 00 1922 staq ap|-2 002014 aa 000323 7000 04 1923 tsx0 call_cons-*,ic  002015 aa 0 77776 2371 00 1924 ldaq ap|-2 002016 1925 wna_com_1:  002016 aa 0 77772 7571 00 1926 staq ap|-6 002017 aa 1 00012 2371 00 1927 ldaq ab|nil  002020 aa 0 77776 7571 00 1928 staq ap|-2 002021 aa 000316 7000 04 1929 tsx0 call_cons-*,ic  002022 aa 000315 7000 04 1930 tsx0 call_cons-*,ic  002023 4a 4 00110 2351 20 1931 lda lisp_error_table_$wrong_no_args  002024 aa 776123 7000 04 1932 tsx0 error-*,ic  1933 "ldaq ap|-2  002025 aa 0 77776 3501 00 1934 eppap ap|-2  002026 aa 777776 3620 03 1935 anx2 -macrobit-1,du clear macrobit  002027 aa 020000 3020 03 1936 canx2 mapf,du from map?  002030 aa 001040 6010 04 1937 tnz map_abending-*,ic yes. 002031 aa 776701 7100 04 1938 tra fcn_fin-*,ic  1939  002032 1940 wrong_no_args_subr: 002032 1941 too_many_args_subr: 002032 1942 too_few_args_subr:  1943  1944 " make list of form and fake args property (nil.nargs) 1945  002032 aa 0 77772 2361 34 1946 ldq ap|fcn,x4* 002033 aa 000022 7720 00 1947 qrl 18 002034 aa 040047 2350 07 1948 lda fixnum_type,dl 002035 aa 0 00006 3501 00 1949 eppap ap|6 002036 aa 0 77776 7571 00 1950 staq ap|-2 002037 aa 1 00012 2371 00 1951 ldaq ab|nil  002040 aa 0 77774 7571 00 1952 cons2zz: staq ap|-4 002041 aa 000276 7000 04 1953 tsx0 call_cons-*,ic  002042 aa 777740 7100 04 1954 tra wna_com-*,ic  1955  1956  002043 1957 wrong_no_args_lsubr:  002043 1958 too_many_args_lsubr:  002043 1959 too_few_args_lsubr: 1960  1961 " make list of form and fake args property (min.max)  1962  002043 aa 0 77772 2361 34 1963 ldq ap|fcn,x4* 002044 aa 000033 7720 00 1964 qrl 27 max  002045 aa 040047 2350 07 1965 lda fixnum_type,dl 002046 aa 0 00006 3501 00 1966 eppap ap|6 002047 aa 0 77776 7571 00 1967 staq ap|-2 002050 aa 0 77764 2361 34 1968 ldq ap|fcn-6,x4*  002051 aa 000022 7720 00 1969 qrl 18 002052 aa 000777 3760 07 1970 anq =o777,dl min 1971 " lda fixnum_type,dl  002053 aa 777765 7100 04 1972 tra cons2zz-*,ic  1973  1974 "  1975 "  1976 " "let" fsubr BSG 09/12/78  1977 "  002054 1978 segdef let 002054 aa 0 00006 3501 00 1979 let: eppap ap|6 Allocate marked PDL work area. 002055 aa 000010 6270 17 1980 eax7 8,x7 Allocate binding block  002056 aa 0 00000 6261 00 1981 eax6 ap|0 = bot block, now also top.  002057 aa 1 77776 7461 17 1982 stx6 ab|-2,x7 Init binding block ctrs.  002060 aa 1 77776 4461 17 1983 sxl6 ab|-2,x7  002061 aa 000000 6240 00 1984 eax4 0 Current size (-) of binding blk.  1985 "  1986 " Dredge out the vars for the binding block 1987 "  002062 aa 0 77770 2371 00 1988 ldaq ap|form (let . foo)? 002063 aa 077700 3150 07 1989 cana lisp_ptr.type,dl  002064 aa 777653 6010 04 1990 tnz bad_fcnl-*,ic  002065 aa 0 77770 3521 20 1991 eppbp ap|form,* bp -> (((var1 val1)....  002066 aa 2 00000 2371 00 1992 ldaq bp|0 s/b let list  002067 aa 1 00012 1171 00 1993 cmpaq ab|nil special case this atomic l.l.  002070 0a 002117 6000 00 1994 tze let_ll_done  002071 aa 077700 3150 07 1995 cana lisp_ptr.type,dl Is it atomic, not nil?  002072 aa 777645 6010 04 1996 tnz bad_fcnl-*,ic Yes, (let foo ..) Barf loudly.  002073 1997 let_bind_1: "Scan let list.  1998 "Rest of let list is in AQ, x4 is -4* nargs processed. 002073 aa 077700 3150 07 1999 cana lisp_ptr.type,dl Done?  002074 0a 002117 6010 00 2000 tnz let_ll_done All done.  002075 aa 0 00004 3501 00 2001 eppap ap|4 Push marked pdl  002076 aa 777774 6240 14 2002 eax4 -4,x4 002077 aa 0 77774 7571 14 2003 staq ap|argl,x4 Set for indirect  002100 aa 0 77774 3521 34 2004 eppbp ap|argl,x4* bp -> letlist  002101 aa 2 00000 2371 00 2005 ldaq bp|0 Letlist element 002102 aa 077700 3150 07 2006 cana lisp_ptr.type,dl Atomic, i.e. (let (foo ...  002103 aa 777634 6010 04 2007 tnz bad_fcnl-*,ic This is what interpreters are for.  002104 aa 2 00000 2371 20 2008 ldaq bp|0,* car of letlist = symbol  002105 aa 0 77776 7571 00 2009 staq ap|-2 Save lambda var  002106 aa 010000 3150 07 2010 cana Atsym,dl Make lambda var checks. 002107 aa 777666 6000 04 2011 tze bad_bound_var-*,ic 002110 aa 1 00012 1171 00 2012 cmpaq ab|nil  002111 aa 777347 6000 04 2013 tze loser_binding_nil-*,ic 002112 aa 0 77776 2371 20 2014 ldaq ap|-2,* Get current val  002113 aa 0 77774 7571 00 2015 staq ap|-4 Save in binding block. 002114 aa 0 77774 3521 34 2016 eppbp ap|argl,x4* Point to "rest" of letlist  002115 aa 2 00002 2371 00 2017 ldaq bp|2 Get that cdr.  002116 aa 777755 7100 04 2018 tra let_bind_1-*,ic  2019  002117 2020 let_ll_done:  002117 aa 0 00000 6211 00 2021 eax1 ap|0  002120 aa 1 77776 7411 17 2022 stx1 ab|-2,x7 set binding_block.topblock. 002121 4a 4 00042 2361 20 2023 ldq lisp_static_vars_$binding_top+1 Avoid fbb hackery for let. 002122 aa 1 77777 7561 17 2024 stq ab|-1,x7  002123 aa 1 77776 6361 17 2025 eaq ab|-2,x7  002124 4a 4 00042 7561 20 2026 stq lisp_static_vars_$binding_top+1  2027 " Now eval the things to be assigned.  2028  002125 aa 0 77770 2371 34 2029 ldaq ap|form,x4* Point at cons which heads let cdr.  002126 aa 0 77774 7571 14 2030 staq ap|argl,x4 Now have let list. 2031  002127 aa 000000 6230 14 2032 eax3 0,x4 Duplicate x4.  002130 aa 0 00002 3501 00 2033 eppap ap|2 Push work var. 002131 2034 let_bind_2: 002131 aa 077700 3150 07 2035 cana lisp_ptr.type,dl Is it done?  002132 0a 002153 6010 00 2036 tnz let_bind_2_done yes.  2037  002133 aa 0 77772 3521 34 2038 eppbp ap|argl-2,x4* Point at current letlist head. 002134 aa 2 00000 3521 20 2039 eppbp bp|0,* Point at car, guaranteed non-atomic  002135 aa 2 00002 2371 00 2040 ldaq bp|2 Is there a cadr?  002136 aa 077700 3150 07 2041 cana lisp_ptr.type,dl ...  002137 0a 002144 6010 00 2042 tnz let_bind_2_gets_nil no 002140 aa 2 00002 2371 20 2043 ldaq bp|2,* Get the cadr. 002141 aa 0 77776 7571 00 2044 staq ap|-2 002142 aa 775670 7000 04 2045 tsx0 recurse-*,ic Get the result of evalling it.  002143 aa 000002 7100 04 2046 tra *+2-*,ic  002144 2047 let_bind_2_gets_nil:  002144 aa 1 00012 2371 00 2048 ldaq ab|nil  002145 aa 0 00000 7571 33 2049 staq ap|2-2,3* -2 for atsym, 2 for work temp.  002146 aa 000004 6230 13 2050 eax3 4,3 Account for one var. 002147 aa 0 77772 3521 34 2051 eppbp ap|argl-2,x4* Point a letlist cons.  002150 aa 2 00002 2371 00 2052 ldaq bp|2 Get cdr.  002151 aa 0 77772 7571 14 2053 staq ap|argl-2,x4 Cdr down list.  002152 0a 002131 7100 00 2054 tra let_bind_2 Loop some more. 2055 "  2056 " Now make like we were a real lambda.  2057 "  002153 2058 let_bind_2_done:  002153 aa 000000 6220 00 2059 eax2 0 Zero all of Moon's flags.  002154 aa 0 77776 3501 00 2060 eppap ap|-2 Drop the work temp.  002155 aa 0 77770 2371 14 2061 ldaq ap|form,x4 Get letlist and body.  002156 aa 0 77772 7571 14 2062 staq ap|fcn,x4 Put where eval_lambda_body wants it.  002157 aa 776533 7050 04 2063 tsx5 eval_lambda_body-*,ic 002160 aa 775640 7100 04 2064 tra lisp_retn-*,ic 2065 "  2066 " arg & setarg subrs for lisp  2067  002234 2068 segdef arg,setarg,listify  2069  002161 aa 0 77776 2371 00 2070 argcom: ldaq ap|-2 argument which is arg number.  002162 aa 040047 1150 07 2071 cmpa fixnum_type,dl  002163 aa 000005 6000 04 2072 tze 5,ic  002164 4a 4 00112 2351 20 2073 wta_arg: lda lisp_error_table_$meaningless_argument_number  002165 aa 777777 2360 12 2074 ldq -1,x2 get fcn name code. 002166 aa 775761 7000 04 2075 tsx0 error-*,ic  002167 aa 777772 7100 04 2076 tra argcom-*,ic  002170 0a 002270 1020 03 2077 cmpx2 qqlistify,du see if called by listify.  002171 aa 000011 6010 04 2078 tnz not_listify-*,ic  002172 aa 000000 6210 06 2079 eax1 0,ql  002173 aa 000011 6050 04 2080 tpl argcom1-*,ic if positive or zero, ok. 002174 4a 4 00046 2371 20 2081 ldaq lisp_static_vars_$argatom check for lexpr 002175 aa 000110 6000 04 2082 tze bad_use_arg-*,ic  002176 4a 4 00046 0611 20 2083 adx1 lisp_static_vars_$argatom 002177 aa 777765 6040 04 2084 tmi wta_arg-*,ic if want more args than we got, error.  002200 4a 4 00046 2211 20 2085 ldx1 lisp_static_vars_$argatom now get last arg addr.  002201 aa 000006 7100 04 2086 tra argcom2-*,ic  002202 2087 not_listify:  002202 aa 000001 1160 07 2088 cmpq 1,dl  002203 aa 777761 6040 04 2089 tmi wta_arg-*,ic  002204 2090 argcom1:  002204 aa 000000 6210 06 2091 eax1 0,ql  2092  2093 " is there really an arg atom?  2094  002205 4a 4 00046 2371 20 2095 ldaq lisp_static_vars_$argatom 002206 aa 000077 6000 04 2096 tze bad_use_arg-*,ic ****** argatom inited to 0 ******  002207 2097 argcom2:  002207 4a 4 00046 1011 20 2098 cmpx1 lisp_static_vars_$argatom check against arg count  002210 aa 000002 6000 04 2099 tze 2,ic  002211 aa 777753 6050 04 2100 tpl wta_arg-*,ic  002212 aa 0 00000 3531 00 2101 epbpbb ap|0  002213 aa 3 00000 3521 02 2102 eppbp bb|0,qu start of arguments on stack  002214 aa 2 77777 3521 11 2103 eppbp bp|-1,x1 002215 aa 2 77777 3521 11 2104 eppbp bp|-1,x1 (twice because args are double-words  002216 aa 000000 7100 15 2105 tra 0,5  2106  002217 aa 000073 6220 04 2107 arg: eax2 qqarg-*,ic  002220 aa 0 77776 2371 00 2108 ldaq ap|-2 get argument  002221 aa 1 00012 1171 00 2109 cmpaq ab|nil if nil, get arg count!  002222 0a 002230 6010 00 2110 tnz arg_non_nil  002223 4a 4 00046 2371 20 2111 ldaq lisp_static_vars_$argatom 002224 aa 000061 6000 04 2112 tze bad_use_arg-*,ic  002225 aa 000066 7730 00 2113 lrl 54 move arg count to q  002226 aa 040047 2350 07 2114 lda fixnum_type,dl 002227 0a 002232 7100 00 2115 tra arg_return 002230 2116 arg_non_nil:  002230 aa 777731 7050 04 2117 tsx5 argcom-*,ic  002231 aa 2 00000 2371 00 2118 ldaq bp|0 the arg  002232 2119 arg_return: 002232 aa 0 77776 3501 00 2120 eppap ap|-2  002233 aa 775566 7100 04 2121 tra lisp_rtn_1-*,ic  2122  002234 aa 000034 6220 04 2123 listify: eax2 qqlistify-*,ic to get right name for wta message.  002235 aa 777724 7050 04 2124 tsx5 argcom-*,ic go to common code for arg and setarg,  2125 " which will get address of last arg to be in list into bp, 002236 aa 0 77777 2351 00 2126 lda ap|-1 load number of things to be consed.  002237 aa 000002 6050 04 2127 tpl 2,ic  002240 aa 000000 5310 03 2128 neg 0,du " make sure positive.  002241 aa 000000 6210 05 2129 eax1 0,al and put into x1.  2130  002242 aa 1 00012 2371 00 2131 ldaq ab|nil get nil result.  002243 aa 000002 6270 17 2132 eax7 2,x7  002244 aa 777777 6210 11 2133 lstfy_loop:eax1 -1,x1 decrement count of things to be consed. 002245 0a 002264 6040 00 2134 tmi lstfy_end  002246 aa 1 77776 5421 17 2135 sprpbp ab|-2,x7 save ptr to arg. 002247 aa 1 77777 7411 17 2136 stx1 ab|-1,x7 and number of args.  002250 aa 0 00004 3501 00 2137 eppap ap|4 get room for args to cons.  002251 aa 0 77776 7571 00 2138 staq ap|-2 store previous result 002252 aa 2 00000 2371 00 2139 ldaq bp|0 get next most recent argument from bp  002253 aa 0 77774 7571 00 2140 staq ap|-4 and make first arg to cons.  002254 aa 000004 6270 17 2141 eax7 4,x7 now call cons  002255 aa 1 77774 6501 17 2142 sprilp ab|-4,x7 save lp  002256 aa 1 77776 3571 17 2143 stcd ab|-2,x7 and return addr.  002257 4a 4 00114 7101 20 2144 tra lisp_alloc_$cons_ and jump.  2145  002260 aa 1 77776 7621 17 2146 lprpbp ab|-2,x7 get back the ptr to args,  002261 aa 1 77777 2211 17 2147 ldx1 ab|-1,x7 and count. 002262 aa 2 77776 3521 00 2148 eppbp bp|-2 move back one arg  002263 aa 777761 7100 04 2149 tra lstfy_loop-*,ic and loop if more args.  2150  002264 2151 lstfy_end:  002264 aa 777776 6270 17 2152 eax7 -2,x7 pop off save space  002265 aa 0 77776 3501 00 2153 eppap ap|-2 and argument 002266 aa 775533 7100 04 2154 tra lisp_rtn_1-*,ic and return.  2155  002267 aa 777777 777545 2156 vfd 18/-1,18/fn_listify  002270 2157 qqlistify:  002270 aa 1 00012 2371 00 2158 ldaq ab|nil  002271 aa 0 77776 7571 00 2159 staq ap|-2 002272 4a 4 00116 2371 20 2160 ldaq lisp_static_vars_$qlstfy  002273 0a 002326 7100 00 2161 tra b_u_a_com  2162  2163  002274 aa 000023 6220 04 2164 setarg: eax2 qqsetarg-*,ic  002275 aa 0 77774 2371 00 2165 ldaq ap|-4 move first arg up 002276 aa 0 00002 3501 00 2166 eppap ap|2 002277 aa 0 77776 7571 00 2167 staq ap|-2 002300 aa 777661 7050 04 2168 tsx5 argcom-*,ic  002301 aa 0 77774 2371 00 2169 ldaq ap|-4 get 2nd arg  002302 aa 2 00000 7571 00 2170 staq bp|0 store into stacked args  002303 aa 0 77772 3501 00 2171 eppap ap|-6 clear stack  002304 aa 775515 7100 04 2172 tra lisp_rtn_1-*,ic  2173  2174 " arg or setarg with no lexpr in process  2175  002305 2176 bad_use_arg:  002305 aa 0 00004 3501 00 2177 eppap ap|4 002306 aa 0 77772 2371 00 2178 ldaq ap|-6 002307 aa 0 77774 7571 00 2179 staq ap|-4 002310 aa 000000 7100 12 2180 tra 0,x2  2181  002311 aa 777777 777765 2182 vfd 18/-1,18/fn_arg  002312 aa 1 00012 2371 00 2183 qqarg: ldaq ab|nil  002313 aa 0 77776 7571 00 2184 staq ap|-2 002314 4a 4 00120 2371 20 2185 ldaq lisp_static_vars_$qarg  002315 aa 000011 7100 04 2186 tra b_u_a_com-*,ic 2187  002316 aa 777777 777764 2188 vfd 18/-1,18/fn_setarg 002317 aa 0 00002 3501 00 2189 qqsetarg: eppap ap|2 this one has two args, have to make list of them 002320 aa 0 77766 2371 00 2190 ldaq ap|-10 get 2nd arg to setarg  002321 aa 0 77774 7571 00 2191 staq ap|-4 002322 aa 1 00012 2371 00 2192 ldaq ab|nil  002323 aa 0 77776 7571 00 2193 staq ap|-2 002324 aa 000013 7000 04 2194 tsx0 call_cons-*,ic  002325 4a 4 00122 2371 20 2195 ldaq lisp_static_vars_$qsetarg 002326 2196 b_u_a_com:  002326 aa 0 77772 7571 00 2197 staq ap|-6 002327 aa 000010 7000 04 2198 tsx0 call_cons-*,ic make list of fcn-name and arg list  002330 aa 0 00002 3501 00 2199 eppap ap|2 002331 aa 1 00012 2371 00 2200 ldaq ab|nil  002332 aa 0 77776 7571 00 2201 staq ap|-2 002333 aa 000004 7000 04 2202 tsx0 call_cons-*,ic  002334 aa 000003 7000 04 2203 tsx0 call_cons-*,ic  002335 4a 4 00124 2351 20 2204 lda lisp_error_table_$no_lexpr 002336 aa 775611 7000 04 2205 tsx0 error-*,ic  2206 " never returns  2207  2208  002337 2209 call_cons:  002337 aa 000012 6270 17 2210 eax7 10,x7 save registers 002340 aa 1 77773 7401 17 2211 stx0 ab|-5,x7  002341 aa 1 77766 7411 17 2212 stx1 ab|-10,x7 002342 aa 1 77767 7421 17 2213 stx2 ab|-9,x7  002343 aa 1 77770 7431 17 2214 stx3 ab|-8,x7  002344 aa 1 77771 7441 17 2215 stx4 ab|-7,x7  002345 aa 1 77772 7451 17 2216 stx5 ab|-6,x7  2217  002346 aa 1 77774 6501 17 2218 sprilp ab|-4,x7  002347 aa 1 77776 3571 17 2219 stcd ab|-2,x7  002350 4a 4 00114 7101 20 2220 tra lisp_alloc_$cons_  002351 aa 0 00002 3501 00 2221 eppap ap|2 002352 aa 0 77776 7571 00 2222 staq ap|-2 2223  002353 aa 1 77772 2211 17 2224 ldx1 ab|-6,x7  002354 aa 1 77773 2221 17 2225 ldx2 ab|-5,x7  002355 aa 1 77774 2231 17 2226 ldx3 ab|-4,x7  002356 aa 1 77775 2241 17 2227 ldx4 ab|-3,x7  002357 aa 1 77776 2251 17 2228 ldx5 ab|-2,x7  002360 aa 1 77777 2201 17 2229 ldx0 ab|-1,x7  002361 aa 777772 6270 17 2230 eax7 -6,x7 002362 aa 000000 7100 10 2231 tra 0,x0  2232  2233  2234  2235 "  2236 " map functions 2237  2238 " written by D. Moon, 3 Aug 72  2239  2240 " the function being mapped is checked first (by find_type) 2241 " to see what kind it is. As much of the work of making  2242 " binding_blocks, etc. as possible is done once only, instead  2243 " of each time the function is called. Then a quick loop is  2244 " entered: the arguments are spread out on the pdl, and in the  2245 " case of a fsubr or fexpr they are consed up again. The  2246 " function is executed, the result it returns is taken care of, 2247 " and the loop repeats. When one (or more) of the map lists is 2248 " exhausted, control passes to map_ending which cleans up and  2249 " returns. Note that becuase of this, if one of the map lists  2250 " is initially nil (or atomic) the number-of-arguments  2251 " checking may never get done.  2252  2253 " use of the marked pdl.  2254 "  2255 " there is some stuff peculiar to map, and above that  2256 " the standard junk used by eval:  2257 "  2258 " bb|0,x3  2259 " mapfcn function being mapped, as  2260 " returned by find_type 2261 " firstlist first list being mapped over  2262 " .  2263 " .  2264 " .  2265 " firstlist+2n-2 last list being mapped over  2266 "(the above are initially the args to 'map', later  2267 " cdr-ized or whatever) 2268 " mapresult accumulates result of map. 2269 " form as in apply 2270 " fcn "  2271 " argl "  2272 " qsrac " 2273 "ap|0,x4  2274 "  2275 "  2276 " - pieces of the lists being mapped over  2277 "ap|0  2278  2279  2280 " use of the unmarked pdl  2281 " (much same as in apply)  2282 "  2283 " save x3 and x5 (2 words, peculiar to map) 2284 " funarg binding block (2 words)  2285 " eval-frame (2 words)  2286 " reg save area (2 words) - also handy non-gc temporaries  2287 " binding_block (2 words)  2288 "ab|0,x7  2289  2290 "  2291 " register usage - registers not listed are temp's 2292 "  2293 " x0 calling (tsx0) 2294 " x2 control flags as in eval & apply  2295 " x3 -> original args to map, on marked pdl 2296 " x4 -size of binding block, as in eval & apply 2297 " x5 number of lists being mapped over. 2298 " ( = number of args to map-1)  2299 " x7 unmarked pdl ptr (with ab) 2300 " ap marked pdl ptr 2301 " bb marked pdl base, used with x3 to get to mapfcn, map lists  2302 " ab unmarked pdl base  2303  2304  2305 " define bits in x2 specifically for map  2306  400000 2307 bool mapcarf,400000 mapc,mapcar,mapcan if 1  2308 "map,maplist,mapcon if 0  200000 2309 bool mapretf,200000 cons up list of return values  100000 2310 bool mapconf,100000 nconc up list of return values 040000 2311 bool listargs,40000 fsubr or fexpr 020000 2312 bool mapf,20000 so fcn_fin knows where to return to  2313  2314 "  2315  000000 2316 equ mapfcn,0  000002 2317 equ firstlist,2  777777 777766 2318 equ mapresult,form-2  2319  2320 "  2321  777777 777766 2322 equ mapsvx3,-10  777777 777767 2323 equ mapsvx5,-9 PROBABLY NOT USED  2324  2325  002375 2326 segdef map,mapc,mapcar,maplist,mapcan,mapcon  2327  2328 "  2329 " entry points - just set x2 bits & enter common code  2330  2331 " these are type 1 lsubr's. 2332 " the args property should be (2 . 777) or 777002  2333  002363 aa 020002 6220 00 2334 map: eax2 applybit+mapf 002364 aa 000012 7100 04 2335 tra mapcom-*,ic  2336  002365 aa 420002 6220 00 2337 mapc: eax2 applybit+mapf+mapcarf  002366 aa 000010 7100 04 2338 tra mapcom-*,ic  2339  002367 aa 620002 6220 00 2340 mapcar: eax2 applybit+mapf+mapcarf+mapretf  002370 aa 000006 7100 04 2341 tra mapcom-*,ic  2342  002371 aa 220002 6220 00 2343 maplist: eax2 applybit+mapf+mapretf 002372 aa 000004 7100 04 2344 tra mapcom-*,ic  2345  002373 aa 520002 6220 00 2346 mapcan: eax2 applybit+mapf+mapcarf+mapconf  002374 aa 000002 7100 04 2347 tra mapcom-*,ic  2348  002375 aa 120002 6220 00 2349 mapcon: eax2 applybit+mapf+mapconf  2350 "tra mapcom-*,ic  2351  2352 "  002376 aa 0 00000 3531 00 2353 mapcom: epbpbb ap|0 002377 aa 0 00000 6231 15 2354 eax3 ap|0,x5 points to our args (lsubt)  002400 aa 000000 6350 15 2355 eaa 0,x5 get number of lists being  002401 aa 000023 7310 00 2356 ars 19 mapped over in x5 002402 aa 000000 5310 00 2357 neg 0  002403 aa 777777 6250 05 2358 eax5 -1,al 2359  2360 " if map or mapc, have to save first list so we can return it  2361  002404 aa 300000 3020 03 2362 canx2 mapretf+mapconf,du  002405 aa 000004 6010 04 2363 tnz mapc_klg_xx-*,ic not map or mapc, skip it  002406 aa 0 00002 3501 00 2364 eppap ap|2 sanwich in between map lists and mapresult,etc.  002407 aa 3 00002 2371 13 2365 ldaq bb|firstlist,x3  002410 aa 0 77776 7571 00 2366 staq ap|-2 002411 2367 mapc_klg_xx:  002411 aa 0 00012 3501 00 2368 eppap ap|-mapresult get room to work  002412 aa 000012 6270 17 2369 eax7 10,x7 .. 002413 aa 0 00000 6261 00 2370 eax6 ap|0  002414 aa 1 77776 7461 17 2371 stx6 ab|-2,x7 binding_block.top_block 002415 aa 1 77776 4461 17 2372 sxl6 ab|-2,x7 binding_block.bot_block 002416 aa 000000 6240 00 2373 eax4 0 ...binding block is empty (now)  002417 aa 1 00012 2371 00 2374 ldaq ab|nil  002420 aa 0 77766 7571 00 2375 staq ap|mapresult init.  002421 aa 3 00000 2371 13 2376 ldaq bb|mapfcn,x3  002422 aa 0 77770 7571 00 2377 staq ap|form  002423 aa 0 77772 7571 00 2378 staq ap|fcn - as in apply 002424 aa 1 77766 7431 17 2379 stx3 ab|mapsvx3,x7 save ptr to our arguments  2380  2381 " in *rset t mode, make eval_frame  2382  002425 4a 4 00026 2371 20 2383 ldaq lisp_static_vars_$star_rset,* 002426 aa 1 00012 1171 00 2384 cmpaq ab|nil  002427 aa 000012 6000 04 2385 tze map_mnf-*,ic  2386  002430 aa 6 00001 6261 00 2387 eax6 sp|1 apply-type frame  002431 aa 1 77773 7461 17 2388 stx6 ab|frame.dat1-6,x7  002432 aa 0 77770 6261 00 2389 eax6 ap|form fcn being mapped 002433 aa 1 77772 4461 17 2390 sxl6 ab|frame.stack_ptr-6,x7  002434 4a 4 00032 2261 20 2391 ldx6 lisp_static_vars_$eval_frame+1  002435 aa 1 77772 7461 17 2392 stx6 ab|frame.prev_frame-6,x7  002436 aa 1 77772 6261 17 2393 eax6 ab|-6,x7  002437 4a 4 00032 7461 20 2394 stx6 lisp_static_vars_$eval_frame+1  002440 aa 000010 2620 03 2395 orx2 framebit,du  2396  002441 2397 map_mnf:  2398  002441 aa 776605 7030 04 2399 tsx3 find_type-*,ic go analyze the fcn being mapped  2400 " return transfer vector for find_type  002442 aa 000073 7100 04 2401 tra map_subr-*,ic array  002443 aa 000072 7100 04 2402 tra map_subr-*,ic subr 002444 aa 000101 7100 04 2403 tra map_lsubr-*,ic 002445 aa 000026 7100 04 2404 tra map_expr-*,ic  002446 aa 000011 7100 04 2405 tra map_fexpr-*,ic 002447 aa 000073 7100 04 2406 tra map_fsubr-*,ic 002450 aa 000033 7100 04 2407 tra map_lexpr-*,ic 2408  2409 "  2410 " set up various things on return from find_type  2411 " called by tsx0  2412  002451 2413 map_set_up: 002451 aa 1 77766 2231 17 2414 ldx3 ab|mapsvx3,x7 restore x3  002452 aa 0 00000 3531 00 2415 epbpbb ap|0 base of marked pdl  002453 aa 0 77772 2371 14 2416 ldaq ap|fcn,x4 save fcn for multiple applications 002454 aa 3 00000 7571 13 2417 staq bb|mapfcn,x3  002455 aa 0 00000 6211 00 2418 eax1 ap|0 since mapped fcns never eval their args,  002456 aa 777015 7100 04 2419 tra finish_bindings-*,ic it is safe to make the pseudo bb a real bb now  2420  2421 "  2422 " set up to map a fexpr 2423  002457 2424 map_fexpr:  002457 aa 777772 7000 04 2425 tsx0 map_set_up-*,ic  002460 aa 040004 2620 03 2426 orx2 listargs+exprbit,du  002461 aa 776043 7000 04 2427 tsx0 lambda_bind-*,ic  002462 aa 000001 1060 03 2428 cmpx6 1,du how many lambda variables? 002463 aa 777254 6020 04 2429 tnc bad_fcnl-*,ic 0 -- lose.  002464 aa 000155 6000 04 2430 tze map_go-*,ic 1 -- easy.  2431 " 2 -- bind 2nd to pdl ptr  002465 aa 1 77776 6361 17 2432 eaq ab|-2,x7 make pdl ptr -> binding block  002466 aa 000022 7720 00 2433 qrl 18 002467 aa 777776 2760 03 2434 orq -2,du  002470 aa 040047 2350 07 2435 lda fixnum_type,dl 002471 aa 0 77776 7571 20 2436 staq ap|-2,*  002472 aa 000147 7100 04 2437 tra map_go-*,ic  2438  2439  2440 " set up to map an expr -- or '(lambda ( ) ...) 2441  002473 2442 map_expr:  002473 aa 777756 7000 04 2443 tsx0 map_set_up-*,ic  002474 aa 000004 2620 03 2444 orx2 exprbit,du  002475 aa 776027 7000 04 2445 tsx0 lambda_bind-*,ic  002476 aa 1 77774 7451 17 2446 stx5 ab|svx5u,x7  002477 aa 1 77774 1061 17 2447 cmpx6 ab|svx5u,x7 right number of args?  002500 aa 000141 6000 04 2448 tze map_go-*,ic yes.  2449  002501 aa 000115 7060 04 2450 tsx6 make_argl-*,ic no, give error 002502 aa 777275 7100 04 2451 tra wrong_no_args_expr-*,ic  2452  2453  2454  2455  2456 " set up to map a lexpr 2457 " we can bind both the lambda atom and the argatom now, 2458 " since we know how many args and where they will be.  2459  002503 2460 map_lexpr:  002503 aa 777746 7000 04 2461 tsx0 map_set_up-*,ic  002504 aa 000024 2620 03 2462 orx2 exprbit+lsubrbit,du  002505 aa 0 00010 3501 00 2463 eppap ap|8 going to bind two things  002506 aa 777770 6240 14 2464 eax4 -8,x4 002507 aa 0 77772 2371 34 2465 ldaq ap|fcn,x4* get the lambda - atom  002510 aa 0 77776 7571 00 2466 staq ap|-2 002511 aa 776743 7000 04 2467 tsx0 ck_bound_var-*,ic 002512 aa 0 77776 2371 20 2468 ldaq ap|-2,*  002513 aa 0 77774 7571 00 2469 staq ap|-4 002514 4a 4 00046 3521 20 2470 eppbp lisp_static_vars_$argatom  002515 aa 1 77774 2521 17 2471 spribp ab|-4,x7 save area is not in use right now 002516 aa 1 77774 2371 17 2472 ldaq ab|-4,x7  002517 aa 060000 2750 07 2473 ora Uncollectable,dl not really an atom  002520 aa 0 77772 7571 00 2474 staq ap|-6 002521 aa 0 77772 2371 20 2475 ldaq ap|-6,*  002522 aa 0 77770 7571 00 2476 staq ap|-8 002523 aa 0 00000 6211 00 2477 eax1 ap|0  002524 aa 1 77776 7411 17 2478 stx1 ab|-2,x7 update binding_block.top_block  2479  002525 aa 0 00000 6361 00 2480 eaq ap|0 loc. of spread args  002526 aa 000000 6350 15 2481 eaa 0,x5 number of args  002527 aa 060000 2750 07 2482 ora Uncollectable,dl  002530 aa 0 77772 7571 20 2483 staq ap|-6,* bind "argatom"  002531 aa 000066 7730 00 2484 lrl 54 002532 aa 040047 2350 07 2485 lda fixnum_type,dl 002533 aa 0 77776 7571 20 2486 staq ap|-2,* bind lambda-atom 002534 aa 000105 7100 04 2487 tra map_go-*,ic  2488  2489 "  2490 " set up to map a subr - check number of args  2491  002535 2492 map_subr:  002535 aa 777714 7000 04 2493 tsx0 map_set_up-*,ic  002536 aa 0 77772 1051 34 2494 cmpx5 ap|fcn,x4* check number of args  002537 aa 000102 6000 04 2495 tze map_go-*,ic ok.  2496  002540 aa 000056 7060 04 2497 tsx6 make_argl-*,ic no, error  002541 aa 777271 7100 04 2498 tra wrong_no_args_subr-*,ic  2499  2500  2501 " set up to map an fsubr - not hard 2502  002542 2503 map_fsubr:  002542 aa 777707 7000 04 2504 tsx0 map_set_up-*,ic  002543 aa 040000 2620 03 2505 orx2 listargs,du  002544 aa 000075 7100 04 2506 tra map_go-*,ic  2507  2508  2509 " set up to map an lsubr - check number of args 2510  002545 2511 map_lsubr:  002545 aa 777704 7000 04 2512 tsx0 map_set_up-*,ic  002546 aa 000020 2620 03 2513 orx2 lsubrbit,du  002547 4a 4 00026 2371 20 2514 ldaq lisp_static_vars_$star_rset,* 002550 aa 1 00012 1171 00 2515 cmpaq ab|nil - only check # args in *rset t mode  002551 aa 000070 6000 04 2516 tze map_go-*,ic  2517  002552 aa 0 77772 2351 34 2518 lda ap|fcn,x4* 002553 aa 000777 3750 03 2519 ana =o000777,du min  002554 aa 1 77774 7551 17 2520 sta ab|-4,x7  002555 aa 0 77772 2351 34 2521 lda ap|fcn,x4* 002556 aa 777000 3750 03 2522 ana =o777000,du max  002557 aa 000011 7710 00 2523 arl 9  002560 aa 000002 6010 04 2524 tnz 2,ic  002561 aa 777777 2350 03 2525 lda =o777777,du if max=0, use big number  002562 aa 1 77775 7551 17 2526 sta ab|-3,x7  002563 aa 1 77774 1051 17 2527 cmpx5 ab|-4,x7 002564 aa 000006 6020 04 2528 tnc map_tfa_lsubr-*,ic 002565 aa 1 77775 1051 17 2529 cmpx5 ab|-3,x7 002566 aa 000053 6000 04 2530 tze map_go-*,ic  002567 aa 000052 6020 04 2531 tnc map_go-*,ic  002570 2532 map_tma_lsubr:  002570 aa 000026 7060 04 2533 tsx6 make_argl-*,ic  002571 aa 777252 7100 04 2534 tra too_many_args_lsubr-*,ic  002572 2535 map_tfa_lsubr:  002572 aa 000024 7060 04 2536 tsx6 make_argl-*,ic  002573 aa 777250 7100 04 2537 tra too_few_args_lsubr-*,ic  2538  2539 "  2540 " routine to put arguments up on top of marked pdl  2541 " this is the map version of arg_spreader  2542  2543 " requires bb,x3 set up to get to map lists 2544 " requires x5 to contain arg count  2545 " updates x4  2546 " uses x1,aq  2547 " Doesn't change x6 or bb  2548 " called by tsx0  2549  002574 aa 3 00002 6211 13 2550 mv_args: eax1 bb|firstlist,x3  002575 aa 000000 6350 15 2551 eaa 0,x5 get number of lists times 2  002576 aa 000001 7350 00 2552 als 1  002577 aa 1 77774 7551 17 2553 sta ab|svx5u,x7  002600 aa 1 77774 0411 17 2554 asx1 ab|svx5u,x7 used by cmpx1 to end the loop 2555  002601 2556 mv_args_loop:  002601 aa 1 77774 1011 17 2557 cmpx1 ab|svx5u,x7 done all map lists?  002602 aa 000000 6000 10 2558 tze 0,0 yes.  002603 aa 3 00000 2371 11 2559 ldaq bb|0,x1 no, get one. 002604 aa 077700 3150 07 2560 cana lisp_ptr.type,dl end? 002605 aa 000243 6010 04 2561 tnz map_ending-*,ic yes, go clean up 002606 aa 400000 3020 03 2562 canx2 mapcarf,du  002607 aa 000002 6000 04 2563 tze 2,ic  002610 aa 3 00000 2371 31 2564 ldaq bb|0,x1*  002611 aa 0 00002 3501 00 2565 eppap ap|2 002612 aa 777776 6240 14 2566 eax4 -2,x4 002613 aa 0 77776 7571 00 2567 staq ap|-2 put an arg on pdl  002614 aa 000002 6210 11 2568 eax1 2,x1 ..and advance to next list  002615 aa 777764 7100 04 2569 tra mv_args_loop-*,ic  2570  2571 "  2572 " routine to cons up an argument list  2573 " used by fsubr, fexpr, and wrong_no_args  2574  2575 " called by tsx6 (yes 6, not 0) 2576 " bb,x3 must be set up to get to map lists  2577 " x5 must contain number of map lists  2578 " uses x1  2579 " destroys bb  2580 " leaves x4, ap unchanged  2581 " returns the argument list in ap|argl,x4  2582  2583 " this routine operates by calling mv_args to spread them out,  2584 " then it pushes a nil on top of pdl to end the list,  2585 " and calls cons enough times to bring them all down  2586 " into a list.  2587  2588 " the entry point make_argl_nmv is for when mv_args 2589 " has already been called  2590  002616 2591 make_argl:  002616 aa 777756 7000 04 2592 tsx0 mv_args-*,ic first spread them out... 002617 2593 make_argl_nmv:  002617 aa 0 00002 3501 00 2594 eppap ap|2 then put a nil at the end  002620 aa 1 00012 2371 00 2595 ldaq ab|nil  002621 aa 0 77776 7571 00 2596 staq ap|-2 002622 aa 000004 6270 17 2597 eax7 4,x7 -- extra save area  002623 aa 1 77777 7451 17 2598 stx5 ab|-1,x7  002624 aa 1 77777 0641 17 2599 adx4 ab|-1,x7 adjust x4 back to what it should be,  002625 aa 1 77777 0641 17 2600 adx4 ab|-1,x7 after all the consing is done  002626 aa 1 77776 7461 17 2601 stx6 ab|-2,x7 save our return addr  2602  002627 aa 777510 7000 04 2603 tsx0 call_cons-*,ic -- known to be at least 1 arg  002630 aa 000001 1650 03 2604 sbx5 1,du  002631 aa 777776 6010 04 2605 tnz -2,ic  2606  002632 aa 1 77776 2261 17 2607 ldx6 ab|-2,x7  002633 aa 1 77777 2251 17 2608 ldx5 ab|-1,x7  2609 "ldaq ap|-2  002634 aa 0 77776 3501 00 2610 eppap ap|-2  002635 aa 777774 6270 17 2611 eax7 -4,x7 002636 aa 0 77774 7571 14 2612 staq ap|argl,x4  002637 aa 000000 7100 16 2613 tra 0,6  2614 "  2615 " here we have the routine to actually apply the function  2616  002640 aa 1 77766 2231 17 2617 map_go3: ldx3 ab|mapsvx3,x7 restore x3 after function call  2618  002641 aa 0 00000 3531 00 2619 map_go: epbpbb ap|0 bb may have been munged  002642 aa 777732 7000 04 2620 tsx0 mv_args-*,ic spread out the args  002643 aa 3 00000 2371 13 2621 ldaq bb|mapfcn,x3 get the fcn  002644 aa 0 77772 7571 14 2622 staq ap|fcn,x4 where eval wants it  002645 aa 000004 3020 03 2623 canx2 exprbit,du expr type or subr type?  002646 aa 000020 6010 04 2624 tnz map_do_expr-*,ic  2625  2626 " subr type 2627  002647 aa 040000 3020 03 2628 canx2 listargs,du fsubr?  002650 aa 000010 6010 04 2629 tnz map_do_fsubr-*,ic yes.  002651 aa 000020 3020 03 2630 canx2 lsubrbit,du lsubr?  002652 aa 776223 6000 04 2631 tze call_subroutine-*,ic no, subr is simple  002653 aa 000000 6350 15 2632 eaa 0,x5 yes, make argcount  002654 aa 000001 7350 00 2633 als 1  002655 aa 000000 5310 00 2634 neg 0  002656 aa 000000 6260 01 2635 eax6 0,au  002657 aa 776216 7100 04 2636 tra call_subroutine-*,ic  2637  2638  002660 2639 map_do_fsubr:  002660 aa 777737 7060 04 2640 tsx6 make_argl_nmv-*,ic  002661 aa 0 77774 2371 14 2641 ldaq ap|argl,x4  002662 aa 0 00002 3501 00 2642 eppap ap|2 pass arg list on top of marked pdl 002663 aa 777776 6240 14 2643 eax4 -2,x4 002664 aa 0 77776 7571 00 2644 staq ap|-2 002665 aa 776210 7100 04 2645 tra call_subroutine-*,ic  2646  2647  2648  2649 " expr type 2650  002666 2651 map_do_expr:  002666 aa 040000 3020 03 2652 canx2 listargs,du fexpr?  002667 aa 000023 6010 04 2653 tnz map_do_fexpr-*,ic yes.  2654  2655 " do any necc bindings then go to eval_lambda_body  2656  002670 aa 000020 3020 03 2657 canx2 lsubrbit,du lexpr?  002671 aa 000027 6010 04 2658 tnz map_do_lexpr-*,ic yes - go reassign nargs to lambda atom  2659  2660 " bind lambda variables for expr - args are on marked pdl  2661  2662  002672 aa 0 77772 2371 34 2663 ldaq ap|fcn,x4* = lambda list  002673 aa 1 77776 2211 17 2664 ldx1 ab|-2,x7 binding_block.top_block = base of args  002674 2665 map_expr_bind_loop: 002674 aa 077700 3150 07 2666 cana lisp_ptr.type,dl end? 002675 aa 000010 6010 04 2667 tnz map_expr_bind_end-*,ic yes...  002676 aa 0 77776 7571 14 2668 staq ap|qsrac,x4 no.  002677 aa 0 77776 3715 34 2669 epplb ap|qsrac,x4* 002700 aa 3 00000 2371 11 2670 ldaq bb|0,x1 get an arg  002701 aa 5 00000 7571 20 2671 staq lb|0,* assign a var  002702 aa 000002 6210 11 2672 eax1 2,x1  002703 aa 5 00002 2371 00 2673 ldaq lb|2  002704 aa 777770 7100 04 2674 tra map_expr_bind_loop-*,ic  2675  002705 2676 map_expr_bind_end:  002705 aa 1 77776 2211 17 2677 ldx1 ab|-2,x7 remove spread args from pdl 002706 aa 3 00000 3501 11 2678 eppap bb|0,x1  002707 aa 1 77776 7241 17 2679 lxl4 ab|-2,x7 reset x4  002710 aa 1 77776 1641 17 2680 sbx4 ab|-2,x7  002711 aa 776001 7100 04 2681 tra eval_lambda_body-*,ic  2682  2683  2684 " bind 1 lambda variable of fexpr  2685  002712 2686 map_do_fexpr:  002712 aa 777705 7060 04 2687 tsx6 make_argl_nmv-*,ic  002713 aa 0 77772 3521 34 2688 eppbp ap|fcn,x4* cons lambdalist body  002714 aa 2 00000 3521 20 2689 eppbp bp|0,* cons firstlambdavar restoflambdalist 002715 aa 0 77774 2371 14 2690 ldaq ap|argl,x4 get argument list  002716 aa 2 00000 7571 20 2691 staq bp|0,* assign it to first lambda-var 002717 aa 775773 7100 04 2692 tra eval_lambda_body-*,ic  2693  2694 " for a lexpr, reset the lambda atom to the number of args  2695 " each time in case loser clobbers it:  2696 " (map '(lambda y (setq y 'foo)) '(1 23) '(4 5))  2697  002720 2698 map_do_lexpr:  2699  002720 aa 000000 6360 15 2700 eaq 0,x5 get nargs  002721 aa 000022 7720 00 2701 qrl 18 002722 aa 040047 2350 07 2702 lda fixnum_type,dl convert to lisp-number 002723 aa 0 77772 3521 34 2703 eppbp ap|fcn,x4* -> atom_ptr -> atom.value  002724 aa 2 00000 7571 20 2704 staq bp|0,* store into atom's value cell 002725 aa 775765 7100 04 2705 tra eval_lambda_body-*,ic now go eval fcn  2706 "  2707 " come here after one evaluation by map 2708 " causes cleanup, resultmunging, and around again going 2709 " NB: x3 doesn't get restored until we go back to map_go3  2710  002726 2711 map_fcn_fin:  002726 aa 1 77776 2211 17 2712 ldx1 ab|-2,x7 remove spread args from pdl if still there  002727 aa 0 00000 3531 00 2713 epbpbb ap|0 (lexpr)  002730 aa 3 00000 3501 11 2714 eppap bb|0,x1  002731 aa 1 77776 7241 17 2715 lxl4 ab|-2,x7 reset x4  002732 aa 1 77776 1641 17 2716 sbx4 ab|-2,x7  2717 "" Now (after calling the fcn) cdr-ize all the lists  2718 " at this point we assume x5 has arg count and x3 can be loaded to point at lists 002733 aa 1 77766 2231 17 2719 ldx3 ab|mapsvx3,x7 002734 aa 3 00002 6211 13 2720 eax1 bb|firstlist,x3  002735 aa 000000 6260 15 2721 eax6 0,x5 x1 -> list, x6 = counter  002736 aa 000007 6000 04 2722 tze map_cdr_loop_end-*,ic  002737 2723 map_cdr_loop:  002737 aa 3 00000 3521 31 2724 eppbp bb|0,x1* -> cons whose car has been done.  002740 aa 2 00002 2371 00 2725 ldaq bp|2 cdr of that cons  002741 aa 3 00000 7571 11 2726 staq bb|0,x1  002742 aa 000002 6210 11 2727 eax1 2,x1  002743 aa 777777 6260 16 2728 eax6 -1,x6 count the lists  002744 aa 777773 6010 04 2729 tnz map_cdr_loop-*,ic  002745 2730 map_cdr_loop_end:  002745 aa 200000 3020 03 2731 canx2 mapretf,du  002746 aa 000004 6010 04 2732 tnz map_ret_er-*,ic  002747 aa 100000 3020 03 2733 canx2 mapconf,du  002750 aa 000033 6010 04 2734 tnz map_con_er-*,ic  002751 aa 777667 7100 04 2735 tra map_go3-*,ic -- go around again  2736  002752 2737 map_ret_er: 002752 0a 002640 6210 00 2738 eax1 map_go3  002753 aa 0 00004 3501 00 2739 eppap ap|4 002754 aa 0 77772 2371 14 2740 ldaq ap|qsrac-4,x4 current result  002755 aa 0 77774 7571 00 2741 staq ap|-4 002756 aa 0 77762 2371 14 2742 ldaq ap|mapresult-4,x4 last cons in list of previous results, cdr = first cons 002757 aa 1 00012 1171 00 2743 cmpaq ab|nil first time?  002760 aa 000013 6000 04 2744 tze map_ret_1st-*,ic  002761 aa 0 77762 3521 34 2745 eppbp ap|mapresult-4,x4* no, get cdr  002762 aa 2 00002 2371 00 2746 ldaq bp|2  002763 aa 0 77776 7571 00 2747 staq ap|-2 002764 aa 777353 7000 04 2748 tsx0 call_cons-*,ic  002765 aa 0 77776 2371 00 2749 ldaq ap|-2 002766 aa 0 77764 3521 34 2750 eppbp ap|mapresult-2,x4*  002767 aa 2 00002 7571 00 2751 staq bp|2  002770 aa 0 77764 7571 14 2752 staq ap|mapresult-2,x4 002771 aa 0 77776 3501 00 2753 eppap ap|-2  002772 aa 000000 7100 11 2754 tra 0,x1  2755  002773 2756 map_ret_1st:  002773 aa 0 77776 7571 00 2757 staq ap|-2 002774 aa 777343 7000 04 2758 tsx0 call_cons-*,ic  002775 aa 0 77776 2371 00 2759 ldaq ap|-2 002776 aa 0 77776 3501 00 2760 eppap ap|-2  002777 aa 0 77766 7571 14 2761 staq ap|mapresult,x4  003000 aa 0 77766 3521 34 2762 eppbp ap|mapresult,x4* 003001 aa 2 00002 7571 00 2763 staq bp|2 set cdr back to start of list  003002 aa 000000 7100 11 2764 tra 0,x1  2765 "  003003 2766 map_con_er: 003003 0a 002640 6200 00 2767 eax0 map_go3  2768  003004 aa 0 77766 2371 14 2769 ldaq ap|mapresult,x4  003005 aa 0 00004 3501 00 2770 eppap ap|4 003006 aa 0 77774 7571 00 2771 staq ap|-4 003007 aa 0 77772 2371 14 2772 ldaq ap|qsrac-4,x4 003010 aa 0 77776 7571 00 2773 staq ap|-2 003011 aa 000006 6270 17 2774 eax7 6,x7 get space to save regs, make call.  003012 aa 1 77772 7421 17 2775 stx2 ab|-6,x7 store registers we still need  003013 aa 1 77773 7451 17 2776 stx5 ab|-5,x7 save x5, since we will clobber it.  003014 aa 1 77773 4401 17 2777 sxl0 ab|-5,x7 save x0, our return ptr 003015 aa 1 77772 4441 17 2778 sxl4 ab|-6,x7 also save x4.  003016 aa 777774 6250 00 2779 eax5 -4 nconc gets 2 args, lsubr convention.  003017 aa 1 77774 6501 17 2780 sprilp ab|-4,x7 save our lp...  003020 aa 1 77776 3571 17 2781 stcd ab|-2,x7 save return address.  003021 4a 4 00126 7101 20 2782 tra lisp_alloc_$nconc  003022 aa 1 77776 2221 17 2783 ldx2 ab|-2,x7 reload registers.  003023 aa 1 77777 2251 17 2784 ldx5 ab|-1,x7  003024 aa 1 77777 7201 17 2785 lxl0 ab|-1,x7  003025 aa 1 77776 7241 17 2786 lxl4 ab|-2,x7  003026 aa 777776 6270 17 2787 eax7 -2,x7 and pop off stack  003027 aa 0 77766 7571 14 2788 staq ap|mapresult,x4 save result of nconc. 003030 aa 000000 7100 10 2789 tra 0,0  2790  2791 " come here when freturn returns from a function being mapped  2792 " have to re-establish binding block, & c.  2793 " and restart the mapping process all over again.  2794  003031 2795 map_freturn:  003031 aa 000000 6240 00 2796 eax4 0 the binding block is all gone  003032 aa 200000 3020 03 2797 canx2 mapretf,du  003033 0a 003043 6010 00 2798 tnz map_ret_er_freturn 003034 aa 100000 3020 03 2799 canx2 mapconf,du  2800 " and fall into map_freturn_restart 003035 2801 map_freturn_restart:  2802  2803 " re-make binding block 2804  003035 aa 0 00000 6261 00 2805 eax6 ap|0  003036 aa 1 77776 7461 17 2806 stx6 ab|-2,x7  003037 aa 1 77776 4461 17 2807 sxl6 ab|-2,x7  003040 aa 0 77770 2371 00 2808 ldaq ap|form the fcn being mapped  003041 aa 0 77772 7571 00 2809 staq ap|fcn put it back  003042 0a 002441 7100 00 2810 tra map_mnf  2811  003043 2812 map_ret_er_freturn: 003043 0a 003035 6210 00 2813 eax1 map_freturn_restart  003044 0a 002753 7100 00 2814 tra map_ret_er+1  003045 2815 map_con_er_freturn: 003045 0a 003035 6200 00 2816 eax0 map_freturn_restart  003046 0a 003004 7100 00 2817 tra map_con_er+1  003047 0a 003035 7100 00 2818 tra map_freturn_restart "  2819 "  2820 "come here when map is done.  2821  003050 2822 map_ending: " first get the result into proper form  2823  003050 aa 200000 3020 03 2824 canx2 mapretf,du  003051 aa 000013 6000 04 2825 tze map_ending_aa-*,ic 003052 aa 0 77766 2371 14 2826 ldaq ap|mapresult,x4 check for nil  003053 aa 1 00012 1171 00 2827 cmpaq ab|nil  003054 aa 000014 6000 04 2828 tze map_ending_2-*,ic nil => don't rplacd 003055 aa 0 77766 3521 34 2829 eppbp ap|mapresult,x4* mapcar, uncircularize return list  003056 aa 2 00002 2371 00 2830 ldaq bp|2  003057 aa 0 77776 7571 14 2831 staq ap|qsrac,x4  003060 aa 1 00012 2371 00 2832 ldaq ab|nil - put nil at end of list 003061 aa 2 00002 7571 00 2833 staq bp|2  003062 aa 0 77776 2371 14 2834 ldaq ap|qsrac,x4 get back ptr to start of list  003063 aa 000005 7100 04 2835 tra map_ending_2-*,ic  2836  003064 2837 map_ending_aa:  003064 aa 100000 3020 03 2838 canx2 mapconf,du  003065 aa 000004 6010 04 2839 tnz map_ending_1-*,ic mapresult already ok if mapconf 2840  2841 " map or mapc, return first map list as result  2842  003066 aa 0 77764 2371 14 2843 ldaq ap|mapresult-2,x4 was saved here on entry  003067 aa 000001 7100 04 2844 tra map_ending_2-*,ic  2845  003070 2846 map_abending:  003070 2847 map_ending_2:  003070 aa 0 77766 7571 14 2848 staq ap|mapresult,x4  2849  003071 2850 map_ending_1:  003071 aa 1 77766 2231 17 2851 ldx3 ab|mapsvx3,x7 get back x3  003072 aa 775673 7000 04 2852 tsx0 unbinder-*,ic 003073 aa 777776 6270 17 2853 eax7 -2,x7 pop map's extra 2 words  003074 aa 0 77766 2371 00 2854 ldaq ap|mapresult = out return value  003075 aa 000000 5074 13 2855 awdx ap|0,x3 clear rest of marked pdl  003076 aa 774723 7100 04 2856 tra lisp_rtn_1-*,ic  2857  2858  2859  2860 " routine to evaluate the bodies of prog's and do's 2861 " called with a pointer to the stack cell containing the  2862 " body of the prog or do on top of unmarked pdl. Pops it off,  2863 " evaluates the nonatomic elements of the body, ignoring the  2864 " values, and returns when it gets to the end.  2865  003077 2866 entry eval_list  2867  003077 aa 774711 7000 04 2868 eval_list: tsx0 pl1_entry-*,ic  003100 aa 0 00012 3501 00 2869 eppap ap|10 room to eval in  003101 aa 1 77776 3521 37 2870 eppbp ab|-2,x7* -> stack temp containing body  003102 aa 777776 6270 17 2871 eax7 -2,x7 003103 aa 2 77776 3521 00 2872 eppbp bp|-2 look like a cons 2873  2874 " cdr-ize the list and eval next element  2875  003104 2876 ev_list_1:  003104 aa 2 00002 2371 00 2877 ldaq bp|2 is cdr atomic? 003105 aa 077700 3150 07 2878 cana lisp_ptr.type,dl ..  003106 aa 000012 6010 04 2879 tnz ev_list_end-*,ic yes.  003107 aa 2 00002 3521 20 2880 eppbp bp|2,* no, point bp at cdr 003110 aa 0 77766 2521 00 2881 spribp ap|-10 and save it (no type bits since is list)  003111 aa 2 00000 2371 00 2882 ldaq bp|0 get cadd...ddr of body 003112 aa 077700 3150 07 2883 cana lisp_ptr.type,dl  003113 aa 000003 6010 04 2884 tnz ev_list_2-*,ic skip over it if it is atomic  003114 aa 0 77770 7571 00 2885 staq ap|form otherwise, evaluate it  003115 aa 775344 7050 04 2886 tsx5 eval_fcn-*,ic 003116 2887 ev_list_2:  003116 aa 0 77766 3521 20 2888 eppbp ap|-10,* get back a ptr to current cons of list  003117 aa 777765 7100 04 2889 tra ev_list_1-*,ic and go eval next elem  2890  003120 2891 ev_list_end:  003120 aa 0 77774 3501 00 2892 eppap ap|-4 clear the pdl  003121 aa 774661 7100 04 2893 tra pl1_return-*,ic and return.  2894  2895 " the return function, a type 1 subr  2896  003122 2897 segdef return  003122 aa 0 00002 3501 00 2898 return: eppap ap|2 put 2 things at top of pdl:  003123 aa 060000 2350 07 2899 lda Uncollectable,dl 1) the return value 003124 aa 0 77776 7571 00 2900 staq ap|-2 2) a non_nil value to distinguish from go  003125 aa 000014 7100 04 2901 tra go_ret-*,ic and return to prog  2902  2903  2904 " the go function, a type 1 fsubr  2905  003126 2906 segdef go  003126 aa 0 77776 2371 20 2907 go: ldaq ap|-2,* get our arg  003127 aa 0 00006 3501 00 2908 eppap ap|6 room to eval in  2909  2910 " keep evaling the arg until it is atomic  2911  003130 aa 077700 3150 07 2912 re_go: cana lisp_ptr.type,dl  003131 aa 000004 6010 04 2913 tnz go_1-*,ic  003132 aa 0 77770 7571 00 2914 staq ap|form  003133 aa 775326 7050 04 2915 tsx5 eval_fcn-*,ic 003134 aa 777774 7100 04 2916 tra re_go-*,ic 2917  003135 aa 0 77770 7571 00 2918 go_1: staq ap|form save label on marked pdl for prog  003136 aa 1 00012 2371 00 2919 ldaq ab|nil and put nil to mark this as a go 003137 aa 0 77772 7571 00 2920 staq ap|form+2 003140 aa 0 77774 3501 00 2921 eppap ap|form+4  2922  003141 2923 go_ret: " now do a non-local goto to the most recent prog (or do)  2924  003141 4a 4 00130 2211 20 2925 ldx1 lisp_static_vars_$prog_frame+1  003142 aa 000022 6000 04 2926 tze bad_go-*,ic err if no prog active 2927  2928 " prog is a pl1 program, so return to pl1_code mode 2929  003143 aa 1 00004 2501 20 2930 spriap ab|stack_ptr_ptr,*  003144 aa 1 00006 7471 20 2931 stx7 ab|unmkd_ptr_ptr,*  003145 aa 1 00016 5541 00 2932 stc1 ab|in_pl1_code  2933  003146 aa 6 00000 6221 00 2934 eax2 sp|0 are we in same stack frame as prog?  003147 aa 1 00005 1021 11 2935 cmpx2 ab|frame.ret+3,x1 (this is the usual case) 003150 aa 000011 6000 04 2936 tze go_ret_same_sp-*,ic yes, go without changing sp  2937  2938 " check if there possibly could be cleanup handlers in the stack  2939  003151 4a 4 00132 1011 20 2940 cmpx1 lisp_static_vars_$err_recp+1 003152 0a 003167 6020 00 2941 tnc go_ret_full_unwind might be cleanup handlers, have to go call unwinder_  003153 aa 1 00004 3521 31 2942 eppbp ab|frame.ret+2,x1* no, get ptr to stack frame of prog  003154 aa 6 00020 2521 00 2943 spribp sp|16 delete intervening frames. (allowed since  2944 " there are no cleanup handlers in lisp)  003155 aa 2 00000 6221 00 2945 eax2 bp|0  003156 aa 1 00002 3521 31 2946 eppbp ab|frame.ret,x1* get return address 003157 aa 7 00024 2521 12 2947 spribp sb|20,x2 set call out return addr in prog's frame 003160 aa 7 00042 7101 20 2948 return " quickly return to prog 2949  003161 2950 go_ret_same_sp: 003161 aa 1 00002 3521 31 2951 eppbp ab|frame.ret,x1* 003162 aa 6 00024 2521 00 2952 spribp sp|20  003163 aa 7 00044 7101 20 2953 short_return  2954  2955 " come here when go or return is done with no prog active  2956  003164 4a 4 00134 2351 20 2957 bad_go: lda lisp_error_table_$bad_prog_op  003165 aa 774762 7000 04 2958 tsx0 error-*,ic  003166 aa 000000 0000 00 2959 arg 0 uncorrectable fail-act, should never return  2960  2961  2962 " have to do the go by calling unwinder.  2963  003167 2964 go_ret_full_unwind: 003167 aa 000100 6270 00 2965 push "must save ab, x1 - get ready to call unwinder_ 003170 aa 7 00040 2721 20 2966 tempd Argl(2) arg list of one arg 2967  003171 0a 003202 2370 00 2968 ldaq arg_list_1_hdr  003172 aa 6 00060 7571 00 2969 staq Argl  003173 aa 1 00002 3521 11 2970 eppbp ab|frame.ret,x1 -> label to return to  003174 aa 6 00062 2521 00 2971 spribp Argl+2  003175 aa 6 00060 3501 00 2972 eppap Argl 003176 4a 4 00136 3521 20 2973 short_call unwinder_$unwinder_  003177 aa 7 00036 6701 20 003200 aa 6 00030 3701 20 2974  2975  003201 aa 000000 0110 03 2976 even  003202 2977 arg_list_1_hdr: 003202 aa 000002 000004 2978 zero 2,4  003203 aa 000000 000000 2979 zero 0,0  2980  003204 2981 negative_4: 003204 aa 000000 040047 2982 zero 0,fixnum_type 003205 aa 777777 777774 2983 dec -4 2984  2985 " come here to call a function with unevaluated arguments from  2986 " lisp-compiled code. ap|form=ap|fcn=function, ap|argl = arg list, 2987 " unmkd pdl has: ptr to link, caller's lp, return addr(bp)  2988  2989 " we find the type of the function and if its an fsubr link directly  2990 " to it, otherwise go through regular apply.  2991  003206 2992 segdef callf  2993  003206 2994 callf:  003206 aa 000002 6220 00 2995 eax2 applybit  003207 aa 000032 6250 04 2996 eax5 callf_rtn-*,ic  003210 aa 775260 7030 04 2997 tsx3 evaler1-*,ic  2998 " return transfer vector for find_type  2999  003211 aa 775651 7100 04 3000 tra eval_subrs_and_arrays-*,ic array  003212 aa 775650 7100 04 3001 tra eval_subrs_and_arrays-*,ic subr  003213 aa 775646 7100 04 3002 tra eval_lsubr-*,ic lsubr  003214 aa 775364 7100 04 3003 tra eval_expr-*,ic expr  003215 aa 775334 7100 04 3004 tra eval_fexpr-*,ic fexpr  003216 aa 000002 7100 04 3005 tra callf_fsubr-*,ic fsubr - special case  003217 aa 775355 7100 04 3006 tra eval_lexpr-*,ic lexpr  3007  3008  3009  3010 " callf to an fsubr -- attempt to direct-link it  3011  003220 3012 callf_fsubr:  003220 aa 000252 7000 04 3013 tsx0 snappable_p-*,ic snappable?  003221 aa 775700 7100 04 3014 tra eval_fsubr-*,ic no.  3015 " yes, so do it.  003222 aa 0 77772 2371 14 3016 ldaq ap|fcn,x4 get subr ptr 003223 aa 000001 0760 03 3017 adq 1,du place to tspbp to  003224 4a 4 00140 4501 20 3018 stz lisp_static_vars_$no_snapped_links 003225 aa 1 77764 3535 37 3019 eppbb ab|-12,x7* caller's lp 003226 aa 777777 6200 00 3020 eax0 -1  003227 aa 3 77772 3401 00 3021 ansx0 bb|-6 clear low half - clears no snapped links bit  003230 aa 1 77762 7571 37 3022 staq ab|-14,x7* store over link  003231 aa 775534 7000 04 3023 tsx0 unbinder-*,ic get rid of binding block, eval frame  003232 aa 0 77774 2371 00 3024 ldaq ap|argl put argl back where it was when we were called 003233 aa 0 77770 7571 00 3025 staq ap|form  003234 aa 0 77772 3501 00 3026 eppap ap|form+2  003235 aa 1 77774 3701 37 3027 epplp ab|-4,x7* restore caller's lp 003236 aa 1 77776 3521 37 3028 eppbp ab|-2,x7*  003237 aa 777772 6270 17 3029 eax7 -6,x7 pop off our temps  003240 aa 2 77777 7101 00 3030 tra bp|-1 return to the tspbp which now goes  3031 " direct to the subr  3032  3033  3034 " come here when done with a callf. This routine packs up and goes home.  3035  003241 3036 callf_rtn:  003241 aa 0 77770 3501 00 3037 eppap ap|form  003242 aa 1 77774 3701 37 3038 epplp ab|-4,x7*  003243 aa 1 77776 3521 37 3039 eppbp ab|-2,x7*  003244 aa 777772 6270 17 3040 eax7 -6,x7 003245 aa 2 00000 7101 00 3041 tra bp|0 return with result in aq  3042  3043 " routine to apply subr's to arguments which are already separated by lisp code.  3044  003246 3045 entry pl1_callable_funcall_  003246 3046 pl1_callable_funcall_:  003246 0a 000010 7000 00 3047 tsx0 pl1_entry Establish ALM environment  003247 aa 0 77777 7251 00 3048 lxl5 ap|-1 Get # of args  003250 aa 0 77776 3501 00 3049 eppap ap|-2 Pop arg count 003251 0a 003261 7000 00 3050 tsx0 funcall0  003252 aa 4 00002 3501 00 3051 eppap lp|2 Pop stack, leave ret loc.  003253 aa 0 77776 7571 00 3052 staq ap|-2 003254 aa 7 00046 2721 20 3053 getlp 003255 0a 000004 7100 00 3054 tra pl1_exit  3055  003256 3056 segdef funcall 003256 0a 003261 7000 00 3057 funcall: tsx0 funcall0  003257 aa 4 00000 3501 00 3058 eppap lp|0 pop stack  003260 0a 000021 7100 00 3059 tra lisp_rtn_1 and return to caller  3060  003261 aa 000002 6250 15 3061 funcall0: eax5 2,x5 003262 0a 003300 6054 00 3062 tpnz fc_0_args 003263 aa 0 00010 3501 00 3063 eppap ap|-form 003264 aa 0 77766 2371 15 3064 ldaq ap|form-2,x5  003265 aa 0 77770 7571 00 3065 staq ap|form  003266 aa 0 77772 7571 00 3066 staq ap|fcn  003267 aa 012002 6220 00 3067 eax2 applybit+already_spread+entered_by_funcall  003270 aa 000006 6270 17 3068 eax7 6,x7  003271 0a 003204 2370 00 3069 ldaq negative_4 for causing fault if used! 003272 aa 1 77772 7571 17 3070 staq ab|-6,x7  003273 aa 0 77766 3521 15 3071 eppbp ap|form-2,x5 we want to sve location to which to pop 003274 aa 1 77774 2521 17 3072 spribp ab|-4,x7 which will come back in lp  003275 aa 000000 3520 10 3073 eppbp 0,x0 Set exit  003276 aa 1 77776 2521 17 3074 spribp ab|-2,x7  003277 0a 003372 7100 00 3075 tra fc_join  3076  3077  003300 3078 fc_0_args:  003300 aa 000000 0020 00 3079 drl 0  3080  3081 """ fsubr's arraycall, subrcall, lsubrcall. 3082  003307 3083 segdef arraycall,subrcall,lsubrcall  3084  003301 aa 000045 7040 04 3085 subrcall: tsx4 foocall-*,ic 003302 aa 776450 7100 04 3086 tra subrcall_error-*,ic  003303 aa 0 77772 2351 20 3087 lda ap|fcn,* make sure it really is a subr.  003304 aa 777000 3150 03 3088 cana =o777000,du  003305 aa 776445 6010 04 3089 tnz subrcall_error-*,ic looks more like an lsubr, barf.  003306 aa 775161 7100 04 3090 tra evaler-*,ic OK, go apply it.  3091  003307 aa 000037 7040 04 3092 lsubrcall:tsx4 foocall-*,ic 003310 aa 776444 7100 04 3093 tra lsubrcall_error-*,ic  003311 aa 0 77772 2351 20 3094 lda ap|fcn,* make sure it really is an lsubr  003312 aa 777000 3150 03 3095 cana =o777000,du  003313 aa 776441 6000 04 3096 tze lsubrcall_error-*,ic looks more like a subr.  003314 aa 000020 2620 03 3097 orx2 lsubrbit,du  003315 aa 775152 7100 04 3098 tra evaler-*,ic OK, go apply it.  3099  003316 aa 0 00002 3501 00 3100 arraycall:eppap ap|2  003317 aa 0 77774 2371 00 3101 ldaq ap|-4 003320 aa 0 77776 7571 00 3102 staq ap|-2 003321 aa 0 77776 2371 20 3103 ldaq ap|-2,* get car of arglist, which is type  003322 aa 0 77774 7571 00 3104 staq ap|-4 save it.  003323 aa 000023 7040 04 3105 tsx4 foocall-*,ic  003324 aa 776432 7100 04 3106 tra arraycall_error-*,ic  003325 aa 000200 3150 07 3107 cana Array,dl make sure it really is an array.  003326 aa 776430 6000 04 3108 tze arraycall_error-*,ic no, barf.  003327 aa 0 77772 3521 20 3109 eppbp ap|fcn,* pick up array pointer  003330 aa 2 00007 2201 00 3110 ldx0 bp|7 pick up type off array  003331 aa 0 77766 2371 00 3111 ldaq ap|form-2 pick up type in other form 003332 0a 003337 7160 10 3112 xec array_test,x0 see if it is right type  003333 aa 776425 6010 04 3113 tnz arraycall_mismatch-*,ic type mismatch, loser.  003334 aa 775133 7050 04 3114 tsx5 evaler-*,ic OK, go call the array.  003335 aa 0 77766 3501 00 3115 eppap ap|form-2 clear all stuff from stack  003336 aa 774463 7100 04 3116 tra lisp_rtn_1-*,ic  3117  003337 3118 array_test: 003337 4a 4 00142 1171 20 3119 cmpaq lisp_static_vars_$t_atom 003340 4a 4 00144 1171 20 3120 cmpaq lisp_static_vars_$nil  003341 4a 4 00146 1171 20 3121 cmpaq lisp_static_vars_$fixnum 003342 4a 4 00150 1171 20 3122 cmpaq lisp_static_vars_$flonum 003343 4a 4 00152 1171 20 3123 cmpaq lisp_static_vars_$readtable  003344 4a 4 00154 1171 20 3124 cmpaq lisp_static_vars_$obarray  003345 0a 001760 7100 00 3125 tra arraycall_mismatch 3126  003346 aa 0 00006 3501 00 3127 foocall: eppap ap|-form-2  003347 aa 0 77770 3521 20 3128 eppbp ap|form,* -> arg list  003350 aa 2 00002 3521 20 3129 eppbp bp|2,* discard the type.  003351 aa 000002 6220 00 3130 eax2 applybit no form available, but arguments are to be evaluated.  003352 aa 2 00000 2371 00 3131 ldaq bp|0 get the alleged subr pointer.  003353 aa 0 77776 7571 00 3132 staq ap|-2 which has to be evaluated  003354 aa 2 00002 2371 00 3133 ldaq bp|2 get list of arguments to be passed  003355 aa 0 77774 7571 00 3134 staq ap|argl  003356 aa 000010 6270 17 3135 eax7 8,x7  003357 aa 774453 7000 04 3136 tsx0 recurse-*,ic evaluate the subr pointer  003360 aa 777770 6270 17 3137 eax7 -8,x7 003361 aa 0 77770 7571 00 3138 staq ap|form and put it away  003362 aa 0 77772 7571 00 3139 staq ap|fcn  003363 aa 002000 3150 07 3140 cana Subr,dl is it at least a subr pointer?  003364 aa 000000 6000 14 3141 tze 0,x4 no, couldn't possibly win  003365 aa 774433 6250 04 3142 eax5 lisp_retn-*,ic set exit going to use. 003366 aa 000001 7100 14 3143 tra 1,x4  3144  3145 " come here to call a function with already evaluated arguments from  3146 " lisp - compiled code. ap|form = fcn, x5 = -2*nargs, unmkd pdl  3147 " has: ptr to link, caller's lp, return addr (bp)  3148 " underneath ap|form on the marked pdl we have the args 3149  3150 " we first call find_type and then if possible  3151 " change the link to point directly to the function, otherwise  3152 " call it in the usual way and then return the result.  3153  003367 3154 segdef call1  3155  003367 3156 call1:  003367 aa 002002 6220 00 3157 eax2 applybit+already_spread  003370 aa 0 77770 2371 00 3158 ldaq ap|form  003371 aa 0 77772 7571 00 3159 staq ap|fcn needs to be in both places  3160  3161 " set ap|argl to an Uncollectable object containing  3162 " nargs in qu and -2*nargs in ql and ptr to args in au  3163 " the already_spread bit in x2 indicates that this is not an argl  3164  003372 3165 fc_join: "funcall joins here. 003372 aa 000000 6350 15 3166 eaa 0,x5  003373 aa 000023 7310 00 3167 ars 19 003374 aa 000000 5310 00 3168 neg 0 al has nargs  003375 aa 000000 6360 15 3169 eaq 0,x5  003376 aa 000022 7730 00 3170 lrl 18 qu has nargs, ql has -2*nargs  003377 aa 0 77770 6351 15 3171 eaa ap|form,x5 ptr to args  003400 aa 060000 2750 07 3172 ora Uncollectable,dl  003401 aa 0 77774 7571 00 3173 staq ap|argl  003402 aa 000111 6250 04 3174 eax5 call1_rtn-*,ic where to come back to after applying 003403 aa 775065 7030 04 3175 tsx3 evaler1-*,ic go to find_type  3176 " return transfer vector for find_type  003404 aa 000032 7100 04 3177 tra cc_subr-*,ic array  003405 aa 000031 7100 04 3178 tra cc_subr-*,ic subr  003406 aa 000021 7100 04 3179 tra cc_lsubr-*,ic lsubr  003407 aa 775171 7100 04 3180 tra eval_expr-*,ic expr - same as usual  003410 aa 000003 7100 04 3181 tra call1_fexpr_check-*,ic fexpr - lose, args already evaled 003411 aa 000014 7100 04 3182 tra call1_fsubr_check-*,ic fsubr - lose, args already evaled 003412 aa 775162 7100 04 3183 tra eval_lexpr-*,ic lexpr - same as usual  3184  3185  3186  003413 3187 call1_fexpr_check:  003413 0a 000551 6200 00 3188 eax0 eval_fexpr  003414 3189 fc_f_fcn_check: 003414 aa 010000 3020 03 3190 canx2 entered_by_funcall,du  003415 0a 001766 6000 00 3191 tze illegal_f_fcn  003416 aa 0 77775 2231 14 3192 ldx3 ap|argl+1,x4 check n args  003417 aa 000001 1030 03 3193 cmpx3 1,du 003420 0a 002032 6054 00 3194 tpnz too_many_args_subr  003421 0a 002032 6040 00 3195 tmi too_few_args_subr  003422 aa 0 77766 2371 14 3196 ldaq ap|form-2,x4  003423 aa 0 77774 7571 14 3197 staq ap|argl,x4  003424 aa 000000 7100 10 3198 tra 0,x0  3199  003425 3200 call1_fsubr_check:  003425 0a 003414 7000 00 3201 tsx0 fc_f_fcn_check  003426 0a 001121 7100 00 3202 tra eval_fsubr 3203  3204  3205 " routines for lsubr's and subr's which check to see if direct linking can  3206 " be used. If so they change the link and then return to the tspbp,  3207 " otherwise they go through the regular cruft  3208  003427 aa 000020 2620 03 3209 cc_lsubr: orx2 lsubrbit,du  003430 aa 010000 3020 03 3210 canx2 entered_by_funcall,du  003431 0a 001061 6010 00 3211 tnz eval_lsubr 003432 aa 1 77762 2351 37 3212 lda ab|-14,x7* get first word of link  003433 aa 077700 3750 07 3213 ana =o77700,dl 003434 aa 077700 1150 07 3214 cmpa =o77700,dl was x5 loaded by caller? 003435 aa 775424 6010 04 3215 tnz eval_lsubr-*,ic if not, must interpret call. 3216  3217  003436 3218 cc_subr:  003436 aa 000034 7000 04 3219 tsx0 snappable_p-*,ic snappable?  003437 aa 000026 7100 04 3220 tra cant_snap-*,ic no.  3221 " yes, so do it.  3222  3223  3224 " seems to be snappable, check the number of args  3225  003440 aa 0 77775 2231 00 3226 ldx3 ap|argl+1 get number of args called with  003441 aa 000020 3020 03 3227 canx2 lsubrbit,du  003442 aa 000026 6010 04 3228 tnz cc_lsubr_ckna-*,ic 003443 aa 0 77772 1031 20 3229 cmpx3 ap|fcn,* 003444 aa 000003 6000 04 3230 tze 3,ic  003445 aa 776365 6020 04 3231 tnc too_few_args_subr-*,ic 003446 aa 776364 6030 04 3232 trc too_many_args_subr-*,ic  003447 3233 cc_lsubr_ck_ret:  3234  3235 " snappable, so change the link to point directly at the function instead of at us  3236  003447 aa 0 77772 2371 14 3237 ldaq ap|fcn,x4 get subr ptr  003450 aa 000001 0760 03 3238 adq 1,du -> place to tspbp to  003451 4a 4 00140 4501 20 3239 stz lisp_static_vars_$no_snapped_links 003452 aa 1 77764 3535 37 3240 eppbb ab|-12,x7* caller's lp  003453 aa 1 77762 7571 37 3241 staq ab|-14,x7* store over link  003454 aa 777777 6350 00 3242 eaa -1 now clear his no snapped links bit  003455 aa 3 77772 3551 00 3243 ansa bb|-6 003456 aa 775307 7000 04 3244 can_snap: tsx0 unbinder-*,ic get rid of binding block, eval frame  003457 aa 0 77775 7251 00 3245 lxl5 ap|argl+1 get back caller's x5  003460 aa 0 77770 3501 00 3246 eppap ap|form set ap back to caller">'s value  003461 aa 1 77774 3701 37 3247 epplp ab|-4,x7* restore caller's lp  003462 aa 1 77776 3521 37 3248 eppbp ab|-2,x7*  003463 aa 777772 6270 17 3249 eax7 -6,x7 set x7 back to caller's value 003464 aa 2 77777 7101 00 3250 tra bp|-1 return to the tspbp, which now goes  3251 " direct to the subr.  3252  3253 " unspappable, do it the regular way  3254  003465 3255 cant_snap:  003465 aa 000020 3020 03 3256 canx2 lsubrbit,du  003466 aa 775373 6010 04 3257 tnz eval_lsubr-*,ic  003467 aa 775373 7100 04 3258 tra eval_subrs_and_arrays-*,ic 3259  003470 3260 cc_lsubr_ckna:  003470 aa 775436 7000 04 3261 tsx0 ck_lsubr_nargs-*,ic  003471 aa 777756 7100 04 3262 tra cc_lsubr_ck_ret-*,ic  3263 " 3264 " routine to see if this call can be snapped, i.e. if the  3265 " itb link through which we were called can be changed  3266 " to point directly at the function.  3267 " called by tsx0, skip return if snappable  3268  003472 3269 snappable_p:  003472 aa 011000 3020 03 3270 canx2 entered_by_funcall+went_through_value_cell,du  003473 aa 000000 6010 10 3271 tnz 0,0  003474 aa 000000 1040 03 3272 cmpx4 0,du 003475 aa 000000 6010 10 3273 tnz 0,0  003476 aa 1 77762 7261 37 3274 lxl6 ab|-14,x7* test snap bit in calling link 003477 aa 000000 6050 10 3275 tpl 0,0  003500 4a 4 00156 2371 20 3276 ldaq lisp_static_vars_$nouuo_flag,*  003501 aa 1 00012 1171 00 3277 cmpaq ab|nil  003502 aa 000000 6010 10 3278 tnz 0,0 suppressed by user  003503 aa 000001 7100 10 3279 tra 1,0 - can snap, skip return.  3280  3281  3282 " the lisp nouuo function, which is a type 1 subr of one arg  3283 " If the arg is nil, snapping is allowed. If anything else (t), 3284 " snapping is disallowed.  3285  003504 3286 segdef nouuo  3287  003504 aa 0 77776 2371 00 3288 nouuo: ldaq ap|-2 get arg 003505 aa 0 77776 3501 00 3289 eppap ap|-2  003506 aa 1 00012 1171 00 3290 cmpaq ab|nil is it nil?  003507 aa 000002 6000 04 3291 tze 2,ic  003510 aa 1 00014 2371 00 3292 ldaq ab|true no, assume t.  003511 4a 4 00156 7571 20 3293 staq lisp_static_vars_$nouuo_flag,*  003512 aa 774307 7100 04 3294 tra lisp_rtn_1-*,ic  3295  3296 " come here when done evaling from a call1  3297  003513 3298 call1_rtn:  003513 aa 0 77775 7251 00 3299 lxl5 ap|argl+1 003514 aa 0 77770 3501 15 3300 eppap ap|form,x5  003515 3301 call1_rtn_1:  003515 aa 1 77774 3701 37 3302 epplp ab|-4,x7*  003516 aa 1 77776 3521 37 3303 eppbp ab|-2,x7*  003517 aa 777772 6270 17 3304 eax7 -6,x7 003520 aa 2 00000 7101 00 3305 tra bp|0 return with result in aq  3306 "  3307  3308 " snapcaller -- entry for pl1 subrs with function args that are  3309 " called repeatedly to use for applying the  3310 " function arg to its arguments. It acts  3311 " quite similarly to callf and call1, since  3312 " it takes a function to be called, and replaces  3313 " that function with a pointer to the subroutine  3314 " entry if the number args match.  3315 "  3316 " called with ab|-2,x7 containing offset of  3317 " function from stack top, and ab|-1,x7  3318 " containing -2*nargs, and with the arguments  3319 " on the top of the marked pdl.  3320  3321 " Last modified by D Reed, 7/7/73  3322  3323  003521 3324 entry snapcaller  003521 3325 snapcaller: 003521 0a 000010 7000 00 3326 tsx0 pl1_entry 003522 aa 1 77776 7201 17 3327 lxl0 ab|-2,x7 get offset of fcn from stack top  003523 aa 1 77777 7251 17 3328 lxl5 ab|-1,x7 and -2*nargs into x5.  003524 aa 0 00000 2371 10 3329 ldaq ap|0,x0 load function  003525 aa 002000 3150 07 3330 cana Subr,dl if function is a subr object 003526 0a 003535 6000 00 3331 tze chk_snapper  003527 aa 000001 3160 03 3332 canq 1,du and points at odd address,  003530 0a 003535 6000 00 3333 tze chk_snapper  003531 3334 call_snapped:  003531 aa 0 00000 2721 30 3335 tspbp ap|0,x0* call the subr. 003532 aa 0 00002 3501 00 3336 eppap ap|2 get room to return result  003533 aa 0 77776 7571 00 3337 staq ap|-2 and do it. 003534 0a 000004 7100 00 3338 tra pl1_exit return to caller 3339  003535 3340 chk_snapper:  003535 aa 002002 6220 00 3341 eax2 applybit+already_spread  003536 aa 0 00010 3501 00 3342 eppap ap|-form get save area  003537 aa 0 77770 7571 00 3343 staq ap|form and initialize it  003540 aa 0 77772 7571 00 3344 staq ap|fcn  003541 aa 000000 6350 15 3345 eaa 0,x5 put special object in ap|argl  003542 aa 000000 5310 00 3346 neg 0  003543 aa 000023 7310 00 3347 ars 19 003544 aa 000000 6360 15 3348 eaq 0,x5  003545 aa 000022 7730 00 3349 lrl 18 003546 aa 0 77770 6351 15 3350 eaa ap|form,x5 address of args.  003547 aa 060000 2750 07 3351 ora Uncollectable,dl  003550 aa 0 77774 7571 00 3352 staq ap|argl ...  3353  003551 aa 000042 6250 04 3354 eax5 snapcall_rtn-*,ic set return for snapcall resulting in apply  003552 0a 000470 7030 00 3355 tsx3 evaler1  003553 0a 003563 7100 00 3356 tra sn_subr  003554 0a 003563 7100 00 3357 tra sn_subr subrs and arrays  003555 0a 003562 7100 00 3358 tra sn_lsubr  003556 0a 000600 7100 00 3359 tra eval_expr  003557 0a 001766 7100 00 3360 tra illegal_f_fcn bad function 003560 0a 001766 7100 00 3361 tra illegal_f_fcn  003561 0a 000574 7100 00 3362 tra eval_lexpr interpret lexpr 3363  003562 aa 000020 2620 03 3364 sn_lsubr: orx2 lsubrbit,du note that lsubr is slightly different.  003563 aa 001000 3020 03 3365 sn_subr: canx2 went_through_value_cell,du check for snappability.  003564 0a 003610 6010 00 3366 tnz sn_cant  003565 aa 000000 1040 03 3367 cmpx4 0,du if bindings made, cant dnap  003566 0a 003610 6010 00 3368 tnz sn_cant  003567 aa 0 77775 2231 00 3369 ldx3 ap|argl+1 get number of args 003570 aa 000020 3020 03 3370 canx2 lsubrbit,du  003571 0a 003606 6010 00 3371 tnz sn_lsubr_ckna  003572 aa 0 77772 1031 20 3372 cmpx3 ap|fcn,* (check number of args, note x4 = 0)  003573 aa 000003 6000 04 3373 tze 3,ic  003574 aa 776236 6020 04 3374 tnc too_few_args_subr-*,ic 003575 aa 776235 7100 04 3375 tra too_many_args_subr-*,ic  003576 3376 sn_lsubr_chk_ret:  003576 aa 775167 7000 04 3377 tsx0 unbinder-*,ic get rid of junk 003577 aa 0 77775 7251 00 3378 lxl5 ap|argl+1 reload x5 for call 003600 aa 1 77776 7201 17 3379 lxl0 ab|-2,x7 reload offset of function  003601 aa 0 77772 2371 00 3380 ldaq ap|fcn  003602 aa 000001 0760 03 3381 adq 1,du make address odd.  003603 aa 0 77770 7571 10 3382 staq ap|form,x0 snap link 003604 aa 0 77770 3501 00 3383 eppap ap|form  003605 0a 003531 7100 00 3384 tra call_snapped and do the call  3385  003606 3386 sn_lsubr_ckna:  003606 0a 001126 7000 00 3387 tsx0 ck_lsubr_nargs  003607 0a 003576 7100 00 3388 tra sn_lsubr_chk_ret  3389  003610 aa 000020 3020 03 3390 sn_cant: canx2 lsubrbit,du if cant snap, then apply function  003611 0a 001061 6010 00 3391 tnz eval_lsubr 003612 0a 001062 7100 00 3392 tra eval_subrs_and_arrays  3393  003613 3394 snapcall_rtn:  003613 aa 0 77775 7251 00 3395 lxl5 ap|argl+1 003614 aa 0 77772 3501 15 3396 eppap ap|form+2,x5 get place to store argument 003615 aa 0 77776 7571 00 3397 staq ap|-2 003616 0a 000004 7100 00 3398 tra pl1_exit  3399  3400  3401  3402 include stack_header  6-1 " BEGIN INCLUDE FILE ... stack_header.incl.alm 3/72 Bill Silver  6-2 "  6-3 " modified 7/76 by M. Weaver for *system links and more system use of areas 6-4 " modified 3/77 by M. Weaver to add rnt_ptr  6-5 " modified 7/77 by S. Webber to add run_unit_depth and assign_linkage_ptr  6-6 " modified 6/83 by J. Ives to add trace_frames and in_trace.  6-7  6-8 " HISTORY COMMENTS: 6-9 " 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396),  6-10 " audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206):  6-11 " added the heap_header_ptr definition  6-12 " 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473),  6-13 " audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206):  6-14 " Modified to support control point management. These changes were 6-15 " actually made in February 1985 by G. Palter.  6-16 " 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473),  6-17 " audit(86-10-22,Farley), install(86-11-03,MR12.0-1206):  6-18 " Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18  6-19 " bit pad after cur_lot_size for the cpm_enabled. This was done to save 6-20 " some space int the stack header and change the cpd_ptr unal to  6-21 " cpm_data_ptr (ITS pair).  6-22 " END HISTORY COMMENTS 6-23  000004 6-24 equ stack_header.cpm_data_ptr,4 ptr to control point for this stack  000006 6-25 equ stack_header.combined_stat_ptr,6 ptr to separate static area  6-26  000010 6-27 equ stack_header.clr_ptr,8 ptr to area containing linkage sections  000012 6-28 equ stack_header.max_lot_size,10 number of words allowed in lot (DU)  000012 6-29 equ stack_header.main_proc_invoked,10 nonzero if main proc was invoked in run unit (DL)  000012 6-30 equ stack_header.run_unit_depth,10 number of active run units stacked (DL) 000013 6-31 equ stack_header.cur_lot_size,11 DU number of words (entries) in lot  000013 6-32 equ stack_header.cpm_enabled,11 DL non-zero if control point management is enabled  000014 6-33 equ stack_header.system_free_ptr,12 ptr to system storage area 000016 6-34 equ stack_header.user_free_ptr,14 ptr to user storage area  6-35  000020 6-36 equ stack_header.parent_ptr,16 ptr to parent stack or null  000022 6-37 equ stack_header.stack_begin_ptr,18 ptr to first stack frame  000024 6-38 equ stack_header.stack_end_ptr,20 ptr to next useable stack frame 000026 6-39 equ stack_header.lot_ptr,22 ptr to the lot for the current ring  6-40  000030 6-41 equ stack_header.signal_ptr,24 ptr to signal proc for current ring  000032 6-42 equ stack_header.bar_mode_sp,26 value of sp before entering bar mode  000034 6-43 equ stack_header.pl1_operators_ptr,28 ptr: pl1_operators_$operator_table  000036 6-44 equ stack_header.call_op_ptr,30 ptr to standard call operator 6-45  000040 6-46 equ stack_header.push_op_ptr,32 ptr to standard push operator 000042 6-47 equ stack_header.return_op_ptr,34 ptr to standard return operator 000044 6-48 equ stack_header.ret_no_pop_op_ptr,36 ptr: stand. return/ no pop operator  000046 6-49 equ stack_header.entry_op_ptr,38 ptr to standard entry operator  6-50  000050 6-51 equ stack_header.trans_op_tv_ptr,40 ptr to table of translator operator ptrs  000052 6-52 equ stack_header.isot_ptr,42 pointer to ISOT  000054 6-53 equ stack_header.sct_ptr,44 pointer to System Condition Table 000056 6-54 equ stack_header.unwinder_ptr,46 pointer to unwinder for current ring 6-55  000060 6-56 equ stack_header.sys_link_info_ptr,48 ptr to *system link name table  000062 6-57 equ stack_header.rnt_ptr,50 ptr to reference name table  000064 6-58 equ stack_header.ect_ptr,52 ptr to event channel table  000066 6-59 equ stack_header.assign_linkage_ptr,54 ptr to area for hcs_$assign_linkage calls  000070 6-60 equ stack_header.heap_header_ptr,56 ptr to heap header.  000072 6-61 equ stack_header.trace_frames,58 stack of trace_catch_ frames 000073 6-62 equ stach_header.trace_top_ptr,59 trace pointer  000074 6-63 equ stack_header.in_trace,60 trace antirecurse bit  000100 6-64 equ stack_header_end,64 length of stack header  6-65  6-66  6-67  6-68  000000 6-69 equ trace_frames.count,0 number of trace frames on stack  000001 6-70 equ trace_frames.top_ptr,1 packed pointer to top one  6-71  6-72 " The following constant is an offset within the pl1 operators table.  6-73 " It references a transfer vector table.  6-74  000551 6-75 bool tv_offset,551 6-76  6-77  6-78 " The following constants are offsets within this transfer vector table.  6-79  001170 6-80 equ call_offset,tv_offset+271  001171 6-81 equ push_offset,tv_offset+272  001172 6-82 equ return_offset,tv_offset+273  001173 6-83 equ return_no_pop_offset,tv_offset+274 001174 6-84 equ entry_offset,tv_offset+275 6-85  6-86  6-87 " END INCLUDE FILE stack_header.incl.alm  3403 end  ENTRY SEQUENCES  003617 5a 000271 0000 00 003620 aa 7 00046 2721 20 003621 0a 000000 7100 00 003622 5a 000243 0000 00 003623 aa 7 00046 2721 20 003624 0a 000132 7100 00 003625 5a 000106 0000 00 003626 aa 7 00046 2721 20 003627 0a 003077 7100 00 003630 5a 000057 0000 00 003631 aa 7 00046 2721 20 003632 0a 003246 7100 00 003633 5a 000010 0000 00 003634 aa 7 00046 2721 20 003635 0a 003521 7100 00 LITERALS 003636 aa 000000 000004 003637 aa 000000 000000 NAME DEFINITIONS FOR ENTRY POINTS AND SEGDEFS 003640 5a 000003 000000 003641 5a 000305 600000 003642 aa 000000 000000 003643 55 000010 000002 003644 5a 000002 400003 003645 55 000006 000010 003646 aa 005 154 151 163 003647 aa 160 137 000 000 003650 55 000016 000003 003651 0a 003634 500000 003652 55 000013 000003 003653 aa 012 163 156 141 snapcaller  003654 aa 160 143 141 154 003655 aa 154 145 162 000 003656 55 000023 000010 003657 0a 003504 400000 003660 55 000021 000003 003661 aa 005 156 157 165 nouuo  003662 aa 165 157 000 000 003663 55 000030 000016 003664 0a 003367 400000 003665 55 000026 000003 003666 aa 005 143 141 154 call1  003667 aa 154 061 000 000 003670 55 000036 000023 003671 0a 003307 400000 003672 55 000033 000003 003673 aa 011 154 163 165 lsubrcall  003674 aa 142 162 143 141 003675 aa 154 154 000 000 003676 55 000044 000030 003677 0a 003301 400000 003700 55 000041 000003 003701 aa 010 163 165 142 subrcall  003702 aa 162 143 141 154 003703 aa 154 000 000 000 003704 55 000052 000036 003705 0a 003316 400000 003706 55 000047 000003 003707 aa 011 141 162 162 arraycall  003710 aa 141 171 143 141 003711 aa 154 154 000 000 003712 55 000057 000044 003713 0a 003256 400000 003714 55 000055 000003 003715 aa 007 146 165 156 funcall 003716 aa 143 141 154 154 003717 55 000070 000052 003720 0a 003631 500000 003721 55 000062 000003 003722 aa 025 160 154 061 pl1_callable_funcall_  003723 aa 137 143 141 154 003724 aa 154 141 142 154 003725 aa 145 137 146 165 003726 aa 156 143 141 154 003727 aa 154 137 000 000 003730 55 000075 000057 003731 0a 003206 400000 003732 55 000073 000003 003733 aa 005 143 141 154 callf  003734 aa 154 146 000 000 003735 55 000101 000070 003736 0a 003126 400000 003737 55 000100 000003 003740 aa 002 147 157 000 go  003741 55 000106 000075 003742 0a 003122 400000 003743 55 000104 000003 003744 aa 006 162 145 164 return  003745 aa 165 162 156 000 003746 55 000114 000101 003747 0a 003626 500000 003750 55 000111 000003 003751 aa 011 145 166 141 eval_list  003752 aa 154 137 154 151 003753 aa 163 164 000 000 003754 55 000121 000106 003755 0a 002375 400000 003756 55 000117 000003 003757 aa 006 155 141 160 mapcon  003760 aa 143 157 156 000 003761 55 000126 000114 003762 0a 002373 400000 003763 55 000124 000003 003764 aa 006 155 141 160 mapcan  003765 aa 143 141 156 000 003766 55 000133 000121 003767 0a 002371 400000 003770 55 000131 000003 003771 aa 007 155 141 160 maplist 003772 aa 154 151 163 164 003773 55 000140 000126 003774 0a 002367 400000 003775 55 000136 000003 003776 aa 006 155 141 160 mapcar  003777 aa 143 141 162 000 004000 55 000145 000133 004001 0a 002365 400000 004002 55 000143 000003 004003 aa 004 155 141 160 mapc  004004 aa 143 000 000 000 004005 55 000151 000140 004006 0a 002363 400000 004007 55 000150 000003 004010 aa 003 155 141 160 map 004011 55 000156 000145 004012 0a 002234 400000 004013 55 000154 000003 004014 aa 007 154 151 163 listify 004015 aa 164 151 146 171 004016 55 000163 000151 004017 0a 002274 400000 004020 55 000161 000003 004021 aa 006 163 145 164 setarg  004022 aa 141 162 147 000 004023 55 000167 000156 004024 0a 002217 400000 004025 55 000166 000003 004026 aa 003 141 162 147 arg 004027 55 000173 000163 004030 0a 002054 400000 004031 55 000172 000003 004032 aa 003 154 145 164 let 004033 55 000201 000167 004034 0a 001667 400000 004035 55 000176 000003 004036 aa 010 145 166 141 evalhook  004037 aa 154 150 157 157 004040 aa 153 000 000 000 004041 55 000211 000173 004042 0a 001611 400000 004043 55 000204 000003 004044 aa 023 145 166 141 evalhook_off_status 004045 aa 154 150 157 157 004046 aa 153 137 157 146 004047 aa 146 137 163 164 004050 aa 141 164 165 163 004051 55 000221 000201 004052 0a 001612 400000 004053 55 000214 000003 004054 aa 022 145 166 141 evalhook_on_status  004055 aa 154 150 157 157 004056 aa 153 137 157 156 004057 aa 137 163 164 141 004060 aa 164 165 163 000 004061 55 000227 000211 004062 0a 001545 400000 004063 55 000224 000003 004064 aa 012 163 164 146 stfunction  004065 aa 165 156 143 164 004066 aa 151 157 156 000 004067 55 000236 000221 004070 0a 000744 400000 004071 55 000232 000003 004072 aa 014 146 162 145 freturn_real  004073 aa 164 165 162 156 004074 aa 137 162 145 141 004075 aa 154 000 000 000 004076 55 000243 000227 004077 0a 000135 400000 004100 55 000241 000003 004101 aa 006 141 160 160 apply_  004102 aa 154 171 137 000 004103 55 000250 000236 004104 0a 003623 500000 004105 55 000246 000003 004106 aa 005 141 160 160 apply  004107 aa 154 171 000 000 004110 55 000255 000243 004111 0a 000121 400000 004112 55 000253 000003 004113 aa 007 163 171 155 symeval 004114 aa 145 166 141 154 004115 55 000264 000250 004116 0a 000025 400000 004117 55 000260 000003 004120 aa 017 165 156 167 unwind_reversal 004121 aa 151 156 144 137 004122 aa 162 145 166 145 004123 aa 162 163 141 154 004124 55 000271 000255 004125 0a 000015 400000 004126 55 000267 000003 004127 aa 005 145 166 141 eval_  004130 aa 154 137 000 000 004131 55 000276 000264 004132 0a 003620 500000 004133 55 000274 000003 004134 aa 004 145 166 141 eval  004135 aa 154 000 000 000 004136 55 000002 000271 004137 6a 000000 400002 004140 55 000301 000003 004141 aa 014 163 171 155 symbol_table  004142 aa 142 157 154 137 004143 aa 164 141 142 154 004144 aa 145 000 000 000 DEFINITIONS HASH TABLE  004145 aa 000000 000065 004146 5a 000167 000000 004147 5a 000264 000000 004150 5a 000030 000000 004151 5a 000271 000000 004152 5a 000044 000000 004153 5a 000163 000000 004154 5a 000010 000000 004155 5a 000023 000000 004156 5a 000057 000000 004157 5a 000070 000000 004160 5a 000221 000000 004161 aa 000000 000000 004162 aa 000000 000000 004163 5a 000126 000000 004164 aa 000000 000000 004165 5a 000114 000000 004166 5a 000121 000000 004167 5a 000133 000000 004170 5a 000227 000000 004171 5a 000140 000000 004172 aa 000000 000000 004173 5a 000145 000000 004174 aa 000000 000000 004175 aa 000000 000000 004176 aa 000000 000000 004177 5a 000151 000000 004200 5a 000201 000000 004201 5a 000211 000000 004202 5a 000276 000000 004203 aa 000000 000000 004204 5a 000101 000000 004205 5a 000255 000000 004206 aa 000000 000000 004207 5a 000052 000000 004210 aa 000000 000000 004211 aa 000000 000000 004212 5a 000156 000000 004213 aa 000000 000000 004214 5a 000250 000000 004215 aa 000000 000000 004216 aa 000000 000000 004217 5a 000016 000000 004220 aa 000000 000000 004221 aa 000000 000000 004222 5a 000036 000000 004223 5a 000106 000000 004224 5a 000236 000000 004225 5a 000075 000000 004226 5a 000173 000000 004227 5a 000243 000000 004230 aa 000000 000000 004231 aa 000000 000000 004232 aa 000000 000000 EXTERNAL NAMES  004233 aa 012 156 157 165 nouuo_flag  004234 aa 165 157 137 146 004235 aa 154 141 147 000 004236 aa 007 157 142 141 obarray 004237 aa 162 162 141 171 004240 aa 011 162 145 141 readtable  004241 aa 144 164 141 142 004242 aa 154 145 000 000 004243 aa 006 146 154 157 flonum  004244 aa 156 165 155 000 004245 aa 006 146 151 170 fixnum  004246 aa 156 165 155 000 004247 aa 003 156 151 154 nil 004250 aa 006 164 137 141 t_atom  004251 aa 164 157 155 000 004252 aa 020 156 157 137 no_snapped_links  004253 aa 163 156 141 160 004254 aa 160 145 144 137 004255 aa 154 151 156 153 004256 aa 163 000 000 000 004257 aa 011 165 156 167 unwinder_  004260 aa 151 156 144 145 004261 aa 162 137 000 000 004262 aa 013 142 141 144 bad_prog_op 004263 aa 137 160 162 157 004264 aa 147 137 157 160 004265 aa 010 145 162 162 err_recp  004266 aa 137 162 145 143 004267 aa 160 000 000 000 004270 aa 012 160 162 157 prog_frame  004271 aa 147 137 146 162 004272 aa 141 155 145 000 004273 aa 005 156 143 157 nconc  004274 aa 156 143 000 000 004275 aa 010 156 157 137 no_lexpr  004276 aa 154 145 170 160 004277 aa 162 000 000 000 004300 aa 007 161 163 145 qsetarg 004301 aa 164 141 162 147 004302 aa 004 161 141 162 qarg  004303 aa 147 000 000 000 004304 aa 006 161 154 163 qlstfy  004305 aa 164 146 171 000 004306 aa 005 143 157 156 cons_  004307 aa 163 137 000 000 004310 aa 033 155 145 141 meaningless_argument_number 004311 aa 156 151 156 147 004312 aa 154 145 163 163 004313 aa 137 141 162 147 004314 aa 165 155 145 156 004315 aa 164 137 156 165 004316 aa 155 142 145 162 004317 aa 015 167 162 157 wrong_no_args  004320 aa 156 147 137 156 004321 aa 157 137 141 162 004322 aa 147 163 000 000 004323 aa 006 142 141 144 bad_bv  004324 aa 137 142 166 000 004325 aa 011 142 141 144 bad_f_fcn  004326 aa 137 146 137 146 004327 aa 143 156 000 000 004330 aa 024 141 162 162 arraycall_wrong_type  004331 aa 141 171 143 141 004332 aa 154 154 137 167 004333 aa 162 157 156 147 004334 aa 137 164 171 160 004335 aa 145 000 000 000 004336 aa 021 141 162 162 arraycall_bad_ptr  004337 aa 141 171 143 141 004340 aa 154 154 137 142 004341 aa 141 144 137 160 004342 aa 164 162 000 000 004343 aa 021 154 163 165 lsubrcall_bad_ptr  004344 aa 142 162 143 141 004345 aa 154 154 137 142 004346 aa 141 144 137 160 004347 aa 164 162 000 000 004350 aa 020 163 165 142 subrcall_bad_ptr  004351 aa 162 143 141 154 004352 aa 154 137 142 141 004353 aa 144 137 160 164 004354 aa 162 000 000 000 004355 aa 022 165 156 144 undefined_function  004356 aa 145 146 151 156 004357 aa 145 144 137 146 004360 aa 165 156 143 164 004361 aa 151 157 156 000 004362 aa 014 142 141 144 bad_function  004363 aa 137 146 165 156 004364 aa 143 164 151 157 004365 aa 156 000 000 000 004366 aa 006 156 143 157 ncons_  004367 aa 156 163 137 000 004370 aa 013 154 151 163 lisp_alloc_ 004371 aa 160 137 141 154 004372 aa 154 157 143 137 004373 aa 015 145 166 141 evalhook_atom  004374 aa 154 150 157 157 004375 aa 153 137 141 164 004376 aa 157 155 000 000 004377 aa 006 146 165 156 funarg  004400 aa 141 162 147 000 004401 aa 017 156 151 150 nihil_ex_nihile 004402 aa 151 154 137 145 004403 aa 170 137 156 151 004404 aa 150 151 154 145 004405 aa 017 165 163 145 user_intr_array 004406 aa 162 137 151 156 004407 aa 164 162 137 141 004410 aa 162 162 141 171 004411 aa 006 154 141 155 lambda  004412 aa 142 144 141 000 004413 aa 023 146 165 156 function_properties 004414 aa 143 164 151 157 004415 aa 156 137 160 162 004416 aa 157 160 145 162 004417 aa 164 151 145 163 004420 aa 007 141 162 147 argatom 004421 aa 141 164 157 155 004422 aa 025 142 151 156 binding_reversal_flag  004423 aa 144 151 156 147 004424 aa 137 162 145 166 004425 aa 145 162 163 141 004426 aa 154 137 146 154 004427 aa 141 147 000 000 004430 aa 013 156 157 164 not_pdl_ptr 004431 aa 137 160 144 154 004432 aa 137 160 164 162 004433 aa 013 154 151 163 lisp_error_ 004434 aa 160 137 145 162 004435 aa 162 157 162 137 004436 aa 012 145 166 141 eval_frame  004437 aa 154 137 146 162 004440 aa 141 155 145 000 004441 aa 016 165 156 144 undefined_atom  004442 aa 145 146 151 156 004443 aa 145 144 137 141 004444 aa 164 157 155 000 004445 aa 021 154 151 163 lisp_error_table_  004446 aa 160 137 145 162 004447 aa 162 157 162 137 004450 aa 164 141 142 154 004451 aa 145 137 000 000 004452 aa 011 163 164 141 star_rset  004453 aa 162 137 162 163 004454 aa 145 164 000 000 004455 aa 017 145 166 141 evalhook_status 004456 aa 154 150 157 157 004457 aa 153 137 163 164 004460 aa 141 164 165 163 004461 aa 013 142 151 156 binding_top 004462 aa 144 151 156 147 004463 aa 137 164 157 160 004464 aa 011 165 156 155 unmkd_ptr  004465 aa 153 144 137 160 004466 aa 164 162 000 000 004467 aa 011 163 164 141 stack_ptr  004470 aa 143 153 137 160 004471 aa 164 162 000 000 004472 aa 021 154 151 163 lisp_static_vars_  004473 aa 160 137 163 164 004474 aa 141 164 151 143 004475 aa 137 166 141 162 004476 aa 163 137 000 000 004477 aa 013 141 154 154 alloc_fault 004500 aa 157 143 137 146 004501 aa 141 165 154 164 004502 aa 025 154 151 163 lisp_default_handler_  004503 aa 160 137 144 145 004504 aa 146 141 165 154 004505 aa 164 137 150 141 004506 aa 156 144 154 145 004507 aa 162 137 000 000 NO TRAP POINTER WORDS  TYPE PAIR BLOCKS  004510 aa 000004 000000 004511 55 000632 000373 004512 aa 000004 000000 004513 55 000632 000376 004514 aa 000004 000000 004515 55 000632 000400 004516 aa 000004 000000 004517 55 000632 000403 004520 aa 000004 000000 004521 55 000632 000405 004522 aa 000004 000000 004523 55 000632 000407 004524 aa 000004 000000 004525 55 000632 000410 004526 aa 000004 000000 004527 55 000632 000412 004530 aa 000004 000000 004531 55 000417 000417 004532 aa 000004 000000 004533 55 000605 000422 004534 aa 000004 000000 004535 55 000632 000425 004536 aa 000004 000000 004537 55 000632 000430 004540 aa 000004 000000 004541 55 000530 000433 004542 aa 000004 000000 004543 55 000605 000435 004544 aa 000004 000000 004545 55 000632 000440 004546 aa 000004 000000 004547 55 000632 000442 004550 aa 000004 000000 004551 55 000632 000444 004552 aa 000004 000000 004553 55 000530 000446 004554 aa 000004 000000 004555 55 000605 000450 004556 aa 000004 000000 004557 55 000605 000457 004560 aa 000004 000000 004561 55 000605 000463 004562 aa 000004 000000 004563 55 000605 000465 004564 aa 000004 000000 004565 55 000605 000470 004566 aa 000004 000000 004567 55 000605 000476 004570 aa 000004 000000 004571 55 000605 000503 004572 aa 000004 000000 004573 55 000605 000510 004574 aa 000004 000000 004575 55 000605 000515 004576 aa 000004 000000 004577 55 000605 000522 004600 aa 000004 000000 004601 55 000530 000526 004602 aa 000004 000000 004603 55 000632 000533 004604 aa 000004 000000 004605 55 000632 000537 004606 aa 000004 000000 004607 55 000605 000541 004610 aa 000004 000000 004611 55 000632 000545 004612 aa 000004 000000 004613 55 000632 000551 004614 aa 000004 000000 004615 55 000632 000553 004616 aa 000004 000000 004617 55 000632 000560 004620 aa 000004 000000 004621 55 000632 000562 004622 aa 000004 000000 004623 55 000605 000570 004624 aa 000004 000000 004625 55 000573 000573 004626 aa 000004 000000 004627 55 000632 000576 004630 aa 000004 000000 004631 55 000605 000601 004632 aa 000004 000000 004633 55 000632 000612 004634 aa 000004 000000 004635 55 000632 000615 004636 aa 000004 000000 004637 55 000632 000621 004640 aa 000004 000000 004641 55 000632 000624 004642 aa 000004 000000 004643 55 000632 000627 004644 aa 000004 000000 004645 55 000642 000637 004646 aa 000001 000000 004647 aa 000000 000000 INTERNAL EXPRESSION WORDS 004650 5a 000650 000000 004651 5a 000652 000000 004652 5a 000654 000000 004653 5a 000656 000000 004654 5a 000660 000000 004655 5a 000662 000000 004656 5a 000664 000000 004657 5a 000666 000000 004660 5a 000670 000000 004661 5a 000672 000000 004662 5a 000674 000001 004663 5a 000676 000001 004664 5a 000700 000000 004665 5a 000702 000000 004666 5a 000704 000000 004667 5a 000706 000000 004670 5a 000710 000000 004671 5a 000712 000000 004672 5a 000714 000000 004673 5a 000716 000000 004674 5a 000720 000000 004675 5a 000722 000000 004676 5a 000724 000000 004677 5a 000726 000000 004700 5a 000730 000000 004701 5a 000732 000000 004702 5a 000734 000000 004703 5a 000736 000000 004704 5a 000740 000000 004705 5a 000742 000000 004706 5a 000744 000000 004707 5a 000746 000000 004710 5a 000750 000042 004711 5a 000752 000000 004712 5a 000754 000000 004713 5a 000756 000000 004714 5a 000766 000000 004715 5a 000776 000001 004716 5a 000760 000000 004717 5a 000762 000000 004720 5a 000764 000000 004721 5a 000766 000001 004722 5a 000770 000000 004723 5a 000772 000000 004724 5a 000774 000000 004725 5a 000776 000000 004726 5a 001000 000000 004727 5a 001000 000001 004730 5a 001002 000000 004731 5a 001004 000000 LINKAGE INFORMATION 000000 aa 000000 000000 000001 0a 003640 000000 000002 aa 000000 000000 000003 aa 000000 000000 000004 aa 000000 000000 000005 aa 000000 000000 000006 22 000010 000160 000007 a2 000000 000000 000010 9a 777770 0000 46 lisp_default_handler_|alloc_fault  000011 5a 001071 0000 00 000012 9a 777766 0000 46 lisp_static_vars_|stack_ptr 000013 5a 001070 0000 00 000014 9a 777764 0000 46 lisp_static_vars_|unmkd_ptr 000015 5a 001067 0000 00 000016 9a 777762 0000 46 lisp_static_vars_|unmkd_ptr 000017 5a 001066 0000 20 000020 9a 777760 0000 46 lisp_static_vars_|stack_ptr 000021 5a 001070 0000 20 000022 9a 777756 0000 46 lisp_static_vars_|binding_top  000023 5a 001065 0000 20 000024 9a 777754 0000 46 lisp_static_vars_|evalhook_status  000025 5a 001064 0000 00 000026 9a 777752 0000 46 lisp_static_vars_|star_rset 000027 5a 001063 0000 20 000030 9a 777750 0000 46 lisp_error_table_|undefined_atom  000031 5a 001062 0000 00 000032 9a 777746 0000 46 lisp_static_vars_|eval_frame  000033 5a 001061 0000 00 000034 9a 777744 0000 46 lisp_error_|lisp_error_ 000035 5a 001060 0000 00 000036 9a 777742 0000 46 lisp_error_table_|not_pdl_ptr  000037 5a 001057 0000 00 000040 9a 777740 0000 46 lisp_static_vars_|binding_reversal_flag 000041 5a 001056 0000 00 000042 9a 777736 0000 46 lisp_static_vars_|binding_top  000043 5a 001055 0000 00 000044 9a 777734 0000 46 lisp_static_vars_|eval_frame  000045 5a 001054 0000 00 000046 9a 777732 0000 46 lisp_static_vars_|argatom  000047 5a 001053 0000 00 000050 9a 777730 0000 46 lisp_static_vars_|function_properties  000051 5a 001052 0000 00 000052 9a 777726 0000 46 lisp_static_vars_|lambda  000053 5a 001051 0000 00 000054 9a 777724 0000 46 lisp_static_vars_|user_intr_array  000055 5a 001050 0000 20 000056 9a 777722 0000 46 lisp_error_table_|nihil_ex_nihile  000057 5a 001047 0000 00 000060 9a 777720 0000 46 lisp_static_vars_|funarg  000061 5a 001046 0000 00 000062 9a 777716 0000 46 lisp_static_vars_|evalhook_atom 000063 5a 001045 0000 20 000064 9a 777714 0000 46 lisp_static_vars_|evalhook_atom 000065 5a 001045 0000 00 000066 9a 777712 0000 46 lisp_alloc_|ncons_  000067 5a 001044 0000 00 000070 9a 777710 0000 46 lisp_error_table_|bad_function  000071 5a 001043 0000 00 000072 9a 777706 0000 46 lisp_error_table_|undefined_function  000073 5a 001042 0000 00 000074 9a 777704 0000 46 lisp_error_table_|subrcall_bad_ptr  000075 5a 001041 0000 00 000076 9a 777702 0000 46 lisp_error_table_|lsubrcall_bad_ptr 000077 5a 001040 0000 00 000100 9a 777700 0000 46 lisp_error_table_|arraycall_bad_ptr 000101 5a 001037 0000 00 000102 9a 777676 0000 46 lisp_error_table_|arraycall_wrong_type  000103 5a 001036 0000 00 000104 9a 777674 0000 46 lisp_error_table_|bad_f_fcn 000105 5a 001035 0000 00 000106 9a 777672 0000 46 lisp_error_table_|bad_bv  000107 5a 001034 0000 00 000110 9a 777670 0000 46 lisp_error_table_|wrong_no_args 000111 5a 001033 0000 00 000112 9a 777666 0000 46 lisp_error_table_|meaningless_argument_number  000113 5a 001032 0000 00 000114 9a 777664 0000 46 lisp_alloc_|cons_  000115 5a 001031 0000 00 000116 9a 777662 0000 46 lisp_static_vars_|qlstfy  000117 5a 001030 0000 00 000120 9a 777660 0000 46 lisp_static_vars_|qarg  000121 5a 001027 0000 00 000122 9a 777656 0000 46 lisp_static_vars_|qsetarg  000123 5a 001026 0000 00 000124 9a 777654 0000 46 lisp_error_table_|no_lexpr  000125 5a 001025 0000 00 000126 9a 777652 0000 46 lisp_alloc_|nconc  000127 5a 001024 0000 00 000130 9a 777650 0000 46 lisp_static_vars_|prog_frame  000131 5a 001023 0000 00 000132 9a 777646 0000 46 lisp_static_vars_|err_recp  000133 5a 001022 0000 00 000134 9a 777644 0000 46 lisp_error_table_|bad_prog_op  000135 5a 001021 0000 00 000136 9a 777642 0000 46 unwinder_|unwinder_ 000137 5a 001020 0000 00 000140 9a 777640 0000 46 lisp_static_vars_|no_snapped_links  000141 5a 001017 0000 00 000142 9a 777636 0000 46 lisp_static_vars_|t_atom  000143 5a 001016 0000 00 000144 9a 777634 0000 46 lisp_static_vars_|nil  000145 5a 001015 0000 00 000146 9a 777632 0000 46 lisp_static_vars_|fixnum  000147 5a 001014 0000 00 000150 9a 777630 0000 46 lisp_static_vars_|flonum  000151 5a 001013 0000 00 000152 9a 777626 0000 46 lisp_static_vars_|readtable 000153 5a 001012 0000 00 000154 9a 777624 0000 46 lisp_static_vars_|obarray  000155 5a 001011 0000 00 000156 9a 777622 0000 46 lisp_static_vars_|nouuo_flag  000157 5a 001010 0000 20 SYMBOL INFORMATION SYMBOL TABLE HEADER  000000 aa 000000 000001 000001 aa 163171 155142 000002 aa 164162 145145 000003 aa 000000 000004 000004 aa 000000 114732 000005 aa 732732 062314 000006 aa 000000 114775 000007 aa 676611 166170 000010 aa 141154 155040 000011 aa 040040 040040 000012 aa 000024 000040 000013 aa 000034 000040 000014 aa 000044 000100 000015 aa 000002 000002 000016 aa 000064 000000 000017 aa 000000 000501 000020 aa 000000 000232 000021 aa 000000 000441 000022 aa 000466 000232 000023 aa 000064 000000 000024 aa 101114 115040 000025 aa 126145 162163 000026 aa 151157 156040 000027 aa 040066 056067 000030 aa 040040 117143 000031 aa 164157 142145 000032 aa 162040 061071 000033 aa 070066 040040 000034 aa 107112 157150 000035 aa 156163 157156 000036 aa 056123 171163 000037 aa 115141 151156 000040 aa 164056 141040 000041 aa 040040 040040 000042 aa 040040 040040 000043 aa 040040 040040 000044 aa 154151 163164 000045 aa 040040 040040 000046 aa 040040 040040 000047 aa 040040 040040 000050 aa 040040 040040 000051 aa 040040 040040 000052 aa 040040 040040 000053 aa 040040 040040 000054 aa 040040 040040 000055 aa 040040 040040 000056 aa 040040 040040 000057 aa 040040 040040 000060 aa 040040 040040 000061 aa 040040 040040 000062 aa 040040 040040 000063 aa 040040 040040 000064 aa 000000 000001 000065 aa 000000 000007 000066 aa 000122 000052 000067 aa 147740 446340 000070 aa 000000 114774 000071 aa 461210 400000 000072 aa 000135 000044 000073 aa 106701 741715 000074 aa 000000 110670 000075 aa 211413 600000 000076 aa 000146 000041 000077 aa 106701 741740 000100 aa 000000 110670 000101 aa 211446 200000 000102 aa 000157 000044 000103 aa 120017 346605 000104 aa 000000 112002 000105 aa 404115 200000 000106 aa 000170 000047 000107 aa 106701 741731 000110 aa 000000 110670 000111 aa 211444 000000 000112 aa 000202 000045 000113 aa 120017 346602 000114 aa 000000 112002 000115 aa 404115 000000 000116 aa 000214 000066 000117 aa 147714 750316 000120 aa 000000 114774 000121 aa 453561 000000 000122 aa 076163 160145 >special_ldd>install>MR12.0-1206>lisp_.alm  000123 aa 143151 141154 000124 aa 137154 144144 000125 aa 076151 156163 000126 aa 164141 154154 000127 aa 076115 122061 000130 aa 062056 060055 000131 aa 061062 060066 000132 aa 076154 151163 000133 aa 160137 056141 000134 aa 154155 040040 000135 aa 076154 144144 >ldd>include>lisp_unmkd_pdl.incl.alm  000136 aa 076151 156143 000137 aa 154165 144145 000140 aa 076154 151163 000141 aa 160137 165156 000142 aa 155153 144137 000143 aa 160144 154056 000144 aa 151156 143154 000145 aa 056141 154155 000146 aa 076154 144144 >ldd>include>lisp_iochan.incl.alm  000147 aa 076151 156143 000150 aa 154165 144145 000151 aa 076154 151163 000152 aa 160137 151157 000153 aa 143150 141156 000154 aa 056151 156143 000155 aa 154056 141154 000156 aa 155040 040040 000157 aa 076154 144144 >ldd>include>lisp_stack_seg.incl.alm  000160 aa 076151 156143 000161 aa 154165 144145 000162 aa 076154 151163 000163 aa 160137 163164 000164 aa 141143 153137 000165 aa 163145 147056 000166 aa 151156 143154 000167 aa 056141 154155 000170 aa 076154 144144 >ldd>include>lisp_object_types.incl.alm 000171 aa 076151 156143 000172 aa 154165 144145 000173 aa 076154 151163 000174 aa 160137 157142 000175 aa 152145 143164 000176 aa 137164 171160 000177 aa 145163 056151 000200 aa 156143 154056 000201 aa 141154 155040 000202 aa 076154 144144 >ldd>include>lisp_name_codes.incl.alm  000203 aa 076151 156143 000204 aa 154165 144145 000205 aa 076154 151163 000206 aa 160137 156141 000207 aa 155145 137143 000210 aa 157144 145163 000211 aa 056151 156143 000212 aa 154056 141154 000213 aa 155040 040040 000214 aa 076163 160145 >special_ldd>install>MR12.0-1206>stack_header.incl.alm  000215 aa 143151 141154 000216 aa 137154 144144 000217 aa 076151 156163 000220 aa 164141 154154 000221 aa 076115 122061 000222 aa 062056 060055 000223 aa 061062 060066 000224 aa 076163 164141 000225 aa 143153 137150 000226 aa 145141 144145 000227 aa 162056 151156 000230 aa 143154 056141 000231 aa 154155 040040 MULTICS ASSEMBLY CROSS REFERENCE LISTING Value Symbol Source file Line number  alloc_fault lisp_: 533. 4000 already_autoloaded_once lisp_: 41, 1366, 1451, 1453.  2000 already_spread lisp_: 34, 864, 1090, 1101, 1232, 1916, 3067, 3157, 3341. 102 append_list_op lisp_stack_seg: 43.  132 apply lisp_: 330, 331.  2 applybit lisp_: 35, 350, 710, 1438, 1914, 2334, 2337, 2340, 2343, 2346, 2349, 2995,  3067, 3130, 3157, 3341.  135 apply_ lisp_: 339, 341, 1771. 140 apply_com lisp_: 332, 349, 432. 215 apply_tsx3 lisp_: 428, 474.  214 apply_with_3_args lisp_: 342, 426.  2217 arg lisp_: 2068, 2107.  argatom lisp_: 1095, 2081, 2083, 2085, 2095, 2098, 2111, 2470.  2161 argcom lisp_: 2070, 2076, 2117, 2124, 2168. 2204 argcom1 lisp_: 2080, 2090.  2207 argcom2 lisp_: 2086, 2097.  60 Argl lisp_: 2966, 2969, 2971, 2972.  777774 argl lisp_: 49, 353, 682, 785, 790, 869, 1100, 1178, 1234, 1266, 1279, 1324,  1442, 1921, 2003, 2004, 2016, 2030, 2038, 2051, 2053, 2612, 2641, 2690,  3024, 3134, 3173, 3192, 3197, 3226, 3245, 3299, 3352, 3369, 3378, 3395.  50 arglist lisp_: 526, 530, 532, 533.  623 args_spread_for_expr lisp_: 841, 1254, 1268. 1031 args_spread_for_lexpr lisp_: 843, 1086.  1107 args_spread_for_lsubr lisp_: 1122, 1160.  1063 args_spread_for_subr lisp_: 1120, 1255, 1284. 3202 arg_list_1_hdr lisp_: 531, 2968, 2977. 2230 arg_non_nil lisp_: 2110, 2116.  2232 arg_return lisp_: 2115, 2119.  1150 arg_spreader lisp_: 800, 832, 837, 1118, 1230. 200 Array lisp_: 3107, lisp_object_types: 25.  3316 arraycall lisp_: 3083, 3100.  arraycall_bad_ptr lisp_: 1866. 1756 arraycall_error lisp_: 1864, 3106, 3108. 1760 arraycall_mismatch lisp_: 1868, 3113, 3125. arraycall_wrong_type lisp_: 1870. 122 array_info_for_store lisp_stack_seg: 51.  126 array_link_snap_opr lisp_stack_seg: 53.  0 array_offset lisp_: 1355, 1402.  124 array_offset_for_store lisp_stack_seg: 52.  112 array_operator lisp_stack_seg: 47.  10 array_pointer lisp_stack_seg: 10.  3337 array_test lisp_: 3112, 3118.  77700 Atomic lisp_object_types: 19.  10000 Atsym lisp_: 242, 316, 662, 753, 893, 1369, 1418, 1433, 1548, 2010,  lisp_object_types: 18.  1775 bad_bound_var lisp_: 754, 1549, 1893, 2011.  1773 bad_bound_var_sp lisp_: 894, 1888.  bad_bv lisp_: 1898. 1737 bad_fcnl lisp_: 778, 1838, 1990, 1996, 2007, 2429.  1732 bad_fcnl_form lisp_: 1423, 1448, 1829, 1842.  bad_function lisp_: 1834. bad_f_fcn lisp_: 1884. 3164 bad_go lisp_: 2926, 2957.  bad_prog_op lisp_: 2957. 2305 bad_use_arg lisp_: 2082, 2096, 2112, 2176.  100 bbf lisp_: 36, 772, 847, 1132, 1162, 1572, 1705. 100 begin_list_op lisp_stack_seg: 42.  174 begin_unmkd_stack lisp_stack_seg: 66.  1000 Bignum lisp_object_types: 20.  1000 Big_fixed lisp_object_types: 29.  binding_reversal_flag lisp_: 495, 514.  binding_top lisp_: 222, 562, 564, 647, 1046, 1049, 1613, 1616, 1664, 1754, 1757, 1777,  1803, 1806, 1819, 2023, 2026. 20 bind_op lisp_stack_seg: 17.  2326 b_u_a_com lisp_: 2161, 2186, 2196. 3367 call1 lisp_: 3154, 3156.  1236 call1_call lisp_: 1315, 1325.  3413 call1_fexpr_check lisp_: 3181, 3187.  3425 call1_fsubr_check lisp_: 3182, 3200.  3513 call1_rtn lisp_: 3174, 3298.  3515 call1_rtn_1 lisp_: 1320, 3301.  3206 callf lisp_: 2992, 2994.  3220 callf_fsubr lisp_: 3005, 3012.  3241 callf_rtn lisp_: 2996, 3036.  2337 call_cons lisp_: 1463, 1681, 1682, 1923, 1929, 1930, 1953, 2194, 2198, 2202, 2203, 2209,  2603, 2748, 2758. 153 call_ext_out lisp_: 368, 385.  1170 call_offset stack_header: 80.  32 call_op lisp_stack_seg: 22.  3531 call_snapped lisp_: 3334, 3384.  1075 call_subroutine lisp_: 1133, 1144, 1171, 2631, 2636, 2645.  1071 call_subr_bbf lisp_: 1131, 1182.  3465 cant_snap lisp_: 3220, 3255.  3456 can_snap lisp_: 3244. 34 catch1_op lisp_stack_seg: 23.  36 catch2_op lisp_stack_seg: 24.  3427 cc_lsubr lisp_: 3179, 3209.  3470 cc_lsubr_ckna lisp_: 3228, 3260.  3447 cc_lsubr_ck_ret lisp_: 3233, 3262.  3436 cc_subr lisp_: 3177, 3178, 3218. 3535 chk_snapper lisp_: 3331, 3333, 3340. 1445 cksubr lisp_: 1388, 1391, 1394, 1403, 1537. 1344 ck_autoload lisp_: 1408, 1450.  1454 ck_bound_var lisp_: 1545, 1704, 2467. 1307 ck_lambda lisp_: 1397, 1399, 1415, 1443.  1126 ck_lsubr_nargs lisp_: 1166, 1189, 1323, 3261, 3387. 1333 ck_macro lisp_: 1405, 1437.  106 compare_op lisp_stack_seg: 45.  2040 cons2zz lisp_: 1952, 1972.  cons_ lisp_: 2144, 2220.  72 cons_op lisp_stack_seg: 39.  136 cons_string_op lisp_stack_seg: 57.  132 create_array_desc_op lisp_stack_seg: 55.  130 create_string_desc_op lisp_stack_seg: 54.  140 create_varying_string_op lisp_stack_seg: 58. 114 dead_array_operator lisp_stack_seg: 48.  1026 destroy_evalframe lisp_: 1054, 1073.  727 end_eval_lambda_body lisp_: 952, 958.  1402 end_of_plist lisp_: 1376, 1484.  10000 entered_by_funcall lisp_: 42, 3067, 3190, 3210, 3270. 1174 entry_offset stack_header: 84.  147 error lisp_: 261, 280, 366, 480, 1557, 1835, 1850, 1876, 1885, 1899, 1932, 2075,  2205, 2958.  24 errset1_op lisp_stack_seg: 19.  26 errset2_op lisp_stack_seg: 20.  64 err_op lisp_stack_seg: 36.  err_recp lisp_: 2940. 0 eval lisp_: 179, 180.  467 evaler lisp_: 356, 689, 3090, 3098, 3114. 470 evaler1 lisp_: 692, 2997, 3175, 3355.  1667 evalhook lisp_: 1787, 1789.  evalhook_atom lisp_: 1732, 1746, 1795. 1613 evalhook_check lisp_: 1722, 1731.  1611 evalhook_off_status lisp_: 1716, 1718.  1612 evalhook_on_status lisp_: 1716, 1721, 1792. evalhook_status lisp_: 236, 657, 1790, 1793, 1821. 1616 evalhook_trap lisp_: 1736. 442 evalu lisp_: 181, 206, 413, 657, 983, 1812.  457 evalu_exit lisp_: 655, 673.  15 eval_ lisp_: 202, 204.  600 eval_expr lisp_: 728, 802, 3003, 3180, 3359. 461 eval_fcn lisp_: 300, 663, 679, 2886, 2915. 551 eval_fexpr lisp_: 729, 771, 3004, 3188.  eval_frame lisp_: 273, 276, 285, 716, 718, 1016, 1075, 1308, 2391, 2394.  1121 eval_fsubr lisp_: 730, 1177, 3014, 3202.  1462 eval_funarg lisp_: 1522, 1568.  1576 eval_label lisp_: 1519, 1698.  712 eval_lambda_body lisp_: 787, 792, 854, 940, 1111, 2063, 2681, 2692, 2705. 716 eval_lambda_body_loop lisp_: 946, 956.  574 eval_lexpr lisp_: 731, 796, 3006, 3183, 3362. 3077 eval_list lisp_: 2866, 2868.  1061 eval_lsubr lisp_: 727, 1113, 3002, 3211, 3215, 3257, 3391. 1062 eval_subrs_and_arrays lisp_: 725, 726, 1117, 3000, 3001, 3258, 3392. 201 eval_with_2_args lisp_: 205, 408.  3104 ev_list_1 lisp_: 2876, 2889.  3116 ev_list_2 lisp_: 2884, 2887.  3120 ev_list_end lisp_: 2879, 2891.  4 exprbit lisp_: 30, 797, 804, 1253, 1267, 2426, 2444, 2462, 2623. 675 expr_assign_0 lisp_: 888, 910.  604 expr_bb_alloc lisp_: 814, 822.  614 expr_bb_fin lisp_: 816, 824.  637 expr_bind lisp_: 846, 856.  653 expr_binder lisp_: 886, 904.  647 expr_bind_0 lisp_: 871, 878.  645 expr_bind_1 lisp_: 865, 875.  622 expr_nil lisp_: 828, 836.  3 expr_offset lisp_: 1358, 1432, 1435. 200 fbb lisp_: 37, 1056, 1299, 1572, 1590. 777772 fcn lisp_: 48, 355, 684, 742, 811, 844, 884, 947, 950, 953, 1093, 1126,  1145, 1199, 1202, 1311, 1316, 1368, 1371, 1417, 1420, 1425, 1430, 1461,  1486, 1488, 1490, 1505, 1518, 1521, 1526, 1533, 1540, 1569, 1571, 1699,  1708, 1831, 1841, 1846, 1853, 1873, 1904, 1946, 1963, 1968, 2062, 2378,  2416, 2465, 2494, 2518, 2521, 2622, 2663, 2688, 2703, 2809, 3016, 3066,  3087, 3094, 3109, 3139, 3159, 3229, 3237, 3344, 3372, 3380.  732 fcn_fin lisp_: 965, 1155, 1938. 3300 fc_0_args lisp_: 3062, 3078.  3414 fc_f_fcn_check lisp_: 3189, 3201.  3372 fc_join lisp_: 3075, 3165.  247 fetch_bcp_error lisp_: 457, 460, 464, 466, 472. 260 fetch_bcp_nil lisp_: 454, 484.  245 fetch_bcp_ret lisp_: 468, 486.  227 fetch_binding_context_ptr lisp_: 410, 429, 451, 482. 571 fexpr_1_arg lisp_: 779, 789.  4 fexpr_offset lisp_: 1359, 1427, 1429. 100 File lisp_object_types: 30.  1246 find_type lisp_: 722, 1352, 1419, 1491, 1534, 1577, 1709, 1854, 2399. 1254 find_type_1 lisp_: 1373, 1385.  1247 find_type_reenter lisp_: 1367, 1480.  515 find_type_tv lisp_: 690, 723.  1473 finish_bindings lisp_: 775, 850, 924, 1110, 1135, 1165, 1589, 2419.  1512 finish_bindings_aa lisp_: 1591, 1606.  1522 fin_loop lisp_: 1618, 1628.  1535 fin_xx lisp_: 1619, 1630.  2 firstlist lisp_: 2317, 2365, 2550, 2720.  40000 Fixed lisp_: 456, lisp_object_types: 15.  fixnum lisp_: 3121. 40047 fixnum_type lisp_: 783, 1108, 1676, 1948, 1965, 2071, 2114, 2435, 2485, 2702, 2982, lisp_object_types: 34.  736777 flag_reset_mask lisp_iochan: 42. 20000 Float lisp_object_types: 16.  120 floating_store_operator lisp_stack_seg: 50.  flonum lisp_: 3122. 20047 flonum_type lisp_object_types: 35.  777707 fn_abs lisp_name_codes: 53.  777720 fn_add1 lisp_name_codes: 44.  777674 fn_add1_fix lisp_name_codes: 64.  777673 fn_add1_flo lisp_name_codes: 65.  777625 fn_alarmclock lisp_name_codes: 103.  777611 fn_allfiles lisp_name_codes: 115.  777617 fn_alphalessp lisp_name_codes: 109.  777657 fn_apply lisp_: 476, lisp_name_codes: 77.  777765 fn_arg lisp_: 2182, lisp_name_codes: 10.  777727 fn_args lisp_name_codes: 37.  777740 fn_array lisp_name_codes: 28.  777537 fn_arraydims lisp_name_codes: 157.  777751 fn_ascii lisp_name_codes: 19.  777631 fn_atan lisp_name_codes: 99.  777650 fn_baktrace lisp_name_codes: 84.  777647 fn_bltarray lisp_name_codes: 85.  777705 fn_boole lisp_name_codes: 55.  777643 fn_boundp lisp_name_codes: 89.  777654 fn_catch lisp_name_codes: 80.  777741 fn_catenate lisp_name_codes: 27.  777544 fn_charpos lisp_name_codes: 152.  1267 fn_checks lisp_: 1382, 1386.  777610 fn_chrct lisp_name_codes: 116.  777557 fn_clear_input lisp_name_codes: 141.  777553 fn_cline lisp_name_codes: 145.  777607 fn_close lisp_name_codes: 117.  777637 fn_cos lisp_name_codes: 93.  777732 fn_CtoI lisp_name_codes: 34.  777561 fn_cursorpos lisp_name_codes: 139.  777756 fn_defaultf lisp_name_codes: 17.  777747 fn_definedp lisp_name_codes: 21.  777731 fn_defsubr lisp_name_codes: 35.  777651 fn_defun lisp_name_codes: 83.  777744 fn_delete lisp_name_codes: 24.  777606 fn_deletef lisp_name_codes: 118.  777743 fn_delq lisp_name_codes: 25.  777711 fn_difference lisp_name_codes: 51.  777664 fn_diff_fix lisp_name_codes: 72.  777663 fn_diff_flo lisp_name_codes: 73.  777516 fn_displace lisp_name_codes: 174.  777766 fn_do lisp_name_codes: 9.  777535 fn_dumparrays lisp_name_codes: 159.  777540 fn_endpagefn lisp_name_codes: 156.  777605 fn_eoffn lisp_name_codes: 119.  777621 fn_eql lisp_name_codes: 107.  777760 fn_errframe lisp_name_codes: 15.  777761 fn_errprint lisp_name_codes: 14.  777655 fn_errset lisp_name_codes: 79.  777660 fn_eval lisp_: 473, lisp_name_codes: 76.  777757 fn_evalframe lisp_name_codes: 16.  777520 fn_eval_when lisp_name_codes: 172.  777635 fn_exp lisp_name_codes: 95.  777706 fn_expt lisp_name_codes: 54.  777534 fn_expt_fix lisp_name_codes: 160.  777533 fn_expt_flo lisp_name_codes: 161.  777604 fn_filepos lisp_name_codes: 120.  777552 fn_fillarray lisp_name_codes: 146.  777701 fn_fix lisp_name_codes: 59.  777700 fn_float lisp_name_codes: 60.  777560 fn_force_output lisp_name_codes: 140.  777640 fn_freturn lisp_name_codes: 92.  777524 fn_fsc lisp_name_codes: 168.  777612 fn_gcd lisp_name_codes: 114.  777645 fn_gensym lisp_name_codes: 87.  777725 fn_get lisp_name_codes: 39.  777615 fn_getchar lisp_name_codes: 111.  777724 fn_getl lisp_name_codes: 40.  777735 fn_get_pname lisp_name_codes: 31.  777716 fn_greaterp lisp_name_codes: 46.  777620 fn_gt lisp_name_codes: 108.  777554 fn_haipart lisp_name_codes: 144.  777555 fn_haulong lisp_name_codes: 143.  777525 fn_ifix lisp_name_codes: 167.  777530 fn_in lisp_name_codes: 164.  777513 fn_includef lisp_name_codes: 177.  777736 fn_index lisp_name_codes: 30.  777603 fn_inpush lisp_name_codes: 121.  777632 fn_isqrt lisp_name_codes: 98.  777733 fn_ItoC lisp_name_codes: 33.  777715 fn_lessp lisp_name_codes: 47.  777602 fn_linel lisp_name_codes: 122.  777542 fn_linenum lisp_name_codes: 154.  777551 fn_listarray lisp_name_codes: 147.  777545 fn_listify lisp_: 2156, lisp_name_codes: 151.  777536 fn_loadarrays lisp_name_codes: 158.  777634 fn_log lisp_name_codes: 96.  777622 fn_ls lisp_name_codes: 106.  777703 fn_lsh lisp_name_codes: 57.  777734 fn_make_atom lisp_name_codes: 32.  777644 fn_makunbound lisp_name_codes: 88.  777522 fn_mapatoms lisp_name_codes: 170.  777676 fn_max lisp_name_codes: 62.  777601 fn_mergef lisp_name_codes: 123.  777675 fn_min lisp_name_codes: 63.  777714 fn_minus lisp_name_codes: 48.  777623 fn_minusp lisp_name_codes: 105.  777600 fn_namelist lisp_name_codes: 124.  777577 fn_names lisp_name_codes: 125.  777576 fn_namestring lisp_name_codes: 126.  777532 fn_nointerrupt lisp_name_codes: 162.  777515 fn_nth lisp_name_codes: 175.  777514 fn_nthcdr lisp_name_codes: 176.  777627 fn_oddp lisp_name_codes: 101.  777531 fn_open lisp_name_codes: 163.  777614 fn_opena lisp_name_codes: 112.  777575 fn_openi lisp_name_codes: 127.  777574 fn_openo lisp_name_codes: 128.  777527 fn_out lisp_name_codes: 165.  777543 fn_pagel lisp_name_codes: 153.  777541 fn_pagenum lisp_name_codes: 155.  777713 fn_plus lisp_name_codes: 49.  777624 fn_plusp lisp_name_codes: 104.  777670 fn_plus_fix lisp_name_codes: 68.  777667 fn_plus_flo lisp_name_codes: 69.  777573 fn_prin1 lisp_name_codes: 129.  777572 fn_princ lisp_name_codes: 130.  777571 fn_print lisp_name_codes: 131.  777656 fn_prog lisp_name_codes: 78.  777523 fn_progv lisp_name_codes: 169.  777723 fn_putprop lisp_name_codes: 41.  777710 fn_quotient lisp_name_codes: 52.  777662 fn_quot_fix lisp_name_codes: 74.  777661 fn_quot_flo lisp_name_codes: 75.  777556 fn_random lisp_name_codes: 142.  777570 fn_read lisp_name_codes: 132.  777567 fn_readch lisp_name_codes: 133.  777566 fn_readstring lisp_name_codes: 134.  777517 fn_read_from_string lisp_name_codes: 173.  777677 fn_remainder lisp_name_codes: 61.  777722 fn_remprop lisp_name_codes: 42.  777565 fn_rename lisp_name_codes: 135.  777704 fn_rot lisp_name_codes: 56.  777750 fn_rplaca lisp_name_codes: 20.  777616 fn_samepnamep lisp_name_codes: 110.  777721 fn_save lisp_name_codes: 43.  777745 fn_set lisp_name_codes: 23.  777764 fn_setarg lisp_: 2188, lisp_name_codes: 11.  777746 fn_setq lisp_name_codes: 22.  777562 fn_setsyntax lisp_name_codes: 138.  777564 fn_shortnamestring lisp_name_codes: 136.  777702 fn_signp lisp_name_codes: 58.  777636 fn_sin lisp_name_codes: 94.  777630 fn_sleep lisp_name_codes: 100.  777550 fn_sort lisp_name_codes: 148.  777547 fn_sortcar lisp_name_codes: 149.  777633 fn_sqrt lisp_name_codes: 97.  777762 fn_sstatus lisp_name_codes: 13.  777730 fn_star_array lisp_name_codes: 36.  777646 fn_star_rearray lisp_name_codes: 86.  777641 fn_star_sstatus lisp_name_codes: 91.  777642 fn_star_status lisp_name_codes: 90.  777763 fn_status lisp_name_codes: 12.  777652 fn_store lisp_name_codes: 82.  777742 fn_stringlength lisp_name_codes: 26.  777717 fn_sub1 lisp_name_codes: 45.  777672 fn_sub1_fix lisp_name_codes: 66.  777671 fn_sub1_flo lisp_name_codes: 67.  777737 fn_substr lisp_name_codes: 29.  777613 fn_sxhash lisp_name_codes: 113.  777726 fn_sysp lisp_name_codes: 38.  777653 fn_throw lisp_name_codes: 81.  777712 fn_times lisp_name_codes: 50.  777666 fn_times_fix lisp_name_codes: 70.  777665 fn_times_flo lisp_name_codes: 71.  777526 fn_truename lisp_name_codes: 166.  777563 fn_tyi lisp_name_codes: 137.  777626 fn_tyipeek lisp_name_codes: 102.  777752 fn_tyo lisp_name_codes: 18.  777521 fn_unwind_protect lisp_name_codes: 171.  777546 fn_zerop lisp_name_codes: 150.  3346 foocall lisp_: 3085, 3092, 3105, 3127.  1762 foocall_error lisp_: 1857, 1861, 1865, 1869, 1872. 777770 form lisp_: 46, 183, 184, 208, 306, 307, 354, 414, 418, 433, 436, 659,  665, 667, 669, 680, 714, 981, 982, 1317, 1441, 1840, 1882, 1913,  1988, 1991, 2029, 2061, 2318, 2377, 2389, 2808, 2885, 2914, 2918, 2920,  2921, 3025, 3026, 3037, 3063, 3064, 3065, 3071, 3111, 3115, 3127, 3128,  3138, 3158, 3171, 3196, 3246, 3300, 3342, 3343, 3350, 3382, 3383, 3396.  1 frame.dat1 lisp_: 272, 713, 2388, lisp_unmkd_pdl: 10.  1 frame.dat2 lisp_unmkd_pdl: 11.  0 frame.prev_frame lisp_: 274, 284, 717, 1015, 1074, 1307, 2392, lisp_unmkd_pdl: 8.  2 frame.ret lisp_: 278, 286, 2935, 2942, 2946, 2951, 2970, lisp_unmkd_pdl: 12.  0 frame.stack_ptr lisp_: 270, 715, 2390, lisp_unmkd_pdl: 9.  10 framebit lisp_: 31, 719, 1013, 1053, 1305, 2395.  736 freturn_join lisp_: 973, 1018.  744 freturn_real lisp_: 990, 992.  5 fsubr_offset lisp_: 1360, 1393, 1542. 102 full_recurse lisp_: 243, 293.  funarg lisp_: 1678. 777771 funarg_pdlptr lisp_: 64, 1576, 1597. 3256 funcall lisp_: 1473, 3056, 3057. 3261 funcall0 lisp_: 3050, 3057, 3061. function_properties lisp_: 1372. 42 gensym_data lisp_stack_seg: 26.  3126 go lisp_: 2906, 2907.  3135 go_1 lisp_: 2913, 2918.  3141 go_ret lisp_: 2901, 2923.  3167 go_ret_full_unwind lisp_: 2941, 2964.  3161 go_ret_same_sp lisp_: 2936, 2950.  400 ignore_macros lisp_: 39, 1446.  1766 illegal_f_fcn lisp_: 1879, 3191, 3360, 3361.  1341 illegal_use_of_a_macro lisp_: 1439, 1445.  16 in_pl1_code lisp_: 187, 196, 388, 400, 525, 540, 997, 2932,  lisp_stack_seg: 13.  10 iochan.aclinfop lisp_iochan: 14. 2000 iochan.charmode lisp_iochan: 27. 13 iochan.charpos lisp_iochan: 16. 12 iochan.component lisp_iochan: 15. 35 iochan.End lisp_iochan: 40. 1000 iochan.extra_nl_done lisp_iochan: 28. 6 iochan.fcbp lisp_iochan: 13. 400 iochan.fixnum_mode lisp_iochan: 29. 15 iochan.flags lisp_iochan: 18. 16 iochan.function lisp_iochan: 34. 40000 iochan.gc_mark lisp_iochan: 22. 200 iochan.image_mode lisp_iochan: 30. 20000 iochan.interactive lisp_iochan: 23. 0 iochan.ioindex lisp_iochan: 9. 1 iochan.iolength lisp_iochan: 10. 2 iochan.ioptr lisp_iochan: 11. 14 iochan.linel lisp_iochan: 17. 33 iochan.linenum lisp_iochan: 38. 10000 iochan.must_reopen lisp_iochan: 25. 22 iochan.name lisp_iochan: 36. 20 iochan.namelist lisp_iochan: 35. 4000 iochan.nlsync lisp_iochan: 26. 32 iochan.pagel lisp_iochan: 37. 34 iochan.pagenum lisp_iochan: 39. 200000 iochan.read lisp_iochan: 20. 400000 iochan.seg lisp_iochan: 19. 4 iochan.thread lisp_iochan: 12. 100000 iochan.write lisp_iochan: 21. 46 iogbind_op lisp_stack_seg: 29.  150 irest_return_op lisp_stack_seg: 62.  lambda lisp_: 1422, 1508.  524 lambda_bind lisp_: 740, 776, 2427, 2445.  526 lambda_bind_1 lisp_: 743, 762.  1000 lambda_completion lisp_: 1031, 1044.  1007 lambda_completion_1 lisp_: 1055, 1076.  1023 lambda_completion_2 lisp_: 1057, 1068.  2054 let lisp_: 1978, 1979.  2073 let_bind_1 lisp_: 1997, 2018.  2131 let_bind_2 lisp_: 2034, 2054.  2153 let_bind_2_done lisp_: 2036, 2058.  2144 let_bind_2_gets_nil lisp_: 2042, 2047.  2117 let_ll_done lisp_: 1994, 2000, 2020. 6 lexpr_offset lisp_: 1361, 1434.  110 link_opr lisp_stack_seg: 46.  lisp_alloc_ lisp_: 1765, 2144, 2220, 2782.  lisp_default_handler_ lisp_: 533. lisp_error_ lisp_: 369. lisp_error_table_ lisp_: 260, 279, 478, 1556, 1834, 1849, 1858, 1862, 1866, 1870, 1884, 1898,  1931, 2073, 2204, 2957.  77700 lisp_ptr.type lisp_: 744, 815, 845, 887, 951, 1237, 1375, 1494, 1989, 1995, 1999, 2006,  2035, 2041, 2560, 2666, 2878, 2883, 2912, lisp_object_types: 13.  20 lisp_retn lisp_: 207, 343, 419, 438, 2064, 3142.  21 lisp_rtn_1 lisp_: 209, 322, 1686, 1825, 2121, 2154, 2172, 2856, 3059, 3116, 3294. lisp_static_vars_ lisp_: 185, 186, 193, 194, 195, 222, 236, 256, 273, 276, 285, 386,  387, 397, 398, 399, 495, 514, 523, 524, 528, 537, 538, 539,  562, 564, 647, 657, 705, 716, 718, 994, 995, 996, 1016, 1046,  1049, 1075, 1095, 1193, 1302, 1308, 1372, 1422, 1454, 1508, 1613, 1616,  1664, 1678, 1732, 1746, 1754, 1757, 1777, 1790, 1793, 1795, 1803, 1806,  1819, 1821, 2023, 2026, 2081, 2083, 2085, 2095, 2098, 2111, 2160, 2185,  2195, 2383, 2391, 2394, 2470, 2514, 2925, 2940, 3018, 3119, 3120, 3121,  3122, 3123, 3124, 3239, 3276, 3293.  40000 listargs lisp_: 2311, 2426, 2505, 2628, 2652. 2234 listify lisp_: 2068, 2123.  1460 loser_binding_nil lisp_: 756, 907, 1555, 2013.  674 loser_bind_nil lisp_: 896, 906.  2264 lstfy_end lisp_: 2134, 2151.  2244 lstfy_loop lisp_: 2133, 2149.  20 lsubrbit lisp_: 32, 797, 842, 1114, 1121, 1309, 2462, 2513, 2630, 2657, 3097, 3209,  3227, 3256, 3364, 3370, 3390. 3307 lsubrcall lisp_: 3083, 3092.  lsubrcall_bad_ptr lisp_: 1862. 1754 lsubrcall_error lisp_: 1860, 3093, 3096. 2 lsubr_offset lisp_: 1357, 1390.  1 macrobit lisp_: 29, 975, 1428, 1440, 1541, 1935.  2616 make_argl lisp_: 2450, 2497, 2533, 2536, 2591. 2617 make_argl_nmv lisp_: 2593, 2640, 2687. 514 make_no_frame lisp_: 707, 721.  2363 map lisp_: 2326, 2334.  2365 mapc lisp_: 2326, 2337.  2373 mapcan lisp_: 2326, 2346.  2367 mapcar lisp_: 2326, 2340.  400000 mapcarf lisp_: 2307, 2337, 2340, 2346, 2562. 2376 mapcom lisp_: 2335, 2338, 2341, 2344, 2347, 2353.  2375 mapcon lisp_: 2326, 2349.  100000 mapconf lisp_: 2310, 2346, 2349, 2362, 2733, 2799, 2838. 2411 mapc_klg_xx lisp_: 2363, 2367.  20000 mapf lisp_: 966, 1008, 1936, 2312, 2334, 2337, 2340, 2343, 2346, 2349.  0 mapfcn lisp_: 2316, 2376, 2417, 2621.  2371 maplist lisp_: 2326, 2343.  777766 mapresult lisp_: 2318, 2368, 2375, 2742, 2745, 2750, 2752, 2761, 2762, 2769, 2788, 2826,  2829, 2843, 2848, 2854.  200000 mapretf lisp_: 2309, 2340, 2343, 2362, 2731, 2797, 2824. 777766 mapsvx3 lisp_: 2322, 2379, 2414, 2617, 2719, 2851.  777767 mapsvx5 lisp_: 2323. 3070 map_abending lisp_: 1937, 2846.  2737 map_cdr_loop lisp_: 2723, 2729.  2745 map_cdr_loop_end lisp_: 2722, 2730.  3003 map_con_er lisp_: 2734, 2766, 2817. 3045 map_con_er_freturn lisp_: 2815. 2666 map_do_expr lisp_: 2624, 2651.  2712 map_do_fexpr lisp_: 2653, 2686.  2660 map_do_fsubr lisp_: 2629, 2639.  2720 map_do_lexpr lisp_: 2658, 2698.  3050 map_ending lisp_: 2561, 2822.  3071 map_ending_1 lisp_: 2839, 2850.  3070 map_ending_2 lisp_: 2828, 2835, 2844, 2847.  3064 map_ending_aa lisp_: 2825, 2837.  2473 map_expr lisp_: 2404, 2442.  2705 map_expr_bind_end lisp_: 2667, 2676.  2674 map_expr_bind_loop lisp_: 2665, 2674.  2726 map_fcn_fin lisp_: 967, 2711.  2457 map_fexpr lisp_: 2405, 2424.  3031 map_freturn lisp_: 1009, 2795.  3035 map_freturn_restart lisp_: 2801, 2813, 2816, 2818.  2542 map_fsubr lisp_: 2406, 2503.  2641 map_go lisp_: 2430, 2437, 2448, 2487, 2495, 2506, 2516, 2530, 2531, 2619.  2640 map_go3 lisp_: 2617, 2735, 2738, 2767.  2503 map_lexpr lisp_: 2407, 2460.  2545 map_lsubr lisp_: 2403, 2511.  2441 map_mnf lisp_: 2385, 2397, 2810. 2773 map_ret_1st lisp_: 2744, 2756.  2752 map_ret_er lisp_: 2732, 2737, 2814. 3043 map_ret_er_freturn lisp_: 2798, 2812.  2451 map_set_up lisp_: 2413, 2425, 2443, 2461, 2493, 2504, 2512. 2535 map_subr lisp_: 2401, 2402, 2492. 2572 map_tfa_lsubr lisp_: 2528, 2535.  2570 map_tma_lsubr lisp_: 2532. 0 marked_stack_bottom lisp_: 465, lisp_stack_seg: 6.  meaningless_argument_number lisp_: 2073.  2574 mv_args lisp_: 2550, 2592, 2620. 2601 mv_args_loop lisp_: 2556, 2569.  nconc lisp_: 2782. ncons_ lisp_: 1765. 74 ncons_op lisp_stack_seg: 40.  3204 negative_4 lisp_: 2981, 3069.  nihil_ex_nihile lisp_: 1556. 12 nil lisp_: 240, 257, 453, 706, 755, 895, 943, 1194, 1303, 1431, 1455, 1550,  1733, 1758, 1927, 1951, 1993, 2012, 2048, 2109, 2131, 2158, 2183, 2192,  2200, 2374, 2384, 2515, 2595, 2743, 2827, 2832, 2919, 3120, 3277, 3290,  lisp_stack_seg: 11.  1416 non_atom_fcn lisp_: 1495, 1500.  40 noteval lisp_: 33, 350, 1244. 2202 not_listify lisp_: 2078, 2087.  210400 not_ok_to_read lisp_iochan: 31. 110400 not_ok_to_write lisp_iochan: 32. not_pdl_ptr lisp_: 478. 3504 nouuo lisp_: 3286, 3288.  nouuo_flag lisp_: 3276, 3293.  no_lexpr lisp_: 2204. no_snapped_links lisp_: 3018, 3239.  61400 Numeric lisp_object_types: 17.  obarray lisp_: 3124. 777774 pdlptr lisp_: 58, 911, 912, 1607, 1618. 3246 pl1_callable_funcall_ lisp_: 3045, 3046.  152 pl1_call_nopop_op lisp_stack_seg: 63.  134 pl1_call_op lisp_stack_seg: 56.  10 pl1_entry lisp_: 180, 192, 221, 331, 2868, 3047, 3326. 4 pl1_exit lisp_: 185, 224, 3054, 3338, 3398. 66 pl1_interface lisp_stack_seg: 37.  70 pl1_lsubr_interface lisp_stack_seg: 38.  2 pl1_return lisp_: 182, 334, 2893. prog_frame lisp_: 2925. 1171 push_offset stack_header: 81.  qarg lisp_: 2185. qlstfy lisp_: 2160. 2312 qqarg lisp_: 2107, 2183.  2270 qqlistify lisp_: 2077, 2123, 2157. 2317 qqsetarg lisp_: 2164, 2189.  qsetarg lisp_: 2195. 777776 qsrac lisp_: 52, 965, 974, 1235, 1239, 1247, 1249, 2668, 2669, 2740, 2772, 2831, 2834. 347 rbc00 lisp_: 566, 574, 581. 356 rbc01 lisp_: 572, 576.  362 rbc02 lisp_: 577, 583.  372 rbc03 lisp_: 596, 604.  365 rbc03a lisp_: 590, 593.  371 rbc03b lisp_: 591, 595.  400 rbc04 lisp_: 599, 602.  403 rbc_ret lisp_: 569, 609.  154 rcv_char_star_op lisp_stack_seg: 64.  readtable lisp_: 3123. 32 recurse lisp_: 236, 955, 1246, 1530, 2045, 3136.  3122 return lisp_: 2897, 2898.  1102 returned_from_subroutine lisp_: 1150.  1173 return_no_pop_offset stack_header: 83.  1172 return_offset stack_header: 82.  62 return_op lisp_stack_seg: 35.  262 reversal lisp_: 495, 573, 601, 631, 643. 266 reverse_1_binding lisp_: 499, 509.  300 reverse_1_binding_aa lisp_: 501, 511.  341 reverse_binding_context lisp_: 412, 431, 557, 1599.  3130 re_go lisp_: 2912, 2916.  2274 setarg lisp_: 2068, 2164.  475 set_eval_frame lisp_: 704. 475 set_eval_frame_1 lisp_: 704. 1537 set_x1_args lisp_: 876, 1092, 1134, 1164, 1641. 56 signp_op lisp_stack_seg: 33.  1265 skip_autoload lisp_: 1383, 1447, 1452, 1456.  3521 snapcaller lisp_: 3324, 3325.  3613 snapcall_rtn lisp_: 3354, 3394.  3472 snappable_p lisp_: 3013, 3219, 3269. 3610 sn_cant lisp_: 3366, 3368, 3390. 3562 sn_lsubr lisp_: 3358, 3364.  3576 sn_lsubr_chk_ret lisp_: 3376, 3388.  3606 sn_lsubr_ckna lisp_: 3371, 3386.  3563 sn_subr lisp_: 3356, 3357, 3365. 1155 spread1 lisp_: 1236, 1250.  1176 spread_adj lisp_: 1233, 1265.  1203 spread_adj_0 lisp_: 1278, 1300, 1304. 1217 spread_adj_aa lisp_: 1274, 1298.  1243 spread_for_lsubr lisp_: 1310, 1322.  1173 spread_no_more lisp_: 1238, 1252.  1207 spread_up lisp_: 1283, 1291.  73 stach_header.trace_top_ptr stack_header: 62. 66 stack_header.assign_linkage_ptr stack_header: 59.  32 stack_header.bar_mode_sp stack_header: 42. 36 stack_header.call_op_ptr stack_header: 44. 10 stack_header.clr_ptr stack_header: 27.  6 stack_header.combined_stat_ptr stack_header: 25.  4 stack_header.cpm_data_ptr stack_header: 24. 13 stack_header.cpm_enabled stack_header: 32. 13 stack_header.cur_lot_size stack_header: 31. 64 stack_header.ect_ptr stack_header: 58.  46 stack_header.entry_op_ptr stack_header: 49. 70 stack_header.heap_header_ptr stack_header: 60. 74 stack_header.in_trace stack_header: 63.  52 stack_header.isot_ptr stack_header: 52.  26 stack_header.lot_ptr stack_header: 39.  12 stack_header.main_proc_invoked stack_header: 29.  12 stack_header.max_lot_size stack_header: 28. 20 stack_header.parent_ptr stack_header: 36.  34 stack_header.pl1_operators_ptr stack_header: 43.  40 stack_header.push_op_ptr stack_header: 46. 42 stack_header.return_op_ptr stack_header: 47. 44 stack_header.ret_no_pop_op_ptr stack_header: 48.  62 stack_header.rnt_ptr stack_header: 57.  12 stack_header.run_unit_depth stack_header: 30. 54 stack_header.sct_ptr stack_header: 53.  30 stack_header.signal_ptr stack_header: 41.  22 stack_header.stack_begin_ptr stack_header: 37. 24 stack_header.stack_end_ptr lisp_: 394,  stack_header: 38. 14 stack_header.system_free_ptr stack_header: 33. 60 stack_header.sys_link_info_ptr stack_header: 56.  72 stack_header.trace_frames stack_header: 61. 50 stack_header.trans_op_tv_ptr stack_header: 51. 56 stack_header.unwinder_ptr stack_header: 54. 16 stack_header.user_free_ptr stack_header: 34. 100 stack_header_end stack_header: 64.  stack_ptr lisp_: 185, 194, 386, 397, 523, 538, 995. 4 stack_ptr_ptr lisp_: 2930, lisp_stack_seg: 8.  star_rset lisp_: 256, 705, 1193, 1302, 2383, 2514.  1545 stfunction lisp_: 1649, 1651.  1560 stfunction_00 lisp_: 1665, 1672.  116 store_operator lisp_stack_seg: 49.  4000 String lisp_object_types: 22.  2000 Subr lisp_: 1496, 1538, 3140, 3330,  lisp_object_types: 23.  3301 subrcall lisp_: 3083, 3085.  subrcall_bad_ptr lisp_: 1858. 1752 subrcall_error lisp_: 1856, 3086, 3089. 1 subr_offset lisp_: 1356, 1387, 1497. 777775 svx0u lisp_: 61, 297, 302, 1059, 1066, 1593, 1603. 777774 svx2l lisp_: 60, 295, 303, 1002, 1147, 1152, 1596, 1600.  777773 svx3l lisp_: 63, 298, 305, 1060, 1065, 1594, 1602. 777775 svx4l lisp_: 62, 296, 301, 1061, 1064, 1595, 1601. 777774 svx5u lisp_: 59, 294, 304, 1001, 1058, 1067, 1146, 1151, 1592, 1604, 2446, 2447,  2553, 2554, 2557. 121 symeval lisp_: 313, 315.  130 symeval_loss lisp_: 317, 319, 324. 126 symeval_ret lisp_: 320, 326.  44 system_lp lisp_stack_seg: 28.  400 System_Subr lisp_object_types: 24.  104 terminate_list_op lisp_stack_seg: 44.  52 throw1_op lisp_stack_seg: 31.  54 throw2_op lisp_stack_seg: 32.  1777 too_few_args_expr lisp_: 914, 1903.  2043 too_few_args_lsubr lisp_: 1209, 1959, 2537. 2032 too_few_args_subr lisp_: 1128, 1313, 1942, 3195, 3231, 3374.  1777 too_many_args_expr lisp_: 853, 915, 1902. 2043 too_many_args_lsubr lisp_: 1212, 1958, 2534. 2032 too_many_args_subr lisp_: 1129, 1314, 1941, 3194, 3232, 3375.  0 trace_frames.count stack_header: 69.  1 trace_frames.top_ptr stack_header: 70.  14 true lisp_: 3292, lisp_stack_seg: 12.  551 tv_offset stack_header: 75, 80, 81, 82, 83, 84. 60 type_fields lisp_stack_seg: 34.  t_atom lisp_: 3119. 765 unbinder lisp_: 968, 1027, 2852, 3023, 3244, 3377.  22 unbind_op lisp_stack_seg: 18.  40 uncatch_op lisp_stack_seg: 25.  60000 Uncollectable lisp_: 830, 1098, 1105, 2473, 2482, 2899, 3172, 3351,  lisp_object_types: 21.  undefined_atom lisp_: 260, 279.  46 undefined_atom_error lisp_: 249, 325, 668. 53 undefined_atom_error_hard lisp_: 258, 263. undefined_function lisp_: 1849. 1742 undef_fcn lisp_: 1487, 1489, 1498, 1539, 1845. 30 unerrset_op lisp_stack_seg: 21.  67500 Unevalable lisp_: 238, 660,  lisp_object_types: 27.  unmkd_ptr lisp_: 186, 193, 195, 387, 398, 399, 524, 528, 537, 539, 994, 996.  6 unmkd_ptr_ptr lisp_: 2931, lisp_stack_seg: 9.  2 unmkd_stack_bottom lisp_: 485, 1673,  lisp_stack_seg: 7.  50 unseen_go_tag_op lisp_stack_seg: 30.  1411 unsymbolic_function lisp_: 1370, 1493.  146 ununwp_op lisp_stack_seg: 61.  unwinder_ lisp_: 2973. 772 unwind_bindings lisp_: 1036, 1042.  25 unwind_reversal lisp_: 218, 220.  405 unwind_reversal_bb lisp_: 223, 416, 435, 616, 1063. 142 unwp1_op lisp_stack_seg: 59.  144 unwp2_op lisp_stack_seg: 60.  413 urb00 lisp_: 623, 628.  425 urb01 lisp_: 630, 636.  426 urb02 lisp_: 637, 641, 644. 410 urbre lisp_: 620, 632.  436 urbxx lisp_: 624, 638, 646. user_intr_array lisp_: 1454. 1000 went_through_value_cell lisp_: 40, 1485, 1527, 1572, 1705, 3270, 3365. 2002 wna_com lisp_: 1911, 1954.  2016 wna_com_1 lisp_: 1915, 1917, 1925. wrong_no_args lisp_: 1931. 1777 wrong_no_args_expr lisp_: 1901, 2451.  2043 wrong_no_args_lsubr lisp_: 1957. 2032 wrong_no_args_subr lisp_: 1940, 2498.  2164 wta_arg lisp_: 2073, 2084, 2089, 2100.  1435 x13 lisp_: 1511, 1526.  76 xcons_op lisp_stack_seg: 41.  1320 xx_lambda lisp_: 1425, 1516.  NO FATAL ERRORS  ----------------------------------------------------------- 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