ASSEMBLY LISTING OF SEGMENT >special_ldd>install>MR12.0-1206>lisp_bignums_.alm ASSEMBLED ON: 11/05/86 1101.5 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 "  7 " lisp_bignums_ 8 "  9 " N.B. The algorithms presented herein are either from  10 " Knuth's Art of Computer Programming, vol 2 (notation  11 " is saved once in a while), or are obvious (hopefully) 12 " and commented.  13 " Large sections of uncommented code (such as in div_bb) will  14 " be easier to read with Knuth's book beside you.  15 "  16 " The format of this set of routines is internal subroutines  17 " first, in alphabetic order, followed by code that is referenced  18 " from outside. 19 "  20 " Initially coded late 1972 and early 1973 by Dan Bricklin  21 " Modified 75.04.17 by DAM to fix bug in haipart and convert for 6180 a little  22 " Last modified Christmas Eve, 1980 by Richard Lamson to fix interaction  23 " between call_alloc_bfx and garbage collector. 24 "  000267 25 segdef convert_bfx_to_sfl  001304 26 segdef plus  001443 27 segdef difference  001474 28 segdef times  001645 29 segdef quotient  002076 30 segdef fix 002171 31 segdef float  002251 32 segdef add1  002314 33 segdef sub1  002317 34 segdef minus  002355 35 segdef abs 002415 36 segdef minusp  002435 37 segdef plusp  002457 38 segdef max 002601 39 segdef min 002616 40 segdef lessp  002636 41 segdef greaterp  002660 42 segdef remainder  002776 43 segdef expt  004140 44 segdef haulong 003351 45 segdef haipart 003546 46 segdef gcd 47 "  48 include stack_header  1-1 " BEGIN INCLUDE FILE ... stack_header.incl.alm 3/72 Bill Silver  1-2 "  1-3 " modified 7/76 by M. Weaver for *system links and more system use of areas 1-4 " modified 3/77 by M. Weaver to add rnt_ptr  1-5 " modified 7/77 by S. Webber to add run_unit_depth and assign_linkage_ptr  1-6 " modified 6/83 by J. Ives to add trace_frames and in_trace.  1-7  1-8 " HISTORY COMMENTS: 1-9 " 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396),  1-10 " audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206):  1-11 " added the heap_header_ptr definition  1-12 " 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473),  1-13 " audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206):  1-14 " Modified to support control point management. These changes were 1-15 " actually made in February 1985 by G. Palter.  1-16 " 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473),  1-17 " audit(86-10-22,Farley), install(86-11-03,MR12.0-1206):  1-18 " Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18  1-19 " bit pad after cur_lot_size for the cpm_enabled. This was done to save 1-20 " some space int the stack header and change the cpd_ptr unal to  1-21 " cpm_data_ptr (ITS pair).  1-22 " END HISTORY COMMENTS 1-23  000004 1-24 equ stack_header.cpm_data_ptr,4 ptr to control point for this stack  000006 1-25 equ stack_header.combined_stat_ptr,6 ptr to separate static area  1-26  000010 1-27 equ stack_header.clr_ptr,8 ptr to area containing linkage sections  000012 1-28 equ stack_header.max_lot_size,10 number of words allowed in lot (DU)  000012 1-29 equ stack_header.main_proc_invoked,10 nonzero if main proc was invoked in run unit (DL)  000012 1-30 equ stack_header.run_unit_depth,10 number of active run units stacked (DL) 000013 1-31 equ stack_header.cur_lot_size,11 DU number of words (entries) in lot  000013 1-32 equ stack_header.cpm_enabled,11 DL non-zero if control point management is enabled  000014 1-33 equ stack_header.system_free_ptr,12 ptr to system storage area 000016 1-34 equ stack_header.user_free_ptr,14 ptr to user storage area  1-35  000020 1-36 equ stack_header.parent_ptr,16 ptr to parent stack or null  000022 1-37 equ stack_header.stack_begin_ptr,18 ptr to first stack frame  000024 1-38 equ stack_header.stack_end_ptr,20 ptr to next useable stack frame 000026 1-39 equ stack_header.lot_ptr,22 ptr to the lot for the current ring  1-40  000030 1-41 equ stack_header.signal_ptr,24 ptr to signal proc for current ring  000032 1-42 equ stack_header.bar_mode_sp,26 value of sp before entering bar mode  000034 1-43 equ stack_header.pl1_operators_ptr,28 ptr: pl1_operators_$operator_table  000036 1-44 equ stack_header.call_op_ptr,30 ptr to standard call operator 1-45  000040 1-46 equ stack_header.push_op_ptr,32 ptr to standard push operator 000042 1-47 equ stack_header.return_op_ptr,34 ptr to standard return operator 000044 1-48 equ stack_header.ret_no_pop_op_ptr,36 ptr: stand. return/ no pop operator  000046 1-49 equ stack_header.entry_op_ptr,38 ptr to standard entry operator  1-50  000050 1-51 equ stack_header.trans_op_tv_ptr,40 ptr to table of translator operator ptrs  000052 1-52 equ stack_header.isot_ptr,42 pointer to ISOT  000054 1-53 equ stack_header.sct_ptr,44 pointer to System Condition Table 000056 1-54 equ stack_header.unwinder_ptr,46 pointer to unwinder for current ring 1-55  000060 1-56 equ stack_header.sys_link_info_ptr,48 ptr to *system link name table  000062 1-57 equ stack_header.rnt_ptr,50 ptr to reference name table  000064 1-58 equ stack_header.ect_ptr,52 ptr to event channel table  000066 1-59 equ stack_header.assign_linkage_ptr,54 ptr to area for hcs_$assign_linkage calls  000070 1-60 equ stack_header.heap_header_ptr,56 ptr to heap header.  000072 1-61 equ stack_header.trace_frames,58 stack of trace_catch_ frames 000073 1-62 equ stach_header.trace_top_ptr,59 trace pointer  000074 1-63 equ stack_header.in_trace,60 trace antirecurse bit  000100 1-64 equ stack_header_end,64 length of stack header  1-65  1-66  1-67  1-68  000000 1-69 equ trace_frames.count,0 number of trace frames on stack  000001 1-70 equ trace_frames.top_ptr,1 packed pointer to top one  1-71  1-72 " The following constant is an offset within the pl1 operators table.  1-73 " It references a transfer vector table.  1-74  000551 1-75 bool tv_offset,551 1-76  1-77  1-78 " The following constants are offsets within this transfer vector table.  1-79  001170 1-80 equ call_offset,tv_offset+271  001171 1-81 equ push_offset,tv_offset+272  001172 1-82 equ return_offset,tv_offset+273  001173 1-83 equ return_no_pop_offset,tv_offset+274 001174 1-84 equ entry_offset,tv_offset+275 1-85  1-86  1-87 " END INCLUDE FILE stack_header.incl.alm  49 include lisp_object_types  2-1  2-2 " BEGIN INCLUDE FILE lisp_object_types.incl.alm 2-3 "  2-4 " D.A.Moon 14 July 72  2-5  2-6 "These are bit masks used to check or set the type bits in lisp pointers  2-7 "they should be used with cana instructions in the dl mode. 2-8 "  2-9 " Modified 1 Oct 1972 by Dan Bricklin to add bignum types.  2-10  2-11  2-12  077700 2-13 bool lisp_ptr.type,077700 "the whole type field  2-14  040000 2-15 bool Fixed,040000 "fixed number, stored in second word of ptr 020000 2-16 bool Float,020000 "floating number, stored in second word of ptr  061400 2-17 bool Numeric,061400 "fixed or float, big or little  010000 2-18 bool Atsym,010000 "Atomic symbol pointed at by ptr  077700 2-19 bool Atomic,077700 "any of these bits indicates an atom (non-list)  001000 2-20 bool Bignum,001000 "points to a bignum - fixed  060000 2-21 bool Uncollectable,060000 "not a pointer, also both bits on = "pdl_ptr"  004000 2-22 bool String,004000 "points at a lisp character string 002000 2-23 bool Subr,002000 "points at subr link 000400 2-24 bool System_Subr,000400 "marks a subr as being in the text of lisp bound seg. 000200 2-25 bool Array,000200 "points at an array,  2-26 " which is a special kind of subr  067500 2-27 bool Unevalable,067500 "any of these bits means  2-28 " does not have car and cdr  001000 2-29 bool Big_fixed,001000 "points to fixed bignum 000100 2-30 bool File,000100 "points to a file object (i.e. an iochan)  2-31  2-32 "fields for making numbers, a fault tag is included in case someone takes the car or cdr of it  2-33  040047 2-34 bool fixnum_type,040047  020047 2-35 bool flonum_type,020047  2-36  2-37 " END INCLUDE FILE: lisp_object_types.incl.alm  50 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  51 include lisp_name_codes  4-1  4-2 " BEGIN INCLUDE FILE lisp_name_codes.incl.alm  4-3  4-4 " These are codes for the names of functions which are stored into ab|-1,x7 before  4-5 " calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 4-6 " are used so that the name of the function which is rejecting its argument 4-7 " can be printed. Please note that all these codes are negative.  4-8  777777 777766 4-9 equ fn_do,-10  777777 777765 4-10 equ fn_arg,-11 777777 777764 4-11 equ fn_setarg,-12  777777 777763 4-12 equ fn_status,-13  777777 777762 4-13 equ fn_sstatus,-14 777777 777761 4-14 equ fn_errprint,-15  777777 777760 4-15 equ fn_errframe,-16  777777 777757 4-16 equ fn_evalframe,-17  777777 777756 4-17 equ fn_defaultf,-18  777777 777752 4-18 equ fn_tyo,-22 777777 777751 4-19 equ fn_ascii,-23  777777 777750 4-20 equ fn_rplaca,-24  777777 777747 4-21 equ fn_definedp,-25  777777 777746 4-22 equ fn_setq,-26  777777 777745 4-23 equ fn_set,-27 777777 777744 4-24 equ fn_delete,-28  777777 777743 4-25 equ fn_delq,-29  777777 777742 4-26 equ fn_stringlength,-30  777777 777741 4-27 equ fn_catenate,-31  777777 777740 4-28 equ fn_array,-32  777777 777737 4-29 equ fn_substr,-33  777777 777736 4-30 equ fn_index,-34  777777 777735 4-31 equ fn_get_pname,-35  777777 777734 4-32 equ fn_make_atom,-36  777777 777733 4-33 equ fn_ItoC,-37  777777 777732 4-34 equ fn_CtoI,-38  777777 777731 4-35 equ fn_defsubr,-39 777777 777730 4-36 equ fn_star_array,-40  777777 777727 4-37 equ fn_args,-41  777777 777726 4-38 equ fn_sysp,-42  777777 777725 4-39 equ fn_get,-43 777777 777724 4-40 equ fn_getl,-44  777777 777723 4-41 equ fn_putprop,-45 777777 777722 4-42 equ fn_remprop,-46 777777 777721 4-43 equ fn_save,-47  777777 777720 4-44 equ fn_add1,-48  777777 777717 4-45 equ fn_sub1,-49  777777 777716 4-46 equ fn_greaterp,-50  777777 777715 4-47 equ fn_lessp,-51  777777 777714 4-48 equ fn_minus,-52  777777 777713 4-49 equ fn_plus,-53  777777 777712 4-50 equ fn_times,-54  777777 777711 4-51 equ fn_difference,-55  777777 777710 4-52 equ fn_quotient,-56  777777 777707 4-53 equ fn_abs,-57 777777 777706 4-54 equ fn_expt,-58  777777 777705 4-55 equ fn_boole,-59  777777 777704 4-56 equ fn_rot,-60 777777 777703 4-57 equ fn_lsh,-61 777777 777702 4-58 equ fn_signp,-62  777777 777701 4-59 equ fn_fix,-63 777777 777700 4-60 equ fn_float,-64  777777 777677 4-61 equ fn_remainder,-65  777777 777676 4-62 equ fn_max,-66 777777 777675 4-63 equ fn_min,-67 777777 777674 4-64 equ fn_add1_fix,-68  777777 777673 4-65 equ fn_add1_flo,-69  777777 777672 4-66 equ fn_sub1_fix,-70  777777 777671 4-67 equ fn_sub1_flo,-71  777777 777670 4-68 equ fn_plus_fix,-72  777777 777667 4-69 equ fn_plus_flo,-73  777777 777666 4-70 equ fn_times_fix,-74  777777 777665 4-71 equ fn_times_flo,-75  777777 777664 4-72 equ fn_diff_fix,-76  777777 777663 4-73 equ fn_diff_flo,-77  777777 777662 4-74 equ fn_quot_fix,-78  777777 777661 4-75 equ fn_quot_flo,-79  777777 777660 4-76 equ fn_eval,-80  777777 777657 4-77 equ fn_apply,-81  777777 777656 4-78 equ fn_prog,-82  777777 777655 4-79 equ fn_errset,-83  777777 777654 4-80 equ fn_catch,-84  777777 777653 4-81 equ fn_throw,-85  777777 777652 4-82 equ fn_store,-86  777777 777651 4-83 equ fn_defun,-87  777777 777650 4-84 equ fn_baktrace,-88  777777 777647 4-85 equ fn_bltarray,-89  777777 777646 4-86 equ fn_star_rearray,-90  777777 777645 4-87 equ fn_gensym,-91  777777 777644 4-88 equ fn_makunbound,-92  777777 777643 4-89 equ fn_boundp,-93  777777 777642 4-90 equ fn_star_status,-94 777777 777641 4-91 equ fn_star_sstatus,-95  777777 777640 4-92 equ fn_freturn,-96 777777 777637 4-93 equ fn_cos,-97 777777 777636 4-94 equ fn_sin,-98 777777 777635 4-95 equ fn_exp,-99 777777 777634 4-96 equ fn_log,-100  777777 777633 4-97 equ fn_sqrt,-101  777777 777632 4-98 equ fn_isqrt,-102  777777 777631 4-99 equ fn_atan,-103  777777 777630 4-100 equ fn_sleep,-104  777777 777627 4-101 equ fn_oddp,-105  777777 777626 4-102 equ fn_tyipeek,-106  777777 777625 4-103 equ fn_alarmclock,-107 777777 777624 4-104 equ fn_plusp,-108  777777 777623 4-105 equ fn_minusp,-109 777777 777622 4-106 equ fn_ls,-110 777777 777621 4-107 equ fn_eql,-111  777777 777620 4-108 equ fn_gt,-112 777777 777617 4-109 equ fn_alphalessp,-113 777777 777616 4-110 equ fn_samepnamep,-114 777777 777615 4-111 equ fn_getchar,-115  777777 777614 4-112 equ fn_opena,-116  777777 777613 4-113 equ fn_sxhash,-117 777777 777612 4-114 equ fn_gcd,-118  777777 777611 4-115 equ fn_allfiles,-119  777777 777610 4-116 equ fn_chrct,-120  777777 777607 4-117 equ fn_close,-121  777777 777606 4-118 equ fn_deletef,-122  777777 777605 4-119 equ fn_eoffn,-123  777777 777604 4-120 equ fn_filepos,-124  777777 777603 4-121 equ fn_inpush,-125 777777 777602 4-122 equ fn_linel,-126  777777 777601 4-123 equ fn_mergef,-127 777777 777600 4-124 equ fn_namelist,-128  777777 777577 4-125 equ fn_names,-129  777777 777576 4-126 equ fn_namestring,-130 777777 777575 4-127 equ fn_openi,-131  777777 777574 4-128 equ fn_openo,-132  777777 777573 4-129 equ fn_prin1,-133  777777 777572 4-130 equ fn_princ,-134  777777 777571 4-131 equ fn_print,-135  777777 777570 4-132 equ fn_read,-136  777777 777567 4-133 equ fn_readch,-137 777777 777566 4-134 equ fn_readstring,-138 777777 777565 4-135 equ fn_rename,-139 777777 777564 4-136 equ fn_shortnamestring,-140  777777 777563 4-137 equ fn_tyi,-141  777777 777562 4-138 equ fn_setsyntax,-142  777777 777561 4-139 equ fn_cursorpos,-143  777777 777560 4-140 equ fn_force_output,-144  777777 777557 4-141 equ fn_clear_input,-145  777777 777556 4-142 equ fn_random,-146 777777 777555 4-143 equ fn_haulong,-147  777777 777554 4-144 equ fn_haipart,-148  777777 777553 4-145 equ fn_cline,-149  777777 777552 4-146 equ fn_fillarray,-150  777777 777551 4-147 equ fn_listarray,-151  777777 777550 4-148 equ fn_sort,-152  777777 777547 4-149 equ fn_sortcar,-153  777777 777546 4-150 equ fn_zerop,-154  777777 777545 4-151 equ fn_listify,-155  777777 777544 4-152 equ fn_charpos,-156  777777 777543 4-153 equ fn_pagel,-157  777777 777542 4-154 equ fn_linenum,-158  777777 777541 4-155 equ fn_pagenum,-159  777777 777540 4-156 equ fn_endpagefn,-160  777777 777537 4-157 equ fn_arraydims,-161  777777 777536 4-158 equ fn_loadarrays,-162 777777 777535 4-159 equ fn_dumparrays,-163 777777 777534 4-160 equ fn_expt_fix,-164  777777 777533 4-161 equ fn_expt_flo,-165  777777 777532 4-162 equ fn_nointerrupt,-166  777777 777531 4-163 equ fn_open,-167  777777 777530 4-164 equ fn_in,-168 777777 777527 4-165 equ fn_out,-169  777777 777526 4-166 equ fn_truename,-170  777777 777525 4-167 equ fn_ifix,-171  777777 777524 4-168 equ fn_fsc,-172  777777 777523 4-169 equ fn_progv,-173  777777 777522 4-170 equ fn_mapatoms,-174  777777 777521 4-171 equ fn_unwind_protect,-175 777777 777520 4-172 equ fn_eval_when,-176  777777 777517 4-173 equ fn_read_from_string,-177  777777 777516 4-174 equ fn_displace,-178  777777 777515 4-175 equ fn_nth,-179  777777 777514 4-176 equ fn_nthcdr,-180 777777 777513 4-177 equ fn_includef,-181  4-178  4-179 " END INCLUDE FILE lisp_name_codes.incl.alm 52 "  004000 53 bool nooverflow,004000 "inhibits overflow and sets carry to zero 54 "  55 " these values are used to access the AUTOMATIC VARIABLES  56 "  777777 777774 57 equ old_lp,-4 "old lp - saved by caller  777777 777774 58 equ bn_pl1_ptr,-4 "ptr to array  777777 777776 59 equ return_point,-2 "return point, saved by caller  777777 777776 60 equ bn_pl1_length,-2 "size of array  777777 777777 61 equ bn_pl1_radix,-1 "arg from pl1 caller  000000 62 equ num_of_args,0 "what x5 contained on entry, in upper 18 bits  000001 63 equ saved_indicators,1 "what the indicator register was, saved with an sti  000002 64 equ initial_value,2 "used by expt and gcd to keep umkdpdl at minimum  000004 65 equ resultp,4 "ptr to result 000006 66 equ biggerp,6 "ptr to bigger of the two  000010 67 equ smallerp,8 "ptr to smaller of the two 000010 68 equ divisor,8 "place to hold sfx divisor  000010 69 equ multiplier,8 "place to hold sfx multiplier  000010 70 equ addend,8 "place to hold sfx addend  000012 71 equ big_limit,10 "length of bigger of the two 000013 72 equ small_limit,11 "length of smaller 000014 73 equ temp,12 "temporary double word  000016 74 equ op_table,14 "needed to decide if add or subtract is needed  000017 75 equ carry,15 "holds carry in multiply  000020 76 equ carrya,16 "another carry 000021 77 equ shift_value,17 "number of bits to shift  000022 78 equ shiftp,18 "where to put shifted result  000024 79 equ divisorp,20 "ptr to divisor  000026 80 equ dividendp,22 "ptr to dividend in bfx divide  000030 81 equ answerp,24 "ptr to quotient in bfx divide 000032 82 equ v1p,26 000032 83 equ presultp,26  000034 84 equ v2p,28 000034 85 equ powerp,28  000036 86 equ n,30  000037 87 equ m,31  000040 88 equ j,32  000041 89 equ qhat,33  000042 90 equ rhat,34  000043 91 equ div_bb_ret,35  000044 92 equ div_bb_temp,36 000046 93 equ div_bb_lsh_ret,38  000047 94 equ switched,39  000050 95 equ function_name,40 "function name code for error  000051 96 equ q,41  000052 97 equ up,42  000054 98 equ vp,44  000056 99 equ ptemp1,46  000060 100 equ ptemp2,48  000062 101 equ ptemp3,50  000064 102 equ ptemp4,52  000066 103 equ uh,54  000067 104 equ vh,55  000070 105 equ A,56  000071 106 equ B,57  000072 107 equ C,58  000073 108 equ D,59  000074 109 equ auto_block_size,60 "size, in words, of the automatic block  110 "  111 "  112 "  113 "  000000 114 abs_sfx_a_to_q: "this routine puts the abs of the a into the q.  115 "if still an sfx, then it skips one on return. 116 "if too big, then it doesn't skip, and returns ptr to  117 "bfx version in lp.  118 "  000000 aa 000044 7330 00 119 lrs 36 "get into aq  000001 aa 000001 6050 10 120 tpl 1,x0 "positive is ok - so skip  000002 aa 000000 5330 00 121 negl 0 "do the abs  000003 0a 004172 1170 00 122 cmpaq =v36/0,o36/400000000000 "is it too big?  000004 aa 000001 6010 10 123 tnz 1,x0 "no, so skip  000005 0a 000241 7100 00 124 tra convert_aq_to_bfx "yes, so convert, and conversion routine will tra 0,x0  125 "  126 "  000006 127 add_bb: "this routine adds bigger and smaller, and  128 "puts result in result (already alloced). It takes  129 "care of sign problems.  130 "  000006 aa 2 00036 7401 00 131 stx0 bp|n "save return point 000007 0a 001446 6240 00 132 eax4 add_opcode "remember that we want to add 000010 aa 2 00016 7441 00 133 stx4 bp|op_table  000011 aa 2 00047 4501 00 134 stz bp|switched  000012 aa 2 00006 7221 20 135 lxl2 bp|biggerp,* "set up limits  000013 aa 2 00012 7421 00 136 stx2 bp|big_limit  000014 aa 2 00010 7221 20 137 lxl2 bp|smallerp,* 000015 aa 2 00013 7421 00 138 stx2 bp|small_limit  000016 0a 000203 7000 00 139 tsx0 compare_bfx "bigger better be bigger 000017 0a 001235 7000 00 140 tsx0 switch_bfx  000020 aa 000000 0110 07 141 nop 0,dl  000021 aa 000000 0110 07 142 nop 0,dl  000022 aa 2 00006 2221 20 143 ldx2 bp|biggerp,* "if signs are different, subtract  000023 aa 2 00010 6621 20 144 erx2 bp|smallerp,* 000024 aa 2 00016 0621 00 145 adx2 bp|op_table  000025 aa 000001 3700 32 146 epplp 1,x2* "exop wants info in lp  000026 aa 2 00006 2221 20 147 ldx2 bp|biggerp,* "set result sign  000027 aa 000003 7160 14 148 xec 3,x4  000030 aa 2 00004 7421 20 149 stx2 bp|resultp,*  000031 aa 2 00036 2201 00 150 ldx0 bp|n "restore return point  000032 0a 000646 7100 00 151 tra exop_bfx "do the add 152 "  153 "  000033 154 add_bs: "this routine adds addend to bignum bigger. 155 "  000033 aa 2 00006 7221 20 156 lxl2 bp|biggerp,* "set big_limit  000034 aa 2 00012 7421 00 157 stx2 bp|big_limit  000035 aa 000001 6220 00 158 eax2 1 "get ptr to first word  000036 0a 001466 3700 00 159 epplp add_structure "get ready to go to exop later  000037 aa 2 00006 2361 72 160 ldq bp|biggerp,*x2 "load first word of bignum 000040 aa 2 00010 0361 00 161 adlq bp|addend "add the sfx  000041 aa 000000 2350 03 162 lda 0,du "clear the a  000042 aa 000001 7370 00 163 lls 1 "get the carry there  000043 aa 000001 7720 00 164 qrl 1  000044 aa 2 00004 7561 72 165 stq bp|resultp,*x2 "store the result  000045 0a 000663 7100 00 166 tra exop_bfx_ripple "ripple the carry 167 "  168 "  000046 169 alloc_bfx6: "this routine allocs a bignum of length x6 on  170 "the unmarked stack, and returns a ptr in lp  171 "  000046 aa 1 00000 3701 17 172 epplp ab|0,x7 "get the ptr  000047 aa 000002 6260 16 173 eax6 2,x6 "add 1 for header word, and 1 for 2 rounding  000050 aa 777776 3660 03 174 anx6 -2,du "make even  000051 aa 2 00014 7461 00 175 stx6 bp|temp "add to x7  000052 aa 2 00014 0671 00 176 adx7 bp|temp  000053 aa 4 00000 4501 00 177 stz lp|0 "certain routines assume sign is set "+"  000054 aa 000000 7100 10 178 tra 0,x0 "return 179 "  180 "  000055 181 bad_error: "recoverable, but only by giving value for function  000055 aa 000010 6270 17 182 eax7 8,x7 "get some space  000056 aa 1 77772 2521 17 183 spribp ab|-6,x7 "save bp 000057 aa 2 00050 2361 00 184 ldq bp|function_name "get who we are, along with error (in aq)  000060 aa 1 77776 7571 17 185 staq ab|-2,x7 "give to lisp_error_  000061 0a 000151 7060 00 186 tsx6 call_lisp_error_ "call the error printer 000062 aa 1 77774 3521 37 187 eppbp ab|-4,x7* "get bp back 000063 aa 0 77776 2371 00 188 ldaq ap|-2 "get value to return to caller  000064 aa 0 77776 3501 00 189 eppap ap|-2 "pop it off the mkd stack  000065 aa 777772 6270 17 190 eax7 -6,x7 "get rid of our temp storage  000066 0a 001123 7100 00 191 tra return "return to caller 192 "  193 "  000067 194 badarg: "recoverable error - input wrong type  000067 aa 000010 6270 17 195 eax7 8,x7 "get some space on unmkd pdl  000070 aa 1 77770 7571 17 196 staq ab|-8,x7 "save the aq  000071 aa 1 77772 2521 17 197 spribp ab|-6,x7 "save the bp (ptr to auto vars)  000072 4a 4 00014 2351 20 198 lda |[bad_arg_correctable]  000073 aa 2 00050 2361 00 199 ldq bp|function_name "also the name of the function causing err  000074 aa 1 77776 7571 17 200 staq ab|-2,x7  000075 aa 0 00000 3701 15 201 epplp ap|0,x5 "get ptr to offending arg  000076 aa 1 77774 6501 17 202 sprilp ab|-4,x7 "remember where it was, for reseting 000077 aa 4 00000 2371 00 203 ldaq lp|0 "give it to lisp_error_  000100 aa 0 00002 3501 00 204 eppap ap|2 "bump marked pdl  000101 aa 0 77776 7571 00 205 staq ap|-2 "store it 000102 0a 000151 7060 00 206 tsx6 call_lisp_error_ "call lisp_error_  000103 aa 0 77776 2371 00 207 ldaq ap|-2 "get corrected arg  000104 aa 0 77776 3501 00 208 eppap ap|-2 "pop mrkd pdl  000105 aa 1 77776 7571 37 209 staq ab|-2,x7* "store over old, bad arg  000106 aa 1 77772 2371 17 210 ldaq ab|-6,x7 "restore aq  000107 aa 1 77774 3521 37 211 eppbp ab|-4,x7* "restore bp  000110 aa 777772 6270 17 212 eax7 -6,x7 "free this temp space (lisp_error_ frees 2)  000111 0a 001107 7100 00 213 tra numval "go back and test type again  214 "  215 "  000112 216 call_alloc_bfx: "this routine replaces result with same bignum,  217 "but allocated in lisp space.  218 "  000112 aa 2 00014 7401 00 219 stx0 bp|temp "save return point  000113 aa 2 00014 4431 00 220 sxl3 bp|temp "save x3  221 "  222 " Now, we need to check to see if the bignum is in the heap.  223 " If it is, the pointer to it has to be in the heap during the  224 " call to lisp_alloc_, because otherwise the GC could smash it. 225 "  000114 aa 2 00015 4501 00 226 stz bp|temp+1 "set flag  000115 aa 2 00000 2131 00 227 epaq bp|0 "get segno of unmarked pdl 000116 aa 000000 6230 01 228 eax3 0,au "into x3  000117 aa 2 00004 1031 00 229 cmpx3 bp|resultp "is resultp in unmkd pdl?  000120 0a 000126 6000 00 230 tze do_call_alloc_bfx "yes -- go do it  000121 aa 2 00015 5541 00 231 stc1 bp|temp+1 "we need to copy resultp  000122 aa 2 00004 2371 00 232 ldaq bp|resultp  000123 aa 001000 2750 07 233 ora Big_fixed,dl "make it a bignum for gc 000124 aa 0 00000 7571 00 234 staq ap|0 "put onto marked stack 000125 aa 0 00002 3501 00 235 eppap ap|2 000126 236 do_call_alloc_bfx:  000126 aa 1 00044 3701 20 237 epplp ab|system_lp,* "get ptr to linkage for call 000127 aa 000000 6250 11 238 eax5 0,x1 "alloc routine preserves x5, and we  239 "need x1 saved to get our auto vars back  000130 aa 2 00004 2361 20 240 ldq bp|resultp,* "get number of words needed, on 4 boundary  000131 aa 000004 0760 07 241 adq 4,dl  000132 aa 777774 3760 07 242 anq =o777774,dl  000133 4a 4 00016 7061 20 243 tsx6 |[words_alloc] "make the call to the alloc routine  000134 aa 000000 6210 15 244 eax1 0,x5 "reload x1 000135 aa 2 00000 3701 00 245 epplp bp|0 "save ptr to alloced area in lp  000136 aa 1 00000 3521 11 246 eppbp ab|0,x1 "reload ptr to auto area  000137 aa 2 00015 2341 00 247 szn bp|temp+1 "did we copy pointer?  000140 0a 000144 6000 00 248 tze finish_call_alloc_bfx "no -- done  000141 aa 0 77776 2371 00 249 ldaq ap|-2 "yes -- get it from stack 000142 aa 0 77776 3501 00 250 eppap ap|-2 "reset stack ptr 000143 aa 2 00004 7571 00 251 staq bp|resultp "and put it back where it's expected  000144 252 finish_call_alloc_bfx:  000144 0a 000761 7060 00 253 tsx6 move_bfx "move the result into new place  000145 aa 2 00004 6501 00 254 sprilp bp|resultp "put ptr to result in resultp  000146 aa 2 00014 7231 00 255 lxl3 bp|temp  000147 aa 2 00014 2201 00 256 ldx0 bp|temp "reload return point  000150 aa 000000 7100 10 257 tra 0,x0 "return 258 "  259 "  000151 260 call_lisp_error_: "this routine calls lisp_error_  261 "it is called by a tsx6  262 "  000151 aa 1 00044 3701 20 263 epplp ab|system_lp,* "get ptr to linkage  000152 4a 4 00020 2501 20 264 spriap |[stack_ptr]" save interesting ptrs  000153 4a 4 00022 7471 20 265 stx7 |[unmkd_ptr]+1 000154 aa 1 00016 5541 00 266 stc1 ab|in_pl1_code "say we are in pl1  000155 aa 000060 6270 00 267 push "get place to save all registers  000156 aa 7 00040 2721 20 000157 aa 6 00000 2541 00 268 call |[lisp_error_]  000160 0a 004174 3500 00 000161 4a 4 00010 3521 20 000162 aa 6 00040 7531 00 000163 aa 7 00036 6701 20 000164 aa 6 00000 1731 00 000165 aa 6 00040 0731 00 000166 aa 6 00020 6351 20 269 eaa sp|16,*  000167 aa 7 00024 6521 00 270 sprisp sb|stack_header.stack_end_ptr  000170 aa 7 00000 3721 01 271 eppsp sb|0,au  000171 4a 4 00024 3511 20 272 epbpab |[unmkd_ptr],*  000172 4a 4 00026 3501 20 273 eppap |[stack_ptr],*  000173 4a 4 00022 2271 20 274 ldx7 |[unmkd_ptr]+1 000174 aa 1 00016 4501 00 275 stz ab|in_pl1_code 000175 aa 000000 7100 16 276 tra 0,x6 "return to caller  277 "  278 "  000176 279 check_aq: "this routine skips if aq is an sfx.  280 "  000176 0a 004172 1170 00 281 cmpaq =v36/0,o36/400000000000  000177 aa 000000 6050 10 282 tpl 0,x0 "no 000200 0a 004176 1170 00 283 cmpaq =v36/-1,o36/400000000000 000201 aa 000001 6050 10 284 tpl 1,x0 "yes  000202 aa 000000 7100 10 285 tra 0,x0 "no 286 "  287 "  000203 288 compare_bfx: "this routine compares bigger and smaller.  289 "it skips 0, 1, or 2 for <, =, >.  290 "it ignores the signs, and uses the limits for sizes  291 "  000203 aa 2 00012 2221 00 292 ldx2 bp|big_limit "load size of bigger  000204 aa 2 00013 1021 00 293 cmpx2 bp|small_limit "compare with smaller  000205 aa 000000 6040 10 294 tmi 0,x0 "if smaller bigger, then bs, so skip 2  000210 aa 000001 6220 12 297 eax2 1,x2 "add one to size, then start checking  000211 298 compare_bfx_loop:  000211 aa 777777 6220 12 299 eax2 -1,x2 "look at next lower order word  000212 aa 000001 6000 10 300 tze 1,x0 "done - all equal => a=b so skip 1  000213 aa 2 00006 2361 72 301 ldq bp|biggerp,*x2 "load bigger number  000214 aa 2 00010 1161 72 302 cmpq bp|smallerp,*x2 "compare with smaller one  000215 aa 000000 6040 10 303 tmi 0,x0 "smaller is bigger, so return no skip (bs, so skip 2  306 "  307 "  000220 308 compare_signed_bfx: "this routine compares bigger and smaller  309 "taking into account the signs.  310 "  000220 aa 2 00006 2221 20 311 ldx2 bp|biggerp,* "compare signs  000221 aa 2 00010 1021 20 312 cmpx2 bp|smallerp,*  000222 aa 000000 6040 10 313 tmi 0,x0 "return with <  000223 aa 000002 6000 04 314 tze 2,ic "since we don't have a tpnz on 645  000224 aa 000002 6050 10 315 tpl 2,x0 "return with >  000225 aa 2 00006 7231 20 316 lxl3 bp|biggerp,* "set up lengths 000226 aa 2 00012 7431 00 317 stx3 bp|big_limit  000227 aa 2 00010 7231 20 318 lxl3 bp|smallerp,* 000230 aa 2 00013 7431 00 319 stx3 bp|small_limit  000231 aa 000000 6220 12 320 eax2 0,x2 "check sign  000232 aa 000002 6040 04 321 tmi 2,ic  000233 0a 000203 7100 00 322 tra compare_bfx "for + it's the normal compare and return 000234 aa 000000 6230 10 323 eax3 0,x0 "save return point 000235 0a 000203 7000 00 324 tsx0 compare_bfx "do a compare, and translate results for neg 000236 aa 000002 7100 13 325 tra 2,x3 " > 000237 aa 000001 7100 13 326 tra 1,x3 " = 000240 aa 000000 7100 13 327 tra 0,x3 " < 328 "  329 "  000241 330 convert_aq_to_bfx: "this routine converts the aq to a bfx.  331 "returns ptr to it in lp, and gives a bfx  332 "of three words. Won't work with -4000... 333 "since it has to negate the aq 334 "  000241 aa 1 00000 3701 17 335 epplp ab|0,x7 "get ptr to bfx to be allocated  000242 aa 000004 6270 17 336 eax7 4,x7 "alloc the bfx 000243 0a 004200 1170 00 337 cmpaq =0 "check sign 000244 aa 000004 6050 04 338 tpl 4,ic "skip around negate if plus 000245 aa 000000 5330 00 339 negl 0 "do the negate  000246 aa 777777 6220 00 340 eax2 -1 "load sign of result 000247 aa 000002 7100 04 341 tra 2,ic  000250 aa 000000 6220 00 342 eax2 0 "positive sign  000251 aa 4 00000 7421 00 343 stx2 lp|0 "store the sign  000252 aa 000001 7370 00 344 lls 1 "store each of the words  000253 aa 000001 7720 00 345 qrl 1  000254 aa 4 00001 7561 00 346 stq lp|1  000255 aa 000002 6220 00 347 eax2 2 "load the tentative length  000256 aa 000043 7730 00 348 lrl 35 000257 aa 000000 1150 07 349 cmpa 0,dl  000260 aa 000003 6000 04 350 tze 3,ic "is the a zero? if so - length = 2  000261 aa 4 00003 7551 00 351 sta lp|3 "store the a if something there 000262 aa 000003 6220 00 352 eax2 3 "length is 3  000263 aa 000001 7720 00 353 qrl 1 "shift q to proper place  000264 aa 4 00002 7561 00 354 stq lp|2 "store the q  000265 aa 4 00000 4421 00 355 sxl2 lp|0 "store the length  000266 aa 000000 7100 10 356 tra 0,x0 "return 357 "  358 "  000267 359 convert_bfx_to_sfl: "this routine converts the bfx->by lp to an  360 "sfl in the EAQ. It is called by tsx6,  361 "and only modifies x2. It is an external entry.  362 "It skips on return if conversion is ok, and  363 "does not skip if there was an overflow  364 "  000267 aa 4 00000 7221 00 365 lxl2 lp|0 "get length  000270 aa 000004 1020 03 366 cmpx2 4,du 000271 0a 000303 6000 00 367 tze convert_bfx_to_sfl_check4 "4 is a special case - not all fit  000272 aa 000000 6050 16 368 tpl 0,x6 "return if too big - no skip=>overflow  000273 aa 4 00000 2351 12 369 lda lp|0,x2 "load last (most sig.) word  000274 aa 4 77777 2361 12 370 ldq lp|-1,x2 "and next to last  000275 aa 000001 7360 00 371 qls 1 "make one bit string (remove empty bit)  000276 372 convert_bfx_to_sfl_l:  000276 0a 000312 4110 12 373 lde convert_bfx_to_sfl_tab,x2 "load an exponent  000277 0a 004201 4750 00 374 fad =0.0 "normalize  000300 aa 4 00000 2221 00 375 ldx2 lp|0 "load the sign 000301 0a 000313 7160 12 376 xec convert_bfx_to_sfl_tab+1,x2 "perhaps negate  000302 aa 000001 7100 16 377 tra 1,x6 "return with skip  000303 378 convert_bfx_to_sfl_check4:  000303 aa 4 00000 2351 12 379 lda lp|0,x2 "load high order word  000304 0a 004202 3150 00 380 cana =vo14/37777,o22/0 "check if too big  000305 aa 000000 6010 16 381 tnz 0,x6 "too big - don't skip  000306 aa 4 77777 2361 12 382 ldq lp|-1,x2 "load next word 000307 aa 000001 7360 00 383 qls 1  000310 aa 000016 7370 00 384 lls 14 "make so exponent isn't too big  000311 0a 000276 7100 00 385 tra convert_bfx_to_sfl_l "join other code  000312 386 convert_bfx_to_sfl_tab: 000312 aa 000000 5130 00 387 fneg 0 000313 aa 000000 0110 07 388 nop 0,dl  000314 aa 214000 000000 389 vfd 8/70  000315 aa 322000 000000 390 vfd 8/105  000316 aa 376000 000000 391 vfd 8/127  392 "  393 "  000317 394 convert_bfx_to_sfx: "this routine converts result to an sfx -  395 "if does not check to see if possible  396 "  000317 aa 2 00004 7221 20 397 lxl2 bp|resultp,* "load length  000320 aa 000002 1020 03 398 cmpx2 2,du "if length 2 then must be -400000000000  000321 0a 000332 6000 00 399 tze convert_bfx_to_sfx_2 "separate code for that  000322 aa 000000 2350 03 400 lda 0,du "clear a  000323 aa 000001 2220 03 401 ldx2 1,du "get address of low order word 000324 aa 2 00004 2361 72 402 ldq bp|resultp,*x2 "put it in q  000325 aa 2 00004 2341 20 403 szn bp|resultp,* "do we need to negate it?  000326 aa 000002 6050 04 404 tpl 2,ic "no, skip neg instruction  000327 aa 000000 5330 00 405 negl 0 "negate the aq  000330 aa 040047 2350 07 406 lda fixnum_type,dl "add type bits 000331 aa 000000 7100 10 407 tra 0,x0 "return 000332 408 convert_bfx_to_sfx_2:  000332 0a 004201 2360 00 409 ldq =o400000000000 "load the value  000333 aa 040047 2350 07 410 lda fixnum_type,dl "add type bits 000334 aa 000000 7100 10 411 tra 0,x0 "return 412 "  413 "  000335 414 convert_q_to_bfx: "this routine returns in the lp a ptr  415 "to the q in bfx format - length 2 words  416 "  000335 aa 1 00000 3701 17 417 epplp ab|0,x7 "get ptr to area to be allocated  000336 aa 000004 6270 17 418 eax7 4,x7 "alloc 4 words 000337 aa 000000 1160 07 419 cmpq 0,dl "find out sign of number  000340 aa 000006 6040 04 420 tmi 6,ic "neg - have to negate for abs value 000341 aa 4 00001 7561 00 421 stq lp|1 "positive - just store as is  000342 aa 4 00002 4501 00 422 stz lp|2 "high order word is zero  000343 aa 000002 2360 07 423 ldq 2,dl "put in sign and length 000344 aa 4 00000 7561 00 424 stq lp|0  000345 aa 000000 7100 10 425 tra 0,x0 "return 000346 aa 000044 7370 00 426 lls 36 "bring into a 000347 aa 000044 7330 00 427 lrs 36 "back to q, extending sign bit  000350 aa 000000 5330 00 428 negl 0 "negate it  000351 aa 000001 7370 00 429 lls 1 "bring high order bit into a  000352 aa 000001 7720 00 430 qrl 1 "bring rest back without it  000353 aa 4 00001 7561 00 431 stq lp|1 "store double word result  000354 aa 4 00002 7551 00 432 sta lp|2  000355 0a 004203 2360 00 433 ldq =v18/-1,18/2 "load neg sign and length 2  000356 aa 4 00000 7561 00 434 stq lp|0 "store in bfx  000357 aa 000000 7100 10 435 tra 0,x0 "return 436 "  437 "  000360 438 convert_q_to_sfl: "this routine converts the sfx in the q into an sfl  439 "in the EAQ.  440 "  000360 aa 000044 7370 00 441 lls 36 000361 aa 106000 4110 03 442 lde =35b25,du  000362 aa 400000 4750 03 443 fad =0.0,du  000363 aa 000000 7100 10 444 tra 0,x0 "return 445 "  446 "  000364 447 div_bb: "this routine divides bfx bigger by bfx smaller,  448 "and places the result in answer.  449 "  000364 aa 2 00043 7401 00 450 stx0 bp|div_bb_ret "save return address  000365 aa 2 00010 7221 20 451 lxl2 bp|smallerp,* "get high order word  000366 aa 000000 2360 07 452 ldq 0,dl "clear q  000367 aa 2 00010 2351 72 453 lda bp|smallerp,*x2 "get into EAQ 000370 aa 000000 4110 03 454 lde 0,du  000371 0a 004200 4750 00 455 fad =0 "normalize (find # of leading zeroes) 000372 aa 2 00014 4561 00 456 ste bp|temp  000373 aa 2 00014 2351 00 457 lda bp|temp "make it a number (it is negative)  000374 aa 000034 7310 00 458 ars 28 000375 aa 000000 5310 00 459 neg 0 "make it positive  000376 aa 2 00021 7551 00 460 sta bp|shift_value "save as shift value  000377 aa 2 00010 3701 20 461 epplp bp|smallerp,* "get ptr to value to be copied and shifted  000400 0a 000604 7000 00 462 tsx0 div_bb_lsh "do it  000401 aa 2 00024 6501 00 463 sprilp bp|divisorp "store ptr to result  000402 aa 2 00006 3701 20 464 epplp bp|biggerp,* "do same for other number  000403 0a 000604 7000 00 465 tsx0 div_bb_lsh  000404 aa 2 00026 6501 00 466 sprilp bp|dividendp  000405 aa 2 00010 7221 20 467 lxl2 bp|smallerp,* "get len of divisor  000406 aa 2 00024 3701 72 468 epplp bp|divisorp,*x2 "get ptr to end of divisor  000407 aa 2 00032 6501 00 469 sprilp bp|v1p "save for future reference 000410 aa 4 77777 3701 00 470 epplp lp|-1  000411 aa 2 00034 6501 00 471 sprilp bp|v2p  000412 aa 2 00036 7421 00 472 stx2 bp|n  000413 aa 2 00006 7261 20 473 lxl6 bp|biggerp,* "get len of other  000414 aa 000001 0660 03 474 adx6 1,du "it is one greater than divisor  000415 aa 2 00040 7461 00 475 stx6 bp|j "save  000416 aa 2 00036 1661 00 476 sbx6 bp|n "calc length of result 000417 0a 000571 6040 00 477 tmi div_bb_zero "divisor is bigger than dividend  000420 0a 000571 6000 00 478 tze div_bb_zero  000421 aa 2 00037 7461 00 479 stx6 bp|m  000422 0a 000046 7000 00 480 tsx0 alloc_bfx6 "alloc result 000423 aa 2 00030 6501 00 481 sprilp bp|answerp "save ptr to it 000424 aa 2 00037 2261 00 482 ldx6 bp|m "store length  000425 aa 4 00000 4461 00 483 sxl6 lp|0  000426 aa 2 00010 2261 20 484 ldx6 bp|smallerp,* 000427 aa 2 00006 6661 20 485 erx6 bp|biggerp,*  000430 aa 2 00030 7461 20 486 stx6 bp|answerp,* "store sign 487 "  000431 488 get_qhat:  000431 aa 2 00040 2221 00 489 ldx2 bp|j "set lp->dividend  000432 aa 2 00026 3701 72 490 epplp bp|dividendp,*x2 000433 aa 4 00000 2351 00 491 lda lp|0 "calc quotient digit guess, a la Knuth. 000434 aa 2 00032 1151 20 492 cmpa bp|v1p,*  000435 0a 000451 6040 00 493 tmi div_bb_less  000436 0a 004204 2360 00 494 ldq =o377777777777 000437 aa 4 77777 2351 00 495 lda lp|-1  000440 0a 000444 7100 00 496 tra l3h  000441 497 dec_qhat:  000441 aa 2 00041 2361 00 498 ldq bp|qhat  000442 aa 000001 1760 07 499 sbq 1,dl  000443 aa 2 00042 2351 00 500 lda bp|rhat  000444 aa 2 00041 7561 00 501 l3h: stq bp|qhat  000445 aa 2 00032 0351 20 502 adla bp|v1p,*  000446 0a 000470 6040 00 503 tmi got_qhat  000447 aa 2 00042 7551 00 504 sta bp|rhat  000450 0a 000456 7100 00 505 tra got_rhat  000451 506 div_bb_less:  000451 aa 4 77777 2361 00 507 ldq lp|-1  000452 aa 000001 7360 00 508 qls 1  000453 aa 2 00032 5071 20 509 dvf bp|v1p,*  000454 aa 2 00041 7551 00 510 sta bp|qhat  000455 aa 2 00042 7561 00 511 stq bp|rhat  000456 512 got_rhat:  000456 aa 2 00041 2361 00 513 ldq bp|qhat  000457 aa 2 00034 4021 20 514 mpy bp|v2p,*  000460 aa 000001 7370 00 515 lls 1  000461 aa 2 00042 1151 00 516 cmpa bp|rhat  000462 0a 000470 6040 00 517 tmi got_qhat  000463 0a 000441 6010 00 518 tnz dec_qhat  000464 aa 000001 7720 00 519 qrl 1  000465 aa 4 77776 1161 00 520 cmpq lp|-2 000466 0a 000470 6040 00 521 tmi got_qhat  000467 0a 000441 6010 00 522 tnz dec_qhat  523 "  000470 524 got_qhat:  000470 aa 000000 6230 00 525 eax3 0 000471 aa 2 00017 4501 00 526 stz bp|carry "do multiply and subtract  000472 aa 2 00020 4501 00 527 stz bp|carrya  000473 aa 2 00036 1621 00 528 sbx2 bp|n  000474 aa 2 00026 3701 72 529 epplp bp|dividendp,*x2 000475 530 div_bb_loop:  000475 aa 000001 6230 13 531 eax3 1,x3  000476 aa 2 00024 2361 73 532 ldq bp|divisorp,*x3  000477 aa 2 00041 4021 00 533 mpy bp|qhat  000500 aa 2 00017 0331 00 534 adl bp|carry  000501 aa 000001 7370 00 535 lls 1  000502 aa 000001 7720 00 536 qrl 1  000503 aa 2 00014 7561 00 537 stq bp|temp  000504 aa 2 00017 7551 00 538 sta bp|carry  000505 aa 4 77777 2361 13 539 ldq lp|-1,x3  000506 aa 2 00020 1361 00 540 sblq bp|carrya 000507 aa 2 00014 1361 00 541 sblq bp|temp  000510 aa 000000 2350 07 542 lda 0,dl  000511 aa 000001 7370 00 543 lls 1  000512 aa 000001 7720 00 544 qrl 1  000513 aa 4 77777 7561 13 545 stq lp|-1,x3  000514 aa 2 00020 7551 00 546 sta bp|carrya  000515 aa 2 00036 1031 00 547 cmpx3 bp|n 000516 0a 000475 6010 00 548 tnz div_bb_loop  000517 aa 000001 6230 13 549 eax3 1,x3  000520 aa 4 77777 2361 13 550 ldq lp|-1,x3  000521 aa 2 00020 1361 00 551 sblq bp|carrya 000522 aa 2 00017 1361 00 552 sblq bp|carry  000523 aa 000000 2350 07 553 lda 0,dl  000524 aa 000001 7370 00 554 lls 1  000525 aa 000001 7720 00 555 qrl 1  000526 aa 4 77777 7561 13 556 stq lp|-1,x3  000527 aa 000000 1150 07 557 cmpa 0,dl  000530 0a 000556 6000 00 558 tze store_q  000531 aa 2 00041 2361 00 559 ldq bp|qhat "qhat too big, so dec by one 000532 aa 000001 1760 07 560 sbq 1,dl  000533 aa 2 00041 7561 00 561 stq bp|qhat  000534 aa 000000 6230 00 562 eax3 0 000535 aa 000000 2350 07 563 lda 0,dl "add back in  000536 564 div_bb_loop1:  000536 aa 000001 6230 13 565 eax3 1,x3  000537 aa 4 77777 2361 13 566 ldq lp|-1,x3  000540 0a 001467 0360 05 567 adlq add_structure+1,al  000541 aa 2 00024 0361 73 568 adlq bp|divisorp,*x3  000542 aa 000000 2350 03 569 lda 0,du  000543 aa 000001 7370 00 570 lls 1  000544 aa 000001 7720 00 571 qrl 1  000545 aa 4 77777 7561 13 572 stq lp|-1,x3  000546 aa 2 00036 1031 00 573 cmpx3 bp|n 000547 0a 000536 6010 00 574 tnz div_bb_loop1  000550 aa 000001 6230 13 575 eax3 1,x3  000551 aa 4 77777 2361 13 576 ldq lp|-1,x3  000552 0a 001467 0360 05 577 adlq add_structure+1,al  000553 aa 000001 7370 00 578 lls 1  000554 aa 000001 7720 00 579 qrl 1  000555 aa 4 77777 7561 13 580 stq lp|-1,x3  581 "  000556 582 store_q:  000556 aa 2 00037 2221 00 583 ldx2 bp|m  000557 aa 2 00041 2351 00 584 lda bp|qhat  000560 aa 2 00030 7551 72 585 sta bp|answerp,*x2 000561 aa 2 00040 2231 00 586 ldx3 bp|j  000562 aa 777777 6230 13 587 eax3 -1,x3 000563 aa 2 00040 7431 00 588 stx3 bp|j  000564 aa 777777 6220 12 589 eax2 -1,x2 000565 aa 2 00037 7421 00 590 stx2 bp|m  000566 0a 000431 6010 00 591 tnz get_qhat  000567 aa 2 00043 2201 00 592 ldx0 bp|div_bb_ret 000570 aa 000000 7100 10 593 tra 0,x0  000571 594 div_bb_zero:  000571 aa 000001 6260 00 595 eax6 1 "result is zero  000572 0a 000046 7000 00 596 tsx0 alloc_bfx6  000573 aa 2 00030 6501 00 597 sprilp bp|answerp  000574 aa 000001 6220 00 598 eax2 1 000575 aa 4 00000 4421 00 599 sxl2 lp|0 "store vital statistics  000576 aa 2 00010 2221 20 600 ldx2 bp|smallerp,* 000577 aa 2 00006 6621 20 601 erx2 bp|biggerp,*  000600 aa 4 00000 7421 00 602 stx2 lp|0  000601 aa 4 00001 4501 00 603 stz lp|1  000602 aa 2 00043 2201 00 604 ldx0 bp|div_bb_ret "return  000603 aa 000000 7100 10 605 tra 0,x0  606 "  607 "  000604 608 div_bb_lsh: 000604 aa 2 00046 7401 00 609 stx0 bp|div_bb_lsh_ret 000605 aa 4 00000 7261 00 610 lxl6 lp|0  000606 aa 2 00044 6501 00 611 sprilp bp|div_bb_temp  000607 aa 000003 0660 03 612 adx6 3,du  000610 0a 000046 7000 00 613 tsx0 alloc_bfx6  000611 aa 2 00022 6501 00 614 sprilp bp|shiftp  000612 aa 2 00044 7221 20 615 lxl2 bp|div_bb_temp,*  000613 aa 4 00000 4501 00 616 stz lp|0  000614 aa 4 00002 4501 12 617 stz lp|2,x2  000615 aa 2 00044 3701 20 618 epplp bp|div_bb_temp,* 000616 0a 000744 7000 00 619 tsx0 lsh_bfx  000617 aa 2 00022 3701 20 620 epplp bp|shiftp,*  000620 aa 2 00046 2201 00 621 ldx0 bp|div_bb_lsh_ret 000621 aa 000000 7100 10 622 tra 0,x0  623 "  624 "  000622 625 div_bs: "this routine divides bfx bigger by divisor,  626 "putting the quotient in result, and the  627 "remainder is left in the q.  628 "  000622 aa 2 00006 7221 20 629 lxl2 bp|biggerp,* "load the offset of last (m.sig.) element  000623 aa 2 00004 4421 20 630 sxl2 bp|resultp,* "it is also the length of result  000624 aa 000000 2350 07 631 lda 0,dl "clear the remainder  000625 632 div_bs_loop:  000625 aa 2 00006 2361 72 633 ldq bp|biggerp,*x2 "get next word to divide  000626 aa 000001 7360 00 634 qls 1 "dvf needs this shift  000627 aa 2 00010 5071 00 635 dvf bp|divisor "do the divide of aq  000630 aa 2 00004 7551 72 636 sta bp|resultp,*x2 "store the quotient  000631 aa 777777 6220 12 637 eax2 -1,x2 "go to next word  000632 aa 000000 6000 10 638 tze 0,x0 "done - return  000633 aa 000044 7770 00 639 llr 36 "move remainder to above next word  000634 0a 000625 7100 00 640 tra div_bs_loop "get next word  641 "  642 "  000635 643 div_by_zero:  000635 4a 4 00030 2351 20 644 lda |[division_by_zero] "load error code  000636 0a 000055 7100 00 645 tra bad_error "join error code  646 "  647 "  000637 648 enter: "this routine does the stuff for entry  649 "  000637 aa 000000 6210 17 650 eax1 0,x7 "save where x7 was in x1  000640 aa 000074 6270 17 651 eax7 auto_block_size,x7 "alloc the automatic variables  000641 aa 1 00000 3521 11 652 eppbp ab|0,x1 "get ptr to them in bp 000642 aa 2 00000 7451 00 653 stx5 bp|num_of_args "save x5 (number of args * -2)  000643 aa 2 00001 7541 00 654 sti bp|saved_indicators "save the indicators  000644 aa 2 00050 7561 00 655 stq bp|function_name "remember who we are for errors  000645 aa 000000 7100 10 656 tra 0,x0 "return 657 "  658 "  000646 659 exop_bfx: "this routine does bfx adds and subtracts 660 "lp should point to a structure in the 661 "correct format.  662 "  000646 aa 000000 2220 03 663 ldx2 0,du  000647 aa 000000 2350 03 664 lda 0,du  000650 665 exop_bfx_loop:  000650 aa 000001 6220 12 666 eax2 1,x2 "get next set of words 000651 aa 2 00006 2361 72 667 ldq bp|biggerp,*x2 "get bigger one  000652 aa 4 00001 0361 05 668 adlq lp|1,al "add carry into it (0,+1,-1)  000653 aa 4 00000 7161 00 669 xec lp|0 "do add or subtract 000654 aa 000000 2350 03 670 lda 0,du "clear a  000655 aa 000001 7370 00 671 lls 1 "shift high bit into a 000656 aa 000001 7720 00 672 qrl 1 "leave it there  000657 aa 2 00004 7561 72 673 stq bp|resultp,*x2 "store q as result 000660 aa 2 00013 1021 00 674 cmpx2 bp|small_limit "are we done this loop?  000661 0a 000650 6010 00 675 tnz exop_bfx_loop "no - do next higher word  000662 0a 000672 7100 00 676 tra exop_bfx_check "join ripple code at check point  000663 677 exop_bfx_ripple:  000663 aa 000001 6220 12 678 eax2 1,x2 "get next word 000664 aa 2 00006 2361 72 679 ldq bp|biggerp,*x2 "load into q  000665 aa 4 00001 0361 05 680 adlq lp|1,al "add in carry factor  000666 aa 000000 2350 03 681 lda 0,du "move high bit into a  000667 aa 000001 7370 00 682 lls 1  000670 aa 000001 7720 00 683 qrl 1  000671 aa 2 00004 7561 72 684 stq bp|resultp,*x2 "store result  000672 685 exop_bfx_check: 000672 aa 2 00012 1021 00 686 cmpx2 bp|big_limit "are we done?  000673 0a 000663 6010 00 687 tnz exop_bfx_ripple "no  000674 aa 000001 6220 12 688 eax2 1,x2 "get room for last carry  000675 aa 2 00004 7551 72 689 sta bp|resultp,*x2 "store it  000676 aa 2 00004 4421 20 690 sxl2 bp|resultp,* "store size 000677 aa 000000 7100 10 691 tra 0,x0  692 "  693 "  000700 694 float_error:  000700 aa 2 00014 6501 00 695 sprilp bp|temp "put value in error in mkd pdl  000701 aa 2 00014 2371 00 696 ldaq bp|temp  000702 aa 001000 2750 07 697 ora Big_fixed,dl  000703 aa 0 00002 3501 00 698 eppap ap|2 "make room on mkd pdl 000704 aa 0 77776 7571 00 699 staq ap|-2 "put value there  000705 4a 4 00032 2351 20 700 lda |[unable_to_float] "load error code 000706 0a 000055 7100 00 701 tra bad_error "join error code  702 "  703 "  000707 704 force_q_to_bfx: "this routine converts the q to a bfx.  705 "it assumes that it is invoked after an  706 "overflow and uses the carry indicator 707 "to know more about the result 708 "it returns a ptr to the bfx in lp 709 "  000707 aa 1 00000 3701 17 710 epplp ab|0,x7 "load ptr to area to be alloced  000710 aa 000004 6270 17 711 eax7 4,x7 "alloc the area  000711 0a 000722 6030 00 712 trc force_q_to_bfx_neg "transfer if carry -> negative result  000712 aa 000000 2350 03 713 lda 0,du "move high order bit into a 000713 aa 000001 7370 00 714 lls 1  000714 aa 000001 7720 00 715 qrl 1  000715 aa 4 00001 7561 00 716 stq lp|1 "store result  000716 aa 4 00002 7551 00 717 sta lp|2  000717 aa 000002 2360 07 718 ldq 2,dl "set length and sign (pos)  000720 aa 4 00000 7561 00 719 stq lp|0  000721 aa 000000 7100 10 720 tra 0,x0  000722 721 force_q_to_bfx_neg: 000722 0a 004205 2350 00 722 lda =v36/-1 "its a large negative number 000723 aa 000000 5330 00 723 negl 0 "get abs  000724 aa 000001 7370 00 724 lls 1 "get second word  000725 aa 000001 7720 00 725 qrl 1  000726 aa 4 00001 7561 00 726 stq lp|1 "store result  000727 aa 4 00002 7551 00 727 sta lp|2  000730 0a 004203 2360 00 728 ldq =v18/-1,18/2 "get length and sign (neg)  000731 aa 4 00000 7561 00 729 stq lp|0 "store it  000732 aa 000000 7100 10 730 tra 0,x0  731 "  732 "  000733 733 load_arg_bfx: "this routine moves result and arg into big and small  734 "  000733 aa 2 00004 3701 20 735 epplp bp|resultp,* 000734 aa 2 00006 6501 00 736 sprilp bp|biggerp  000735 aa 4 00000 7221 00 737 lxl2 lp|0  000736 aa 2 00012 7421 00 738 stx2 bp|big_limit  000737 aa 0 00000 3701 35 739 epplp ap|0,x5* 000740 aa 2 00010 6501 00 740 sprilp bp|smallerp 000741 aa 4 00000 7221 00 741 lxl2 lp|0  000742 aa 2 00013 7421 00 742 stx2 bp|small_limit  000743 aa 000000 7100 10 743 tra 0,x0  744 "  745 "  000744 746 lsh_bfx: "this routine shifts left bfx->lp shift_value places  747 "and puts the answer in shiftp->bfx. X2 says how many words.  748 "  000744 aa 2 00021 7231 00 749 lxl3 bp|shift_value  000745 aa 2 00022 3521 20 750 eppbp bp|shiftp,*  000746 aa 2 00001 4501 12 751 stz bp|1,x2  000747 752 lsh_bfx_loop:  000747 aa 000000 2350 07 753 lda 0,dl  000750 aa 4 00000 2361 12 754 ldq lp|0,x2  000751 aa 000001 7370 13 755 lls 1,x3  000752 aa 000001 7720 00 756 qrl 1  000753 aa 2 00001 2551 12 757 orsa bp|1,x2  000754 aa 2 00000 7561 12 758 stq bp|0,x2  000755 aa 777777 6220 12 759 eax2 -1,x2 000756 0a 000747 6010 00 760 tnz lsh_bfx_loop  000757 aa 1 00000 3521 11 761 eppbp ab|0,x1  000760 aa 000000 7100 10 762 tra 0,x0  763 "  764 "  000761 765 move_bfx: "moves resulp->bfx to lp->bfx 766 "called with tsx6, and clobbers x4, a, q  767 "  000761 aa 2 00004 3535 20 768 eppbb bp|resultp,* "get pointer to bfx to be moved in bb  000762 aa 3 00000 2361 00 769 ldq bb|0 "get length 000763 aa 000002 7360 00 770 qls 2 "convert to number of characters  000764 aa 000004 6240 06 771 eax4 4,ql "add allow for header. (assume not ridiculously huge)  000765 aa 0 00140 1005 40 772 mlr (pr,rl),(pr,rl) "move the stuff  000766 aa 300000 000014 773 desc9a bb|0,x4 000767 aa 400000 000014 774 desc9a lp|0,x4 000770 aa 000000 7100 16 775 tra 0,x6 "return 776 "  777 "  000771 778 mpy_bfx: "this routine multiplies bigger by smaller 779 "  000771 aa 000001 6220 00 780 eax2 1 "load ptrs, 2 -> bigger (multiplicandd)  000772 aa 000001 6230 00 781 eax3 1 " 3 -> smaller(multiplier)  000773 aa 000001 6240 00 782 eax4 1 " 4 -> result (product) 000774 aa 2 00017 4501 00 783 stz bp|carry "zero the carry 000775 784 mpy_bfx_loop1:  000775 aa 2 00006 2361 72 785 ldq bp|biggerp,*x2 "load next word of multiplicand  000776 aa 2 00010 4021 73 786 mpy bp|smallerp,*x3 "do the multiply  000777 aa 2 00017 0331 00 787 adl bp|carry "add the single word carry to the aq  001000 aa 000001 7370 00 788 lls 1 "store the lower word  001001 aa 000001 7720 00 789 qrl 1  001002 aa 2 00004 7561 74 790 stq bp|resultp,*x4 001003 aa 000001 6240 14 791 eax4 1,x4 "go to next word of result 001004 aa 2 00017 7551 00 792 sta bp|carry "store the new carry  001005 aa 2 00012 1021 00 793 cmpx2 bp|big_limit "are we done the first pass?  001006 0a 001026 6000 00 794 tze mpy_bfx_join "yes 001007 aa 000001 6220 12 795 eax2 1,x2 "no - get next word of bigger  001010 0a 000775 7100 00 796 tra mpy_bfx_loop1 "continue multiplying  001011 797 mpy_bfx_loop2:  001011 aa 2 00006 2361 72 798 ldq bp|biggerp,*x2 "load next word of bigger  001012 aa 2 00010 4021 73 799 mpy bp|smallerp,*x3 "do mult  001013 aa 2 00017 0331 00 800 adl bp|carry "add carry  001014 aa 2 00004 0331 74 801 adl bp|resultp,*x4 "add to result 001015 aa 000001 7370 00 802 lls 1  001016 aa 000001 7720 00 803 qrl 1  001017 aa 2 00004 7561 74 804 stq bp|resultp,*x4 "store low word  001020 aa 000001 6240 14 805 eax4 1,x4 "now add high word to result  001021 aa 2 00017 7551 00 806 sta bp|carry "store the new carry  001022 aa 2 00012 1021 00 807 cmpx2 bp|big_limit "are we done with multiplicand?  001023 aa 000003 6000 04 808 tze 3,ic "yes - check multiplier 001024 aa 000001 6220 12 809 eax2 1,x2 "bump x2  001025 0a 001011 7100 00 810 tra mpy_bfx_loop2 "continue  001026 811 mpy_bfx_join:  001026 aa 2 00017 2351 00 812 lda bp|carry "store the carry in next word  001027 aa 2 00004 7551 74 813 sta bp|resultp,*x4 001030 aa 000001 6240 14 814 eax4 1,x4 "bump x4 incase next x3 ->val is zero  001031 aa 2 00017 4501 00 815 stz bp|carry "clear the carry  001032 aa 000001 6220 00 816 eax2 1 "reset multiplicand ptr  001033 aa 2 00013 1031 00 817 cmpx3 bp|small_limit "are we done with multiplier?  001034 0a 001042 6000 00 818 tze mpy_bfx_done "yes 001035 aa 000001 6230 13 819 eax3 1,x3 "bump x3  001036 aa 2 00010 2341 73 820 szn bp|smallerp,*x3 "is multiplier zero?  001037 0a 001026 6000 00 821 tze mpy_bfx_join "yes - skip the multiply 001040 aa 000000 6240 13 822 eax4 0,x3 "product ptr starts where multiplier's is  001041 0a 001011 7100 00 823 tra mpy_bfx_loop2 "continue  001042 824 mpy_bfx_done:  001042 aa 777777 6240 14 825 eax4 -1,x4 "x4 is one too far  001043 aa 2 00004 4441 20 826 sxl4 bp|resultp,* "done - store length  001044 aa 000000 7100 10 827 tra 0,x0 "return 828 "  829 "  001045 830 mpy_bs: "this routine multiplies bigger by sfx multiplier  831 "  001045 aa 2 00006 3701 20 832 epplp bp|biggerp,* "get ptr to bfx  001046 aa 4 00000 7221 00 833 lxl2 lp|0 "get length of bfx 001047 aa 2 00012 7421 00 834 stx2 bp|big_limit "store as loop terminater.  001050 aa 000000 6220 00 835 eax2 0 "initialize counter  001051 aa 2 00017 4501 00 836 stz bp|carry "clear carry  001052 837 mpy_bs_loop:  001052 aa 000001 6220 12 838 eax2 1,x2 "get next word 001053 aa 4 00000 2361 12 839 ldq lp|0,x2 "load next word  001054 aa 2 00010 4021 00 840 mpy bp|multiplier "do the multiply  001055 aa 2 00017 0331 00 841 adl bp|carry "add the carry  001056 aa 000001 7370 00 842 lls 1 "get new carry 001057 aa 000001 7720 00 843 qrl 1  001060 aa 2 00004 7561 72 844 stq bp|resultp,*x2 "store the result  001061 aa 2 00017 7551 00 845 sta bp|carry "store the carry  001062 aa 2 00012 1021 00 846 cmpx2 bp|big_limit "are we done?  001063 0a 001052 6040 00 847 tmi mpy_bs_loop "no  001064 aa 000001 6220 12 848 eax2 1,x2 "get next result word  001065 aa 2 00004 7551 72 849 sta bp|resultp,*x2 "store the last carry  001066 aa 2 00004 4421 20 850 sxl2 bp|resultp,* "store the length  001067 aa 000000 7100 10 851 tra 0,x0 "return 852 "  853 "  001070 854 norm_a: " normalizes A reg., returns number of significant  855 " bits in Q.  001070 aa 000000 2360 07 856 ldq 0,dl  001071 aa 106000 4110 03 857 lde =o106000,du " 35.<-28.  001072 aa 000000 1150 07 858 cmpa 0,dl " get sign of arg  001073 aa 000000 6000 10 859 tze 0,x0 " return if zero.  001074 0a 001102 6050 00 860 tpl norm_ge0 " if A < 0  001075 aa 400000 1150 03 861 cmpa =o400000,du " check for bad case.  001076 aa 000003 6010 04 862 tnz 3,ic " and return 36 001077 aa 000044 2360 07 863 ldq 36,dl " in this case 001100 aa 000000 7100 10 864 tra 0,x0  001101 aa 000001 1750 07 865 sba 1,dl  001102 866 norm_ge0:  001102 aa 400000 4750 03 867 fad =0.0,du " normalize. 001103 aa 2 00014 4561 00 868 ste bp|temp " get the exponent register  001104 aa 2 00014 2361 00 869 ldq bp|temp " into the Q 001105 aa 000034 7320 00 870 qrs 36-8 " shift it to correct place,  001106 aa 000000 7100 10 871 tra 0,x0  872 "  873 "  001107 874 numval: "checks type of arg -> by x5, skipping: 875 " 0 if sfx 876 " 1 if sfl 877 " 2 if bfx 878 " 3 if bfl 879 " error otherwise  880 "  881 "uses x2.  882 "  001107 aa 0 00000 7221 15 883 lxl2 ap|0,x5 "load the type bits into x2 001110 aa 040000 3020 03 884 canx2 Fixed,du "check with all numeric types and skip  001111 aa 000000 6010 10 885 tnz 0,x0  001112 aa 020000 3020 03 886 canx2 Float,du 001113 aa 000001 6010 10 887 tnz 1,x0  001114 aa 001000 3020 03 888 canx2 Big_fixed,du 001115 aa 000002 6010 10 889 tnz 2,x0  001116 0a 000067 7100 00 890 tra badarg "ERROR  891 "  892 "  001117 893 ret_to_pl1: "this routine returns to a pl1 program - 894 "it needs to have the lp set.  895 "  001117 4a 4 00020 2501 20 896 spriap |[stack_ptr] "let pl1 prog know about stack changes  001120 4a 4 00022 7471 20 897 stx7 |[unmkd_ptr]+1 001121 aa 1 00016 5541 00 898 stc1 ab|in_pl1_code "indicate that we aren't in non-pl1  001122 aa 7 00044 7101 20 899 short_return  900 "  901 "  001123 902 return: "this routine is the opposite of enter  903 "returned values should be in aq  904 "  001123 aa 2 00001 6341 00 905 ldi bp|saved_indicators "restore the indicators  001124 aa 2 00000 2251 00 906 ldx5 bp|num_of_args "restore x5 for the next instruction  001125 aa 0 00000 3501 15 907 eppap ap|0,x5 "pop the marked stack  001126 aa 2 77774 3701 20 908 epplp bp|old_lp,* "restore the caller's lp  001127 aa 2 77776 3521 20 909 eppbp bp|return_point,* "get ptr to return point  001130 aa 777774 6270 11 910 eax7 -4,x1 "pop the unmarked stack  001131 aa 2 00000 7101 00 911 tra bp|0 "return 912 "  913 "  001132 914 return_0: "returns with a zero value  915 "  001132 aa 040047 2350 07 916 lda fixnum_type,dl "put type bits in the a  001133 aa 000000 2360 07 917 ldq 0,dl "load a value of zero  001134 0a 001123 7100 00 918 tra return "return  919 "  920 "  001135 921 return_0.0: "returns a floating zero 001135 aa 020047 2350 07 922 lda flonum_type,dl 001136 0a 004201 2360 00 923 ldq =0.0  001137 0a 001123 7100 00 924 tra return 925 "  926 "  001140 927 return_1:  001140 aa 040047 2350 07 928 lda fixnum_type,dl 001141 aa 000001 2360 07 929 ldq 1,dl  001142 0a 001123 7100 00 930 tra return 931 "  932 "  001143 933 return_1.0: "returns a floating one  001143 aa 020047 2350 07 934 lda flonum_type,dl 001144 0a 004206 2360 00 935 ldq =1.0  001145 0a 001123 7100 00 936 tra return 937 "  938 "  001146 939 return_bfx: "gets a place for result, then returns  940 "  001146 0a 000112 7000 00 941 tsx0 call_alloc_bfx "allocate the bfx 001147 aa 2 00004 2371 00 942 ldaq bp|resultp "get ptr to it  001150 aa 001000 2750 07 943 ora Big_fixed,dl "make bignum ptr 001151 0a 001123 7100 00 944 tra return "do a return  945 "  946 "  001152 947 return_minus1: "returns a minus one  001152 aa 040047 2350 07 948 lda fixnum_type,dl "load type bits  001153 aa 000001 3360 07 949 lcq 1,dl "load the value 001154 0a 001123 7100 00 950 tra return "return  951 "  952 "  001155 953 return_nil: "returns the value nil  001155 aa 1 00012 2371 00 954 ldaq ab|nil  001156 0a 001123 7100 00 955 tra return 956 "  957 "  001157 958 return_sfl: "returns q as an sfl 001157 aa 2 00014 4551 00 959 fst bp|temp "store EAQ in sfl  001160 aa 2 00014 2361 00 960 ldq bp|temp "load as one number (one word)  001161 aa 020047 2350 07 961 lda flonum_type,dl "load type bits  001162 0a 001123 7100 00 962 tra return 963 "  964 "  001163 965 return_sfx: "returns q as an sfx 001163 aa 040047 2350 07 966 lda fixnum_type,dl "load type bits  001164 0a 001123 7100 00 967 tra return 968 "  969 "  001165 970 return_true: "returns the value t  001165 aa 1 00014 2371 00 971 ldaq ab|true  001166 0a 001123 7100 00 972 tra return 973 "  974 "  001167 975 rsh_bfx: "shifts lp->bfx right shift_value  976 "places, in place. 977 "  001167 aa 2 00021 7231 00 978 lxl3 bp|shift_value "get value to shift  001170 aa 4 00000 7221 00 979 lxl2 lp|0 "get length  001171 aa 2 00012 7421 00 980 stx2 bp|big_limit "save it  001172 aa 000001 1020 03 981 cmpx2 1,du "rsh_bfx (1)? 001173 0a 001212 6000 00 982 tze rsh_bfx_1  001174 aa 000001 6220 00 983 eax2 1 "initialize x2, word counter  001175 aa 4 00000 2361 12 984 ldq lp|0,x2 "get first word  001176 aa 000001 7360 00 985 qls 1 "move up to block sign 001177 986 rsh_bfx_loop:  001177 aa 4 00001 2351 12 987 lda lp|1,x2 "get next word  001200 aa 000000 7730 13 988 lrl 0,x3 "do the shift  001201 aa 000001 7720 00 989 qrl 1 "make a sign bit  001202 aa 4 00000 7561 12 990 stq lp|0,x2 "store the result  001203 aa 000045 7770 13 991 llr 37,x3 "move what's left to the q in position 001204 aa 000001 6220 12 992 eax2 1,x2 "get next word 001205 aa 2 00012 1021 00 993 cmpx2 bp|big_limit "are we done?  001206 0a 001177 6040 00 994 tmi rsh_bfx_loop "no  001207 aa 000001 7720 13 995 qrl 1,x3 "store last word  001210 aa 4 00000 7561 12 996 stq lp|0,x2  001211 aa 000000 7100 10 997 tra 0,x0 "return 998  001212 aa 4 00001 2361 00 999 rsh_bfx_1:ldq lp|1  001213 aa 000000 7720 13 1000 qrl 0,x3  001214 aa 4 00001 7561 00 1001 stq lp|1  001215 aa 000000 7100 10 1002 tra 0,x0  1003 "  1004 "  001216 1005 setup_mpy_bfx: "this routine takes bigger and smaller and sets  1006 "the proper variables for a mpy_bfx -  1007 "including allocing the result and setting 1008 "sign. 1009 "  001216 aa 2 00006 7221 20 1010 lxl2 bp|biggerp,* "set limits 001217 aa 2 00012 7421 00 1011 stx2 bp|big_limit  001220 aa 2 00010 7221 20 1012 lxl2 bp|smallerp,* 001221 aa 2 00013 7421 00 1013 stx2 bp|small_limit  001222 aa 1 00000 3701 17 1014 epplp ab|0,x7 "alloc correct size result 001223 aa 2 00004 6501 00 1015 sprilp bp|resultp  001224 aa 000002 6220 17 1016 eax2 2,x7  001225 aa 2 00012 0621 00 1017 adx2 bp|big_limit  001226 aa 2 00013 0621 00 1018 adx2 bp|small_limit  001227 aa 777776 3620 03 1019 anx2 -2,du 001230 aa 000000 6270 12 1020 eax7 0,x2  001231 aa 2 00006 2221 20 1021 ldx2 bp|biggerp,*  001232 aa 2 00010 6621 20 1022 erx2 bp|smallerp,* 001233 aa 2 00004 7421 20 1023 stx2 bp|resultp,*  001234 aa 000000 7100 10 1024 tra 0,x0  1025 "  1026 "  001235 1027 switch_bfx: "switches bigger and smaller 1028 "  001235 aa 2 00006 2371 00 1029 ldaq bp|biggerp "switch the ptrs  001236 aa 2 00014 7571 00 1030 staq bp|temp  001237 aa 2 00010 2371 00 1031 ldaq bp|smallerp  001240 aa 2 00006 7571 00 1032 staq bp|biggerp  001241 aa 2 00014 2371 00 1033 ldaq bp|temp  001242 aa 2 00010 7571 00 1034 staq bp|smallerp  001243 aa 2 00012 2371 00 1035 ldaq bp|big_limit "load big and small limits as a unit  1036 "this requires them to be 2 word aligned  001244 aa 000044 7770 00 1037 llr 36 "switch their positions  001245 aa 2 00012 7571 00 1038 staq bp|big_limit "store the switched values  001246 aa 777777 2350 03 1039 lda -1,du "indicate that a swich was performed  001247 aa 2 00047 6551 00 1040 ersa bp|switched  001250 aa 000000 7100 10 1041 tra 0,x0 "return 1042 "  1043 "  001251 1044 switch_to_lisp: "loads registers to make a lisp environment  1045 "  001251 4a 4 00024 3511 20 1046 epbpab |[unmkd_ptr],*  001252 4a 4 00026 3501 20 1047 eppap |[stack_ptr],*  001253 4a 4 00022 2271 20 1048 ldx7 |[unmkd_ptr]+1 001254 aa 1 00016 4501 00 1049 stz ab|in_pl1_code 001255 aa 000000 7100 10 1050 tra 0,x0  1051 "  1052 "  001256 1053 truncate_bfx: "this routine sets the length of result  1054 "to the smallest value possible, stripping 1055 "off leading zeroes. It will skip on return  1056 "if the result could be an sfx.  1057 "  001256 aa 2 00004 7221 20 1058 lxl2 bp|resultp,* "get length 001257 aa 000001 6220 12 1059 eax2 1,x2 "start out one ahead  001260 1060 truncate_bfx_loop:  001260 aa 777777 6220 12 1061 eax2 -1,x2 "go back one word 001261 0a 001301 6000 00 1062 tze truncate_bfx_small "all zero -> small 001262 aa 2 00004 2341 72 1063 szn bp|resultp,*x2 "see if word is zero  001263 0a 001260 6000 00 1064 tze truncate_bfx_loop "yes, look at word before it  001264 aa 2 00004 4421 20 1065 sxl2 bp|resultp,* "store new length  001265 aa 000001 1020 03 1066 cmpx2 1,du "are we now an sfx?  001266 aa 000001 6000 10 1067 tze 1,x0 "yes  001267 aa 000002 1020 03 1068 cmpx2 2,du "now check for -400000000000  001270 aa 000000 6010 10 1069 tnz 0,x0  001271 aa 2 00004 2341 20 1070 szn bp|resultp,*  001272 aa 000000 6050 10 1071 tpl 0,x0  001273 aa 2 00004 2351 72 1072 lda bp|resultp,*x2 001274 aa 777777 6220 12 1073 eax2 -1,x2 001275 aa 2 00004 2361 72 1074 ldq bp|resultp,*x2 001276 0a 004210 1170 00 1075 cmpaq =v36/1,36/0  001277 aa 000001 6000 10 1076 tze 1,x0 "skip on return if could be sfx 001300 aa 000000 7100 10 1077 tra 0,x0  001301 1078 truncate_bfx_small: 001301 aa 000001 2220 03 1079 ldx2 1,du "get length of one 001302 aa 2 00004 4421 20 1080 sxl2 bp|resultp,* "store it  001303 aa 000001 7100 10 1081 tra 1,x0 "skip on return 1082 "  1083 "  001304 1084 plus: "This is the plus lsubr  001304 aa 000065 3360 07 1085 lcq -fn_plus,dl "remember who we are (incase of error)  001305 0a 001446 6240 00 1086 eax4 add_opcode "since this op is table driven, load the table  001306 1087 plus_start: 001306 0a 000637 7000 00 1088 tsx0 enter "set up the automatic variables  001307 aa 2 00016 7441 00 1089 stx4 bp|op_table "save what type of op we are 001310 aa 000000 6250 15 1090 eax5 0,x5 "are there any arguments?  001311 0a 001132 6000 00 1091 tze return_0 "no - return a zero 001312 0a 001107 7000 00 1092 tsx0 numval "branch on type of first arg 001313 0a 001316 7100 00 1093 tra plus_sfx  001314 0a 001341 7100 00 1094 tra plus_sfl  001315 0a 001365 7100 00 1095 tra plus_bfx  1096 "  001316 1097 plus_sfx:  001316 aa 004000 6340 07 1098 ldi nooverflow,dl "inhibit overflow  001317 aa 0 00000 2371 15 1099 ldaq ap|0,x5 "load first arg and its type bits  001320 1100 plus_sfx_loop:  001320 aa 000002 6250 15 1101 eax5 2,x5 "get next arg  001321 0a 001123 6000 00 1102 tze return "no more - return what we have in the aq  001322 0a 001107 7000 00 1103 tsx0 numval "branch on type  001323 0a 001326 7100 00 1104 tra plus_sfx_add  001324 0a 001337 7100 00 1105 tra plus_sfx_sfl  001325 0a 001334 7100 00 1106 tra plus_sfx_make_big  1107 "  001326 1108 plus_sfx_add:  001326 aa 000002 7160 14 1109 xec 2,x4 "do the operation - add or subtract 001327 aa 000002 6170 04 1110 tov 2,ic "if overflow, then switch to bignum 001330 0a 001320 7100 00 1111 tra plus_sfx_loop "get next arg and add it  001331 0a 000707 7000 00 1112 tsx0 force_q_to_bfx "get ptr to q in bfx form 001332 aa 2 00004 6501 00 1113 sprilp bp|resultp "store it in resultp  001333 0a 001367 7100 00 1114 tra plus_bfx_loop "join bfx code  001334 1115 plus_sfx_make_big:  001334 0a 000335 7000 00 1116 tsx0 convert_q_to_bfx "change to bfx  001335 aa 2 00004 6501 00 1117 sprilp bp|resultp  001336 0a 001375 7100 00 1118 tra plus_bfx_add "join bfx code  1119 "  001337 1120 plus_sfx_sfl:  001337 0a 000360 7000 00 1121 tsx0 convert_q_to_sfl "convert the sfx to sfl 001340 0a 001350 7100 00 1122 tra plus_sfl_add "and join the sfl code  1123 "  001341 1124 plus_sfl:  001341 aa 0 00001 4311 15 1125 fld ap|1,x5 "load first arg  001342 1126 plus_sfl_loop:  001342 aa 000002 6250 15 1127 eax5 2,x5 "get next arg  001343 0a 001157 6000 00 1128 tze return_sfl "no more - return  001344 0a 001107 7000 00 1129 tsx0 numval "branch on arg type  001345 0a 001352 7100 00 1130 tra plus_sfl_sfx  001346 0a 001350 7100 00 1131 tra plus_sfl_add  001347 0a 001357 7100 00 1132 tra plus_sfl_bfx  001350 1133 plus_sfl_add:  001350 aa 000006 7160 14 1134 xec 6,x4 "do add or subtract 001351 0a 001342 7100 00 1135 tra plus_sfl_loop "get next arg  001352 1136 plus_sfl_sfx:  001352 aa 2 00014 4551 00 1137 fst bp|temp "save what we have  001353 aa 0 00001 2361 15 1138 ldq ap|1,x5 "convert arg to sfl  001354 0a 000360 7000 00 1139 tsx0 convert_q_to_sfl  001355 aa 000004 7170 14 1140 xed 4,x4 "do operation, with optional negate 001356 0a 001342 7100 00 1141 tra plus_sfl_loop  001357 1142 plus_sfl_bfx:  001357 aa 2 00014 4551 00 1143 fst bp|temp "save q  001360 aa 0 00000 3701 35 1144 epplp ap|0,x5* "get ptr to bfx  001361 0a 000267 7060 00 1145 tsx6 convert_bfx_to_sfl "do convert  001362 0a 000700 7100 00 1146 tra float_error "no skip means a conversion error 001363 aa 000004 7170 14 1147 xed 4,x4 "do operation  001364 0a 001342 7100 00 1148 tra plus_sfl_loop "get next arg  1149 "  001365 1150 plus_bfx:  001365 aa 0 00000 2371 15 1151 ldaq ap|0,x5 "move ptr to 1st arg to resultp 001366 aa 2 00004 7571 00 1152 staq bp|resultp  001367 1153 plus_bfx_loop:  001367 aa 000002 6250 15 1154 eax5 2,x5 "get next arg  001370 0a 001146 6000 00 1155 tze return_bfx "no more - alloc result and return 001371 0a 001107 7000 00 1156 tsx0 numval "branch on arg type  001372 0a 001424 7100 00 1157 tra plus_bfx_make_big  001373 0a 001437 7100 00 1158 tra plus_bfx_sfl  001374 0a 001375 7100 00 1159 tra plus_bfx_add  001375 1160 plus_bfx_add:  001375 aa 2 00047 4501 00 1161 stz bp|switched "reset check for switching (subtract needs)  001376 0a 000733 7000 00 1162 tsx0 load_arg_bfx "move result and arg into big and small 001377 0a 000203 7000 00 1163 tsx0 compare_bfx "compare them  001400 0a 001235 7000 00 1164 tsx0 switch_bfx "switch if b overflow  001442 0a 001350 7100 00 1202 tra plus_sfl_add "join sfl code  1203 "  1204 "  001443 1205 difference: 001443 aa 000067 3360 07 1206 lcq -fn_difference,dl "remember who we are  001444 0a 001456 6240 00 1207 eax4 sub_opcode "indicate that we are subtract  001445 0a 001306 7100 00 1208 tra plus_start "and then join the plus code  1209 "  1210 "  1211 even  001446 1212 add_opcode: 001446 0a 001471 0000 00 1213 arg sub_structure  001447 0a 001466 0000 00 1214 arg add_structure  001450 aa 0 00001 0761 15 1215 adq ap|1,x5  001451 aa 000000 0110 03 1216 nop 0,du  001452 aa 2 00014 4751 00 1217 fad bp|temp  001453 aa 000000 0110 07 1218 nop 0,dl  001454 aa 0 00001 4751 15 1219 fad ap|1,x5  001455 aa 000001 0760 07 1220 adq 1,dl  1221 "  1222 even  001456 1223 sub_opcode: 001456 0a 001466 0000 00 1224 arg add_structure  001457 0a 001471 0000 00 1225 arg sub_structure  001460 aa 0 00001 1761 15 1226 sbq ap|1,x5  001461 aa 2 00047 6621 00 1227 erx2 bp|switched  001462 aa 2 00014 5751 00 1228 fsb bp|temp  001463 aa 000000 5130 00 1229 fneg 0 001464 aa 0 00001 5751 15 1230 fsb ap|1,x5  001465 aa 000001 1760 07 1231 sbq 1,dl  001466 1232 add_structure:  001466 aa 2 00010 0361 72 1233 adlq bp|smallerp,*x2  001467 aa 000000 000000 1234 dec 0  001470 aa 000000 000001 1235 dec 1  001471 1236 sub_structure:  001471 aa 2 00010 1361 72 1237 sblq bp|smallerp,*x2  001472 aa 000000 000000 1238 dec 0  001473 aa 777777 777777 1239 dec -1 1240 "  1241 "  001474 1242 times:  001474 aa 000066 3360 07 1243 lcq -fn_times,dl "remember who we are 001475 0a 000637 7000 00 1244 tsx0 enter "set up the auto vars 001476 aa 000000 6250 15 1245 eax5 0,x5 "are there any args?  001477 0a 001140 6000 00 1246 tze return_1 "no - return a one  001500 0a 001107 7000 00 1247 tsx0 numval "branch on arg type  001501 0a 001504 7100 00 1248 tra times_sfx  001502 0a 001530 7100 00 1249 tra times_sfl  001503 0a 001554 7100 00 1250 tra times_bfx  001504 1251 times_sfx:  001504 aa 0 00001 2361 15 1252 ldq ap|1,x5 "load the first arg  001505 1253 times_sfx_loop: 001505 aa 000002 6250 15 1254 eax5 2,x5 "get next arg  001506 0a 001163 6000 00 1255 tze return_sfx "no more - done  001507 0a 001107 7000 00 1256 tsx0 numval "branch on type of next arg  001510 0a 001513 7100 00 1257 tra times_sfx_mpy  001511 0a 001523 7100 00 1258 tra times_sfx_sfl  001512 0a 001525 7100 00 1259 tra times_sfx_bfx  001513 1260 times_sfx_mpy:  001513 aa 0 00001 4021 15 1261 mpy ap|1,x5 "do the multiply 001514 0a 004172 1170 00 1262 cmpaq =v36/0,o36/400000000000 "check that the product is still sfx 001515 aa 000003 6050 04 1263 tpl 3,ic "no 001516 0a 004176 1170 00 1264 cmpaq =v36/-1,o36/400000000000 001517 0a 001505 6050 00 1265 tpl times_sfx_loop "ok - still sfx so continue  001520 1266 times_sfx_gets_big: 001520 0a 000241 7000 00 1267 tsx0 convert_aq_to_bfx "convert result to bfx 001521 aa 2 00004 6501 00 1268 sprilp bp|resultp "store ptr to it  001522 0a 001556 7100 00 1269 tra times_bfx_loop "join bfx code 001523 1270 times_sfx_sfl:  001523 0a 000360 7000 00 1271 tsx0 convert_q_to_sfl "convert to sfl and join them  001524 0a 001537 7100 00 1272 tra times_sfl_mpy  001525 1273 times_sfx_bfx:  001525 aa 0 00000 3701 35 1274 epplp ap|0,x5* "set up for big times small  001526 aa 2 00006 6501 00 1275 sprilp bp|biggerp "move in ptr to bfx 001527 0a 001607 7100 00 1276 tra times_bs_join "small num is in q, so just join  1277 "  001530 1278 times_sfl:  001530 aa 0 00001 4311 15 1279 fld ap|1,x5 "load first arg  001531 1280 times_sfl_loop: 001531 aa 000002 6250 15 1281 eax5 2,x5 "get next arg  001532 0a 001157 6000 00 1282 tze return_sfl 001533 0a 001107 7000 00 1283 tsx0 numval "branch on arg type  001534 0a 001541 7100 00 1284 tra times_sfl_sfx  001535 0a 001537 7100 00 1285 tra times_sfl_mpy  001536 0a 001546 7100 00 1286 tra times_sfl_bfx  001537 1287 times_sfl_mpy:  001537 aa 0 00001 4611 15 1288 fmp ap|1,x5 "do the mpy  001540 0a 001531 7100 00 1289 tra times_sfl_loop "get next arg  001541 1290 times_sfl_sfx:  001541 aa 2 00014 4551 00 1291 fst bp|temp "save EAQ  001542 aa 0 00001 2361 15 1292 ldq ap|1,x5 "get sfx to be made into sfl 001543 0a 000360 7000 00 1293 tsx0 convert_q_to_sfl  001544 aa 2 00014 4611 00 1294 fmp bp|temp "do the mpy  001545 0a 001531 7100 00 1295 tra times_sfl_loop "do again  001546 1296 times_sfl_bfx:  001546 aa 2 00014 4551 00 1297 fst bp|temp "save  001547 aa 0 00000 3701 35 1298 epplp ap|0,x5* "convert bfx arg to sfl  001550 0a 000267 7060 00 1299 tsx6 convert_bfx_to_sfl  001551 0a 000700 7100 00 1300 tra float_error "no skip - overflow  001552 aa 2 00014 4611 00 1301 fmp bp|temp "do the mpy  001553 0a 001531 7100 00 1302 tra times_sfl_loop "and get next arg  1303 "  001554 1304 times_bfx:  001554 aa 0 00000 2371 15 1305 ldaq ap|0,x5 "make first arg old result  001555 aa 2 00004 7571 00 1306 staq bp|resultp  001556 1307 times_bfx_loop: 001556 aa 000002 6250 15 1308 eax5 2,x5 "get next arg  001557 0a 001146 6000 00 1309 tze return_bfx "no more - done  001560 0a 001107 7000 00 1310 tsx0 numval "branch on type of next arg  001561 0a 001604 7100 00 1311 tra times_bfx_sfx  001562 0a 001641 7100 00 1312 tra times_bfx_sfl  001563 0a 001564 7100 00 1313 tra times_bfx_mpy  001564 1314 times_bfx_mpy:  001564 0a 000733 7000 00 1315 tsx0 load_arg_bfx "load result and arg into big and small 001565 1316 times_bfx_common:  001565 aa 1 00000 3701 17 1317 epplp ab|0,x7 "get ptr to result (to be allocated)  001566 aa 2 00004 6501 00 1318 sprilp bp|resultp "store in resultp  001567 aa 000002 6220 17 1319 eax2 2,x7 "calc EVEN(x7 + big_limit + small_limit + 2)  001570 aa 2 00012 0621 00 1320 adx2 bp|big_limit  001571 aa 2 00013 0621 00 1321 adx2 bp|small_limit  001572 aa 777776 3620 03 1322 anx2 -2,du 001573 aa 000000 6270 12 1323 eax7 0,x2 "alloc the appropriate number of words 001574 aa 2 00006 2221 20 1324 ldx2 bp|biggerp,* "calc sign of result  001575 aa 2 00010 6621 20 1325 erx2 bp|smallerp,* 001576 aa 2 00004 7421 20 1326 stx2 bp|resultp,* "store it  001577 0a 000771 7000 00 1327 tsx0 mpy_bfx "do the multiply  001600 0a 001256 7000 00 1328 tsx0 truncate_bfx "truncate it  001601 0a 001556 7100 00 1329 tra times_bfx_loop "get next arg  001602 0a 000317 7000 00 1330 tsx0 convert_bfx_to_sfx "truncate skipped => make small  001603 0a 001505 7100 00 1331 tra times_sfx_loop "join sfx code 001604 1332 times_bfx_sfx:  001604 aa 2 00004 2371 00 1333 ldaq bp|resultp "move in bignum  001605 aa 2 00006 7571 00 1334 staq bp|biggerp  001606 aa 0 00001 2361 15 1335 ldq ap|1,x5 "get small num  001607 1336 times_bs_join:  001607 aa 2 00006 2221 20 1337 ldx2 bp|biggerp,* "get sign of bfx  001610 aa 000044 7370 00 1338 lls 36 "xor with sign of sfx (put in a)  001611 0a 001616 6050 00 1339 tpl times_bs_pos "sfx positive=> don't negate value and bfx sign  001612 0a 004201 1150 00 1340 cmpa =o400000000000 "see if we can't negate it  001613 0a 001631 6000 00 1341 tze times_bs_make_bb "can't negate - go to bfx times bfx  001614 aa 000000 5310 00 1342 neg 0 "negate the number - need abs 001615 aa 777777 6620 03 1343 erx2 -1,du "change sign of result  001616 1344 times_bs_pos:  001616 aa 2 00010 7551 00 1345 sta bp|multiplier "save abs of sfx as multiplier  001617 aa 2 00006 7261 20 1346 lxl6 bp|biggerp,* "get length of bfx  001620 aa 000001 6260 16 1347 eax6 1,x6 "add one for length of sfx = len result  001621 0a 000046 7000 00 1348 tsx0 alloc_bfx6 "alloc the result 001622 aa 2 00004 6501 00 1349 sprilp bp|resultp "save ptr to it 001623 aa 4 00000 7421 00 1350 stx2 lp|0 "save the sign 001624 0a 001045 7000 00 1351 tsx0 mpy_bs "do the multiply 001625 0a 001256 7000 00 1352 tsx0 truncate_bfx "try to make smaller  001626 0a 001556 7100 00 1353 tra times_bfx_loop "get next arg  001627 0a 000317 7000 00 1354 tsx0 convert_bfx_to_sfx "skip => make small  001630 0a 001505 7100 00 1355 tra times_sfx_loop 001631 1356 times_bs_make_bb:  001631 aa 000044 7330 00 1357 lrs 36 "put in q 001632 0a 000335 7000 00 1358 tsx0 convert_q_to_bfx "change the sfx to a bfx  001633 aa 2 00010 6501 00 1359 sprilp bp|smallerp "setup for bfx times bfx  001634 aa 4 00000 7221 00 1360 lxl2 lp|0  001635 aa 2 00013 7421 00 1361 stx2 bp|small_limit  001636 aa 2 00006 7221 20 1362 lxl2 bp|biggerp,*  001637 aa 2 00012 7421 00 1363 stx2 bp|big_limit  001640 0a 001565 7100 00 1364 tra times_bfx_common "join bfx bfx code  1365 "  001641 1366 times_bfx_sfl:  001641 aa 2 00004 3701 20 1367 epplp bp|resultp,* "get ptr to result to convert  001642 0a 000267 7060 00 1368 tsx6 convert_bfx_to_sfl  001643 0a 000700 7100 00 1369 tra float_error "error in conversion  001644 0a 001537 7100 00 1370 tra times_sfl_mpy "no error - join sfl code  1371 "  1372 "  001645 1373 quotient:  001645 aa 000070 3360 07 1374 lcq -fn_quotient,dl "remember who we are  001646 0a 000637 7000 00 1375 tsx0 enter "set up the auto vars, etc.  001647 aa 000000 6250 15 1376 eax5 0,x5 "any args? 001650 0a 001140 6000 00 1377 tze return_1 "no - return the identity - 1  001651 0a 001107 7000 00 1378 tsx0 numval "branch on arg type  001652 0a 001655 7100 00 1379 tra quot_sfx  001653 0a 001716 7100 00 1380 tra quot_sfl  001654 0a 001750 7100 00 1381 tra quot_bfx  1382 "  001655 1383 quot_sfx:  001655 aa 0 00001 2361 15 1384 ldq ap|1,x5 "pick up first arg  001656 1385 quot_sfx_loop:  001656 aa 000002 6250 15 1386 eax5 2,x5 "get next arg (in sfx mode)  001657 0a 001163 6000 00 1387 tze return_sfx "no more - done  001660 0a 001107 7000 00 1388 tsx0 numval "branch on arg type  001661 0a 001664 7100 00 1389 tra quot_sfx_div  001662 0a 001714 7100 00 1390 tra quot_sfx_sfl  001663 0a 001676 7100 00 1391 tra quot_sfx_bfx  001664 1392 quot_sfx_div:  001664 0a 004201 1160 00 1393 cmpq =o400000000000 "check that won't overflow  001665 aa 000004 6010 04 1394 tnz 4,ic  001666 0a 004205 2350 00 1395 lda =-1 "-4000000.../-1 will do that 001667 aa 0 00001 1151 15 1396 cmpa ap|1,x5  001670 0a 001673 6000 00 1397 tze quot_sfx_make_big "go to bfx mode 001671 aa 0 00001 5061 15 1398 div ap|1,x5 "do the divide  001672 0a 001656 7100 00 1399 tra quot_sfx_loop "get next arg  001673 1400 quot_sfx_make_big:  001673 0a 000335 7000 00 1401 tsx0 convert_q_to_bfx "do the conversion  001674 aa 2 00004 6501 00 1402 sprilp bp|resultp  001675 0a 001760 7100 00 1403 tra quot_bs "join the other code 001676 1404 quot_sfx_bfx:  001676 0a 004201 1160 00 1405 cmpq =o400000000000 "are we -400.../400...?  001677 0a 001712 6010 00 1406 tnz quot_sfx_zero "no 001700 aa 0 00000 3701 35 1407 epplp ap|0,x5* 001701 aa 4 00000 2351 00 1408 lda lp|0  001702 aa 4 00001 2361 00 1409 ldq lp|1  001703 0a 004212 1170 00 1410 cmpaq =v18/0,18/2,36/0 001704 0a 001712 6010 00 1411 tnz quot_sfx_zero  001705 aa 4 00002 2351 00 1412 lda lp|2  001706 aa 000001 1150 07 1413 cmpa 1,dl  001707 0a 001712 6010 00 1414 tnz quot_sfx_zero  001710 0a 004205 2360 00 1415 ldq =-1  001711 0a 001656 7100 00 1416 tra quot_sfx_loop  001712 1417 quot_sfx_zero:  001712 aa 000000 2360 07 1418 ldq 0,dl  001713 0a 001656 7100 00 1419 tra quot_sfx_loop "get next  001714 1420 quot_sfx_sfl:  001714 0a 000360 7000 00 1421 tsx0 convert_q_to_sfl "change to sfl mode 001715 0a 001725 7100 00 1422 tra quot_sfl_div  1423 "  001716 1424 quot_sfl:  001716 aa 0 00001 4311 15 1425 fld ap|1,x5 "load first arg  001717 1426 quot_sfl_loop:  001717 aa 000002 6250 15 1427 eax5 2,x5 "get next arg  001720 0a 001157 6000 00 1428 tze return_sfl "no more - return  001721 0a 001107 7000 00 1429 tsx0 numval "what type is arg?  001722 0a 001727 7100 00 1430 tra quot_sfl_sfx  001723 0a 001725 7100 00 1431 tra quot_sfl_div  001724 0a 001734 7100 00 1432 tra quot_sfl_bfx  001725 1433 quot_sfl_div:  001725 aa 0 00001 5651 15 1434 fdv ap|1,x5 "do the divide  001726 0a 001717 7100 00 1435 tra quot_sfl_loop "get next arg  001727 1436 quot_sfl_sfx:  001727 aa 2 00014 4551 00 1437 fst bp|temp "save the EAQ  001730 aa 0 00001 2361 15 1438 ldq ap|1,x5 "load the sfx and convert  001731 0a 000360 7000 00 1439 tsx0 convert_q_to_sfl  001732 aa 2 00014 5251 00 1440 fdi bp|temp "do the divide  001733 0a 001717 7100 00 1441 tra quot_sfl_loop "get next arg  001734 1442 quot_sfl_bfx:  001734 aa 2 00014 4551 00 1443 fst bp|temp "save  001735 aa 0 00000 3701 35 1444 epplp ap|0,x5* "get ptr to arg  001736 0a 000267 7060 00 1445 tsx6 convert_bfx_to_sfl "and convert it to sfl  001737 0a 001742 7100 00 1446 tra quot_sfl_bfx_overflow "overflow  001740 aa 2 00014 5251 00 1447 fdi bp|temp "do the divide  001741 0a 001717 7100 00 1448 tra quot_sfl_loop "and get the next arg  1449  001742 1450 quot_sfl_bfx_overflow:  001742 aa 1 00044 3715 20 1451 epplb ab|system_lp,*  000012 1452 link zunderflow,|[zunderflow],* zunderflow=t?  001743 4a 5 00012 2371 20 1453 ldaq lb|zunderflow,*  001744 aa 1 00012 1171 00 1454 cmpaq ab|nil  001745 0a 000700 6000 00 1455 tze float_error no, error.  001746 aa 400000 4310 03 1456 fld =0.0,du yes, return 0.0  001747 0a 001157 7100 00 1457 tra return_sfl 1458 "  001750 1459 quot_bfx:  001750 aa 0 00000 2371 15 1460 ldaq ap|0,x5 "make first arg old result  001751 aa 2 00004 7571 00 1461 staq bp|resultp  001752 1462 quot_bfx_loop:  001752 aa 000002 6250 15 1463 eax5 2,x5 "get next arg  001753 0a 001146 6000 00 1464 tze return_bfx "no more - return  001754 0a 001107 7000 00 1465 tsx0 numval "branch on type  001755 0a 001760 7100 00 1466 tra quot_bs  001756 0a 002013 7100 00 1467 tra quot_bfx_sfl  001757 0a 002017 7100 00 1468 tra quot_bb  001760 1469 quot_bs:  001760 aa 2 00004 2371 00 1470 ldaq bp|resultp "divide bfx by sfx, move result to bigger 001761 aa 2 00006 7571 00 1471 staq bp|biggerp  001762 aa 2 00006 2221 20 1472 ldx2 bp|biggerp,* "load sign of dividend  001763 aa 0 00001 2351 15 1473 lda ap|1,x5 "load divisor value  001764 0a 001771 6050 00 1474 tpl quot_bs_join "don't do anything if non-negative  001765 0a 004201 1150 00 1475 cmpa =o400000000000 "see if can't take negative  001766 0a 002007 6000 00 1476 tze quot_bs_make_bb  001767 aa 000000 5310 00 1477 neg 0 "get abs value 001770 aa 777777 6620 03 1478 erx2 -1,du "get sign of result  001771 1479 quot_bs_join:  001771 aa 2 00010 7551 00 1480 sta bp|divisor "store divisor 001772 aa 1 00000 3701 17 1481 epplp ab|0,x7 "get ptr to result (to be alloced) 001773 aa 2 00004 6501 00 1482 sprilp bp|resultp "store in resultp  001774 aa 2 00004 7421 20 1483 stx2 bp|resultp,* "store sign 001775 aa 2 00006 7221 20 1484 lxl2 bp|biggerp,* "get length of dividend 001776 aa 000002 0620 03 1485 adx2 2,du "add one for header, and 1 to round  001777 aa 777776 3620 03 1486 anx2 -2,du "round down to even  002000 aa 2 00014 7421 00 1487 stx2 bp|temp  002001 aa 2 00014 0671 00 1488 adx7 bp|temp "bump x7  002002 0a 000622 7000 00 1489 tsx0 div_bs "do the divide  002003 0a 001256 7000 00 1490 tsx0 truncate_bfx "try to truncate  002004 0a 001752 7100 00 1491 tra quot_bfx_loop "get next arg  002005 0a 000317 7000 00 1492 tsx0 convert_bfx_to_sfx "skipped, so convert to sfx  002006 0a 001656 7100 00 1493 tra quot_sfx_loop  002007 1494 quot_bs_make_bb:  002007 aa 000044 7330 00 1495 lrs 36 "move into q  002010 0a 000335 7000 00 1496 tsx0 convert_q_to_bfx "do conversion  002011 aa 2 00010 6501 00 1497 sprilp bp|smallerp 002012 0a 002020 7100 00 1498 tra quot_bb_div "join bfx code  002013 1499 quot_bfx_sfl:  002013 aa 2 00004 3701 20 1500 epplp bp|resultp,* "get ptr to bfx so far 002014 0a 000267 7060 00 1501 tsx6 convert_bfx_to_sfl "convert it  002015 0a 000700 7100 00 1502 tra float_error "error  002016 0a 001725 7100 00 1503 tra quot_sfl_div "join other code 002017 1504 quot_bb:  002017 0a 000733 7000 00 1505 tsx0 load_arg_bfx  002020 1506 quot_bb_div:  002020 0a 000364 7000 00 1507 tsx0 div_bb  002021 aa 2 00030 2371 00 1508 ldaq bp|answerp  002022 aa 2 00004 7571 00 1509 staq bp|resultp  002023 0a 001256 7000 00 1510 tsx0 truncate_bfx  002024 0a 001752 7100 00 1511 tra quot_bfx_loop  002025 0a 000317 7000 00 1512 tsx0 convert_bfx_to_sfx  002026 0a 001656 7100 00 1513 tra quot_sfx_loop  1514 "  1515 "  002027 1516 entry bnprint  002027 1517 bnprint:  002027 0a 001251 7000 00 1518 tsx0 switch_to_lisp "setup lisp environment  002030 0a 000637 7000 00 1519 tsx0 enter "get auto vars  002031 aa 0 77776 2371 00 1520 ldaq ap|-2 "get ptr to bignum to be broken up  002032 aa 2 00006 7571 00 1521 staq bp|biggerp "store it where it can be used  1522 "  002033 aa 2 77777 2351 00 1523 lda bp|bn_pl1_radix "load radix  002034 aa 2 00010 7551 00 1524 sta bp|divisor "store where it will be needed 002035 aa 2 00006 7261 20 1525 lxl6 bp|biggerp,* "alloc result - about twice bigger in size  002036 aa 2 00014 7461 00 1526 stx6 bp|temp  002037 aa 2 00014 0661 00 1527 adx6 bp|temp  002040 0a 000046 7000 00 1528 tsx0 alloc_bfx6  002041 aa 2 00004 6501 00 1529 sprilp bp|resultp  002042 aa 4 00000 4501 00 1530 stz lp|0 "make sign positive 002043 aa 1 00000 3701 17 1531 epplp ab|0,x7 "get ptr to array of results  002044 aa 2 77774 6501 00 1532 sprilp bp|bn_pl1_ptr  002045 aa 000002 6270 17 1533 eax7 2,x7 "bump x7  002046 aa 000000 6230 00 1534 eax3 0 "x3 is index into this array  002047 1535 bnprint_loop:  002047 0a 000622 7000 00 1536 tsx0 div_bs "do the divide  002050 aa 2 77774 7561 73 1537 stq bp|bn_pl1_ptr,*x3 "store the remainder  002051 aa 000001 6230 13 1538 eax3 1,x3 "bump the pointer  002052 aa 000001 3030 03 1539 canx3 1,du "check if time to bumb x7 002053 aa 000002 6010 04 1540 tnz 2,ic  002054 aa 000002 6270 17 1541 eax7 2,x7 "bump it  002055 0a 001256 7000 00 1542 tsx0 truncate_bfx "truncate result  002056 0a 002063 7100 00 1543 tra bnprint_still_big "still bignum  002057 aa 000001 6220 00 1544 eax2 1 "could be small, so are we done?  002060 aa 2 00004 2351 72 1545 lda bp|resultp,*x2 "done if quotient is < radix  002061 aa 2 77777 1151 00 1546 cmpa bp|bn_pl1_radix "do the compare  002062 0a 002066 6040 00 1547 tmi bnprint_done "if radix>quot, then done  002063 1548 bnprint_still_big:  002063 aa 2 00004 2371 00 1549 ldaq bp|resultp "move result into bigger  002064 aa 2 00006 7571 00 1550 staq bp|biggerp  002065 0a 002047 7100 00 1551 tra bnprint_loop "do again  002066 1552 bnprint_done:  002066 0a 000317 7000 00 1553 tsx0 convert_bfx_to_sfx "get last word  002067 aa 2 77774 7561 73 1554 stq bp|bn_pl1_ptr,*x3 "store it  002070 aa 000001 6230 13 1555 eax3 1,x3 "make x3 be length 002071 aa 2 77776 4501 00 1556 stz bp|bn_pl1_length "clear high bits 002072 aa 2 77776 4431 00 1557 sxl3 bp|bn_pl1_length "store array length 002073 aa 0 77776 3501 00 1558 eppap ap|-2 "clear arg  002074 aa 1 00044 3701 20 1559 epplp ab|system_lp,* "load lp 002075 0a 001117 7100 00 1560 tra ret_to_pl1 "return  1561 "  1562 "  002076 1563 fix:  002076 aa 000077 3360 07 1564 lcq -fn_fix,dl 002077 aa 777776 6250 00 1565 eax5 -2 "indicate that we have one arg  002100 0a 000637 7000 00 1566 tsx0 enter "set up auto vars 002101 0a 001107 7000 00 1567 tsx0 numval "check type of arg  002102 0a 002105 7100 00 1568 tra fix_sfx  002103 0a 002107 7100 00 1569 tra fix_sfl  002104 0a 002166 7100 00 1570 tra fix_bfx  002105 1571 fix_sfx:  002105 aa 0 77776 2371 00 1572 ldaq ap|-2 "just a straight copy 002106 0a 001123 7100 00 1573 tra return 002107 1574 fix_sfl:  002107 aa 0 77777 4311 00 1575 fld ap|-1 "load the value  002110 0a 002122 6040 00 1576 tmi fix_sfl_neg "test sign  002111 0a 004206 5150 00 1577 fcmp =1.0 "see if it is greater than 1  002112 0a 001132 6040 00 1578 tmi return_0 "smaller => 0  002113 0a 001140 6000 00 1579 tze return_1 "equal => 1 002114 0a 004214 5150 00 1580 fcmp =1.0e10 "are we sure that it can be sfx 002115 aa 000003 6040 04 1581 tmi 3,ic "yes  002116 aa 000000 6240 00 1582 eax4 0 "load sign (0 => +)  002117 0a 002134 7100 00 1583 tra fix_sfl_bfx "go do bfx conversion 002120 aa 216000 4350 03 1584 ufa =71b25,du "convert to sfx  002121 0a 001163 7100 00 1585 tra return_sfx 002122 1586 fix_sfl_neg:  002122 0a 004206 4250 00 1587 fcmg =1.0 "see if fraction  002123 0a 001152 6000 00 1588 tze return_minus1 "equal -1  002124 0a 001132 6040 00 1589 tmi return_0 "is fraction  002125 0a 004214 4250 00 1590 fcmg =1.0e10 "can it be an sfx?  002126 aa 000004 6040 04 1591 tmi 4,ic "yes  002127 aa 777777 6240 00 1592 eax4 -1 "no, so set sign, and go to bfx  002130 aa 000000 5130 00 1593 fneg 0 002131 0a 002134 7100 00 1594 tra fix_sfl_bfx  002132 aa 216000 4350 03 1595 ufa =71b25,du "do the conversion to sfx  002133 0a 001163 7100 00 1596 tra return_sfx "and return  002134 1597 fix_sfl_bfx:  002134 aa 2 00015 4551 00 1598 fst bp|temp+1 "save the floating value  002135 aa 000005 6260 00 1599 eax6 5 "alloc bfx of 5 words 002136 0a 000046 7000 00 1600 tsx0 alloc_bfx6  002137 aa 2 00004 6501 00 1601 sprilp bp|resultp  002140 0a 004174 2370 00 1602 ldaq =v36/0,36/0 "load a zero 002141 aa 4 00000 7571 00 1603 staq lp|0 "zero out bfx  002142 aa 4 00002 7571 00 1604 staq lp|2  002143 aa 4 00004 7571 00 1605 staq lp|4  002144 aa 2 00015 2351 00 1606 lda bp|temp+1 "load sfl as word, to get exp  002145 aa 000100 7730 00 1607 lrl 64 "put exp as value in q  002146 aa 000043 5060 07 1608 div 35,dl "find how many words result will be  002147 aa 000000 6220 06 1609 eax2 0,ql "put value in x2  002150 aa 000000 5310 00 1610 neg 0 "negate remainder  002151 aa 000043 6230 05 1611 eax3 35,al "add to 35  002152 aa 2 00015 4311 00 1612 fld bp|temp+1 "load number  002153 aa 000000 7730 13 1613 lrl 0,x3 "do the shift  002154 aa 000001 7720 00 1614 qrl 1  002155 aa 4 00001 7551 12 1615 sta lp|1,x2 "store the result  002156 aa 4 00000 7561 12 1616 stq lp|0,x2  002157 aa 000001 6220 12 1617 eax2 1,x2 "get bfx length  002160 aa 4 00000 4421 00 1618 sxl2 lp|0 "store it in bfx  002161 aa 4 00000 7441 00 1619 stx4 lp|0 "store sign  002162 0a 001256 7000 00 1620 tsx0 truncate_bfx "can we be an sfx?  002163 0a 001146 7100 00 1621 tra return_bfx "no - return  002164 0a 000317 7000 00 1622 tsx0 convert_bfx_to_sfx "convert  002165 0a 001163 7100 00 1623 tra return_sfx "return  002166 1624 fix_bfx:  002166 aa 0 77776 2371 00 1625 ldaq ap|-2 "just return bfx given  002167 aa 2 00004 7571 00 1626 staq bp|resultp  002170 0a 001146 7100 00 1627 tra return_bfx 1628 "  1629 "  002171 1630 float:  002171 aa 000100 3360 07 1631 lcq -fn_float,dl  002172 aa 777776 6250 00 1632 eax5 -2 "indicate that we take one arg  002173 0a 000637 7000 00 1633 tsx0 enter "setup the bignums environment  002174 0a 001107 7000 00 1634 tsx0 numval "branch on type  002175 0a 002200 7100 00 1635 tra float_sfx  002176 0a 002203 7100 00 1636 tra float_sfl  002177 0a 002205 7100 00 1637 tra float_bfx  002200 1638 float_sfx:  002200 aa 0 77777 2361 00 1639 ldq ap|-1 "get arg  002201 0a 000360 7000 00 1640 tsx0 convert_q_to_sfl "do the conversion  002202 0a 001157 7100 00 1641 tra return_sfl 002203 1642 float_sfl:  002203 aa 0 77776 2371 00 1643 ldaq ap|-2 "just return the arg  002204 0a 001123 7100 00 1644 tra return 002205 1645 float_bfx:  002205 aa 0 77776 3701 20 1646 epplp ap|-2,* "get ptr to value  002206 0a 000267 7060 00 1647 tsx6 convert_bfx_to_sfl "do the conversion  002207 0a 000700 7100 00 1648 tra float_error "overflow 002210 0a 001157 7100 00 1649 tra return_sfl "do the return 1650 "  1651 "  002211 1652 entry bnread  002211 1653 bnread: 002211 0a 001251 7000 00 1654 tsx0 switch_to_lisp "get lisp environment 002212 0a 000637 7000 00 1655 tsx0 enter "get this set of routine's environment  002213 aa 2 77776 2261 00 1656 ldx6 bp|bn_pl1_length "alloc bfx at least as big as array length  002214 aa 2 00013 7461 00 1657 stx6 bp|small_limit "save for loop test  002215 0a 000046 7000 00 1658 tsx0 alloc_bfx6  002216 aa 2 00004 6501 00 1659 sprilp bp|resultp "store ptr in resultp  002217 aa 2 77774 2361 20 1660 ldq bp|bn_pl1_ptr,* "load first word  002220 0a 000335 7000 00 1661 tsx0 convert_q_to_bfx "make it a bfx for rest of routine  002221 aa 2 00006 6501 00 1662 sprilp bp|biggerp  002222 aa 000001 6230 00 1663 eax3 1 "init counter 002223 1664 bnread_loop:  002223 aa 2 77777 2351 00 1665 lda bp|bn_pl1_radix "load radix  002224 aa 2 00010 7551 00 1666 sta bp|multiplier "store as multiplier  002225 0a 001045 7000 00 1667 tsx0 mpy_bs "mult times the accumulated result  002226 aa 2 00004 3701 20 1668 epplp bp|resultp,* "move result to bigger 002227 aa 2 00006 6501 00 1669 sprilp bp|biggerp  002230 aa 2 77774 2351 73 1670 lda bp|bn_pl1_ptr,*x3 "load next number to be added  002231 aa 2 00010 7551 00 1671 sta bp|addend "it is put in addend  002232 0a 000033 7000 00 1672 tsx0 add_bs "do the add  002233 0a 001256 7000 00 1673 tsx0 truncate_bfx "truncate result for neatness  002234 aa 000000 0110 00 1674 nop 0 "don't care if can be sfx  002235 aa 2 00004 3701 20 1675 epplp bp|resultp,* "move  002236 aa 2 00006 6501 00 1676 sprilp bp|biggerp  002237 aa 000001 6230 13 1677 eax3 1,x3 "get next word 002240 aa 2 00013 1031 00 1678 cmpx3 bp|small_limit "are we done?  002241 0a 002223 6010 00 1679 tnz bnread_loop "no  002242 0a 000112 7000 00 1680 tsx0 call_alloc_bfx "put result into lisp space  002243 aa 0 00002 3501 00 1681 eppap ap|2 "get place on mrkd stack for result  002244 aa 2 00004 2371 00 1682 ldaq bp|resultp "put bignum ptr there 002245 aa 001000 2750 07 1683 ora Big_fixed,dl  002246 aa 0 77776 7571 00 1684 staq ap|-2 002247 aa 1 00044 3701 20 1685 epplp ab|system_lp,* "get ready to return 002250 0a 001117 7100 00 1686 tra ret_to_pl1 "do it 1687 "  1688 "  002251 1689 add1:  002251 aa 000060 3360 07 1690 lcq -fn_add1,dl  002252 0a 001446 6240 00 1691 eax4 add_opcode "indicate that we will do adds  002253 1692 add1_enter: 002253 aa 777776 6250 00 1693 eax5 -2 "we are called with one arg  002254 0a 000637 7000 00 1694 tsx0 enter "set up auto vars 002255 0a 001107 7000 00 1695 tsx0 numval "check type of arg  002256 0a 002261 7100 00 1696 tra add1_sfx  002257 0a 002271 7100 00 1697 tra add1_sfl  002260 0a 002276 7100 00 1698 tra add1_bfx  002261 1699 add1_sfx:  002261 aa 004000 6340 07 1700 ldi nooverflow,dl "mask overflows 002262 aa 0 77777 2361 00 1701 ldq ap|-1 "load value  002263 aa 000007 7160 14 1702 xec 7,x4 "add or subtract one  002264 aa 000002 6170 04 1703 tov 2,ic "check for overflow 002265 0a 001163 7100 00 1704 tra return_sfx "done  002266 0a 000707 7000 00 1705 tsx0 force_q_to_bfx "change to bfx  002267 aa 2 00004 6501 00 1706 sprilp bp|resultp  002270 0a 001146 7100 00 1707 tra return_bfx "done  002271 1708 add1_sfl:  002271 0a 004206 4310 00 1709 fld =1.0 "get the one to add or subtract 002272 aa 2 00014 4551 00 1710 fst bp|temp "save it 002273 aa 0 77777 4311 00 1711 fld ap|-1 "load value to be add/sub to  002274 aa 000004 7160 14 1712 xec 4,x4 "do the operation  002275 0a 001157 7100 00 1713 tra return_sfl "done  002276 1714 add1_bfx:  002276 aa 2 00016 7441 00 1715 stx4 bp|op_table "we will use the code of plus_bfx  002277 aa 0 77776 3701 20 1716 epplp ap|-2,* "get bfx value setup like plus 002300 aa 2 00006 6501 00 1717 sprilp bp|biggerp  002301 aa 2 00047 4501 00 1718 stz bp|switched  002302 aa 2 00006 7221 20 1719 lxl2 bp|biggerp,*  002303 aa 2 00012 7421 00 1720 stx2 bp|big_limit  002304 0a 002312 3700 00 1721 epplp bfx_one  002305 aa 2 00010 6501 00 1722 sprilp bp|smallerp 002306 aa 000001 6220 00 1723 eax2 1 002307 aa 2 00013 7421 00 1724 stx2 bp|small_limit  002310 0a 001402 7100 00 1725 tra plus_bfx_common  1726 "  002311 aa 000000 0110 03 1727 even  002312 1728 bfx_one:  002312 aa 000000 000001 1729 vfd 18/0,18/1  002313 aa 000000 000001 1730 dec 1  1731 "  1732 "  002314 1733 sub1:  002314 aa 000061 3360 07 1734 lcq -fn_sub1,dl  002315 0a 001456 6240 00 1735 eax4 sub_opcode  002316 0a 002253 7100 00 1736 tra add1_enter 1737 "  1738 "  002317 1739 minus:  002317 aa 000064 3360 07 1740 lcq -fn_minus,dl  002320 aa 777776 6250 00 1741 eax5 -2 "we have one arg 002321 0a 000637 7000 00 1742 tsx0 enter "start  002322 0a 001107 7000 00 1743 tsx0 numval "branch on type  002323 0a 002326 7100 00 1744 tra minus_sfx  002324 0a 002336 7100 00 1745 tra minus_sfl  002325 0a 002341 7100 00 1746 tra minus_bfx  002326 1747 minus_sfx:  002326 aa 0 77777 2351 00 1748 lda ap|-1 "load value  002327 aa 000044 7330 00 1749 lrs 36 "put into AQ  002330 aa 000000 5330 00 1750 negl 0 "do tbe minus 002331 0a 004172 1170 00 1751 cmpaq =v36/0,o36/400000000000 "check that it hasn't become a bfx  002332 0a 001163 6010 00 1752 tnz return_sfx 002333 0a 000241 7000 00 1753 tsx0 convert_aq_to_bfx "it has - change  002334 aa 2 00004 6501 00 1754 sprilp bp|resultp  002335 0a 001146 7100 00 1755 tra return_bfx 002336 1756 minus_sfl:  002336 aa 0 77777 4311 00 1757 fld ap|-1 "load the value  002337 aa 000000 5130 00 1758 fneg 0 "negate it  002340 0a 001157 7100 00 1759 tra return_sfl 002341 1760 minus_bfx:  002341 aa 0 77776 2371 00 1761 ldaq ap|-2 "copy bfx 002342 aa 2 00004 7571 00 1762 staq bp|resultp  002343 0a 000112 7000 00 1763 tsx0 call_alloc_bfx  002344 aa 777777 6220 00 1764 eax2 -1 "negate it  002345 aa 2 00004 6421 20 1765 ersx2 bp|resultp,* 002346 0a 001256 7000 00 1766 tsx0 truncate_bfx "check for -400000000000  002347 0a 002352 7100 00 1767 tra minus_bfx_big  002350 0a 000317 7000 00 1768 tsx0 convert_bfx_to_sfx "convert to sfx  002351 0a 001163 7100 00 1769 tra return_sfx 002352 1770 minus_bfx_big:  002352 aa 2 00004 2371 00 1771 ldaq bp|resultp "setup return 002353 aa 001000 2750 07 1772 ora Big_fixed,dl  002354 0a 001123 7100 00 1773 tra return 1774 "  1775 "  002355 1776 abs:  002355 aa 000071 3360 07 1777 lcq -fn_abs,dl 002356 aa 777776 6250 00 1778 eax5 -2 "we have one arg 002357 0a 000637 7000 00 1779 tsx0 enter "get environment  002360 0a 001107 7000 00 1780 tsx0 numval "branch on arg type  002361 0a 002364 7100 00 1781 tra abs_sfx  002362 0a 002375 7100 00 1782 tra abs_sfl  002363 0a 002401 7100 00 1783 tra abs_bfx  002364 1784 abs_sfx:  002364 aa 0 77777 2351 00 1785 lda ap|-1 "get arg  002365 aa 000044 7330 00 1786 lrs 36 "make 2 words 002366 0a 001163 6050 00 1787 tpl return_sfx "do abs operation  002367 aa 000000 5330 00 1788 negl 0 002370 0a 004172 1170 00 1789 cmpaq =v36/0,o36/400000000000  002371 0a 001163 6010 00 1790 tnz return_sfx 002372 0a 000241 7000 00 1791 tsx0 convert_aq_to_bfx 002373 aa 2 00004 6501 00 1792 sprilp bp|resultp  002374 0a 001146 7100 00 1793 tra return_bfx 002375 1794 abs_sfl:  002375 aa 0 77777 4311 00 1795 fld ap|-1 "load value  002376 0a 001157 6050 00 1796 tpl return_sfl "do abs operation  002377 aa 000000 5130 00 1797 fneg 0 002400 0a 001157 7100 00 1798 tra return_sfl 002401 1799 abs_bfx:  002401 aa 0 77776 2341 20 1800 szn ap|-2,* "check sign  002402 0a 002405 6040 00 1801 tmi abs_bfx_minus "branch if negative 002403 aa 0 77776 2371 00 1802 ldaq ap|-2 "return argument as is  002404 0a 001123 7100 00 1803 tra return 002405 1804 abs_bfx_minus:  002405 aa 0 77776 2371 00 1805 ldaq ap|-2 002406 aa 2 00004 7571 00 1806 staq bp|resultp "copy and change sign 002407 0a 000112 7000 00 1807 tsx0 call_alloc_bfx  002410 aa 000000 6220 00 1808 eax2 0 002411 aa 2 00004 3421 20 1809 ansx2 bp|resultp,* 002412 aa 2 00004 2371 00 1810 ldaq bp|resultp  002413 aa 001000 2750 07 1811 ora Big_fixed,dl  002414 0a 001123 7100 00 1812 tra return "return  1813 "  1814 "  002415 1815 minusp: 002415 aa 000155 3360 07 1816 lcq -fn_minusp,dl  002416 aa 777776 6250 00 1817 eax5 -2 "we have one arg 002417 0a 000637 7000 00 1818 tsx0 enter "do entry sequence  002420 0a 001107 7000 00 1819 tsx0 numval "branch to code suitable for arg type  002421 0a 002424 7100 00 1820 tra minusp_sfx 002422 0a 002427 7100 00 1821 tra minusp_sfl 002423 0a 002432 7100 00 1822 tra minusp_bfx 002424 1823 minusp_sfx: 002424 aa 0 77777 2341 00 1824 szn ap|-1 "test sign 002425 0a 001165 6040 00 1825 tmi return_true "return verdict  002426 0a 001155 7100 00 1826 tra return_nil 002427 1827 minusp_sfl: 002427 aa 0 77777 4301 00 1828 fszn ap|-1 002430 0a 001165 6040 00 1829 tmi return_true  002431 0a 001155 7100 00 1830 tra return_nil 002432 1831 minusp_bfx: 002432 aa 0 77776 2341 20 1832 szn ap|-2,*  002433 0a 001165 6040 00 1833 tmi return_true  002434 0a 001155 7100 00 1834 tra return_nil 1835 "  1836 "  002435 1837 plusp:  002435 aa 000154 3360 07 1838 lcq -fn_plusp,dl  002436 aa 777776 6250 00 1839 eax5 -2 "we have 2 args  002437 0a 000637 7000 00 1840 tsx0 enter "enter  002440 0a 001107 7000 00 1841 tsx0 numval "dispatch  002441 0a 002444 7100 00 1842 tra plusp_sfx  002442 0a 002450 7100 00 1843 tra plusp_sfl  002443 0a 002454 7100 00 1844 tra plusp_bfx  002444 1845 plusp_sfx:  002444 aa 0 77777 2341 00 1846 szn ap|-1  002445 0a 001155 6040 00 1847 tmi return_nil "tell verdict  002446 0a 001155 6000 00 1848 tze return_nil 002447 0a 001165 7100 00 1849 tra return_true  002450 1850 plusp_sfl:  002450 aa 0 77777 4301 00 1851 fszn ap|-1 002451 0a 001155 6040 00 1852 tmi return_nil 002452 0a 001155 6000 00 1853 tze return_nil 002453 0a 001165 7100 00 1854 tra return_true  002454 1855 plusp_bfx:  002454 aa 0 77776 2341 20 1856 szn ap|-2,*  002455 0a 001155 6040 00 1857 tmi return_nil 002456 0a 001165 7100 00 1858 tra return_true "can't have zero bfx  1859 "  1860 "  002457 1861 max:  002457 aa 000102 3360 07 1862 lcq -fn_max,dl 002460 0a 002567 6240 00 1863 eax4 max_table "set up max xec table 002461 1864 max_start:  002461 0a 000637 7000 00 1865 tsx0 enter "set up environment  002462 0a 001107 7000 00 1866 tsx0 numval "branch on arg type  002463 0a 002466 7100 00 1867 tra max_sfx  002464 0a 002506 7100 00 1868 tra max_sfl  002465 0a 002535 7100 00 1869 tra max_bfx  002466 1870 max_sfx:  002466 aa 0 00000 2371 15 1871 ldaq ap|0,x5 "load first arg 002467 1872 max_sfx_loop:  002467 aa 000002 6250 15 1873 eax5 2,x5 "get next arg  002470 aa 000001 7160 14 1874 xec 1,x4  002471 0a 001107 7000 00 1875 tsx0 numval "branch on type of next arg  002472 0a 002475 7100 00 1876 tra max_sfx_sfx  002473 0a 002501 7100 00 1877 tra max_sfx_sfl  002474 0a 002503 7100 00 1878 tra max_sfx_bfx  002475 1879 max_sfx_sfx:  002475 aa 0 00001 1161 15 1880 cmpq ap|1,x5 "do the comparison  002476 aa 000000 7160 14 1881 xec 0,x4 "what to do is table driven 002477 aa 0 00001 2361 15 1882 ldq ap|1,x5 "load other value  002500 0a 002467 7100 00 1883 tra max_sfx_loop  002501 1884 max_sfx_sfl:  002501 0a 000360 7000 00 1885 tsx0 convert_q_to_sfl "convert to sfl 002502 0a 002524 7100 00 1886 tra max_sfl_sfl "join that code  002503 1887 max_sfx_bfx:  002503 0a 000335 7000 00 1888 tsx0 convert_q_to_bfx "go to bfx mode 002504 aa 2 00006 6501 00 1889 sprilp bp|biggerp  002505 0a 002557 7100 00 1890 tra max_bfx_bfx  002506 1891 max_sfl:  002506 aa 0 00001 4311 15 1892 fld ap|1,x5 "load initial value  002507 1893 max_sfl_loop:  002507 aa 000002 6250 15 1894 eax5 2,x5 "get next arg  002510 aa 000005 7160 14 1895 xec 5,x4  002511 0a 001107 7000 00 1896 tsx0 numval "branch on type  002512 0a 002515 7100 00 1897 tra max_sfl_sfx  002513 0a 002524 7100 00 1898 tra max_sfl_sfl  002514 0a 002530 7100 00 1899 tra max_sfl_bfx  002515 1900 max_sfl_sfx:  002515 aa 2 00014 4551 00 1901 fst bp|temp "save old value  002516 aa 0 00001 2361 15 1902 ldq ap|1,x5 "get sfx value to be made sfl  002517 0a 000360 7000 00 1903 tsx0 convert_q_to_sfl "convert it 002520 1904 max_sfl_sfx_cmp:  002520 aa 2 00014 5151 00 1905 fcmp bp|temp "compare with old value 002521 aa 000002 7160 14 1906 xec 2,x4  002522 aa 2 00014 4311 00 1907 fld bp|temp "switch to old value 002523 aa 000003 7160 14 1908 xec 3,x4  002524 1909 max_sfl_sfl:  002524 aa 0 00001 5151 15 1910 fcmp ap|1,x5 "do the compare 002525 aa 000004 7160 14 1911 xec 4,x4  002526 aa 0 00001 4311 15 1912 fld ap|1,x5  002527 0a 002507 7100 00 1913 tra max_sfl_loop  002530 1914 max_sfl_bfx:  002530 aa 2 00014 4551 00 1915 fst bp|temp "save old value  002531 aa 0 00000 3701 35 1916 epplp ap|0,x5* "try to convert new value to sfl  002532 0a 000267 7060 00 1917 tsx6 convert_bfx_to_sfl  002533 0a 000700 7100 00 1918 tra float_error  002534 0a 002520 7100 00 1919 tra max_sfl_sfx_cmp "do the compare  002535 1920 max_bfx:  002535 aa 0 00000 2371 15 1921 ldaq ap|0,x5 "get initial value  002536 aa 2 00006 7571 00 1922 staq bp|biggerp  002537 1923 max_bfx_loop:  002537 aa 2 00006 2371 00 1924 ldaq bp|biggerp  002540 aa 2 00004 7571 00 1925 staq bp|resultp  002541 aa 000002 6250 15 1926 eax5 2,x5 "get next arg  002542 aa 000011 7160 14 1927 xec 9,x4  002543 0a 001107 7000 00 1928 tsx0 numval "check type  002544 0a 002547 7100 00 1929 tra max_bfx_sfx  002545 0a 002553 7100 00 1930 tra max_bfx_sfl  002546 0a 002557 7100 00 1931 tra max_bfx_bfx  002547 1932 max_bfx_sfx:  002547 aa 0 00001 2361 15 1933 ldq ap|1,x5 "get value  002550 0a 000335 7000 00 1934 tsx0 convert_q_to_bfx "make it big  002551 aa 2 00010 6501 00 1935 sprilp bp|smallerp 002552 0a 002561 7100 00 1936 tra max_bfx_bfx_cmp  002553 1937 max_bfx_sfl:  002553 aa 2 00006 3701 20 1938 epplp bp|biggerp,* "get value so far  002554 0a 000267 7060 00 1939 tsx6 convert_bfx_to_sfl "convert to sfl  002555 0a 000700 7100 00 1940 tra float_error  002556 0a 002524 7100 00 1941 tra max_sfl_sfl "join sfl code  002557 1942 max_bfx_bfx:  002557 aa 0 00000 2371 15 1943 ldaq ap|0,x5 "get new value  002560 aa 2 00010 7571 00 1944 staq bp|smallerp  002561 1945 max_bfx_bfx_cmp:  002561 0a 000220 7000 00 1946 tsx0 compare_signed_bfx  002562 aa 000006 7160 14 1947 xec 6,x4  002563 aa 000007 7160 14 1948 xec 7,x4  002564 aa 000010 7160 14 1949 xec 8,x4  002565 1950 max_bfx_bfx_switch: 002565 0a 001235 7000 00 1951 tsx0 switch_bfx "change bigger and smaller  002566 0a 002537 7100 00 1952 tra max_bfx_loop "continue  1953 "  002567 1954 max_table:  002567 0a 002467 6050 00 1955 tpl max_sfx_loop " 0  002570 0a 001163 6000 00 1956 tze return_sfx " 1  002571 0a 002507 6050 00 1957 tpl max_sfl_loop " 2  002572 0a 002507 7100 00 1958 tra max_sfl_loop " 3  002573 0a 002507 6050 00 1959 tpl max_sfl_loop " 4  002574 0a 001157 6000 00 1960 tze return_sfl " 5  002575 0a 002565 7100 00 1961 tra max_bfx_bfx_switch " 6  002576 0a 002537 7100 00 1962 tra max_bfx_loop " 7  002577 0a 002537 7100 00 1963 tra max_bfx_loop " 8  002600 0a 001146 6000 00 1964 tze return_bfx " 9  1965 "  1966 "  002601 1967 min:  002601 aa 000103 3360 07 1968 lcq -fn_min,dl 002602 0a 002604 6240 00 1969 eax4 min_table 002603 0a 002461 7100 00 1970 tra max_start "set up and join max  1971 "  002604 1972 min_table:  002604 0a 002467 6040 00 1973 tmi max_sfx_loop " 0  002605 0a 001163 6000 00 1974 tze return_sfx " 1  002606 0a 002507 6040 00 1975 tmi max_sfl_loop " 2  002607 0a 002507 7100 00 1976 tra max_sfl_loop " 3  002610 0a 002507 6040 00 1977 tmi max_sfl_loop " 4  002611 0a 001157 6000 00 1978 tze return_sfl " 5  002612 0a 002537 7100 00 1979 tra max_bfx_loop " 6  002613 0a 002537 7100 00 1980 tra max_bfx_loop " 7  002614 0a 002565 7100 00 1981 tra max_bfx_bfx_switch " 8  002615 0a 001146 6000 00 1982 tze return_bfx " 9  1983 "  1984 "  002616 1985 lessp:  002616 aa 000063 3360 07 1986 lcq -fn_lessp,dl  002617 0a 002621 6240 00 1987 eax4 lessp_table  002620 0a 002461 7100 00 1988 tra max_start  1989 "  002621 1990 lessp_table:  002621 0a 001155 6050 00 1991 tpl return_nil " 0  002622 0a 001165 6000 00 1992 tze return_true " 1  002623 0a 002634 7170 00 1993 xed lessp_table_2 " 2 002624 0a 001155 7100 00 1994 tra return_nil " 3  002625 0a 001155 6050 00 1995 tpl return_nil " 4  002626 0a 001165 6000 00 1996 tze return_true " 5  002627 0a 002565 7100 00 1997 tra max_bfx_bfx_switch " 6  002630 0a 001155 7100 00 1998 tra return_nil " 7  002631 0a 001155 7100 00 1999 tra return_nil " 8  002632 0a 001165 6000 00 2000 tze return_true " 9  002633 aa 000000 0110 03 2001 even  002634 2002 lessp_table_2:  002634 0a 001155 6000 00 2003 tze return_nil 002635 0a 002507 6050 00 2004 tpl max_sfl_loop  2005 "  2006 "  002636 2007 greaterp:  002636 aa 000062 3360 07 2008 lcq -fn_greaterp,dl  002637 0a 002641 6240 00 2009 eax4 greaterp_table "load table ptr and join max  002640 0a 002461 7100 00 2010 tra max_start  2011 "  002641 2012 greaterp_table: 002641 0a 002654 7170 00 2013 xed greaterp_table_0 " 0  002642 0a 001165 6000 00 2014 tze return_true " 1  002643 0a 002507 6040 00 2015 tmi max_sfl_loop " 2  002644 0a 001155 7100 00 2016 tra return_nil " 3  002645 0a 002656 7170 00 2017 xed greaterp_table_4 " 4  002646 0a 001165 6000 00 2018 tze return_true " 5  002647 0a 001155 7100 00 2019 tra return_nil " 6  002650 0a 001155 7100 00 2020 tra return_nil " 7  002651 0a 002565 7100 00 2021 tra max_bfx_bfx_switch " 8  002652 0a 001165 6000 00 2022 tze return_true " 9  002653 aa 000000 0110 03 2023 even  002654 2024 greaterp_table_0:  002654 0a 001155 6040 00 2025 tmi return_nil 002655 0a 001155 6000 00 2026 tze return_nil 002656 2027 greaterp_table_4:  002656 0a 001155 6040 00 2028 tmi return_nil 002657 0a 001155 6000 00 2029 tze return_nil 2030 "  2031 "  002660 2032 remainder:  002660 aa 000101 3360 07 2033 lcq -fn_remainder,dl  002661 aa 777774 6250 00 2034 eax5 -4 "we have 2 args  002662 0a 000637 7000 00 2035 tsx0 enter "set up environment  002663 0a 001107 7000 00 2036 tsx0 numval "test type of first arg  002664 0a 002667 7100 00 2037 tra rem_sfx  002665 0a 000067 7100 00 2038 tra badarg 002666 0a 002725 7100 00 2039 tra rem_bfx  002667 2040 rem_sfx:  002667 aa 777776 6250 00 2041 eax5 -2 "check second arg  002670 0a 001107 7000 00 2042 tsx0 numval  002671 0a 002674 7100 00 2043 tra rem_sfx_sfx  002672 0a 000067 7100 00 2044 tra badarg 002673 0a 002707 7100 00 2045 tra rem_sfx_bfx  002674 2046 rem_sfx_sfx:  002674 aa 0 77775 2361 00 2047 ldq ap|-3 "get first number  002675 0a 004201 1160 00 2048 cmpq =o400000000000 "check for -400.../-1 002676 aa 000004 6010 04 2049 tnz 4,ic  002677 0a 004205 2350 00 2050 lda =-1  002700 aa 0 77777 1151 00 2051 cmpa ap|-1 002701 0a 002705 6000 00 2052 tze rem_sfx_make_big "need bfx arith. 002702 aa 0 77777 5061 00 2053 div ap|-1 "do the division  002703 aa 000044 7330 00 2054 lrs 36 "get the remainder in proper place  002704 0a 001163 7100 00 2055 tra return_sfx "return  002705 2056 rem_sfx_make_big:  002705 0a 000335 7000 00 2057 tsx0 convert_q_to_bfx  002706 0a 002733 7100 00 2058 tra rem_bfx_sfx_start "join bfx code  002707 2059 rem_sfx_bfx:  002707 aa 0 77775 2361 00 2060 ldq ap|-3 "check for -400.../400...  002710 0a 004201 1160 00 2061 cmpq =o400000000000  002711 0a 002723 6010 00 2062 tnz rem_sfx_bfx_rem  002712 aa 0 77776 3701 20 2063 epplp ap|-2,*  002713 aa 4 00000 2351 00 2064 lda lp|0  002714 aa 4 00001 2361 00 2065 ldq lp|1  002715 0a 004212 1170 00 2066 cmpaq =v18/0,18/2,36/0 002716 0a 002723 6010 00 2067 tnz rem_sfx_bfx_rem  002717 aa 4 00002 2351 00 2068 lda lp|2  002720 aa 000001 1150 07 2069 cmpa 1,dl  002721 0a 002723 6010 00 2070 tnz rem_sfx_bfx_rem  002722 0a 001132 7100 00 2071 tra return_0 "rem(-400.../400...) = 0  002723 2072 rem_sfx_bfx_rem:  002723 aa 0 77775 2361 00 2073 ldq ap|-3 "the dividend is the remainder 002724 0a 001163 7100 00 2074 tra return_sfx 002725 2075 rem_bfx:  002725 aa 777776 6250 00 2076 eax5 -2 "look at second arg  002726 0a 001107 7000 00 2077 tsx0 numval  002727 0a 002732 7100 00 2078 tra rem_bfx_sfx  002730 0a 000067 7100 00 2079 tra badarg 002731 0a 002756 7100 00 2080 tra rem_bfx_bfx  002732 2081 rem_bfx_sfx:  002732 aa 0 77774 3701 20 2082 epplp ap|-4,* "get ptr to first arg  002733 2083 rem_bfx_sfx_start:  002733 aa 2 00006 6501 00 2084 sprilp bp|biggerp "store it  002734 aa 0 77777 2351 00 2085 lda ap|-1 "get divisor  002735 0a 002741 6050 00 2086 tpl rem_bfx_sfx_join "get abs 002736 0a 004201 1150 00 2087 cmpa =o400000000000 "is it too big?  002737 0a 002753 6000 00 2088 tze rem_bfx_sfx_expand 002740 aa 000000 5310 00 2089 neg 0  002741 2090 rem_bfx_sfx_join:  002741 aa 2 00010 7551 00 2091 sta bp|divisor "store as divisor  002742 aa 4 00000 7261 00 2092 lxl6 lp|0 "quotient is of the size of the dividend  002743 0a 000046 7000 00 2093 tsx0 alloc_bfx6 "alloc the result 002744 aa 2 00004 6501 00 2094 sprilp bp|resultp  002745 0a 000622 7000 00 2095 tsx0 div_bs "do the division 002746 aa 000000 2350 00 2096 lda 0 "remainder is in q 002747 aa 2 00006 2341 20 2097 szn bp|biggerp,* "sgn(rem) = sgn(dividend)  002750 aa 000002 6050 04 2098 tpl 2,ic  002751 aa 000000 5330 00 2099 negl 0 002752 0a 001163 7100 00 2100 tra return_sfx "return  002753 2101 rem_bfx_sfx_expand: 002753 aa 000044 7330 00 2102 lrs 36 "put it in the q  002754 0a 000335 7000 00 2103 tsx0 convert_q_to_bfx "convert to bfx 002755 0a 002757 7100 00 2104 tra rem_bfx_bfx_start "join bfx bfx code  002756 2105 rem_bfx_bfx:  002756 aa 0 77776 3701 20 2106 epplp ap|-2,* "get ptr to second arg 002757 2107 rem_bfx_bfx_start:  002757 aa 2 00010 6501 00 2108 sprilp bp|smallerp "store it  002760 aa 0 77774 3701 20 2109 epplp ap|-4,* "get ptr to first  002761 aa 2 00006 6501 00 2110 sprilp bp|biggerp "store it, too  002762 0a 000364 7000 00 2111 tsx0 div_bb "do the divide  002763 aa 2 00036 2221 00 2112 ldx2 bp|n "get length of divisor 002764 aa 2 00026 4421 20 2113 sxl2 bp|dividendp,* "store as length of remainder 002765 aa 2 00006 2221 20 2114 ldx2 bp|biggerp,* "get sign of dividend  002766 aa 2 00026 7421 20 2115 stx2 bp|dividendp,* "it is sign of remainder  002767 aa 2 00026 3701 20 2116 epplp bp|dividendp,* "get ptr to it  002770 aa 2 00004 6501 00 2117 sprilp bp|resultp "store in result  002771 0a 001167 7000 00 2118 tsx0 rsh_bfx "shift right to normalize result  002772 0a 001256 7000 00 2119 tsx0 truncate_bfx "make as small as possible  002773 0a 001146 7100 00 2120 tra return_bfx "that's it 002774 0a 000317 7000 00 2121 tsx0 convert_bfx_to_sfx "skip => can be sfx  002775 0a 001163 7100 00 2122 tra return_sfx 2123 "  2124 "  002776 2125 expt:  002776 aa 000072 3360 07 2126 lcq -fn_expt,dl  002777 aa 777774 6250 00 2127 eax5 -4 "we have two args  003000 0a 000637 7000 00 2128 tsx0 enter "enter  003001 aa 777776 6250 00 2129 eax5 -2 "look at second arg 003002 0a 001107 7000 00 2130 tsx0 numval  003003 0a 003006 7100 00 2131 tra expt_x_sfx 003004 0a 003141 7100 00 2132 tra expt_x_sfl 003005 0a 003313 7100 00 2133 tra expt_x_bfx 003006 2134 expt_x_sfx: 003006 aa 777774 6250 00 2135 eax5 -4 "look at other arg  003007 0a 001107 7000 00 2136 tsx0 numval  003010 0a 003013 7100 00 2137 tra expt_sfx_sfx  003011 0a 003104 7100 00 2138 tra expt_sfl_sfx  003012 0a 003204 7100 00 2139 tra expt_bfx_sfx  003013 2140 expt_sfx_sfx:  003013 aa 0 77777 2341 00 2141 szn ap|-1 "to what are we raising it?  003014 0a 001140 6000 00 2142 tze return_1 "x**0 is 1  003015 0a 000067 6040 00 2143 tmi badarg "only positive exponents allowed  003016 aa 0 77775 2361 00 2144 ldq ap|-3 "get base  003017 0a 001132 6000 00 2145 tze return_0 "zero to anything but zer o is zero 003020 aa 000001 1160 07 2146 cmpq 1,dl "one to anything but zero is one  003021 0a 001140 6000 00 2147 tze return_1  003022 0a 004205 1160 00 2148 cmpq =-1 "minus one is almost as easy  003023 0a 003031 6010 00 2149 tnz expt_sfx_sfx_nmo "nmo => not minus one  003024 aa 0 77777 2351 00 2150 lda ap|-1 "load power  003025 aa 000001 3150 07 2151 cana 1,dl "test for even/odd 003026 aa 000002 6010 04 2152 tnz 2,ic "transfer if odd (leaving -1 in q)  003027 aa 000001 2360 07 2153 ldq 1,dl  003030 0a 001163 7100 00 2154 tra return_sfx 003031 2155 expt_sfx_sfx_nmo:  003031 aa 0 77777 2351 00 2156 lda ap|-1 "load power  003032 aa 000001 1150 07 2157 cmpa 1,dl "special cas e one 003033 0a 001163 6000 00 2158 tze return_sfx 003034 aa 2 00036 7551 00 2159 sta bp|n "save exponent  003035 aa 2 00037 7561 00 2160 stq bp|m "save base as initial value to be squared  003036 aa 000001 2360 07 2161 ldq 1,dl "initial result 003037 aa 2 00040 7561 00 2162 stq bp|j " j is the partial result  003040 2163 expt_sfx_sfx_loop:  003040 aa 2 00036 2351 00 2164 lda bp|n "get the exponent  003041 aa 000001 3150 07 2165 cana 1,dl "is it odd?  003042 0a 003050 6000 00 2166 tze expt_sfx_sfx_even  003043 aa 2 00040 2361 00 2167 ldq bp|j  003044 aa 2 00037 4021 00 2168 mpy bp|m "multiply accumulated power * partial result  003045 0a 000176 7000 00 2169 tsx0 check_aq "is it still small?  003046 0a 003064 7100 00 2170 tra expt_sfx_sfx_big1 "no 003047 aa 2 00040 7561 00 2171 stq bp|j "store as new partial result  003050 2172 expt_sfx_sfx_even:  003050 aa 2 00036 2351 00 2173 lda bp|n "ge t the exponent  003051 aa 000001 7310 00 2174 ars 1 "get next bit  003052 0a 003062 6000 00 2175 tze expt_sfx_sfx_done "zero - done  003053 aa 2 00036 7551 00 2176 sta bp|n "save it  003054 aa 2 00037 2361 00 2177 ldq bp|m "get next power 003055 aa 2 00037 4021 00 2178 mpy bp|m  003056 0a 000176 7000 00 2179 tsx0 check_aq  003057 0a 003073 7100 00 2180 tra expt_sfx_sfx_big2  003060 aa 2 00037 7561 00 2181 stq bp|m  003061 0a 003040 7100 00 2182 tra expt_sfx_sfx_loop "do next  003062 2183 expt_sfx_sfx_done:  003062 aa 2 00040 2361 00 2184 ldq bp|j "get result 003063 0a 001163 7100 00 2185 tra return_sfx "return  003064 2186 expt_sfx_sfx_big1:  003064 aa 2 00002 7471 00 2187 stx7 bp|initial_value "need to remember where stack was  003065 0a 000241 7000 00 2188 tsx0 convert_aq_to_bfx "change j and m to bfx and join bfx  003066 aa 2 00032 6501 00 2189 sprilp bp|presultp 003067 aa 2 00037 2361 00 2190 ldq bp|m  003070 0a 000335 7000 00 2191 tsx0 convert_q_to_bfx  003071 aa 2 00034 6501 00 2192 sprilp bp|powerp  003072 0a 003244 7100 00 2193 tra expt_bfx_sfx_even  003073 2194 expt_sfx_sfx_big2:  003073 aa 2 00002 7471 00 2195 stx7 bp|initial_value "remember where stack was  003074 aa 2 00014 7571 00 2196 staq bp|temp "want j stored before m 003075 aa 2 00040 2361 00 2197 ldq bp|j  003076 0a 000335 7000 00 2198 tsx0 convert_q_to_bfx  003077 aa 2 00032 6501 00 2199 sprilp bp|presultp 003100 aa 2 00014 2371 00 2200 ldaq bp|temp  003101 0a 000241 7000 00 2201 tsx0 convert_aq_to_bfx 003102 aa 2 00034 6501 00 2202 sprilp bp|powerp  003103 0a 003227 7100 00 2203 tra expt_bfx_sfx_loop  003104 2204 expt_sfl_sfx:  003104 aa 0 77777 2351 00 2205 lda ap|-1 "to what are we raising it?  003105 0a 001143 6000 00 2206 tze return_1.0 "x**0 is one, floating point  003106 aa 2 00036 7551 00 2207 sta bp|n  003107 0a 003115 6050 00 2208 tpl expt_sfl_sfx_plus handle negative powers here 003110 aa 000000 5310 00 2209 neg 0  003111 aa 2 00036 7551 00 2210 sta bp|n  003112 aa 002400 4310 03 2211 fld =1.0,du "get inverse of base 003113 aa 0 77775 5651 00 2212 fdv ap|-3  003114 aa 000002 7100 04 2213 tra 2,ic "and store as base  003115 2214 expt_sfl_sfx_plus:  003115 aa 0 77775 4311 00 2215 fld ap|-3 "get base  003116 aa 2 00037 4551 00 2216 fst bp|m "save as multiplier 003117 aa 002400 4310 03 2217 fld =1.0,du "get initial partial result  003120 aa 2 00040 4551 00 2218 fst bp|j "save it  003121 2219 expt_sfl_sfx_loop:  003121 aa 2 00036 2351 00 2220 lda bp|n "is the current power value even?  003122 aa 000001 3150 07 2221 cana 1,dl  003123 0a 003127 6000 00 2222 tze expt_sfl_sfx_even "yes  003124 aa 2 00040 4311 00 2223 fld bp|j "odd => p. res. <- p. res. * multiplier 003125 aa 2 00037 4611 00 2224 fmp bp|m  003126 aa 2 00040 4551 00 2225 fst bp|j  003127 2226 expt_sfl_sfx_even:  003127 aa 2 00036 2351 00 2227 lda bp|n "get next bit of power  003130 aa 000001 7310 00 2228 ars 1  003131 0a 003137 6000 00 2229 tze expt_sfl_sfx_done "no more one bits => done  003132 aa 2 00036 7551 00 2230 sta bp|n "save power 003133 aa 2 00037 4311 00 2231 fld bp|m "square multiplier  003134 aa 2 00037 4611 00 2232 fmp bp|m  003135 aa 2 00037 4551 00 2233 fst bp|m  003136 0a 003121 7100 00 2234 tra expt_sfl_sfx_loop "do again  003137 2235 expt_sfl_sfx_done:  003137 aa 2 00040 4311 00 2236 fld bp|j  003140 0a 001157 7100 00 2237 tra return_sfl 2238  003141 2239 expt_x_sfl: 003141 aa 777774 6250 00 2240 eax5 -4 "look at other arg  003142 0a 001107 7000 00 2241 tsx0 numval  003143 0a 003146 7100 00 2242 tra expt_sfx_sfl  003144 0a 003146 7100 00 2243 tra expt_sfl_sfl  003145 0a 000067 7100 00 2244 tra badarg "bignum to float power not supported  2245  003146 2246 expt_sfx_sfl:  003146 2247 expt_sfl_sfl: "hard cases - call PL/I support procedure  2248  003146 aa 2 00001 6341 00 2249 ldi bp|saved_indicators flush ourselves  003147 aa 2 00000 2251 00 2250 ldx5 bp|num_of_args  003150 aa 0 00004 3501 15 2251 eppap ap|4,x5 leave just our 2 args on stack 003151 aa 000000 6270 11 2252 eax7 0,x1 flush all but caller's lp and bp  2253  003152 4a 4 00020 2501 20 2254 spriap |[stack_ptr] now enter PL/I mode  003153 4a 4 00022 7471 20 2255 stx7 |[unmkd_ptr]+1 003154 aa 1 00016 5541 00 2256 stc1 ab|in_pl1_code  003155 aa 000060 6270 00 2257 push  003156 aa 7 00040 2721 20 003157 4a 4 00034 3501 20 2258 eppap |[..lisp..]  003160 aa 6 00026 2501 00 2259 spriap sp|22  003161 0a 003202 3500 00 2260 eppap null_arg_list  003162 4a 4 00036 3521 20 2261 short_call |[expt_assistance]  003163 aa 7 00036 6701 20 003164 aa 6 00030 3701 20 003165 aa 6 00020 3521 20 2262 eppbp sp|16,* pop stack  003166 aa 7 00024 6521 00 2263 sprisp sb|20  003167 aa 2 00000 3721 00 2264 eppsp bp|0 003170 4a 4 00026 3501 20 2265 eppap |[stack_ptr],*  003171 4a 4 00024 3511 20 2266 epbpab |[unmkd_ptr],*  003172 4a 4 00022 2271 20 2267 ldx7 |[unmkd_ptr]+1 003173 aa 1 00016 4501 00 2268 stz ab|in_pl1_code 2269  003174 aa 0 77776 2371 00 2270 ldaq ap|-2 003175 aa 0 77776 3501 00 2271 eppap ap|-2  003176 aa 1 77774 3701 37 2272 epplp ab|old_lp,x7*  003177 aa 1 77776 3521 37 2273 eppbp ab|return_point,x7*  003200 aa 777774 6270 17 2274 eax7 -4,x7 003201 aa 2 00000 7101 00 2275 tra bp|0  2276  2277 even  003202 2278 null_arg_list:  003202 aa 000000 000004 2279 oct 4,0  003203 aa 000000 000000 2280  003204 2281 expt_bfx_sfx:  003204 aa 0 77777 2341 00 2282 szn ap|-1 "to what are we raising it?  003205 0a 001140 6000 00 2283 tze return_1 "x**0 is 1  003206 0a 000067 6040 00 2284 tmi badarg "only positive exponents allowed  003207 aa 0 77777 2351 00 2285 lda ap|-1 "check if x**1 003210 aa 000001 1150 07 2286 cmpa 1,dl  003211 aa 000003 6010 04 2287 tnz 3,ic  003212 aa 0 77774 2371 00 2288 ldaq ap|-4 "identity 003213 0a 001123 7100 00 2289 tra return 003214 aa 2 00036 7551 00 2290 sta bp|n "save exponent  003215 aa 2 00002 7471 00 2291 stx7 bp|initial_value "remember where umstk was  003216 aa 000001 2360 07 2292 ldq 1,dl "initial partial result is one  003217 0a 000335 7000 00 2293 tsx0 convert_q_to_bfx  003220 aa 2 00032 6501 00 2294 sprilp bp|presultp "move base to power  003221 aa 0 77774 2371 00 2295 ldaq ap|-4 003222 aa 2 00004 7571 00 2296 staq bp|resultp  003223 aa 2 00004 7261 20 2297 lxl6 bp|resultp,*  003224 0a 000046 7000 00 2298 tsx0 alloc_bfx6  003225 aa 2 00034 6501 00 2299 sprilp bp|powerp  003226 0a 000761 7060 00 2300 tsx6 move_bfx  003227 2301 expt_bfx_sfx_loop:  003227 aa 2 00036 2351 00 2302 lda bp|n "get exponent  003230 aa 000001 3150 07 2303 cana 1,dl "was it odd or even?  003231 0a 003244 6000 00 2304 tze expt_bfx_sfx_even "no 003232 aa 2 00032 2371 00 2305 ldaq bp|presultp "presult <= presult * power  003233 aa 2 00010 7571 00 2306 staq bp|smallerp  003234 aa 2 00034 2371 00 2307 ldaq bp|powerp 003235 aa 2 00006 7571 00 2308 staq bp|biggerp  003236 0a 001216 7000 00 2309 tsx0 setup_mpy_bfx 003237 0a 000771 7000 00 2310 tsx0 mpy_bfx  003240 0a 001256 7000 00 2311 tsx0 truncate_bfx  003241 aa 000000 0110 07 2312 nop 0,dl  003242 aa 2 00004 2371 00 2313 ldaq bp|resultp  003243 aa 2 00032 7571 00 2314 staq bp|presultp  003244 2315 expt_bfx_sfx_even:  003244 aa 2 00036 2351 00 2316 lda bp|n "get exponent  003245 aa 000001 7310 00 2317 ars 1 "get next bit  003246 0a 003310 6000 00 2318 tze expt_bfx_sfx_done "zero - done  003247 aa 2 00036 7551 00 2319 sta bp|n "save exponent  003250 aa 2 00034 2371 00 2320 ldaq bp|powerp "square power 003251 aa 2 00010 7571 00 2321 staq bp|smallerp  003252 aa 2 00006 7571 00 2322 staq bp|biggerp  003253 0a 001216 7000 00 2323 tsx0 setup_mpy_bfx 003254 0a 000771 7000 00 2324 tsx0 mpy_bfx  003255 0a 001256 7000 00 2325 tsx0 truncate_bfx  003256 aa 000000 0110 07 2326 nop 0,dl  003257 aa 2 00004 2371 00 2327 ldaq bp|resultp  003260 aa 2 00034 7571 00 2328 staq bp|powerp 003261 aa 2 00002 2221 00 2329 ldx2 bp|initial_value "is presult at the lowest place in umstk?  003262 aa 2 00033 1021 00 2330 cmpx2 bp|presultp+1  003263 0a 003271 6000 00 2331 tze expt_bfx_sfx_copy_p "yes  003264 aa 2 00032 2371 00 2332 ldaq bp|presultp "move it to lowest place 003265 aa 2 00004 7571 00 2333 staq bp|resultp  003266 aa 1 00000 3701 12 2334 epplp ab|0,x2  003267 aa 2 00032 6501 00 2335 sprilp bp|presultp 003270 0a 000761 7060 00 2336 tsx6 move_bfx  003271 2337 expt_bfx_sfx_copy_p:  003271 aa 2 00032 7221 20 2338 lxl2 bp|presultp,* "how low can we move power?  003272 aa 000002 6220 12 2339 eax2 2,x2  003273 aa 2 00002 0621 00 2340 adx2 bp|initial_value  003274 aa 777776 3620 03 2341 anx2 -2,du 003275 aa 1 00000 3701 12 2342 epplp ab|0,x2  003276 aa 2 00034 2371 00 2343 ldaq bp|powerp 003277 aa 2 00004 7571 00 2344 staq bp|resultp "move it  003300 aa 2 00034 6501 00 2345 sprilp bp|powerp  003301 0a 000761 7060 00 2346 tsx6 move_bfx  003302 aa 2 00034 7221 20 2347 lxl2 bp|powerp,* "truncate stack  003303 aa 000002 6220 12 2348 eax2 2,x2  003304 aa 777776 3620 03 2349 anx2 -2,du 003305 aa 2 00035 0621 00 2350 adx2 bp|powerp+1  003306 aa 000000 6270 12 2351 eax7 0,x2  003307 0a 003227 7100 00 2352 tra expt_bfx_sfx_loop  003310 2353 expt_bfx_sfx_done:  003310 aa 2 00032 2371 00 2354 ldaq bp|presultp "done - get result  003311 aa 2 00004 7571 00 2355 staq bp|resultp  003312 0a 001146 7100 00 2356 tra return_bfx "done  003313 2357 expt_x_bfx: 003313 aa 777774 6250 00 2358 eax5 -4 "look at first arg  003314 0a 001107 7000 00 2359 tsx0 numval  003315 0a 003320 7100 00 2360 tra expt_sfx_bfx  003316 0a 003334 7100 00 2361 tra expt_sfl_bfx  003317 0a 000067 7100 00 2362 tra badarg 003320 2363 expt_sfx_bfx:  003320 aa 777776 6250 00 2364 eax5 -2 "checking second arg's applicability to first - so err on 2nd  003321 aa 0 77775 2361 00 2365 ldq ap|-3 "get the base  003322 0a 001132 6000 00 2366 tze return_0 "0**x is zero (x bfx)  003323 aa 000001 1160 07 2367 cmpq 1,dl "1**x is 1 003324 0a 001140 6000 00 2368 tze return_1  003325 0a 004205 1160 00 2369 cmpq =-1 "is it -1?  003326 0a 000067 6010 00 2370 tnz badarg "that's the last legal one  003327 aa 000001 6220 00 2371 eax2 1 "check for even odd  003330 aa 0 77776 2351 72 2372 lda ap|-2,*x2  003331 aa 000001 3150 07 2373 cana 1,dl  003332 0a 001140 6000 00 2374 tze return_1  003333 0a 001163 7100 00 2375 tra return_sfx "-1 left in q  003334 2376 expt_sfl_bfx:  003334 aa 777776 6250 00 2377 eax5 -2 "similar to sfx_bfx  003335 aa 0 77775 4311 00 2378 fld ap|-3  003336 0a 001135 6000 00 2379 tze return_0.0 003337 aa 002400 5150 03 2380 fcmp =1.0,du  003340 0a 001143 6000 00 2381 tze return_1.0 003341 aa 001000 5150 03 2382 fcmp =-1.0,du  003342 0a 000067 6010 00 2383 tnz badarg 003343 aa 000001 6220 00 2384 eax2 1 003344 aa 0 77776 2351 72 2385 lda ap|-2,*x2  003345 aa 000001 3150 07 2386 cana 1,dl  003346 0a 001143 6000 00 2387 tze return_1.0 003347 aa 001000 4310 03 2388 fld =-1.0,du  003350 0a 001157 7100 00 2389 tra return_sfl 2390 "  2391 "  003351 aa 000224 3360 07 2392 haipart: lcq -fn_haipart,dl 003352 aa 777774 6250 00 2393 eax5 -4  003353 0a 000637 7000 00 2394 tsx0 enter 003354 aa 777776 6250 00 2395 eax5 -2  003355 0a 001107 7000 00 2396 tsx0 numval " check second arg type. 003356 0a 003361 7100 00 2397 tra haipart_ok 003357 0a 000067 7100 00 2398 tra badarg 003360 0a 000067 7100 00 2399 tra badarg 2400  003361 2401 haipart_ok: 003361 aa 777774 6250 00 2402 eax5 -4  003362 0a 001107 7000 00 2403 tsx0 numval " branck on first arg type.  003363 0a 003366 7100 00 2404 tra haipart_sfx  003364 0a 000067 7100 00 2405 tra badarg 003365 0a 003426 7100 00 2406 tra haipart_bfx  2407  003366 2408 haipart_sfx:  003366 aa 0 00001 2351 15 2409 lda ap|1,x5 " get first argument into A  003367 0a 001070 7000 00 2410 tsx0 norm_a " and get number of significant bits in it.  003370 aa 000044 7370 00 2411 lls 36 " move length to A,  003371 aa 0 00001 2361 15 2412 ldq ap|1,x5 " and get argument 1.  003372 aa 000003 6050 04 2413 tpl 3,ic " if negative, make positive  003373 0a 004205 6760 00 2414 erq =-1 " avoiding fixedoverflow 003374 aa 000001 0360 07 2415 adlq 1,dl " by negating with two instructions.  003375 aa 0 00003 4051 15 2416 cmg ap|3,x5 " compare length to |arg 2|  003376 0a 003413 6000 00 2417 tze simple_haipart_sfx " if length <= |arg 2| 003377 0a 003413 6040 00 2418 tmi simple_haipart_sfx 2419  003400 aa 0 00003 2341 15 2420 szn ap|3,x5 " get sign of second arg.  003401 0a 001132 6000 00 2421 tze return_0 " if second arg 0, the result is 0. 003402 0a 003406 6040 00 2422 tmi haipart_sfx_rem " if negative, do remainder  003403 aa 0 00003 1751 15 2423 sba ap|3,x5 " get power of 2 to divide by  003404 aa 000000 7720 05 2424 qrl 0,al " shift down top part of word.  003405 0a 001163 7100 00 2425 tra return_sfx 2426  003406 2427 haipart_sfx_rem:  003406 aa 000044 2350 07 2428 lda 36,dl " get amount to delete from front  003407 aa 0 00003 0751 15 2429 ada ap|3,x5 " which is 36-number of bits wanted. 003410 aa 000000 7360 05 2430 qls 0,al  003411 aa 000000 7720 05 2431 qrl 0,al  003412 0a 001163 7100 00 2432 tra return_sfx 2433  003413 2434 simple_haipart_sfx: " return absolute value, which is in q.  003413 aa 400000 1160 03 2435 cmpq =o400000,du " check for screw case, which is bignum. 003414 0a 001163 6010 00 2436 tnz return_sfx " otherwise return small number.  003415 aa 1 00000 3701 17 2437 epplp ab|0,x7 " get space for bignum.  003416 aa 000004 6270 17 2438 eax7 4,x7 " on unmarked stack  003417 aa 000002 2350 07 2439 lda 2,dl " 2 words long, 003420 aa 4 00000 7551 00 2440 sta lp|0  003421 aa 4 00001 4501 00 2441 stz lp|1 " a zero word, and  003422 aa 000001 2350 07 2442 lda 1,dl " a one word  003423 aa 4 00002 7551 00 2443 sta lp|2  003424 aa 2 00004 6501 00 2444 sprilp bp|resultp " set result  003425 0a 001146 7100 00 2445 tra return_bfx " and return bignum.  2446  2447  2448 "  2449 "  2450 "  003426 2451 haipart_bfx:  003426 aa 0 00000 3701 35 2452 epplp ap|0,x5* " get pointer to first argument.  003427 aa 4 00000 7221 00 2453 lxl2 lp|0 " and length.  003430 aa 4 00000 2351 12 2454 lda lp|0,x2 " get last word  003431 0a 001070 7000 00 2455 tsx0 norm_a " count number of bits in it 003432 aa 2 00014 7561 00 2456 stq bp|temp " and save the count 003433 aa 777777 6360 12 2457 eaq -1,x2 " get number of whole words in argument  003434 aa 000022 7320 00 2458 qrs 18 003435 aa 000043 4020 07 2459 mpy 35,dl " get length in bits  003436 aa 2 00014 0761 00 2460 adq bp|temp " ...  2461  003437 aa 000044 7370 00 2462 lls 36 " compare bit length  003440 aa 0 00003 4051 15 2463 cmg ap|3,x5 " with secons argument.  003441 0a 003534 6040 00 2464 tmi simple_haipart_bfx " if second arg specifies more bits,  003442 0a 003534 6000 00 2465 tze simple_haipart_bfx " just do the right thing  003443 aa 0 00003 2341 15 2466 szn ap|3,x5 " check whether to do remainder  003444 0a 001132 6000 00 2467 tze return_0 " return zero if no bits asked for  003445 aa 000003 6050 04 2468 tpl 3,ic " if remainder, 003446 aa 0 00003 3351 15 2469 lca ap|3,x5 " get number of bits.  003447 aa 000002 7100 04 2470 tra 2,ic  003450 aa 0 00003 1751 15 2471 sba ap|3,x5 " else subtract 2nd arg. 2472  003451 aa 000044 7730 00 2473 lrl 36 " determine how many bits are to be divided off the right 003452 aa 000043 5060 07 2474 div 35,dl " A contains number of bits,  2475 " Q contains number of whole words.  2476  003453 aa 0 00003 2341 15 2477 szn ap|3,x5 " check again whether to remainder  003454 0a 003504 6040 00 2478 tmi haipart_bfx_rem  2479  003455 aa 2 00021 7551 00 2480 sta bp|shift_value 003456 aa 000022 7360 00 2481 qls 18 003457 aa 2 00014 7561 00 2482 stq bp|temp " savenumber of words to truncate from right.  003460 aa 4 00000 7261 00 2483 lxl6 lp|0 " compute length of result 003461 aa 2 00014 1661 00 2484 sbx6 bp|temp " by subtracting off number of words truncated. 003462 aa 2 00015 7461 00 2485 stx6 bp|temp+1 " save size in words of result  003463 aa 2 00014 2231 00 2486 ldx3 bp|temp " get offset for mlr below  003464 0a 000046 7000 00 2487 tsx0 alloc_bfx6 " allocate result on stack  003465 aa 2 00004 6501 00 2488 sprilp bp|resultp " and save location.  003466 aa 2 00015 2221 00 2489 ldx2 bp|temp+1 " set the length of the result.  003467 aa 4 00000 4421 00 2490 sxl2 lp|0 " note that the sign is zero.  003470 aa 0 00000 3535 35 2491 eppbb ap|0,x5* " bb -> place copied from.  003471 aa 3 00000 3535 13 2492 eppbb bb|0,x3 " offset by number of words dropped  003472 aa 000000 6360 12 2493 eaq 0,x2 " qu := # words to copy (not header)  003473 aa 000002 7360 00 2494 qls 2 " convert # words to # characters  003474 aa 0 00140 1005 40 2495 mlr (pr,rl),(pr,rl)  003475 aa 300001 000002 2496 desc9a bb|1,qu 003476 aa 400001 000002 2497 desc9a lp|1,qu 003477 0a 001167 7000 00 2498 tsx0 rsh_bfx " shift bfx right by amount required.  003500 0a 001256 7000 00 2499 tsx0 truncate_bfx  003501 0a 001146 7100 00 2500 tra return_bfx 003502 0a 000317 7000 00 2501 tsx0 convert_bfx_to_sfx " truncate skipped, so make sfx  003503 0a 001123 7100 00 2502 tra return 2503  2504  003504 2505 haipart_bfx_rem: " remainder operation.  003504 aa 000044 1750 07 2506 sba 36,dl  003505 aa 000000 5310 00 2507 neg 0 " get amount to delete from high order word.  003506 aa 2 00021 7551 00 2508 sta bp|shift_value 003507 aa 000001 6260 06 2509 eax6 1,ql " allocate this many words.  003510 aa 2 00015 7461 00 2510 stx6 bp|temp+1 003511 0a 000046 7000 00 2511 tsx0 alloc_bfx6 " allocate the bfx on stack.  003512 aa 2 00004 6501 00 2512 sprilp bp|resultp  003513 aa 2 00015 2221 00 2513 ldx2 bp|temp+1 003514 aa 4 00000 4421 00 2514 sxl2 lp|0 " set length of result.  2515  003515 aa 0 00000 3535 35 2516 eppbb ap|0,x5* " get pointer to argument.  003516 aa 000000 6360 12 2517 eaq 0,x2 " compute length of stuff after header, in characters  003517 aa 000004 4020 07 2518 mpy 4,dl  003520 aa 0 00140 1005 40 2519 mlr (pr,rl),(pr,rl)  003521 aa 300001 000002 2520 desc9a bb|1,qu 003522 aa 400001 000002 2521 desc9a lp|1,qu 2522  003523 aa 4 00000 2351 12 2523 lda lp|0,x2 " get high order word  003524 aa 2 00021 7231 00 2524 lxl3 bp|shift_value " get amount to delete  003525 aa 000000 7350 13 2525 als 0,x3  003526 aa 000000 7710 13 2526 arl 0,x3  003527 aa 4 00000 7551 12 2527 sta lp|0,x2 " put back word after deleteion. 2528  003530 0a 001256 7000 00 2529 tsx0 truncate_bfx  003531 0a 001146 7100 00 2530 tra return_bfx 003532 0a 000317 7000 00 2531 tsx0 convert_bfx_to_sfx  003533 0a 001123 7100 00 2532 tra return 2533  003534 2534 simple_haipart_bfx: 003534 aa 0 00000 2371 15 2535 ldaq ap|0,x5 " get first arg.  003535 aa 4 00000 2341 00 2536 szn lp|0 " check its sign,  003536 0a 001123 6050 00 2537 tpl return " return the arg as result.  003537 aa 2 00004 7571 00 2538 staq bp|resultp " set up to cpy to result 003540 0a 000112 7000 00 2539 tsx0 call_alloc_bfx  003541 aa 000000 6220 00 2540 eax2 0 " to set sign.  003542 aa 2 00004 7421 20 2541 stx2 bp|resultp,*  003543 aa 2 00004 2371 00 2542 ldaq bp|resultp " load the name of the result 003544 aa 001000 2750 07 2543 ora Big_fixed,dl  003545 0a 001123 7100 00 2544 tra return " and return  2545 "  2546 "  2547 "  2548 "  2549 "  003546 2550 gcd:  003546 aa 000166 3360 07 2551 lcq -fn_gcd,dl "load type code of gcd 003547 aa 777774 6250 00 2552 eax5 -4 "we are a subr with 2 args  003550 0a 000637 7000 00 2553 tsx0 enter "set up environment  003551 0a 001107 7000 00 2554 tsx0 numval "look at first arg  003552 0a 003555 7100 00 2555 tra gcd_sfx  003553 0a 000067 7100 00 2556 tra badarg 003554 0a 003617 7100 00 2557 tra gcd_bfx  003555 2558 gcd_sfx:  003555 aa 0 77775 2351 00 2559 lda ap|-3 "look at first arg 003556 0a 000000 7000 00 2560 tsx0 abs_sfx_a_to_q "get abs of first arg 003557 0a 003620 7100 00 2561 tra gcd_bfx_join "if too big, join big code  003560 aa 2 00010 7561 00 2562 stq bp|divisor "save it  003561 aa 777776 6250 00 2563 eax5 -2 "check second arg  003562 0a 001107 7000 00 2564 tsx0 numval  003563 0a 003566 7100 00 2565 tra gcd_ss 003564 0a 000067 7100 00 2566 tra badarg 003565 0a 003605 7100 00 2567 tra gcd_sb 003566 2568 gcd_ss: 003566 aa 0 77777 2351 00 2569 lda ap|-1 "load second arg  003567 0a 000000 7000 00 2570 tsx0 abs_sfx_a_to_q "get abs  003570 0a 003606 7100 00 2571 tra gcd_sb_join "too big  003571 aa 2 00010 2341 00 2572 szn bp|divisor "test for zero operands => return abs of other 003572 0a 001163 6000 00 2573 tze return_sfx "answer is in q already  003573 aa 000000 1160 07 2574 cmpq 0,dl "test other one  003574 0a 003577 6010 00 2575 tnz gcd_ss_loop  003575 aa 2 00010 2361 00 2576 ldq bp|divisor 003576 0a 001163 7100 00 2577 tra return_sfx 003577 2578 gcd_ss_loop:  003577 aa 2 00010 5061 00 2579 div bp|divisor "get remainder of (q) and divisor  003600 2580 gcd_ss_loop1:  003600 aa 2 00010 2361 00 2581 ldq bp|divisor "replace (q) with other value 003601 aa 2 00010 7551 00 2582 sta bp|divisor "replace other with remainder  003602 aa 000000 1150 07 2583 cmpa 0,dl "if remainder was zero, done, otherwise, loop  003603 0a 003577 6010 00 2584 tnz gcd_ss_loop  003604 0a 001163 7100 00 2585 tra return_sfx "old other value (in q now) is result  003605 2586 gcd_sb: 003605 aa 0 77776 3701 20 2587 epplp ap|-2,* "get ptr to big arg  003606 2588 gcd_sb_join:  003606 aa 2 00006 6501 00 2589 sprilp bp|biggerp "save it  003607 2590 gcd_sb_do:  003607 aa 2 00010 2341 00 2591 szn bp|divisor "test smallnum for 0 (big can't be zero)  003610 0a 003633 6000 00 2592 tze gcd_bs0  003611 aa 2 00006 7261 20 2593 lxl6 bp|biggerp,* "alloc space for quotient, which we ignore  003612 0a 000046 7000 00 2594 tsx0 alloc_bfx6  003613 aa 2 00004 6501 00 2595 sprilp bp|resultp  003614 0a 000622 7000 00 2596 tsx0 div_bs "do a divide 003615 aa 000044 7370 00 2597 lls 36 "put in the a the remainder (now in q)  003616 0a 003600 7100 00 2598 tra gcd_ss_loop1 "join other code 003617 2599 gcd_bfx:  003617 aa 0 77774 3701 20 2600 epplp ap|-4,* "get ptr to big num  003620 2601 gcd_bfx_join:  003620 aa 2 00006 6501 00 2602 sprilp bp|biggerp "store the ptr to big num  003621 aa 777776 6250 00 2603 eax5 -2 "look at second arg  003622 0a 001107 7000 00 2604 tsx0 numval  003623 0a 003626 7100 00 2605 tra gcd_bs 003624 0a 000067 7100 00 2606 tra badarg 003625 0a 003643 7100 00 2607 tra gcd_bb 003626 2608 gcd_bs: 003626 aa 0 77777 2351 00 2609 lda ap|-1 "get small num 003627 0a 000000 7000 00 2610 tsx0 abs_sfx_a_to_q  003630 0a 003644 7100 00 2611 tra gcd_bb_join  003631 aa 2 00010 7561 00 2612 stq bp|divisor "save it  003632 0a 003607 7100 00 2613 tra gcd_sb_do "join other big/small code 003633 2614 gcd_bs0:  003633 aa 2 00006 3701 20 2615 epplp bp|biggerp,* "get copy of big arg, and abs of it  003634 aa 2 00004 6501 00 2616 sprilp bp|resultp  003635 0a 000112 7000 00 2617 tsx0 call_alloc_bfx "get copy into lisp space 003636 aa 000000 6220 00 2618 eax2 0 "set sign to plus 003637 aa 2 00004 7421 20 2619 stx2 bp|resultp,*  003640 aa 2 00004 2371 00 2620 ldaq bp|resultp "set up return  003641 aa 001000 2750 07 2621 ora Big_fixed,dl  003642 0a 001123 7100 00 2622 tra return 003643 2623 gcd_bb: 003643 aa 0 77776 3701 20 2624 epplp ap|-2,* "get ptr to second arg 003644 2625 gcd_bb_join:  003644 aa 2 00010 6501 00 2626 sprilp bp|smallerp "save it  003645 aa 4 00000 7221 00 2627 lxl2 lp|0 "make sure bigger is bigger  003646 aa 2 00013 7421 00 2628 stx2 bp|small_limit  003647 aa 2 00006 7221 20 2629 lxl2 bp|biggerp,*  003650 aa 2 00012 7421 00 2630 stx2 bp|big_limit  003651 0a 000203 7000 00 2631 tsx0 compare_bfx  003652 0a 001235 7000 00 2632 tsx0 switch_bfx  003653 aa 000000 0110 07 2633 nop 0,dl  003654 aa 000000 0110 07 2634 nop 0,dl  003655 aa 2 00012 2261 00 2635 ldx6 bp|big_limit "put bigger of two in u, smaller in v  003656 0a 000046 7000 00 2636 tsx0 alloc_bfx6  003657 aa 2 00052 6501 00 2637 sprilp bp|up  003660 aa 2 00006 2371 00 2638 ldaq bp|biggerp  003661 aa 2 00004 7571 00 2639 staq bp|resultp  003662 0a 000761 7060 00 2640 tsx6 move_bfx  003663 aa 2 00013 2261 00 2641 ldx6 bp|small_limit  003664 0a 000046 7000 00 2642 tsx0 alloc_bfx6  003665 aa 2 00054 6501 00 2643 sprilp bp|vp  003666 aa 2 00010 2371 00 2644 ldaq bp|smallerp  003667 aa 2 00004 7571 00 2645 staq bp|resultp  003670 0a 000761 7060 00 2646 tsx6 move_bfx  003671 aa 000000 6220 00 2647 eax2 0 "set signs to zero - i.e. get abs 003672 aa 2 00052 7421 20 2648 stx2 bp|up,*  003673 aa 2 00054 7421 20 2649 stx2 bp|vp,*  003674 aa 2 00002 7471 00 2650 stx7 bp|initial_value "save stack end - so we can truncate garbage  003675 2651 gcd_bb_l1:  003675 aa 2 00054 2351 20 2652 lda bp|vp,* "check that we don't have to go to gcd_bs  003676 aa 000001 1150 07 2653 cmpa 1,dl "is length 1?  003677 0a 004132 6000 00 2654 tze gcd_bb_to_bs  003700 aa 2 00052 1151 20 2655 cmpa bp|up,* "make sure lengths are same (sign is 0, so lda) 003701 0a 004105 6010 00 2656 tnz gcd_bb_doremain "if not equal, then make like Euclid  003702 aa 2 00052 2361 65 2657 ldq bp|up,*al "high order word is used for quicky calculation  003703 aa 2 00066 7561 00 2658 stq bp|uh "u hat 003704 aa 2 00054 2361 65 2659 ldq bp|vp,*al  003705 aa 2 00067 7561 00 2660 stq bp|vh "v hat 003706 aa 000001 2360 07 2661 ldq 1,dl "set A,D = 1  003707 aa 2 00070 7561 00 2662 stq bp|A  003710 aa 2 00073 7561 00 2663 stq bp|D  003711 aa 2 00071 4501 00 2664 stz bp|B "and B, C = 0  003712 aa 2 00072 4501 00 2665 stz bp|C  003713 2666 gcd_bb_l2:  003713 aa 2 00067 2361 00 2667 ldq bp|vh "follow Lehmer's alg in Knuth  003714 aa 2 00072 0361 00 2668 adlq bp|C  003715 0a 003763 6000 00 2669 tze gcd_bb_l4  003716 aa 2 00014 7561 00 2670 stq bp|temp  003717 aa 2 00066 2361 00 2671 ldq bp|uh  003720 aa 2 00070 0361 00 2672 adlq bp|A  003721 0a 003763 6040 00 2673 tmi gcd_bb_l4 "overflow  003722 aa 2 00014 5061 00 2674 div bp|temp  003723 aa 2 00051 7561 00 2675 stq bp|q  003724 aa 2 00067 2361 00 2676 ldq bp|vh  003725 aa 2 00073 0361 00 2677 adlq bp|D  003726 0a 003763 6000 00 2678 tze gcd_bb_l4  003727 0a 003763 6040 00 2679 tmi gcd_bb_l4  003730 aa 2 00014 7561 00 2680 stq bp|temp  003731 aa 2 00066 2361 00 2681 ldq bp|uh  003732 aa 2 00071 0361 00 2682 adlq bp|B  003733 aa 2 00014 5061 00 2683 div bp|temp  003734 aa 2 00051 1161 00 2684 cmpq bp|q  003735 0a 003763 6010 00 2685 tnz gcd_bb_l4  003736 2686 gcd_bb_l3:  003736 aa 2 00072 4021 00 2687 mpy bp|C  003737 aa 000000 5330 00 2688 negl 0 003740 aa 2 00070 0331 00 2689 adl bp|A  003741 aa 2 00072 2351 00 2690 lda bp|C  003742 aa 2 00070 7551 00 2691 sta bp|A  003743 aa 2 00072 7561 00 2692 stq bp|C  003744 aa 2 00051 2361 00 2693 ldq bp|q  003745 aa 2 00073 4021 00 2694 mpy bp|D  003746 aa 000000 5330 00 2695 negl 0 003747 aa 2 00071 0331 00 2696 adl bp|B  003750 aa 2 00073 2351 00 2697 lda bp|D  003751 aa 2 00071 7551 00 2698 sta bp|B  003752 aa 2 00073 7561 00 2699 stq bp|D  003753 aa 2 00051 2361 00 2700 ldq bp|q  003754 aa 2 00067 4021 00 2701 mpy bp|vh  003755 aa 000000 5330 00 2702 negl 0 003756 aa 2 00066 0331 00 2703 adl bp|uh  003757 aa 2 00067 2351 00 2704 lda bp|vh  003760 aa 2 00066 7551 00 2705 sta bp|uh  003761 aa 2 00067 7561 00 2706 stq bp|vh  003762 0a 003713 7100 00 2707 tra gcd_bb_l2  003763 2708 gcd_bb_l4:  003763 aa 2 00071 2341 00 2709 szn bp|B  003764 0a 004105 6000 00 2710 tze gcd_bb_doremain  003765 aa 2 00052 3701 20 2711 epplp bp|up,* "calc Au, Bv, Cu, and Dv, then combine 003766 aa 2 00006 6501 00 2712 sprilp bp|biggerp  003767 aa 4 00000 7261 00 2713 lxl6 lp|0  003770 aa 000001 6260 16 2714 eax6 1,x6  003771 0a 000046 7000 00 2715 tsx0 alloc_bfx6  003772 aa 2 00004 6501 00 2716 sprilp bp|resultp  003773 aa 2 00056 6501 00 2717 sprilp bp|ptemp1  003774 aa 000000 6220 00 2718 eax2 0 003775 aa 2 00070 2351 00 2719 lda bp|A  003776 aa 000003 6050 04 2720 tpl 3,ic "set sign of result 003777 aa 000000 5310 00 2721 neg 0  004000 aa 777777 6220 00 2722 eax2 -1  004001 aa 4 00000 7421 00 2723 stx2 lp|0  004002 aa 2 00010 7551 00 2724 sta bp|multiplier  004003 0a 001045 7000 00 2725 tsx0 mpy_bs  004004 aa 2 00054 3701 20 2726 epplp bp|vp,*  004005 aa 2 00006 6501 00 2727 sprilp bp|biggerp  004006 aa 4 00000 7261 00 2728 lxl6 lp|0  004007 aa 000001 6260 16 2729 eax6 1,x6  004010 0a 000046 7000 00 2730 tsx0 alloc_bfx6  004011 aa 2 00004 6501 00 2731 sprilp bp|resultp  004012 aa 2 00060 6501 00 2732 sprilp bp|ptemp2  004013 aa 000000 6220 00 2733 eax2 0 004014 aa 2 00071 2351 00 2734 lda bp|B  004015 aa 000003 6050 04 2735 tpl 3,ic  004016 aa 000000 5310 00 2736 neg 0  004017 aa 777777 6220 00 2737 eax2 -1  004020 aa 4 00000 7421 00 2738 stx2 lp|0  004021 aa 2 00010 7551 00 2739 sta bp|multiplier  004022 0a 001045 7000 00 2740 tsx0 mpy_bs  004023 aa 2 00052 3701 20 2741 epplp bp|up,*  004024 aa 2 00006 6501 00 2742 sprilp bp|biggerp  004025 aa 4 00000 7261 00 2743 lxl6 lp|0  004026 aa 000001 6260 16 2744 eax6 1,x6  004027 0a 000046 7000 00 2745 tsx0 alloc_bfx6  004030 aa 2 00004 6501 00 2746 sprilp bp|resultp  004031 aa 2 00062 6501 00 2747 sprilp bp|ptemp3  004032 aa 000000 6220 00 2748 eax2 0 004033 aa 2 00072 2351 00 2749 lda bp|C  004034 aa 000003 6050 04 2750 tpl 3,ic  004035 aa 000000 5310 00 2751 neg 0  004036 aa 777777 6220 00 2752 eax2 -1  004037 aa 4 00000 7421 00 2753 stx2 lp|0  004040 aa 2 00010 7551 00 2754 sta bp|multiplier  004041 0a 001045 7000 00 2755 tsx0 mpy_bs  004042 aa 2 00054 3701 20 2756 epplp bp|vp,*  004043 aa 2 00006 6501 00 2757 sprilp bp|biggerp  004044 aa 4 00000 7261 00 2758 lxl6 lp|0  004045 aa 000001 6260 16 2759 eax6 1,x6  004046 0a 000046 7000 00 2760 tsx0 alloc_bfx6  004047 aa 2 00004 6501 00 2761 sprilp bp|resultp  004050 aa 2 00064 6501 00 2762 sprilp bp|ptemp4  004051 aa 000000 6220 00 2763 eax2 0 004052 aa 2 00073 2351 00 2764 lda bp|D  004053 aa 000003 6050 04 2765 tpl 3,ic  004054 aa 000000 5310 00 2766 neg 0  004055 aa 777777 6220 00 2767 eax2 -1  004056 aa 4 00000 7421 00 2768 stx2 lp|0  004057 aa 2 00010 7551 00 2769 sta bp|multiplier  004060 0a 001045 7000 00 2770 tsx0 mpy_bs  004061 aa 2 00056 2371 00 2771 ldaq bp|ptemp1 "do the combining 004062 aa 2 00006 7571 00 2772 staq bp|biggerp  004063 aa 2 00060 2371 00 2773 ldaq bp|ptemp2 004064 aa 2 00010 7571 00 2774 staq bp|smallerp  004065 aa 2 00052 2371 00 2775 ldaq bp|up 004066 aa 2 00004 7571 00 2776 staq bp|resultp  004067 0a 000006 7000 00 2777 tsx0 add_bb  004070 0a 001256 7000 00 2778 tsx0 truncate_bfx  004071 aa 000000 0110 07 2779 nop 0,dl  004072 aa 2 00062 2371 00 2780 ldaq bp|ptemp3 004073 aa 2 00006 7571 00 2781 staq bp|biggerp  004074 aa 2 00064 2371 00 2782 ldaq bp|ptemp4 004075 aa 2 00010 7571 00 2783 staq bp|smallerp  004076 aa 2 00054 2371 00 2784 ldaq bp|vp 004077 aa 2 00004 7571 00 2785 staq bp|resultp  004100 0a 000006 7000 00 2786 tsx0 add_bb  004101 0a 001256 7000 00 2787 tsx0 truncate_bfx  004102 aa 000000 0110 07 2788 nop 0,dl  004103 aa 2 00002 2271 00 2789 ldx7 bp|initial_value "release all scratch space used above  004104 0a 003675 7100 00 2790 tra gcd_bb_l1 "go around again  004105 2791 gcd_bb_doremain:  004105 aa 2 00052 2371 00 2792 ldaq bp|up 004106 aa 2 00006 7571 00 2793 staq bp|biggerp  004107 aa 2 00054 2371 00 2794 ldaq bp|vp 004110 aa 2 00010 7571 00 2795 staq bp|smallerp "do normal remainder way 004111 0a 000364 7000 00 2796 tsx0 div_bb  004112 aa 2 00054 3701 20 2797 epplp bp|vp,*  004113 aa 2 00004 6501 00 2798 sprilp bp|resultp  004114 aa 2 00052 3701 20 2799 epplp bp|up,*  004115 0a 000761 7060 00 2800 tsx6 move_bfx "move v to u  004116 aa 2 00036 2221 00 2801 ldx2 bp|n "normalize remainder, and put in v 004117 aa 2 00026 3701 20 2802 epplp bp|dividendp,*  004120 aa 4 00000 4501 00 2803 stz lp|0 "make positive  004121 aa 4 00000 4421 00 2804 sxl2 lp|0 "store size  004122 aa 2 00004 6501 00 2805 sprilp bp|resultp  004123 0a 001167 7000 00 2806 tsx0 rsh_bfx  004124 0a 001256 7000 00 2807 tsx0 truncate_bfx  004125 aa 000000 0110 07 2808 nop 0,dl  004126 aa 2 00054 3701 20 2809 epplp bp|vp,*  004127 0a 000761 7060 00 2810 tsx6 move_bfx  004130 aa 2 00002 2271 00 2811 ldx7 bp|initial_value "clean up mess  004131 0a 003675 7100 00 2812 tra gcd_bb_l1  004132 2813 gcd_bb_to_bs:  004132 aa 2 00054 3701 20 2814 epplp bp|vp,* "set up for bs 004133 aa 2 00004 6501 00 2815 sprilp bp|resultp  004134 0a 000317 7000 00 2816 tsx0 convert_bfx_to_sfx "make the smaller one an sfx  004135 aa 2 00010 7561 00 2817 stq bp|divisor 004136 aa 2 00052 3701 20 2818 epplp bp|up,*  004137 0a 003606 7100 00 2819 tra gcd_sb_join  2820 "  2821 "  004140 aa 000223 3360 07 2822 haulong: lcq -fn_haulong,dl " function to count significant bits in a number.  004141 aa 777776 6250 00 2823 eax5 -2  004142 0a 000637 7000 00 2824 tsx0 enter " set up. 004143 0a 001107 7000 00 2825 tsx0 numval " check argument type.  004144 0a 004147 7100 00 2826 tra haulong_sfx  004145 0a 000067 7100 00 2827 tra badarg 004146 0a 004152 7100 00 2828 tra haulong_bfx  004147 2829 haulong_sfx: " single precision haulong. 004147 aa 0 00001 2351 15 2830 lda ap|1,x5 " load argument. 004150 0a 001070 7000 00 2831 tsx0 norm_a " normalize it  004151 0a 001163 7100 00 2832 tra return_sfx " return Q, which contains number of significant bits. 2833  004152 2834 haulong_bfx:  004152 aa 0 00000 3701 35 2835 epplp ap|0,x5* " get pointer to bignum  004153 aa 4 00000 7221 00 2836 lxl2 lp|0 " get number words in bignum  004154 aa 4 00000 2351 12 2837 lda lp|0,x2 " load the most significant word.  004155 0a 001070 7000 00 2838 tsx0 norm_a " get number of significant bits in Q.  004156 aa 2 00014 7561 00 2839 stq bp|temp " and remember for later.  004157 aa 777777 6360 12 2840 eaq -1,x2 " get number of words in bignum in Q.  004160 aa 000022 7320 00 2841 qrs 18 004161 aa 000043 4020 07 2842 mpy 35,dl " 35 bits per word.  004162 aa 2 00014 0761 00 2843 adq bp|temp  004163 0a 001163 7100 00 2844 tra return_sfx 2845 end  ENTRY SEQUENCES  004164 5a 000017 0000 00 004165 aa 7 00046 2721 20 004166 0a 002027 7100 00 004167 5a 000012 0000 00 004170 aa 7 00046 2721 20 004171 0a 002211 7100 00 LITERALS 004172 aa 000000 000000 004173 aa 400000 000000 004174 aa 000000 000000 004175 aa 000000 000000 004176 aa 777777 777777 004177 aa 400000 000000 004200 aa 000000 000000 004201 aa 400000 000000 004202 aa 777760 000000 004203 aa 777777 000002 004204 aa 377777 777777 004205 aa 777777 777777 004206 aa 002400 000000 004210 aa 000000 000001 004211 aa 000000 000000 004212 aa 000000 000002 004213 aa 000000 000000 004214 aa 104452 013710 NAME DEFINITIONS FOR ENTRY POINTS AND SEGDEFS 004215 5a 000003 000000 004216 5a 000213 600000 004217 aa 000000 000000 004220 55 000012 000002 004221 5a 000002 400003 004222 55 000006 000012 004223 aa 015 154 151 163 004224 aa 160 137 142 151 004225 aa 147 156 165 155 004226 aa 163 137 000 000 004227 55 000017 000003 004230 0a 004170 500000 004231 55 000015 000003 004232 aa 006 142 156 162 bnread  004233 aa 145 141 144 000 004234 55 000024 000012 004235 0a 004165 500000 004236 55 000022 000003 004237 aa 007 142 156 160 bnprint 004240 aa 162 151 156 164 004241 55 000030 000017 004242 0a 003546 400000 004243 55 000027 000003 004244 aa 003 147 143 144 gcd 004245 55 000035 000024 004246 0a 003351 400000 004247 55 000033 000003 004250 aa 007 150 141 151 haipart 004251 aa 160 141 162 164 004252 55 000042 000030 004253 0a 004140 400000 004254 55 000040 000003 004255 aa 007 150 141 165 haulong 004256 aa 154 157 156 147 004257 55 000047 000035 004260 0a 002776 400000 004261 55 000045 000003 004262 aa 004 145 170 160 expt  004263 aa 164 000 000 000 004264 55 000055 000042 004265 0a 002660 400000 004266 55 000052 000003 004267 aa 011 162 145 155 remainder  004270 aa 141 151 156 144 004271 aa 145 162 000 000 004272 55 000063 000047 004273 0a 002636 400000 004274 55 000060 000003 004275 aa 010 147 162 145 greaterp  004276 aa 141 164 145 162 004277 aa 160 000 000 000 004300 55 000070 000055 004301 0a 002616 400000 004302 55 000066 000003 004303 aa 005 154 145 163 lessp  004304 aa 163 160 000 000 004305 55 000074 000063 004306 0a 002601 400000 004307 55 000073 000003 004310 aa 003 155 151 156 min 004311 55 000100 000070 004312 0a 002457 400000 004313 55 000077 000003 004314 aa 003 155 141 170 max 004315 55 000105 000074 004316 0a 002435 400000 004317 55 000103 000003 004320 aa 005 160 154 165 plusp  004321 aa 163 160 000 000 004322 55 000112 000100 004323 0a 002415 400000 004324 55 000110 000003 004325 aa 006 155 151 156 minusp  004326 aa 165 163 160 000 004327 55 000116 000105 004330 0a 002355 400000 004331 55 000115 000003 004332 aa 003 141 142 163 abs 004333 55 000123 000112 004334 0a 002317 400000 004335 55 000121 000003 004336 aa 005 155 151 156 minus  004337 aa 165 163 000 000 004340 55 000130 000116 004341 0a 002314 400000 004342 55 000126 000003 004343 aa 004 163 165 142 sub1  004344 aa 061 000 000 000 004345 55 000135 000123 004346 0a 002251 400000 004347 55 000133 000003 004350 aa 004 141 144 144 add1  004351 aa 061 000 000 000 004352 55 000142 000130 004353 0a 002171 400000 004354 55 000140 000003 004355 aa 005 146 154 157 float  004356 aa 141 164 000 000 004357 55 000146 000135 004360 0a 002076 400000 004361 55 000145 000003 004362 aa 003 146 151 170 fix 004363 55 000154 000142 004364 0a 001645 400000 004365 55 000151 000003 004366 aa 010 161 165 157 quotient  004367 aa 164 151 145 156 004370 aa 164 000 000 000 004371 55 000161 000146 004372 0a 001474 400000 004373 55 000157 000003 004374 aa 005 164 151 155 times  004375 aa 145 163 000 000 004376 55 000167 000154 004377 0a 001443 400000 004400 55 000164 000003 004401 aa 012 144 151 146 difference  004402 aa 146 145 162 145 004403 aa 156 143 145 000 004404 55 000174 000161 004405 0a 001304 400000 004406 55 000172 000003 004407 aa 004 160 154 165 plus  004410 aa 163 000 000 000 004411 55 000204 000167 004412 0a 000267 400000 004413 55 000177 000003 004414 aa 022 143 157 156 convert_bfx_to_sfl  004415 aa 166 145 162 164 004416 aa 137 142 146 170 004417 aa 137 164 157 137 004420 aa 163 146 154 000 004421 55 000002 000174 004422 6a 000000 400002 004423 55 000207 000003 004424 aa 014 163 171 155 symbol_table  004425 aa 142 157 154 137 004426 aa 164 141 142 154 004427 aa 145 000 000 000 DEFINITIONS HASH TABLE  004430 aa 000000 000065 004431 aa 000000 000000 004432 5a 000100 000000 004433 5a 000142 000000 004434 5a 000167 000000 004435 aa 000000 000000 004436 aa 000000 000000 004437 aa 000000 000000 004440 aa 000000 000000 004441 aa 000000 000000 004442 aa 000000 000000 004443 aa 000000 000000 004444 5a 000161 000000 004445 aa 000000 000000 004446 aa 000000 000000 004447 aa 000000 000000 004450 aa 000000 000000 004451 aa 000000 000000 004452 5a 000047 000000 004453 5a 000154 000000 004454 aa 000000 000000 004455 aa 000000 000000 004456 aa 000000 000000 004457 aa 000000 000000 004460 aa 000000 000000 004461 aa 000000 000000 004462 aa 000000 000000 004463 aa 000000 000000 004464 aa 000000 000000 004465 5a 000105 000000 004466 5a 000030 000000 004467 5a 000055 000000 004470 5a 000017 000000 004471 5a 000074 000000 004472 5a 000116 000000 004473 5a 000042 000000 004474 5a 000012 000000 004475 5a 000070 000000 004476 5a 000204 000000 004477 aa 000000 000000 004500 aa 000000 000000 004501 5a 000112 000000 004502 5a 000035 000000 004503 5a 000130 000000 004504 5a 000024 000000 004505 5a 000135 000000 004506 5a 000146 000000 004507 aa 000000 000000 004510 aa 000000 000000 004511 5a 000063 000000 004512 5a 000174 000000 004513 aa 000000 000000 004514 aa 000000 000000 004515 5a 000123 000000 EXTERNAL NAMES  004516 aa 017 145 170 160 expt_assistance 004517 aa 164 137 141 163 004520 aa 163 151 163 164 004521 aa 141 156 143 145 004522 aa 012 154 151 163 lisp_trig_  004523 aa 160 137 164 162 004524 aa 151 147 137 000 004525 aa 010 056 056 154 ..lisp..  004526 aa 151 163 160 056 004527 aa 056 000 000 000 004530 aa 015 154 151 163 lisp_subr_tv_  004531 aa 160 137 163 165 004532 aa 142 162 137 164 004533 aa 166 137 000 000 004534 aa 017 165 156 141 unable_to_float 004535 aa 142 154 145 137 004536 aa 164 157 137 146 004537 aa 154 157 141 164 004540 aa 020 144 151 166 division_by_zero  004541 aa 151 163 151 157 004542 aa 156 137 142 171 004543 aa 137 172 145 162 004544 aa 157 000 000 000 004545 aa 011 165 156 155 unmkd_ptr  004546 aa 153 144 137 160 004547 aa 164 162 000 000 004550 aa 011 163 164 141 stack_ptr  004551 aa 143 153 137 160 004552 aa 164 162 000 000 004553 aa 013 167 157 162 words_alloc 004554 aa 144 163 137 141 004555 aa 154 154 157 143 004556 aa 013 154 151 163 lisp_alloc_ 004557 aa 160 137 141 154 004560 aa 154 157 143 137 004561 aa 023 142 141 144 bad_arg_correctable 004562 aa 137 141 162 147 004563 aa 137 143 157 162 004564 aa 162 145 143 164 004565 aa 141 142 154 145 004566 aa 021 154 151 163 lisp_error_table_  004567 aa 160 137 145 162 004570 aa 162 157 162 137 004571 aa 164 141 142 154 004572 aa 145 137 000 000 004573 aa 012 172 165 156 zunderflow  004574 aa 144 145 162 146 004575 aa 154 157 167 000 004576 aa 021 154 151 163 lisp_static_vars_  004577 aa 160 137 163 164 004600 aa 141 164 151 143 004601 aa 137 166 141 162 004602 aa 163 137 000 000 004603 aa 013 154 151 163 lisp_error_ 004604 aa 160 137 145 162 004605 aa 162 157 162 137 NO TRAP POINTER WORDS  TYPE PAIR BLOCKS  004606 aa 000004 000000 004607 55 000305 000301 004610 aa 000004 000000 004611 55 000313 000310 004612 aa 000004 000000 004613 55 000351 000317 004614 aa 000004 000000 004615 55 000351 000323 004616 aa 000004 000000 004617 55 000361 000330 004620 aa 000004 000000 004621 55 000361 000333 004622 aa 000004 000000 004623 55 000341 000336 004624 aa 000004 000000 004625 55 000351 000344 004626 aa 000004 000000 004627 55 000361 000356 004630 aa 000004 000000 004631 55 000366 000366 004632 aa 000001 000000 004633 aa 000000 000000 INTERNAL EXPRESSION WORDS 004634 5a 000371 000000 004635 5a 000373 000000 004636 5a 000375 000000 004637 5a 000377 000000 004640 5a 000401 000000 004641 5a 000401 000001 004642 5a 000403 000000 004643 5a 000405 000000 004644 5a 000407 000000 004645 5a 000411 000000 004646 5a 000413 000000 004647 aa 000000 000000 LINKAGE INFORMATION 000000 aa 000000 000000 000001 0a 004215 000000 000002 aa 000000 000000 000003 aa 000000 000000 000004 aa 000000 000000 000005 aa 000000 000000 000006 22 000010 000040 000007 a2 000000 000000 000010 9a 777770 0000 46 lisp_error_|lisp_error_ 000011 5a 000431 0000 00 000012 9a 777766 0000 46 lisp_static_vars_|zunderflow  000013 5a 000430 0000 20 000014 9a 777764 0000 46 lisp_error_table_|bad_arg_correctable  000015 5a 000427 0000 00 000016 9a 777762 0000 46 lisp_alloc_|words_alloc 000017 5a 000426 0000 00 000020 9a 777760 0000 46 lisp_static_vars_|stack_ptr 000021 5a 000425 0000 00 000022 9a 777756 0000 46 lisp_static_vars_|unmkd_ptr 000023 5a 000424 0000 00 000024 9a 777754 0000 46 lisp_static_vars_|unmkd_ptr 000025 5a 000423 0000 20 000026 9a 777752 0000 46 lisp_static_vars_|stack_ptr 000027 5a 000425 0000 20 000030 9a 777750 0000 46 lisp_error_table_|division_by_zero  000031 5a 000422 0000 00 000032 9a 777746 0000 46 lisp_error_table_|unable_to_float  000033 5a 000421 0000 00 000034 9a 777744 0000 46 lisp_subr_tv_|..lisp..  000035 5a 000420 0000 00 000036 9a 777742 0000 46 lisp_trig_|expt_assistance  000037 5a 000417 0000 00 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 677014 520314 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 000541 000020 aa 000000 000202 000021 aa 000000 000520 000022 aa 000527 000202 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 000005 000066 aa 000112 000062 000067 aa 147740 446345 000070 aa 000000 114774 000071 aa 461236 000000 000072 aa 000127 000066 000073 aa 147714 750316 000074 aa 000000 114774 000075 aa 453561 000000 000076 aa 000145 000047 000077 aa 106701 741731 000100 aa 000000 110670 000101 aa 211444 000000 000102 aa 000157 000044 000103 aa 120017 346605 000104 aa 000000 112002 000105 aa 404115 200000 000106 aa 000170 000045 000107 aa 120017 346602 000110 aa 000000 112002 000111 aa 404115 000000 000112 aa 076163 160145 >special_ldd>install>MR12.0-1206>lisp_bignums_.alm  000113 aa 143151 141154 000114 aa 137154 144144 000115 aa 076151 156163 000116 aa 164141 154154 000117 aa 076115 122061 000120 aa 062056 060055 000121 aa 061062 060066 000122 aa 076154 151163 000123 aa 160137 142151 000124 aa 147156 165155 000125 aa 163137 056141 000126 aa 154155 040040 000127 aa 076163 160145 >special_ldd>install>MR12.0-1206>stack_header.incl.alm  000130 aa 143151 141154 000131 aa 137154 144144 000132 aa 076151 156163 000133 aa 164141 154154 000134 aa 076115 122061 000135 aa 062056 060055 000136 aa 061062 060066 000137 aa 076163 164141 000140 aa 143153 137150 000141 aa 145141 144145 000142 aa 162056 151156 000143 aa 143154 056141 000144 aa 154155 040040 000145 aa 076154 144144 >ldd>include>lisp_object_types.incl.alm 000146 aa 076151 156143 000147 aa 154165 144145 000150 aa 076154 151163 000151 aa 160137 157142 000152 aa 152145 143164 000153 aa 137164 171160 000154 aa 145163 056151 000155 aa 156143 154056 000156 aa 141154 155040 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_name_codes.incl.alm  000171 aa 076151 156143 000172 aa 154165 144145 000173 aa 076154 151163 000174 aa 160137 156141 000175 aa 155145 137143 000176 aa 157144 145163 000177 aa 056151 156143 000200 aa 154056 141154 000201 aa 155040 040040 MULTICS ASSEMBLY CROSS REFERENCE LISTING Value Symbol Source file Line number  ..lisp.. lisp_bignums_: 2258.  70 A lisp_bignums_: 105, 2662, 2672, 2689, 2691, 2719. 2355 abs lisp_bignums_: 35, 1776. 2401 abs_bfx lisp_bignums_: 1783, 1799. 2405 abs_bfx_minus lisp_bignums_: 1801, 1804. 2375 abs_sfl lisp_bignums_: 1782, 1794. 2364 abs_sfx lisp_bignums_: 1781, 1784. 0 abs_sfx_a_to_q lisp_bignums_: 114, 2560, 2570, 2610. 2251 add1 lisp_bignums_: 32, 1689. 2276 add1_bfx lisp_bignums_: 1698, 1714. 2253 add1_enter lisp_bignums_: 1692, 1736. 2271 add1_sfl lisp_bignums_: 1697, 1708. 2261 add1_sfx lisp_bignums_: 1696, 1699. 10 addend lisp_bignums_: 70, 161, 1671.  6 add_bb lisp_bignums_: 127, 2777, 2786.  33 add_bs lisp_bignums_: 154, 1672. 1446 add_opcode lisp_bignums_: 132, 1086, 1212, 1691. 1466 add_structure lisp_bignums_: 159, 567, 577, 1214, 1224, 1232. 46 alloc_bfx6 lisp_bignums_: 169, 480, 596, 613, 1348, 1528, 1600, 1658, 2093, 2298, 2487,  2511, 2594, 2636, 2642, 2715, 2730, 2745, 2760. 30 answerp lisp_bignums_: 81, 481, 486, 585, 597, 1508. 102 append_list_op lisp_stack_seg: 43.  200 Array lisp_object_types: 25.  122 array_info_for_store lisp_stack_seg: 51.  126 array_link_snap_opr lisp_stack_seg: 53.  124 array_offset_for_store lisp_stack_seg: 52.  112 array_operator lisp_stack_seg: 47.  10 array_pointer lisp_stack_seg: 10.  77700 Atomic lisp_object_types: 19.  10000 Atsym lisp_object_types: 18.  74 auto_block_size lisp_bignums_: 109, 651. 71 B lisp_bignums_: 106, 2664, 2682, 2696, 2698, 2709, 2734.  67 badarg lisp_bignums_: 194, 890, 2038, 2044, 2079, 2143, 2244, 2284, 2362, 2370, 2383,  2398, 2399, 2405, 2556, 2566, 2606, 2827.  bad_arg_correctable lisp_bignums_: 198.  55 bad_error lisp_bignums_: 181, 645, 701.  100 begin_list_op lisp_stack_seg: 42.  174 begin_unmkd_stack lisp_stack_seg: 66.  2312 bfx_one lisp_bignums_: 1721, 1728. 6 biggerp lisp_bignums_: 66, 135, 143, 147, 156, 160, 301, 311, 316, 464, 473,  485, 601, 629, 633, 667, 679, 736, 785, 798, 832, 1010,  1021, 1029, 1032, 1173, 1178, 1193, 1275, 1324, 1334, 1337, 1346,  1362, 1471, 1472, 1484, 1521, 1525, 1550, 1662, 1669, 1676, 1717,  1719, 1889, 1922, 1924, 1938, 2084, 2097, 2110, 2114, 2308, 2322,  2589, 2593, 2602, 2615, 2629, 2638, 2712, 2727, 2742, 2757, 2772,  2781, 2793. 1000 Bignum lisp_object_types: 20.  1000 Big_fixed lisp_bignums_: 233, 697, 888, 943, 1683, 1772, 1811, 2543, 2621,  lisp_object_types: 29.  12 big_limit lisp_bignums_: 71, 136, 157, 292, 317, 686, 738, 793, 807, 834, 846,  980, 993, 1011, 1017, 1035, 1038, 1170, 1195, 1320, 1363, 1720,  2630, 2635. 20 bind_op lisp_stack_seg: 17.  2027 bnprint lisp_bignums_: 1516, 1517. 2066 bnprint_done lisp_bignums_: 1547, 1552. 2047 bnprint_loop lisp_bignums_: 1535, 1551. 2063 bnprint_still_big lisp_bignums_: 1543, 1548. 2211 bnread lisp_bignums_: 1652, 1653. 2223 bnread_loop lisp_bignums_: 1664, 1679. 777776 bn_pl1_length lisp_bignums_: 60, 1556, 1557, 1656. 777774 bn_pl1_ptr lisp_bignums_: 58, 1532, 1537, 1554, 1660, 1670. 777777 bn_pl1_radix lisp_bignums_: 61, 1523, 1546, 1665. 72 C lisp_bignums_: 107, 2665, 2668, 2687, 2690, 2692, 2749.  112 call_alloc_bfx lisp_bignums_: 216, 941, 1680, 1763, 1807, 2539, 2617.  151 call_lisp_error_ lisp_bignums_: 186, 206, 260.  1170 call_offset stack_header: 80.  32 call_op lisp_stack_seg: 22.  17 carry lisp_bignums_: 75, 526, 534, 538, 552, 783, 787, 792, 800, 806, 812,  815, 836, 841, 845. 20 carrya lisp_bignums_: 76, 527, 540, 546, 551.  34 catch1_op lisp_stack_seg: 23.  36 catch2_op lisp_stack_seg: 24.  176 check_aq lisp_bignums_: 279, 2169, 2179.  203 compare_bfx lisp_bignums_: 139, 288, 322, 324, 1163, 2631. 211 compare_bfx_loop lisp_bignums_: 298, 304. 106 compare_op lisp_stack_seg: 45.  220 compare_signed_bfx lisp_bignums_: 308, 1946. 72 cons_op lisp_stack_seg: 39.  136 cons_string_op lisp_stack_seg: 57.  241 convert_aq_to_bfx lisp_bignums_: 124, 330, 1267, 1753, 1791, 2188, 2201.  267 convert_bfx_to_sfl lisp_bignums_: 25, 359, 1145, 1200, 1299, 1368, 1445, 1501, 1647, 1917, 1939.  303 convert_bfx_to_sfl_check4 lisp_bignums_: 367, 378.  276 convert_bfx_to_sfl_l lisp_bignums_: 372, 385. 312 convert_bfx_to_sfl_tab lisp_bignums_: 373, 376, 386.  317 convert_bfx_to_sfx lisp_bignums_: 394, 1184, 1330, 1354, 1492, 1512, 1553, 1622, 1768, 2121, 2501,  2531, 2816. 332 convert_bfx_to_sfx_2 lisp_bignums_: 399, 408. 335 convert_q_to_bfx lisp_bignums_: 414, 1116, 1188, 1358, 1401, 1496, 1661, 1888, 1934, 2057, 2103,  2191, 2198, 2293.  360 convert_q_to_sfl lisp_bignums_: 438, 1121, 1139, 1271, 1293, 1421, 1439, 1640, 1885, 1903. 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. 73 D lisp_bignums_: 108, 2663, 2677, 2694, 2697, 2699, 2764.  114 dead_array_operator lisp_stack_seg: 48.  441 dec_qhat lisp_bignums_: 497, 518, 522.  1443 difference lisp_bignums_: 27, 1205. 26 dividendp lisp_bignums_: 80, 466, 490, 529, 2113, 2115, 2116, 2802. division_by_zero lisp_bignums_: 644.  10 divisor lisp_bignums_: 68, 635, 1480, 1524, 2091, 2562, 2572, 2576, 2579, 2581, 2582,  2591, 2612, 2817.  24 divisorp lisp_bignums_: 79, 463, 468, 532, 568.  364 div_bb lisp_bignums_: 447, 1507, 2111, 2796. 451 div_bb_less lisp_bignums_: 493, 506. 475 div_bb_loop lisp_bignums_: 530, 548. 536 div_bb_loop1 lisp_bignums_: 564, 574. 604 div_bb_lsh lisp_bignums_: 462, 465, 608.  46 div_bb_lsh_ret lisp_bignums_: 93, 609, 621.  43 div_bb_ret lisp_bignums_: 91, 450, 592, 604. 44 div_bb_temp lisp_bignums_: 92, 611, 615, 618. 571 div_bb_zero lisp_bignums_: 477, 478, 594.  622 div_bs lisp_bignums_: 625, 1489, 1536, 2095, 2596.  625 div_bs_loop lisp_bignums_: 632, 640. 635 div_by_zero lisp_bignums_: 643.  126 do_call_alloc_bfx lisp_bignums_: 230, 236. 637 enter lisp_bignums_: 648, 1088, 1244, 1375, 1519, 1566, 1633, 1655, 1694, 1742, 1779,  1818, 1840, 1865, 2035, 2128, 2394, 2553, 2824. 1174 entry_offset stack_header: 84.  24 errset1_op lisp_stack_seg: 19.  26 errset2_op lisp_stack_seg: 20.  64 err_op lisp_stack_seg: 36.  646 exop_bfx lisp_bignums_: 151, 659, 1177.  672 exop_bfx_check lisp_bignums_: 676, 685. 650 exop_bfx_loop lisp_bignums_: 665, 675. 663 exop_bfx_ripple lisp_bignums_: 166, 677, 687.  2776 expt lisp_bignums_: 43, 2125. expt_assistance lisp_bignums_: 2261.  3204 expt_bfx_sfx lisp_bignums_: 2139, 2281. 3271 expt_bfx_sfx_copy_p lisp_bignums_: 2331, 2337. 3310 expt_bfx_sfx_done lisp_bignums_: 2318, 2353. 3244 expt_bfx_sfx_even lisp_bignums_: 2193, 2304, 2315.  3227 expt_bfx_sfx_loop lisp_bignums_: 2203, 2301, 2352.  3334 expt_sfl_bfx lisp_bignums_: 2361, 2376. 3146 expt_sfl_sfl lisp_bignums_: 2243, 2247. 3104 expt_sfl_sfx lisp_bignums_: 2138, 2204. 3137 expt_sfl_sfx_done lisp_bignums_: 2229, 2235. 3127 expt_sfl_sfx_even lisp_bignums_: 2222, 2226. 3121 expt_sfl_sfx_loop lisp_bignums_: 2219, 2234. 3115 expt_sfl_sfx_plus lisp_bignums_: 2208, 2214. 3320 expt_sfx_bfx lisp_bignums_: 2360, 2363. 3146 expt_sfx_sfl lisp_bignums_: 2242, 2246. 3013 expt_sfx_sfx lisp_bignums_: 2137, 2140. 3064 expt_sfx_sfx_big1 lisp_bignums_: 2170, 2186. 3073 expt_sfx_sfx_big2 lisp_bignums_: 2180, 2194. 3062 expt_sfx_sfx_done lisp_bignums_: 2175, 2183. 3050 expt_sfx_sfx_even lisp_bignums_: 2166, 2172. 3040 expt_sfx_sfx_loop lisp_bignums_: 2163, 2182. 3031 expt_sfx_sfx_nmo lisp_bignums_: 2149, 2155. 3313 expt_x_bfx lisp_bignums_: 2133, 2357. 3141 expt_x_sfl lisp_bignums_: 2132, 2239. 3006 expt_x_sfx lisp_bignums_: 2131, 2134. 100 File lisp_object_types: 30.  144 finish_call_alloc_bfx lisp_bignums_: 248, 252. 40000 Fixed lisp_bignums_: 884,  lisp_object_types: 15.  2076 fix lisp_bignums_: 30, 1563. 40047 fixnum_type lisp_bignums_: 406, 410, 916, 928, 948, 966, lisp_object_types: 34.  2166 fix_bfx lisp_bignums_: 1570, 1624. 2107 fix_sfl lisp_bignums_: 1569, 1574. 2134 fix_sfl_bfx lisp_bignums_: 1583, 1594, 1597.  2122 fix_sfl_neg lisp_bignums_: 1576, 1586. 2105 fix_sfx lisp_bignums_: 1568, 1571. 20000 Float lisp_bignums_: 886,  lisp_object_types: 16.  2171 float lisp_bignums_: 31, 1630. 120 floating_store_operator lisp_stack_seg: 50.  2205 float_bfx lisp_bignums_: 1637, 1645. 700 float_error lisp_bignums_: 694, 1146, 1201, 1300, 1369, 1455, 1502, 1648, 1918, 1940. 2203 float_sfl lisp_bignums_: 1636, 1642. 2200 float_sfx lisp_bignums_: 1635, 1638. 20047 flonum_type lisp_bignums_: 922, 934, 961,  lisp_object_types: 35.  777707 fn_abs lisp_bignums_: 1777,  lisp_name_codes: 53.  777720 fn_add1 lisp_bignums_: 1690,  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_name_codes: 77.  777765 fn_arg 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.  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_bignums_: 1206,  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_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_bignums_: 2126,  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_bignums_: 1564,  lisp_name_codes: 59.  777700 fn_float lisp_bignums_: 1631,  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_bignums_: 2551,  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_bignums_: 2008,  lisp_name_codes: 46.  777620 fn_gt lisp_name_codes: 108.  777554 fn_haipart lisp_bignums_: 2392,  lisp_name_codes: 144.  777555 fn_haulong lisp_bignums_: 2822,  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_bignums_: 1986,  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_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_bignums_: 1862,  lisp_name_codes: 62.  777601 fn_mergef lisp_name_codes: 123.  777675 fn_min lisp_bignums_: 1968,  lisp_name_codes: 63.  777714 fn_minus lisp_bignums_: 1740,  lisp_name_codes: 48.  777623 fn_minusp lisp_bignums_: 1816,  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_bignums_: 1085,  lisp_name_codes: 49.  777624 fn_plusp lisp_bignums_: 1838,  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_bignums_: 1374,  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_bignums_: 2033,  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_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_bignums_: 1734,  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_bignums_: 1243,  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.  707 force_q_to_bfx lisp_bignums_: 704, 1112, 1705.  722 force_q_to_bfx_neg lisp_bignums_: 712, 721. 50 function_name lisp_bignums_: 95, 184, 199, 655. 3546 gcd lisp_bignums_: 46, 2550. 3643 gcd_bb lisp_bignums_: 2607, 2623. 4105 gcd_bb_doremain lisp_bignums_: 2656, 2710, 2791.  3644 gcd_bb_join lisp_bignums_: 2611, 2625. 3675 gcd_bb_l1 lisp_bignums_: 2651, 2790, 2812.  3713 gcd_bb_l2 lisp_bignums_: 2666, 2707. 3736 gcd_bb_l3 lisp_bignums_: 2686.  3763 gcd_bb_l4 lisp_bignums_: 2669, 2673, 2678, 2679, 2685, 2708. 4132 gcd_bb_to_bs lisp_bignums_: 2654, 2813. 3617 gcd_bfx lisp_bignums_: 2557, 2599. 3620 gcd_bfx_join lisp_bignums_: 2561, 2601. 3626 gcd_bs lisp_bignums_: 2605, 2608. 3633 gcd_bs0 lisp_bignums_: 2592, 2614. 3605 gcd_sb lisp_bignums_: 2567, 2586. 3607 gcd_sb_do lisp_bignums_: 2590, 2613. 3606 gcd_sb_join lisp_bignums_: 2571, 2588, 2819.  3555 gcd_sfx lisp_bignums_: 2555, 2558. 3566 gcd_ss lisp_bignums_: 2565, 2568. 3577 gcd_ss_loop lisp_bignums_: 2575, 2578, 2584.  3600 gcd_ss_loop1 lisp_bignums_: 2580, 2598. 42 gensym_data lisp_stack_seg: 26.  431 get_qhat lisp_bignums_: 488, 591. 470 got_qhat lisp_bignums_: 503, 517, 521, 524. 456 got_rhat lisp_bignums_: 505, 512. 2636 greaterp lisp_bignums_: 41, 2007. 2641 greaterp_table lisp_bignums_: 2009, 2012. 2654 greaterp_table_0 lisp_bignums_: 2013, 2024. 2656 greaterp_table_4 lisp_bignums_: 2017, 2027. 3351 haipart lisp_bignums_: 45, 2392. 3426 haipart_bfx lisp_bignums_: 2406, 2451. 3504 haipart_bfx_rem lisp_bignums_: 2478, 2505. 3361 haipart_ok lisp_bignums_: 2397, 2401. 3366 haipart_sfx lisp_bignums_: 2404, 2408. 3406 haipart_sfx_rem lisp_bignums_: 2422, 2427. 4140 haulong lisp_bignums_: 44, 2822. 4152 haulong_bfx lisp_bignums_: 2828, 2834. 4147 haulong_sfx lisp_bignums_: 2826, 2829. 2 initial_value lisp_bignums_: 64, 2187, 2195, 2291, 2329, 2340, 2650, 2789, 2811.  16 in_pl1_code lisp_bignums_: 266, 275, 898, 1049, 2256, 2268, lisp_stack_seg: 13.  46 iogbind_op lisp_stack_seg: 29.  150 irest_return_op lisp_stack_seg: 62.  40 j lisp_bignums_: 88, 475, 489, 586, 588, 2162, 2167, 2171, 2184, 2197, 2218,  2223, 2225, 2236.  444 l3h lisp_bignums_: 496, 501. 2616 lessp lisp_bignums_: 40, 1985. 2621 lessp_table lisp_bignums_: 1987, 1990. 2634 lessp_table_2 lisp_bignums_: 1993, 2002. 110 link_opr lisp_stack_seg: 46.  lisp_alloc_ lisp_bignums_: 243.  lisp_error_ lisp_bignums_: 268.  lisp_error_table_ lisp_bignums_: 198, 644, 700.  77700 lisp_ptr.type lisp_object_types: 13.  lisp_static_vars_ lisp_bignums_: 264, 265, 272, 273, 274, 896, 897, 1046, 1047, 1048, 1452,  2254, 2255, 2265, 2266, 2267.  lisp_subr_tv_ lisp_bignums_: 2258.  lisp_trig_ lisp_bignums_: 2261.  733 load_arg_bfx lisp_bignums_: 733, 1162, 1315, 1505. 744 lsh_bfx lisp_bignums_: 619, 746. 747 lsh_bfx_loop lisp_bignums_: 752, 760. 37 m lisp_bignums_: 87, 479, 482, 583, 590, 2160, 2168, 2177, 2178, 2181, 2190,  2216, 2224, 2231, 2232, 2233.  0 marked_stack_bottom lisp_stack_seg: 6.  2457 max lisp_bignums_: 38, 1861. 2535 max_bfx lisp_bignums_: 1869, 1920. 2557 max_bfx_bfx lisp_bignums_: 1890, 1931, 1942.  2561 max_bfx_bfx_cmp lisp_bignums_: 1936, 1945. 2565 max_bfx_bfx_switch lisp_bignums_: 1950, 1961, 1981, 1997, 2021.  2537 max_bfx_loop lisp_bignums_: 1923, 1952, 1962, 1963, 1979, 1980. 2553 max_bfx_sfl lisp_bignums_: 1930, 1937. 2547 max_bfx_sfx lisp_bignums_: 1929, 1932. 2506 max_sfl lisp_bignums_: 1868, 1891. 2530 max_sfl_bfx lisp_bignums_: 1899, 1914. 2507 max_sfl_loop lisp_bignums_: 1893, 1913, 1957, 1958, 1959, 1975, 1976, 1977, 2004, 2015. 2524 max_sfl_sfl lisp_bignums_: 1886, 1898, 1909, 1941. 2515 max_sfl_sfx lisp_bignums_: 1897, 1900. 2520 max_sfl_sfx_cmp lisp_bignums_: 1904, 1919. 2466 max_sfx lisp_bignums_: 1867, 1870. 2503 max_sfx_bfx lisp_bignums_: 1878, 1887. 2467 max_sfx_loop lisp_bignums_: 1872, 1883, 1955, 1973. 2501 max_sfx_sfl lisp_bignums_: 1877, 1884. 2475 max_sfx_sfx lisp_bignums_: 1876, 1879. 2461 max_start lisp_bignums_: 1864, 1970, 1988, 2010. 2567 max_table lisp_bignums_: 1863, 1954. 2601 min lisp_bignums_: 39, 1967. 2317 minus lisp_bignums_: 34, 1739. 2415 minusp lisp_bignums_: 36, 1815. 2432 minusp_bfx lisp_bignums_: 1822, 1831. 2427 minusp_sfl lisp_bignums_: 1821, 1827. 2424 minusp_sfx lisp_bignums_: 1820, 1823. 2341 minus_bfx lisp_bignums_: 1746, 1760. 2352 minus_bfx_big lisp_bignums_: 1767, 1770. 2336 minus_sfl lisp_bignums_: 1745, 1756. 2326 minus_sfx lisp_bignums_: 1744, 1747. 2604 min_table lisp_bignums_: 1969, 1972. 761 move_bfx lisp_bignums_: 253, 765, 2300, 2336, 2346, 2640, 2646, 2800, 2810.  771 mpy_bfx lisp_bignums_: 778, 1327, 2310, 2324. 1042 mpy_bfx_done lisp_bignums_: 818, 824. 1026 mpy_bfx_join lisp_bignums_: 794, 811, 821.  775 mpy_bfx_loop1 lisp_bignums_: 784, 796. 1011 mpy_bfx_loop2 lisp_bignums_: 797, 810, 823.  1045 mpy_bs lisp_bignums_: 830, 1351, 1667, 2725, 2740, 2755, 2770.  1052 mpy_bs_loop lisp_bignums_: 837, 847. 10 multiplier lisp_bignums_: 69, 840, 1345, 1666, 2724, 2739, 2754, 2769. 36 n lisp_bignums_: 86, 131, 150, 472, 476, 528, 547, 573, 2112, 2159, 2164,  2173, 2176, 2207, 2210, 2220, 2227, 2230, 2290, 2302, 2316, 2319, 2801. 74 ncons_op lisp_stack_seg: 40.  12 nil lisp_bignums_: 954, 1454, lisp_stack_seg: 11.  4000 nooverflow lisp_bignums_: 53, 1098, 1700.  1070 norm_a lisp_bignums_: 854, 2410, 2455, 2831, 2838.  1102 norm_ge0 lisp_bignums_: 860, 866. 3202 null_arg_list lisp_bignums_: 2260, 2278. 61400 Numeric lisp_object_types: 17.  1107 numval lisp_bignums_: 213, 874, 1092, 1103, 1129, 1156, 1247, 1256, 1283, 1310, 1378,  1388, 1429, 1465, 1567, 1634, 1695, 1743, 1780, 1819, 1841, 1866,  1875, 1896, 1928, 2036, 2042, 2077, 2130, 2136, 2241, 2359, 2396,  2403, 2554, 2564, 2604, 2825.  0 num_of_args lisp_bignums_: 62, 653, 906, 2250. 777774 old_lp lisp_bignums_: 57, 908, 2272.  16 op_table lisp_bignums_: 74, 133, 145, 1089, 1175, 1715. 152 pl1_call_nopop_op lisp_stack_seg: 63.  134 pl1_call_op lisp_stack_seg: 56.  66 pl1_interface lisp_stack_seg: 37.  70 pl1_lsubr_interface lisp_stack_seg: 38.  1304 plus lisp_bignums_: 26, 1084. 2435 plusp lisp_bignums_: 37, 1837. 2454 plusp_bfx lisp_bignums_: 1844, 1855. 2450 plusp_sfl lisp_bignums_: 1843, 1850. 2444 plusp_sfx lisp_bignums_: 1842, 1845. 1365 plus_bfx lisp_bignums_: 1095, 1150. 1375 plus_bfx_add lisp_bignums_: 1118, 1159, 1160.  1402 plus_bfx_common lisp_bignums_: 1166, 1197, 1725.  1367 plus_bfx_loop lisp_bignums_: 1114, 1153, 1183.  1424 plus_bfx_make_big lisp_bignums_: 1157, 1186. 1437 plus_bfx_sfl lisp_bignums_: 1158, 1198. 1341 plus_sfl lisp_bignums_: 1094, 1124. 1350 plus_sfl_add lisp_bignums_: 1122, 1131, 1133, 1202. 1357 plus_sfl_bfx lisp_bignums_: 1132, 1142. 1342 plus_sfl_loop lisp_bignums_: 1126, 1135, 1141, 1148. 1352 plus_sfl_sfx lisp_bignums_: 1130, 1136. 1316 plus_sfx lisp_bignums_: 1093, 1097. 1326 plus_sfx_add lisp_bignums_: 1104, 1108. 1320 plus_sfx_loop lisp_bignums_: 1100, 1111, 1185.  1334 plus_sfx_make_big lisp_bignums_: 1106, 1115. 1337 plus_sfx_sfl lisp_bignums_: 1105, 1120. 1306 plus_start lisp_bignums_: 1087, 1208. 34 powerp lisp_bignums_: 85, 2192, 2202, 2299, 2307, 2320, 2328, 2343, 2345, 2347, 2350.  32 presultp lisp_bignums_: 83, 2189, 2199, 2294, 2305, 2314, 2330, 2332, 2335, 2338, 2354.  56 ptemp1 lisp_bignums_: 99, 2717, 2771.  60 ptemp2 lisp_bignums_: 100, 2732, 2773.  62 ptemp3 lisp_bignums_: 101, 2747, 2780.  64 ptemp4 lisp_bignums_: 102, 2762, 2782.  1171 push_offset stack_header: 81.  51 q lisp_bignums_: 96, 2675, 2684, 2693, 2700.  41 qhat lisp_bignums_: 89, 498, 501, 510, 513, 533, 559, 561, 584.  1645 quotient lisp_bignums_: 29, 1373. 2017 quot_bb lisp_bignums_: 1468, 1504. 2020 quot_bb_div lisp_bignums_: 1498, 1506. 1750 quot_bfx lisp_bignums_: 1381, 1459. 1752 quot_bfx_loop lisp_bignums_: 1462, 1491, 1511.  2013 quot_bfx_sfl lisp_bignums_: 1467, 1499. 1760 quot_bs lisp_bignums_: 1403, 1466, 1469.  1771 quot_bs_join lisp_bignums_: 1474, 1479. 2007 quot_bs_make_bb lisp_bignums_: 1476, 1494. 1716 quot_sfl lisp_bignums_: 1380, 1424. 1734 quot_sfl_bfx lisp_bignums_: 1432, 1442. 1742 quot_sfl_bfx_overflow lisp_bignums_: 1446, 1450. 1725 quot_sfl_div lisp_bignums_: 1422, 1431, 1433, 1503. 1717 quot_sfl_loop lisp_bignums_: 1426, 1435, 1441, 1448. 1727 quot_sfl_sfx lisp_bignums_: 1430, 1436. 1655 quot_sfx lisp_bignums_: 1379, 1383. 1676 quot_sfx_bfx lisp_bignums_: 1391, 1404. 1664 quot_sfx_div lisp_bignums_: 1389, 1392. 1656 quot_sfx_loop lisp_bignums_: 1385, 1399, 1416, 1419, 1493, 1513. 1673 quot_sfx_make_big lisp_bignums_: 1397, 1400. 1714 quot_sfx_sfl lisp_bignums_: 1390, 1420. 1712 quot_sfx_zero lisp_bignums_: 1406, 1411, 1414, 1417. 154 rcv_char_star_op lisp_stack_seg: 64.  2660 remainder lisp_bignums_: 42, 2032. 2725 rem_bfx lisp_bignums_: 2039, 2075. 2756 rem_bfx_bfx lisp_bignums_: 2080, 2105. 2757 rem_bfx_bfx_start lisp_bignums_: 2104, 2107. 2732 rem_bfx_sfx lisp_bignums_: 2078, 2081. 2753 rem_bfx_sfx_expand lisp_bignums_: 2088, 2101. 2741 rem_bfx_sfx_join lisp_bignums_: 2086, 2090. 2733 rem_bfx_sfx_start lisp_bignums_: 2058, 2083. 2667 rem_sfx lisp_bignums_: 2037, 2040. 2707 rem_sfx_bfx lisp_bignums_: 2045, 2059. 2723 rem_sfx_bfx_rem lisp_bignums_: 2062, 2067, 2070, 2072. 2705 rem_sfx_make_big lisp_bignums_: 2052, 2056. 2674 rem_sfx_sfx lisp_bignums_: 2043, 2046. 4 resultp lisp_bignums_: 65, 149, 165, 229, 232, 240, 251, 254, 397, 402, 403,  630, 636, 673, 684, 689, 690, 735, 768, 790, 801, 804,  813, 826, 844, 849, 850, 942, 1015, 1023, 1058, 1063, 1065,  1070, 1072, 1074, 1080, 1113, 1117, 1152, 1168, 1180, 1192, 1199,  1268, 1306, 1318, 1326, 1333, 1349, 1367, 1402, 1461, 1470, 1482,  1483, 1500, 1509, 1529, 1545, 1549, 1601, 1626, 1659, 1668, 1675,  1682, 1706, 1754, 1762, 1765, 1771, 1792, 1806, 1809, 1810, 1925,  2094, 2117, 2296, 2297, 2313, 2327, 2333, 2344, 2355, 2444, 2488,  2512, 2538, 2541, 2542, 2595, 2616, 2619, 2620, 2639, 2645, 2716,  2731, 2746, 2761, 2776, 2785, 2798, 2805, 2815. 1123 return lisp_bignums_: 191, 902, 918, 924, 930, 936, 944, 950, 955, 962, 967,  972, 1102, 1573, 1644, 1773, 1803, 1812, 2289, 2502, 2532, 2537,  2544, 2622. 1132 return_0 lisp_bignums_: 914, 1091, 1578, 1589, 2071, 2145, 2366, 2421, 2467.  1135 return_0.0 lisp_bignums_: 921, 2379. 1140 return_1 lisp_bignums_: 927, 1246, 1377, 1579, 2142, 2147, 2283, 2368, 2374.  1143 return_1.0 lisp_bignums_: 933, 2206, 2381, 2387. 1146 return_bfx lisp_bignums_: 939, 1155, 1309, 1464, 1621, 1627, 1707, 1755, 1793, 1964, 1982,  2120, 2356, 2445, 2500, 2530.  1152 return_minus1 lisp_bignums_: 947, 1588. 1155 return_nil lisp_bignums_: 953, 1826, 1830, 1834, 1847, 1848, 1852, 1853, 1857, 1991, 1994,  1995, 1998, 1999, 2003, 2016, 2019, 2020, 2025, 2026, 2028, 2029.  1173 return_no_pop_offset stack_header: 83.  1172 return_offset stack_header: 82.  62 return_op lisp_stack_seg: 35.  777776 return_point lisp_bignums_: 59, 909, 2273.  1157 return_sfl lisp_bignums_: 958, 1128, 1282, 1428, 1457, 1641, 1649, 1713, 1759, 1796, 1798,  1960, 1978, 2237, 2389. 1163 return_sfx lisp_bignums_: 965, 1255, 1387, 1585, 1596, 1623, 1704, 1752, 1769, 1787, 1790,  1956, 1974, 2055, 2074, 2100, 2122, 2154, 2158, 2185, 2375, 2425,  2432, 2436, 2573, 2577, 2585, 2832, 2844.  1165 return_true lisp_bignums_: 970, 1825, 1829, 1833, 1849, 1854, 1858, 1992, 1996, 2000, 2014,  2018, 2022. 1117 ret_to_pl1 lisp_bignums_: 893, 1560, 1686.  42 rhat lisp_bignums_: 90, 500, 504, 511, 516.  1167 rsh_bfx lisp_bignums_: 975, 2118, 2498, 2806. 1212 rsh_bfx_1 lisp_bignums_: 982, 999. 1177 rsh_bfx_loop lisp_bignums_: 986, 994. 1 saved_indicators lisp_bignums_: 63, 654, 905, 2249. 1216 setup_mpy_bfx lisp_bignums_: 1005, 2309, 2323.  22 shiftp lisp_bignums_: 78, 614, 620, 750. 21 shift_value lisp_bignums_: 77, 460, 749, 978, 2480, 2508, 2524.  56 signp_op lisp_stack_seg: 33.  3534 simple_haipart_bfx lisp_bignums_: 2464, 2465, 2534.  3413 simple_haipart_sfx lisp_bignums_: 2417, 2418, 2434.  10 smallerp lisp_bignums_: 67, 137, 144, 302, 312, 318, 451, 453, 461, 467, 484,  600, 740, 786, 799, 820, 1012, 1022, 1031, 1034, 1174, 1189,  1233, 1237, 1325, 1359, 1497, 1722, 1935, 1944, 2108, 2306, 2321,  2626, 2644, 2774, 2783, 2795.  13 small_limit lisp_bignums_: 72, 138, 293, 319, 674, 742, 817, 1013, 1018, 1191, 1321,  1361, 1657, 1678, 1724, 2628, 2641. 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_bignums_: 270, 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_bignums_: 264, 273, 896, 1047, 2254, 2265. 4 stack_ptr_ptr lisp_stack_seg: 8.  116 store_operator lisp_stack_seg: 49.  556 store_q lisp_bignums_: 558, 582. 4000 String lisp_object_types: 22.  2314 sub1 lisp_bignums_: 33, 1733. 2000 Subr lisp_object_types: 23.  1456 sub_opcode lisp_bignums_: 1207, 1223, 1735.  1471 sub_structure lisp_bignums_: 1213, 1225, 1236.  47 switched lisp_bignums_: 94, 134, 1040, 1161, 1196, 1227, 1718.  1235 switch_bfx lisp_bignums_: 140, 1027, 1164, 1951, 2632.  1251 switch_to_lisp lisp_bignums_: 1044, 1518, 1654.  44 system_lp lisp_bignums_: 237, 263, 1451, 1559, 1685,  lisp_stack_seg: 28.  400 System_Subr lisp_object_types: 24.  14 temp lisp_bignums_: 73, 175, 176, 219, 220, 226, 231, 247, 255, 256, 456,  457, 537, 541, 695, 696, 868, 869, 959, 960, 1030, 1033,  1137, 1143, 1217, 1228, 1291, 1294, 1297, 1301, 1437, 1440, 1443,  1447, 1487, 1488, 1526, 1527, 1598, 1606, 1612, 1710, 1901, 1905,  1907, 1915, 2196, 2200, 2456, 2460, 2482, 2484, 2485, 2486, 2489,  2510, 2513, 2670, 2674, 2680, 2683, 2839, 2843. 104 terminate_list_op lisp_stack_seg: 44.  52 throw1_op lisp_stack_seg: 31.  54 throw2_op lisp_stack_seg: 32.  1474 times lisp_bignums_: 28, 1242. 1554 times_bfx lisp_bignums_: 1250, 1304. 1565 times_bfx_common lisp_bignums_: 1316, 1364. 1556 times_bfx_loop lisp_bignums_: 1269, 1307, 1329, 1353. 1564 times_bfx_mpy lisp_bignums_: 1313, 1314. 1641 times_bfx_sfl lisp_bignums_: 1312, 1366. 1604 times_bfx_sfx lisp_bignums_: 1311, 1332. 1607 times_bs_join lisp_bignums_: 1276, 1336. 1631 times_bs_make_bb lisp_bignums_: 1341, 1356. 1616 times_bs_pos lisp_bignums_: 1339, 1344. 1530 times_sfl lisp_bignums_: 1249, 1278. 1546 times_sfl_bfx lisp_bignums_: 1286, 1296. 1531 times_sfl_loop lisp_bignums_: 1280, 1289, 1295, 1302. 1537 times_sfl_mpy lisp_bignums_: 1272, 1285, 1287, 1370. 1541 times_sfl_sfx lisp_bignums_: 1284, 1290. 1504 times_sfx lisp_bignums_: 1248, 1251. 1525 times_sfx_bfx lisp_bignums_: 1259, 1273. 1520 times_sfx_gets_big lisp_bignums_: 1266.  1505 times_sfx_loop lisp_bignums_: 1253, 1265, 1331, 1355. 1513 times_sfx_mpy lisp_bignums_: 1257, 1260. 1523 times_sfx_sfl lisp_bignums_: 1258, 1270. 0 trace_frames.count stack_header: 69.  1 trace_frames.top_ptr stack_header: 70.  14 true lisp_bignums_: 971,  lisp_stack_seg: 12.  1256 truncate_bfx lisp_bignums_: 1053, 1182, 1328, 1352, 1490, 1510, 1542, 1620, 1673, 1766, 2119,  2311, 2325, 2499, 2529, 2778, 2787, 2807.  1260 truncate_bfx_loop lisp_bignums_: 1060, 1064. 1301 truncate_bfx_small lisp_bignums_: 1062, 1078. 551 tv_offset stack_header: 75, 80, 81, 82, 83, 84. 60 type_fields lisp_stack_seg: 34.  66 uh lisp_bignums_: 103, 2658, 2671, 2681, 2703, 2705. unable_to_float lisp_bignums_: 700.  22 unbind_op lisp_stack_seg: 18.  40 uncatch_op lisp_stack_seg: 25.  60000 Uncollectable lisp_object_types: 21.  30 unerrset_op lisp_stack_seg: 21.  67500 Unevalable lisp_object_types: 27.  unmkd_ptr lisp_bignums_: 265, 272, 274, 897, 1046, 1048, 2255, 2266, 2267.  6 unmkd_ptr_ptr lisp_stack_seg: 9.  2 unmkd_stack_bottom lisp_stack_seg: 7.  50 unseen_go_tag_op lisp_stack_seg: 30.  146 ununwp_op lisp_stack_seg: 61.  142 unwp1_op lisp_stack_seg: 59.  144 unwp2_op lisp_stack_seg: 60.  52 up lisp_bignums_: 97, 2637, 2648, 2655, 2657, 2711, 2741, 2775, 2792, 2799, 2818.  32 v1p lisp_bignums_: 82, 469, 492, 502, 509.  34 v2p lisp_bignums_: 84, 471, 514.  67 vh lisp_bignums_: 104, 2660, 2667, 2676, 2701, 2704, 2706.  54 vp lisp_bignums_: 98, 2643, 2649, 2652, 2659, 2726, 2756, 2784, 2794, 2797, 2809, 2814. words_alloc lisp_bignums_: 243.  76 xcons_op lisp_stack_seg: 41.  12 zunderflow lisp_bignums_: 1452, 1453. 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