COMPILATION LISTING OF SEGMENT lisp_array_fcns_
	Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983
	Compiled at: Honeywell LCPD Phoenix, System M
	Compiled on: 06/30/83  0843.5 mst Thu
	    Options: map single_symbol_list

        1 /* **************************************************************
        2*   *                                                            *
        3*   * Copyright, (C) Massachusetts Institute of Technology, 1973 *
        4*   *                                                            *
        5*   ************************************************************** */
        6 lisp_array_fcns_:	procedure;
        7 
        8 /* This procedure implements all of the lisp sorting functions.
        9*   The algorithm used is a slightly modified version of the
       10*   algorithm "heapsort", as described in Knuth, Vol. III.
       11*
       12*   In addition, several array utility functions are implemented
       13*   here, as they use common code to handle array properties.
       14*   In addition, various array manipulation functions are
       15*   provided.
       16*
       17*   Coded D. Reed, July 10, 1973.
       18*
       19*   Modified 74.05.14 by DAM to:
       20*	[1] move the sorting package to the end.
       21*	[2] add the rest of the array manipulation functions (formerly in lisp_defsubr_)
       22*	    i.e. *array, array, arraydims, *rearray, bltarray.
       23*	[3] implement the "new array" scheme.
       24*
       25*     NOTE:  this code frequently relies on the knowledge that fixnums and
       26*	  flonums are stored in an equivalent format, and that flonum assignment
       27*	  may be performed using a fixnum overlay.  This is to eliminate extra
       28*	  unnecessary special cases.
       29*   Modified 74.12.06 by DAM for changes in definition of listarray and fillarray
       30*    and for external arrays, which are 1-dimensional fixnum arrays stored in external segments.
       31*  */
       32 
       33 dcl (stack,
       34     tstack,
       35      ustack ) ptr,
       36     lisp_property_fns_$get entry,
       37     lisp_error_ entry,
       38     lisp_alloc_$cons entry,
       39     lisp_alloc_$ncons entry,
       40     lisp_static_man_$allocate entry(pointer, fixed bin(18)),
       41     lisp_alloc_ entry(fixed bin(18), pointer),
       42     lisp_$eval entry,
       43     lisp_list_utils_$subst entry,
       44     lisp_property_fns_$putprop entry,
       45     lisp_$snapcaller entry, 		/* special entry to evaluator */
       46 
       47     (lisp_static_vars_$alphalessp_atom,
       48      lisp_static_vars_$readtable,
       49      lisp_static_vars_$external,
       50      lisp_static_vars_$fixnum,
       51      lisp_static_vars_$flonum) fixed bin(71) external,
       52 
       53     L fixed bin,			/* Knuth's losing 1 char variable names */
       54     R fixed bin,
       55     arraydim fixed bin,
       56 
       57     1 snapcall_args based aligned,
       58       2 fn_offset fixed bin,
       59       2 arg_length fixed bin,
       60 
       61     1 error_args based aligned,
       62       2 code fixed bin,
       63       2 name fixed bin,
       64 
       65     myname fixed bin,
       66     temp_item fixed bin(71),
       67     special_action_flag bit(1),
       68     (addr, addrel, divide, unspec, null, substr, mod, min, ptr, size) builtin;
       69 
       70 dcl type_field bit(36) aligned,	/* type field to fill in in number sort */
       71     entry_id fixed bin;		/* code for type of sort to do:
       72*
       73*	0		S-expression sort
       74*	1		S-expression sortcar
       75*	2		S-expression alphasort
       76*	3		S-expression alphasortcar
       77*	-1		Number sort
       78* */
       79 
       80 dcl ndims fixed bin,
       81     nargs fixed bin,
       82     star_rearray bit(1),
       83     other_array_type fixed bin,
       84     other_array_ptr pointer,
       85     other_array_size fixed bin(18),
       86     external_array bit(1),		/* flag on if creating an external array */
       87     array_type fixed bin,
       88     array_ptr pointer,
       89     array_size fixed bin(18),
       90     i fixed bin(18);
       91 
       92 dcl 1 packed_pointer_aligned aligned based,
       93     2 packed_pointer unaligned pointer;
       94 
       95 
       96 dcl (fix1, fix2) fixed bin(35),
       97     (float1, float2) float bin(27);
       98 
       99 	/* Error Codes */
      100 
      101 dcl (lisp_error_table_$bad_argument,
      102      lisp_error_table_$wrong_external_array_ndims,
      103      lisp_error_table_$argument_must_be_array,
      104      lisp_error_table_$not_same_type,
      105      lisp_error_table_$special_array_type,
      106      lisp_error_table_$too_few_args,
      107      lisp_error_table_$too_many_args,
      108      lisp_error_table_$array_too_big,
      109      lisp_error_table_$store_not_allowed,
      110      lisp_error_table_$not_an_array,
      111     lisp_error_table_$not_alpha_array,
      112      lisp_error_table_$dead_array_reference) fixed bin external;
      113 dcl  bad_argument fixed bin defined lisp_error_table_$bad_argument,
      114      wrong_external_array_ndims fixed bin defined lisp_error_table_$wrong_external_array_ndims,
      115      argument_must_be_array fixed bin defined lisp_error_table_$argument_must_be_array,
      116      not_same_type fixed bin defined lisp_error_table_$not_same_type,
      117      special_array_type fixed bin defined lisp_error_table_$special_array_type,
      118      too_few_args fixed bin defined lisp_error_table_$too_few_args,
      119      too_many_args fixed bin defined lisp_error_table_$too_many_args,
      120      array_too_big fixed bin defined lisp_error_table_$array_too_big,
      121      store_not_allowed fixed bin defined lisp_error_table_$store_not_allowed,
      122      not_an_array fixed bin defined lisp_error_table_$not_an_array,
      123     not_alpha_array fixed bin defined lisp_error_table_$not_alpha_array,
      124      dead_array_reference fixed bin defined lisp_error_table_$dead_array_reference;
      125 
      126 	/* information used in constructing arrays */
      127 
      128 dcl fault_tag_3_number_2 bit(72) static init("000000000000000010000000000000100111000000000000000000000000000000000000"b);
      129 
      130 dcl words_per_item (0:5) fixed bin static init(2,2,1,1,1,2);
      131 
      132 dcl 1 array_load_sequence(0:5) static aligned,		/* instructions to load  from array */
      133       2 inst(3) bit(36) initial(
      134 		(2)("101000000000000000010011111001000110"b,
      135 		    "010000000000000000111001000001000000"b, ""b),	/* S-expr, Un-gc:  ldaq lb|0,ql  tra bp|0 */
      136 		"000100000000100111010011101000000111"b,
      137 		"101000000000000000010011110001000110"b,
      138 		"010000000000000000111001000001000000"b,	/* fixnum - lda 040047,dl  ldq lb|0,ql  tra bp|0 */
      139 		"000010000000100111010011101000000111"b,
      140 		"101000000000000000010011110001000110"b,
      141 		"010000000000000000111001000001000000"b,	/* flonum - lda 020047,dl  ldq lb|0,ql  tra bp|0 */
      142 		"000100000000100111010011101000000111"b,
      143 		"101000000000000000010011110001000110"b,
      144 		"010000000000000000111001000001000000"b,	/* readtable - lda 040047,dl  ldq lb|0,ql  tra bp|0 */
      145 		"101000000000000000010011111001000110"b,
      146 		"010000000000000000111001000001000000"b,
      147 		""b);					/* obarray - ldaq lb|0,ql  tra bp|0 */
      148 
      149 dcl fixed_data (0:array_size-1) fixed bin(35) aligned based,
      150     float_data (0:array_size-1) float bin(27) aligned based,
      151     array_element (0:array_size-1) fixed bin(71) aligned based,
      152     bounds (ndims) fixed bin(18) aligned based(ustack);	/* vector of bounds in unmkd pdl */
      153 
      154 
      155 
      156 
  1     1 	/***** BEGIN INCLUDE FILE lisp_array_fmt.incl.pl1 *****/
  1     2 
  1     3 /* This include file defines the format of the "new" LISP arrays.
  1     4*   Written 74.05.13 by DAM */
  1     5 
  1     6 	/* Info block in static space.  pointed at by array ptr */
  1     7 
  1     8 dcl 1 array_info aligned based structure,		/* 8 words long */
  1     9     2 ndims fixed bin(17) unaligned,			/* number of dimensions */
  1    10     2 gc_mark bit(18) unaligned,			/* alternating bits for garbage coll. */
  1    11     2 call_array_operator bit(36),			/* tspbp instruction to array opr */
  1    12     2 array_data_ptr pointer,				/* -> array_data structure */
  1    13     2 array_load_sequence(3) bit(36),			/* lda, ldq, tra bp|0 */
  1    14     2 type fixed bin(17) unaligned,			/* type of array, see dcl below */
  1    15     2 minus_2_times_ndims fixed bin(17) unaligned;	/* for convenience of array opr */
  1    16 
  1    17 	/* Codes for the different types of arrays:
  1    18*     Name		Value		arg to *array to create one      */
  1    19 
  1    20 dcl (S_expr_array init(0),		/* t */
  1    21      Un_gc_array init(1),		/* nil */
  1    22      Fixnum_array init(2),		/* fixnum */
  1    23      Flonum_array init(3),		/* flonum */
  1    24      Readtable_array init(4),		/* readtable */
  1    25      Obarray_array init(5),		/* obarray */
  1    26      Dead_array init(6)		/* (*rearray a) */
  1    27     ) fixed bin(17) static;
  1    28 
  1    29 	/* Block of array data and dimensions, in garbage-collected Lists space */
  1    30 
  1    31 dcl 1 array_data aligned based structure,
  1    32       2 dope_vector(ZERO),		/* address by dope_vector(i-ndims).  no way to dcl in PL/I */
  1    33         3 bounds fixed bin(35),	/* 0 <_ subscript < bounds */
  1    34         3 multiplier fixed bin(35),	/* multiplier in polynomial-type subscript calc. */
  1    35       2 data(0:1000) fixed bin(71);	/* single or double words depending on type of array */
  1    36 
  1    37 dcl ZERO fixed bin static init(0);	/* Circumvent a compiler bug causing reference through null pointer in get_array_size$multf */
  1    38 
  1    39 	/***** END INCLUDE FILE lisp_array_fmt.incl.pl1 *****/
      157 
  2     1 /* lisp stack header format */
  2     2 /* Last modified 7/21/72 by Reed for in_pl1 flag */
  2     3 /* Modified 1978 by Greenberg for unwind-protect ops */
  2     4 
  2     5 declare
  2     6 
  2     7      1 stack_seg based aligned,		/* stored in base of unmkd_pdl segment */
  2     8        2 marked_stack_bottom ptr,		/* where marked stack begins... */
  2     9        2 unmkd_stack_bottom ptr,		/* where unmkd_ stack actually starts */
  2    10        2 stack_ptr_ptr ptr,			/* points at lisp_static_vars_$stack_ptr */
  2    11        2 unmkd_ptr_ptr ptr,			/* points at lisp_static_vars_$unmkd_ptr's offset word */
  2    12        2 array_pointer ptr,			/* obsolete */
  2    13        2 nil fixed bin(71),			/* object for nil */
  2    14        2 true fixed bin(71),			/* object for t */
  2    15        2 in_pl1_code bit(36),			/* flag indicating that we are in pl1 code if non-zero */
  2    16        2 padding0 bit(36),			/* double word boundary preservation */
  2    17        2 bind_op ptr,			/* pointers to operators for run-time support */
  2    18        2 unbind_op ptr,
  2    19        2 errset1_op ptr,
  2    20        2 errset2_op ptr,
  2    21        2 unerrset_op ptr,
  2    22        2 call_op ptr,
  2    23        2 catch1_op ptr,
  2    24        2 catch2_op ptr,
  2    25        2 uncatch_op ptr,
  2    26         2 gensym_data (2) bit(36) aligned,	/* stuff used by the gensym function */
  2    27        2 system_lp ptr,			/* pointer to the system's linkage section */
  2    28        2 iogbind_op ptr,
  2    29        2 unseen_go_tag_op ptr,
  2    30        2 throw1_op ptr,
  2    31        2 throw2_op ptr,
  2    32        2 signp_op ptr,
  2    33        2 type_fields bit(72) aligned,		/* fixnum, flonum type for compiled code */
  2    34        2 return_op ptr,
  2    35        2 err_op ptr,
  2    36        2 pl1_interface ptr,			/* pointer to pl1 interface for type 2 subrs. */
  2    37        2 pl1_lsubr_interface ptr,		/* same for type -2 subrs */
  2    38        2 cons_opr ptr,			/* cons operator */
  2    39        2 ncons_opr ptr,			/* ncons operator */
  2    40        2 xcons_opr ptr,			/* xcons operator */
  2    41        2 begin_list_opr ptr,			/* operator to make initial cell of list */
  2    42        2 append_list_opr ptr,			/* operator to append to last-made cell of list */
  2    43        2 terminate_list_opr ptr,		/* opeator to append last cell to next to last cell of list */
  2    44        2 compare_op ptr,			/* fixnum/flonum comparison operator */
  2    45        2 link_op ptr,
  2    46        2 array_operator pointer,		/* accessing operator, invoked by arrays */
  2    47        2 dead_array_operator pointer,		/* dead arrays invoke this operator instead */
  2    48        2 store_operator pointer,		/* operator to do compiled store */
  2    49        2 floating_store_operator pointer,	/* ditto, but operand is in EAQ */
  2    50        2 array_info_for_store pointer,		/* -> array_info block of last array referenced */
  2    51        2 array_offset_for_store fixed bin(18),	/* offset in array_data block of last array element referenced */
  2    52        2 padding bit(36),
  2    53        2 array_link_snap_opr pointer,
  2    54        2 create_string_desc_op ptr,
  2    55        2 create_array_desc_op ptr,
  2    56        2 pl1_call_op ptr,
  2    57        2 cons_string_op ptr,
  2    58        2 create_varying_string_op ptr,
  2    59        2 unwp1_op ptr,
  2    60        2 unwp2_op ptr,
  2    61        2 ununwp_op ptr,
  2    62        2 irest_return_op ptr,
  2    63        2 pl1_call_nopop_op ptr,
  2    64        2 rcv_char_star_op ptr,
  2    65        2 spare2 (7) ptr,
  2    66        2 begin_unmkd_stack(16325) fixed bin(71);	/* rest of segment is the unmarked pdl */
  2    67 
  2    68 dcl call_array_operator bit(36) static init("100112273120"b3),	/* tspbb ab|112,* */
  2    69     call_dead_array_operator bit(36) static init("100114273120"b3);	/* tspbb ab|114,* */
  2    70 
  2    71 /* end stack segment format */
      158 
  3     1 /* lisp number format -- overlaid on standard its pointer. */
  3     2 
  3     3 
  3     4 dcl 1 fixnum_fmt based aligned,
  3     5       2 type_info bit(36) aligned,
  3     6       2 fixedb fixed bin,
  3     7 
  3     8     1 flonum_fmt based aligned,
  3     9       2 type_info bit(36) aligned,
  3    10       2 floatb float bin,
  3    11 
  3    12     fixnum_type bit(36) aligned static init("000000000000000000000100000000100111"b),
  3    13     flonum_type bit(36) aligned static init("000000000000000000000010000000100111"b);
  3    14 
  3    15 /* end of lisp number format */
  3    16 
      159 
  4     1 
  4     2 	/* BEGIN INCLUDE FILE lisp_readtable.incl.pl1 */
  4     3 
  4     4 dcl num_macs fixed bin static init(8);	/* size of efficient portion of macro_table */
  4     5 
  4     6 					/* if changed, the declarations below must also be changed */
  4     7 dcl read_table_dim_vector dimension(1) fixed bin static init(145); /* number of dbl words in read_table data */
  4     8 
  4     9 
  4    10 
  4    11 dcl 1 read_table aligned based(addr(addr(readtable)->based_ptr -> atom.value)->based_ptr -> array_info.array_data_ptr),
  4    12       2 macro_table(8) fixed bin(71),		/* -> exprs for first few macros */
  4    13       2 more_macros fixed bin(71),		/* list of any remaining macros */
  4    14       2 syntax (0:131) bit(27) aligned,	/* syntax bits for 128 ascii chars + 4 pseudo chars */
  4    15       2 translation (0:131) fixed bin aligned,	/* character translation or index in macro_table */
  4    16       2 status_terpri bit(1) aligned,		/* "1"b if (status terpri) is t */
  4    17       2 status_underline bit(1) aligned,	/* "1"b if (status _) is t */
  4    18 
  4    19       2 status_ttyread bit(1) aligned,		/* not actually used at present */
  4    20       2 abbreviate_on_files bit(1) aligned,	/* (sstatus abbrev 1) */
  4    21       2 abbreviate_on_flat bit(1) aligned,	/* (sstatus abbrev 2) */
  4    22       2 words_not_used_yet (3) bit(36) aligned;
  4    23 
  4    24 
  4    25 	/* Manifest constants for syntax bits */
  4    26 
  4    27 dcl (
  4    28 
  4    29 forcefeed		init("000000100000000000000000000"b),	/* used only by ITS lisp */
  4    30 vertical_motion	init("000000010000000000000000000"b),	/* bit on for NL and NP characters */
  4    31 string_quote_exp	init("000000001000000000000000000"b),	/* string quote if bit12=1, exponent if bit12 = 0 */
  4    32 special		init("000000000100000000000000000"b),	/* always slash if in atom */
  4    33 single_char_object	init("000000000010000000000000000"b),
  4    34 blank		init("000000000001000000000000000"b),	/* space, tab, comma, nl, etc. */
  4    35 lparn		init("000000000000100000000000000"b),	/* "(", bit12 => super left paren */
  4    36 dotted_pair_dot	init("000000000000010000000000000"b),	/* the two uses of "." are kept seperate */
  4    37 rparn		init("000000000000001000000000000"b),	/* ")", bit12 => super right paren */
  4    38 macro		init("000000000000000100000000000"b),
  4    39 slashifier	init("000000000000000010000000000"b),
  4    40 rubout		init("000000000000000001000000000"b),		/* used only by ITS lisp */
  4    41 slash_if_first	init("000000000000000000100000000"b),	/* slashify if first char in pname */
  4    42 decimal_point	init("000000000000000000010000000"b),
  4    43 slash_if_not_first  init("000000000000000000001000000"b),	/* slashify on output when in pname & not 1st */
  4    44 slash_output	init("000000000000000000101000000"b),	/* slashify on output when in pname */
  4    45 bit12		init("000000000000000000000100000"b),	/* selects from two meanings of certain other bits */
  4    46 						/* NOTE: this is not really bit 12 anymore, but keep name */
  4    47 splice		init("000000000000000000000100000"b),	/* splicing macro */
  4    48 shift_scale	init("000000000000000000000010000"b),	/* left shift if bit12 = 1
  4    49*					   fixed point scale if bit12 = 0 */
  4    50 plus_minus	init("000000000000000000000001000"b),	/* + if bit12 = 0, - if bit12 = 1 */
  4    51 digit		init("000000000000000000000000100"b),	/* decimal digit */
  4    52 extd_alpha	init("000000000000000000000000010"b),	/* extended alphabetic */
  4    53 alpha		init("000000000000000000000000001"b)	/* familiar alphabetic */
  4    54 
  4    55 ) bit(27) static;
  4    56 
  4    57 	/* End include file lisp_readtable.incl.pl1 */
  4    58 
      160 
  5     1 /* Include file lisp_common_vars.incl.pl1;
  5     2*   describes the external static variables which may be referenced
  5     3*   by lisp routines.
  5     4*   D. Reed 4/1/71 */
  5     5 
  5     6 dcl 1 lisp_static_vars_$lisp_static_vars_ external,
  5     7       2 cclist_ptr	ptr,	/* pointer to list of constants kept
  5     8*			by compiled programs */
  5     9      2 garbage_collect_soon bit(1) aligned,	/* if this is on we should garbage collect soon */
  5    10 
  5    11      lisp_static_vars_$err_recp ptr ext aligned,	/* pointer to error data */
  5    12      err_recp ptr defined (lisp_static_vars_$err_recp),
  5    13     eval_frame ptr defined (lisp_static_vars_$eval_frame),	/* info kept by eval if *rset t */
  5    14     lisp_static_vars_$eval_frame ptr ext static,
  5    15      lisp_static_vars_$prog_frame ptr ext aligned,
  5    16      lisp_static_vars_$err_frame ptr ext aligned,
  5    17      lisp_static_vars_$catch_frame ptr ext aligned,
  5    18      lisp_static_vars_$unwp_frame ptr ext aligned,
  5    19      lisp_static_vars_$stack_ptr ptr ext aligned,
  5    20      lisp_static_vars_$t_atom fixed bin(71) ext aligned,
  5    21      lisp_static_vars_$top_level label ext,	/* top level read_eval_print loop */
  5    22      lisp_static_vars_$unmkd_ptr ptr ext aligned,
  5    23      lisp_static_vars_$binding_top ptr ext aligned,
  5    24      lisp_static_vars_$obarray fixed bin(71) aligned ext,
  5    25      obarray fixed bin(71)  defined (lisp_static_vars_$obarray),
  5    26      lisp_static_vars_$array_atom fixed bin(71) aligned ext,
  5    27      array_atom fixed bin(71) defined (lisp_static_vars_$array_atom),
  5    28      binding_top ptr defined (lisp_static_vars_$binding_top),
  5    29      unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr),
  5    30      stack_ptr ptr defined (lisp_static_vars_$stack_ptr),
  5    31      lisp_static_vars_$nil ext static fixed bin(71) aligned,
  5    32      nil fixed bin(71) defined (lisp_static_vars_$nil),
  5    33      lisp_static_vars_$tty_input_chan ext static ptr,	/* used by the reader */
  5    34      lisp_static_vars_$tty_output_chan ext static ptr,	/*used by print*/
  5    35      tty_input_chan ptr def (lisp_static_vars_$tty_input_chan),
  5    36      tty_output_chan ptr def (lisp_static_vars_$tty_output_chan),
  5    37     lisp_static_vars_$iochan_list external pointer,		/* list of all open iochans */
  5    38     nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned,
  5    39      prog_frame ptr def (lisp_static_vars_$prog_frame),		/* 3 ptrs for use of lisp_prog_fns_ */
  5    40      err_frame ptr def (lisp_static_vars_$err_frame),		/* they point out frames in unmkd pdl */
  5    41      catch_frame ptr def (lisp_static_vars_$catch_frame),
  5    42      unwp_frame ptr def (lisp_static_vars_$unwp_frame),
  5    43      t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)),
  5    44      t_atom fixed bin(71) defined (lisp_static_vars_$t_atom);		/* pointer to atom t */
  5    45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static,	/* -> atoms whose values are intr service functions */
  5    46     user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array),
  5    47     lisp_static_vars_$star_rset fixed bin(71) aligned ext static,
  5    48     star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset);
  5    49 
  5    50 
  5    51 /* end include file lisp_common_vars.incl.pl1 */
      161 
  6     1 /* Include file lisp_cons_fmt.incl.pl1;
  6     2*   defines the format for a cons within the lisp system
  6     3*   D.Reed 4/1/71 */
  6     4 
  6     5 dcl consptr	ptr,
  6     6     1 cons	aligned based (consptr),	/* structure defining format for cons */
  6     7       2 car	fixed bin(71),
  6     8       2 cdr	fixed bin(71),
  6     9 
  6    10     1 cons_ptrs	aligned based (consptr),	/* for using car and cdr as pointers */
  6    11       2 car	ptr,
  6    12       2 cdr	ptr,
  6    13 
  6    14 
  6    15     1 cons_types	aligned based (consptr),	/* structure for extracting types out of cons */
  6    16       2 padding	bit(21) unaligned,
  6    17       2 car	bit(9) unaligned,
  6    18       2 padding2	bit(63) unaligned,
  6    19       2 cdr	bit(9) unaligned,
  6    20       2 padend	bit(42) unaligned;
  6    21 
  6    22 dcl 1 cons_types36 aligned based,
  6    23       2 car bit(36),
  6    24       2 pada bit(36),
  6    25       2 cdr bit(36),
  6    26       2 padd bit(36);
  6    27 
  6    28 
  6    29 /* end include file lisp_cons_fmt.incl.pl1 */
      162 
  7     1 
  7     2 /*  BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */
  7     3 
  7     4 /*  These are codes for the names of functions which are stored into ab|-1,x7 before
  7     5*    calling lisp_error_ for a bad_argument or bad_arg_correctable error. They
  7     6*    are used so that the name of the function which is rejecting its argument
  7     7*    can be printed.  Please note that all these codes are negative. */
  7     8 
  7     9 dcl (
  7    10 	fn_do			init (-10),
  7    11 	fn_arg			init (-11),
  7    12 	fn_setarg			init (-12),
  7    13 	fn_status			init (-13),
  7    14 	fn_sstatus		init (-14),
  7    15 	fn_errprint		init (-15),
  7    16 	fn_errframe		init (-16),
  7    17 	fn_evalframe		init (-17),
  7    18 	fn_defaultf		init (-18),
  7    19 	fn_tyo			init (-22),
  7    20 	fn_ascii			init (-23),
  7    21 	fn_rplaca			init (-24),
  7    22 	fn_definedp		init (-25),
  7    23 	fn_setq			init (-26),
  7    24 	fn_set			init (-27),
  7    25 	fn_delete			init (-28),
  7    26 	fn_delq			init (-29),
  7    27 	fn_stringlength		init (-30),
  7    28 	fn_catenate		init (-31),
  7    29 	fn_array			init (-32),
  7    30 	fn_substr			init (-33),
  7    31 	fn_index			init (-34),
  7    32 	fn_get_pname		init (-35),
  7    33 	fn_make_atom		init (-36),
  7    34 	fn_ItoC			init (-37),
  7    35 	fn_CtoI			init (-38),
  7    36 	fn_defsubr		init (-39),
  7    37 	fn_star_array		init (-40),
  7    38 	fn_args			init (-41),
  7    39 	fn_sysp			init (-42),
  7    40 	fn_get			init (-43),
  7    41 	fn_getl			init (-44),
  7    42 	fn_putprop		init (-45),
  7    43 	fn_remprop		init (-46),
  7    44 	fn_save			init (-47),
  7    45 	fn_add1			init (-48),
  7    46 	fn_sub1			init (-49),
  7    47 	fn_greaterp		init (-50),
  7    48 	fn_lessp			init (-51),
  7    49 	fn_minus			init (-52),
  7    50 	fn_plus			init (-53),
  7    51 	fn_times			init (-54),
  7    52 	fn_difference		init (-55),
  7    53 	fn_quotient		init (-56),
  7    54 	fn_abs			init (-57),
  7    55 	fn_expt			init (-58),
  7    56 	fn_boole			init (-59),
  7    57 	fn_rot			init (-60),
  7    58 	fn_lsh			init (-61),
  7    59 	fn_signp			init (-62),
  7    60 	fn_fix			init (-63),
  7    61 	fn_float			init (-64),
  7    62 	fn_remainder		init (-65),
  7    63 	fn_max			init (-66),
  7    64 	fn_min			init (-67),
  7    65 	fn_add1_fix		init (-68),
  7    66 	fn_add1_flo		init (-69),
  7    67 	fn_sub1_fix		init (-70),
  7    68 	fn_sub1_flo		init (-71),
  7    69 	fn_plus_fix		init (-72),
  7    70 	fn_plus_flo		init (-73),
  7    71 	fn_times_fix		init (-74),
  7    72 	fn_times_flo		init (-75),
  7    73 	fn_diff_fix		init (-76),
  7    74 	fn_diff_flo		init (-77),
  7    75 	fn_quot_fix		init (-78),
  7    76 	fn_quot_flo		init (-79),
  7    77 	fn_eval			init (-80),
  7    78 	fn_apply			init (-81),
  7    79 	fn_prog			init (-82),
  7    80 	fn_errset			init (-83),
  7    81 	fn_catch			init (-84),
  7    82 	fn_throw			init (-85),
  7    83 	fn_store			init (-86),
  7    84 	fn_defun			init (-87),
  7    85 	fn_baktrace		init (-88),
  7    86 	fn_bltarray		init (-89),
  7    87 	fn_star_rearray		init (-90),
  7    88 	fn_gensym			init (-91),
  7    89 	fn_makunbound		init (-92),
  7    90 	fn_boundp			init (-93),
  7    91 	fn_star_status		init (-94),
  7    92 	fn_star_sstatus		init (-95),
  7    93 	fn_freturn		init (-96),
  7    94 	fn_cos			init (-97),
  7    95 	fn_sin			init (-98),
  7    96 	fn_exp			init (-99),
  7    97 	fn_log			init (-100),
  7    98 	fn_sqrt			init (-101),
  7    99 	fn_isqrt			init (-102),
  7   100 	fn_atan			init (-103),
  7   101 	fn_sleep			init (-104),
  7   102 	fn_oddp			init (-105),
  7   103 	fn_tyipeek		init (-106),
  7   104 	fn_alarmclock		init (-107),
  7   105 	fn_plusp			init (-108),
  7   106 	fn_minusp			init (-109),
  7   107 	fn_ls			init (-110),
  7   108 	fn_eql			init (-111),
  7   109 	fn_gt			init (-112),
  7   110 	fn_alphalessp		init (-113),
  7   111 	fn_samepnamep		init (-114),
  7   112 	fn_getchar		init (-115),
  7   113 	fn_opena			init (-116),
  7   114 	fn_sxhash			init (-117),
  7   115 	fn_gcd			init (-118),
  7   116 	fn_allfiles		init (-119),
  7   117 	fn_chrct			init (-120),
  7   118 	fn_close			init (-121),
  7   119 	fn_deletef		init (-122),
  7   120 	fn_eoffn			init (-123),
  7   121 	fn_filepos		init (-124),
  7   122 	fn_inpush			init (-125),
  7   123 	fn_linel			init (-126),
  7   124 	fn_mergef			init (-127),
  7   125 	fn_namelist		init (-128),
  7   126 	fn_names			init (-129),
  7   127 	fn_namestring		init (-130),
  7   128 	fn_openi			init (-131),
  7   129 	fn_openo			init (-132),
  7   130 	fn_prin1			init (-133),
  7   131 	fn_princ			init (-134),
  7   132 	fn_print			init (-135),
  7   133 	fn_read			init (-136),
  7   134 	fn_readch			init (-137),
  7   135 	fn_readstring		init (-138),
  7   136 	fn_rename			init (-139),
  7   137 	fn_shortnamestring		init (-140),
  7   138 	fn_tyi			init (-141),
  7   139 	fn_setsyntax		init (-142),
  7   140 	fn_cursorpos		init (-143),
  7   141 	fn_force_output		init (-144),
  7   142 	fn_clear_input		init (-145),
  7   143 	fn_random			init (-146),
  7   144 	fn_haulong		init (-147),
  7   145 	fn_haipart		init (-148),
  7   146 	fn_cline			init (-149),
  7   147 	fn_fillarray		init (-150),
  7   148 	fn_listarray		init (-151),
  7   149 	fn_sort			init (-152),
  7   150 	fn_sortcar		init (-153),
  7   151 	fn_zerop			init (-154),
  7   152 	fn_listify		init (-155),
  7   153 	fn_charpos		init (-156),
  7   154 	fn_pagel			init (-157),
  7   155 	fn_linenum		init (-158),
  7   156 	fn_pagenum		init (-159),
  7   157 	fn_endpagefn		init (-160),
  7   158 	fn_arraydims		init (-161),
  7   159 	fn_loadarrays		init (-162),
  7   160 	fn_dumparrays		init (-163),
  7   161 	fn_expt_fix		init (-164),
  7   162 	fn_expt_flo		init (-165),
  7   163 	fn_nointerrupt		init (-166),
  7   164 	fn_open			init (-167),
  7   165 	fn_in			init (-168),
  7   166 	fn_out			init (-169),
  7   167 	fn_truename		init (-170),
  7   168 	fn_ifix			init (-171),
  7   169 	fn_fsc			init (-172),
  7   170 	fn_progv			init (-173),
  7   171 	fn_mapatoms		init (-174),
  7   172 	fn_unwind_protect		init (-175),
  7   173 	fn_eval_when		init (-176),
  7   174 	fn_read_from_string		init (-177),
  7   175 	fn_displace		init (-178),
  7   176 	fn_nth			init (-179),
  7   177 	fn_nthcdr			init (-180),
  7   178 	fn_includef		init (-181)
  7   179     ) fixed bin static;
  7   180 
  7   181 /*  END INCLUDE FILE lisp_name_codes.incl.pl1 */
      163 
  8     1 /* include file lisp_stack_fmt.incl.pl1 --
  8     2*   describes the format of the pushdown list
  8     3*   used by the lisp evaluator and lisp subrs
  8     4*   for passing arguments, saving atom bindings,
  8     5*   and as temporaries */
  8     6 
  8     7 dcl
  8     8       temp(10000) fixed bin(71) aligned based,
  8     9 
  8    10       temp_ptr(10000) ptr aligned based,
  8    11     1 push_down_list_ptr_types(10000) based aligned,
  8    12       2 junk bit(21) unaligned,
  8    13       2 temp_type bit(9) unaligned,
  8    14       2 more_junk bit(42) unaligned,
  8    15 
  8    16     1 pdl_ptr_types36(10000) based aligned,
  8    17       2 temp_type36 bit(36),
  8    18       2 junk bit(36),
  8    19 
  8    20     1 binding_block aligned based,
  8    21       2 top_block bit(18) unaligned,
  8    22       2 bot_block bit(18) unaligned,    /* these two are rel pointers into the marked PDL */
  8    23       2 back_ptr  bit(18) unaligned,      /* relative pointer into unmarked PDL for last binding block. */
  8    24       2 rev_ptr  bit(18) unaligned,	/* relative pointer to reversal bb which reversed this one, init to 0 */
  8    25 
  8    26     1 bindings(10000) based aligned,	/* format fof bindings on stack */
  8    27       2 old_val fixed bin(71) aligned,
  8    28       2 atom fixed bin(71) aligned;
  8    29 
  8    30 
  8    31 
  8    32 /* end include file lisp_stack_fmt.incl.pl1 */
      164 
  9     1 /* Include file lisp_ptr_fmt.incl.pl1;
  9     2*    describes the format of lisp pointers as
  9     3*   a bit string overlay on the double word ITS pair
  9     4*    which allows lisp to access some unused bits in
  9     5*    the standard ITS pointer format. It should be noted that
  9     6*    this is somewhat of a kludge, since
  9     7*    it is quite machine dependent.  However, to store type
  9     8*    fields in the pointer, saves 2 words in each cons,
  9     9*    plus some efficiency problems.
  9    10*
  9    11*    D.Reed 4/1/71 */
  9    12 /* modified to move type field to other half of ptr */
  9    13 /* D.Reed 5/31/72 */
  9    14 
  9    15 
  9    16 dcl based_ptr ptr aligned based;	/* for dealing with lisp values as pointers */
  9    17 dcl lisp_ptr_type bit(36) aligned based,	/* for more efficient checking of type bits */
  9    18     1 lisp_ptr	based aligned,	/* structure of double word pointer in lisp */
  9    19       2 segno 	bit(18) unaligned,	/* segment number pointed to by pointer */
  9    20       2 ringnum	bit(3) unaligned,	/* ring mumber for validation */
  9    21       2 type	bit(9) unaligned,	/* type field */
  9    22       2 itsmod	bit(6) unaligned,
  9    23       2 offset 	fixed bin(17) unaligned,	/* offset in segment of object pointed to */
  9    24       2 chain	bit(18) unaligned,	/* normally 0, but may be set to chain pointers together */
  9    25 
  9    26 /* manifest constant strings for testing above type field */
  9    27 
  9    28    (
  9    29     Cons		init("000000000"b),		/* a pointer to a list has a zero type field */
  9    30     Fixed		init("100000000"b),		/* a fixed point number, stored in second word of the ptr */
  9    31     Float		init("010000000"b),		/* a floating number, also stored in the second word of the ptr */
  9    32     Atsym		init("001000000"b),		/* this bit on means a ptr to an atomic symbol */
  9    33     Atomic	init("111111111"b),		/* any bit on means an atomic data type */
  9    34     Bignum	init("000001000"b),		/* a multiple-precision number */
  9    35     Bigfix	init("000001000"b),		/* a fixed point bignum (only kind for now) */
  9    36     Numeric	init("110000000"b),		/* either type immediate number.  Both bits on
  9    37*					   means a special internal uncollectable weird object */
  9    38     Uncollectable	init("110000000"b),		/* not looked through by garbage collector */
  9    39     String	init("000100000"b),		/* pointer to lisp character string - length word, chars */
  9    40     Subr		init("000010000"b),		/* pointer to compiled (or builtin) subroutine (linkage) code */
  9    41     System_Subr	init("000000100"b),		/* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */
  9    42     Array		init("000000010"b),		/* Subr bit must be on too, indicates ptr to a lisp array */
  9    43     File		init("000000001"b)		/* pointer to a file object (iochan block) */
  9    44    ) bit(9) static,
  9    45 
  9    46 	/* 36 bit manifest constant strings for testing lisp_ptr_type */
  9    47 
  9    48 
  9    49 (
  9    50 Cons36	init("000000000000000000000000000000"b),
  9    51 Fixed36	init("000000000000000000000100000000"b),
  9    52 Float36	init("000000000000000000000010000000"b),
  9    53 Atsym36	init("000000000000000000000001000000"b),
  9    54 Atomic36	init("000000000000000000000111111100"b),
  9    55 Bignum36  init("000000000000000000000000001000"b),
  9    56 System_Subr36
  9    57 	init("000000000000000000000000000100"b),
  9    58 Bigfix36  init("000000000000000000000000001000"b),
  9    59 Numeric36 init("000000000000000000000110000000"b),	/* does not check for bignum */
  9    60 NotConsOrAtsym36
  9    61 	init("000000000000000000000110111111"b),
  9    62 SubrNumeric36
  9    63 	init("000000000000000000000110010000"b),	/* used in garbage collector, for quick check */
  9    64 String36	init("000000000000000000000000100000"b),
  9    65 Subr36	init("000000000000000000000000010000"b),
  9    66 File36	init("000000000000000000000000000001"b),
  9    67 Array36	init("000000000000000000000000000010"b)) bit(36) aligned static,
  9    68 
  9    69     /* undefined pointer value is double word of zeros */
  9    70 
  9    71     Undefined 	bit(72) static init(""b);
  9    72 
  9    73 /* end of include file lisp_ptr_fmt.incl.pl1 */
      165 
 10     1 /* Include file lisp_atom_fmt.incl.pl1;
 10     2*   describes internal format of atoms in the lisp system
 10     3*   D.Reed 4/1/71 */
 10     4 
 10     5 dcl 1 atom 	aligned based,	/* overlay for atom fomat */
 10     6       2 value 	fixed bin(71),	/* atom's value */
 10     7       2 plist 	fixed bin(71),	/* property list */
 10     8       2 pnamel 	fixed bin,	/* length of print name */
 10     9       2 pname 	char(1 refer(pnamel)),	/* print name of atom */
 10    10 
 10    11     1 atom_ptrs 		based aligned,	/* for use of plist and value of atom as ptrs */
 10    12       2 value		ptr,
 10    13       2 plist		ptr,
 10    14 
 10    15     1 atom_double_words 	based aligned,	/* overlay for atom pointer checking */
 10    16       2 value	bit(72),
 10    17       2 plist	bit(72);
 10    18 
 10    19 /* end of include file lisp_atom_fmt.incl.pl1 */
      166 
 11     1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 *****
 11     2*   describes format of storage for lisp
 11     3*   character strings.
 11     4*   D. Reed 4/1/71 */
 11     5 
 11     6 dcl 1 lisp_string based aligned,
 11     7       2 string_length fixed bin,
 11     8       2 string char(1 refer(string_length));
 11     9 
 11    10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */
      167 
      168 
      169 
      170 star_array:  entry;		/* LISP *array function, create an array */
      171 
      172 	myname = fn_star_array;
      173 	call lsubr_initialization;
      174 	star_rearray = "0"b;
      175 	call make_array;			/* call common code for array and *array */
      176 	go to exit;
      177 
      178 make_array: procedure;
      179 
      180 	special_action_flag = "0"b;
      181 	external_array = "0"b;
      182 	unspec(ptr(ustack, 0) -> stack_seg.array_info_for_store) = fault_tag_3_number_2;
      183 
      184 	ndims = divide(nargs, -2, 17, 0)-2;	/* number of dimensions in array */
      185 
      186 	/* identify type of array to be created */
      187 
      188 	if stack -> temp(2) = nil then array_type = Un_gc_array;
      189 	else if stack -> temp(2) = t_atom then array_type = S_expr_array;
      190 	else if stack -> temp(2) = lisp_static_vars_$fixnum then array_type = Fixnum_array;
      191 	else if stack -> temp(2) = lisp_static_vars_$flonum then array_type = Flonum_array;
      192 	else if stack -> temp(2) = lisp_static_vars_$obarray then array_type = Obarray_array;
      193 	else if stack -> temp(2) = lisp_static_vars_$readtable then array_type = Readtable_array;
      194 	else if stack -> temp(2) = lisp_static_vars_$external then do;
      195 		external_array = "1"b;
      196 		array_type = Fixnum_array;	/* looks much like a fixnum array */
      197 		ndims = ndims - 1;		/* First "dimension" is packed ptr */
      198 		if ndims ^= 1 then call reject_argument(1, wrong_external_array_ndims);
      199 		end;
      200 	else call reject_argument(2, bad_argument);
      201 
      202 	/* first argument may be nil (generate array pointer),
      203*	   an array pointer (to be reused), or an atomic symbol (apply to array property) */
      204 
      205 	if stack -> temp(1) = nil
      206 	then if ^ star_rearray then call make_array_pointer;
      207 	     else call reject_argument(1, bad_argument);
      208 	else if stack -> temp_type36(1) & Atsym36 then do;
      209 		call get_array_prop;
      210 		if tstack -> temp(1) = nil then do;	/* put on array property */
      211 		   if star_rearray then call reject_argument(1, argument_must_be_array);
      212 		   tstack -> temp(1) = stack -> temp(1);	/* symbol */
      213 		   call make_array_pointer;
      214 		   stack_ptr = addr(tstack -> temp(4));
      215 		   tstack -> temp(2) = stack -> temp(1);	/* array ptr */
      216 		   tstack -> temp(3) = lisp_static_vars_$array_atom;	/* 'array */
      217 		   call lisp_property_fns_$putprop;
      218 		   end;
      219 		else stack -> temp(1) = tstack -> temp(1);	/* prior array property  */
      220 		end;
      221 
      222 	if stack -> temp_type36(1) & Array36
      223 	then if ^ star_rearray
      224 	     then call kill_array;
      225 	     else;			/* don't kill the array if *rearray */
      226 	else call reject_argument(1, bad_argument);
      227 
      228 	/* special checks for *rearray - type must match and not be special */
      229 
      230 	if star_rearray then do;
      231 	   if array_type ^= stack -> temp_ptr(1) -> array_info.type
      232 	   then call reject_argument(2, not_same_type);
      233 	   if array_type >= Readtable_array then call reject_argument(1, special_array_type);
      234 	   other_array_size = 1;		/* compute old size */
      235 	   other_array_ptr = stack -> temp_ptr(1) -> array_info.array_data_ptr;
      236 	   do i = 1 to stack -> temp_ptr(1) -> array_info.ndims;
      237 	      other_array_size = other_array_size * other_array_ptr ->
      238 				array_data.dope_vector(i - stack -> temp_ptr(1) -> array_info.ndims).bounds;
      239 	      end;
      240 	   end;
      241 
      242 	/* at this point, stack -> temp(1) is an array pointer
      243*	   to an array info block, dead unless *rearray.  Now fill in the info block */
      244 
      245 	if array_type >= Readtable_array then ndims = 1;	/* args treated differently in these cases */
      246 	stack -> temp_ptr(1) -> array_info.ndims = ndims;
      247 	stack -> temp_ptr(1) -> array_info.minus_2_times_ndims = -2*ndims;
      248 	stack -> temp_ptr(1) -> array_info.gc_mark = ""b;
      249 
      250 	stack -> temp_ptr(1) -> array_info.array_load_sequence =
      251 		array_load_sequence(array_type).inst(*);
      252 
      253 	if ^ external_array then do;		/* following code omitted for ext arrays */
      254 
      255 	/* create copy of bounds vector in unmkd pdl, do error checking,
      256*	   and compute number of elements in the array (array_size) */
      257 
      258 	if ndims <= 0 then call reject_argument(1, too_few_args);
      259 	else if ndims > 510 then call reject_argument(1, too_many_args);
      260 	unmkd_ptr = addrel(ustack, ndims+mod(ndims,2));	/* room for bounds vector, even word alignment */
      261 	if array_type < Readtable_array then do;		/* bounds come from arguments */
      262 	     array_size = 1;
      263 	     do i = 1 to ndims;
      264 	        if stack -> temp_type36(i+2) & Fixed36
      265 	        then do;
      266 		   bounds(i) = addr(stack -> temp(i+2)) -> fixedb;
      267 		   if bounds(i) < 0 then call reject_argument(i+2, bad_argument);
      268 		   else array_size = array_size * bounds(i);
      269 		   end;
      270 	        else call reject_argument(i+2, bad_argument);
      271 	        end;
      272 	     end;
      273 	else if array_type = Readtable_array then do;	/* Readtable */
      274 	     array_size, bounds(1) = 290;
      275 	     end;
      276 	else do;					/* Obarray */
      277 	     array_size, bounds(1) = 639;
      278 	     end;
      279 
      280 	/* create data area */
      281 
      282 	i = words_per_item(array_type)*array_size + 2*ndims;
      283 	if i > 50000 then call reject_argument(1, array_too_big);	/* decide it is too big */
      284 	call lisp_alloc_(i, array_ptr);
      285 	array_ptr = addrel(array_ptr, 2*ndims);	/* -> after dope vector, before data */
      286 
      287 	other_array_ptr = stack -> temp_ptr(1) -> array_info.array_data_ptr;		/* may have gc'ed */
      288 
      289 	/* initialize dope vector */
      290 
      291 	do i = 1 to ndims;
      292 	   array_ptr -> array_data.dope_vector(i-ndims).bounds = bounds(i);
      293 	   end;
      294 
      295 	array_ptr -> array_data.dope_vector(ZERO).multiplier = words_per_item(array_type);
      296 	do i = ndims-1 by -1 to 1;
      297 	   array_ptr -> array_data.dope_vector(i-ndims).multiplier = bounds(i+1);
      298 	   end;
      299 
      300 	/* initialize the data area */
      301 
      302 	if ^ star_rearray then other_array_size = 0;	/* if nothing to copy */
      303 	if array_type < Fixnum_array 		/* init to nil */
      304 	then do;
      305 	     do i = 0 by 1 to min(array_size, other_array_size)-1;
      306 	        array_ptr -> array_element(i) = other_array_ptr -> array_element(i);
      307 	        end;
      308 	     do i = i by 1 while (i < array_size);
      309 	        array_ptr -> array_element(i) = nil;
      310 	        end;
      311 	     end;
      312 
      313 	else if array_type = Fixnum_array
      314 	then do;
      315 	     do i = 0 by 1 to min(array_size, other_array_size)-1;
      316 	        array_ptr -> fixed_data(i) = other_array_ptr -> fixed_data(i);
      317 	        end;
      318 	     do i = i by 1 while (i < array_size);
      319 	        array_ptr -> fixed_data(i) = 0;
      320 	        end;
      321 	     end;
      322 
      323 	else if array_type = Flonum_array
      324 	then do;
      325 	     do i = 0 by 1 to min(array_size, other_array_size)-1;
      326 	        array_ptr -> float_data(i) = other_array_ptr -> float_data(i);
      327 	        end;
      328 	     do i = i by 1 while (i < array_size);
      329 	        array_ptr -> float_data(i) = 0.0;
      330 	        end;
      331 	     end;
      332 
      333 	else if array_type = Obarray_array then do;
      334 	     if nargs > -6 then stack -> temp(3) = t_atom;	/* default 3rd arg is t */
      335 	     if stack -> temp(3) = nil		/* leave completely empty */
      336 	     then do i = 0 to 638;
      337 		array_ptr -> array_data.data(i) = nil;
      338 		end;
      339 	     else do;			/* copy some existing obarray */
      340 		if stack -> temp(3) = t_atom then stack -> temp(3) = addr(lisp_static_vars_$obarray)->based_ptr -> atom.value;
      341 		call get_array_prop_3;
      342 		if tstack -> temp_type36(1) & Array36 then;
      343 		else do;
      344 		     call reject_argument(3, argument_must_be_array);
      345 		     end;
      346 		if tstack -> temp_ptr(1) -> array_info.type ^= Obarray_array
      347 		then call reject_argument(3, not_same_type);
      348 
      349 		array_ptr -> array_element(*) = tstack -> temp_ptr(1) -> array_info.array_data_ptr -> array_element(*);
      350 		special_action_flag = "1"b;	/* remember to copy the buckets */
      351 		end;
      352 	     end;
      353 
      354 	else if array_type = Readtable_array then do;
      355 	     if nargs > -6 then stack -> temp(3) = nil;	/* default 3rd arg is nil */
      356 	     if stack -> temp(3) = nil then stack -> temp(3) = addr(lisp_static_vars_$readtable)->based_ptr -> atom.value;
      357 	     if stack -> temp(3) = t_atom		/* copy initial readtable */
      358 	     then call initialize_a_readtable;
      359 	     else do;				/* copy other readtable */
      360 		call get_array_prop_3;
      361 		if tstack -> temp_type36(1) & Array36 then;
      362 		else do;
      363 		     call reject_argument(3, argument_must_be_array);
      364 		     end;
      365 		if tstack -> temp_ptr(1) -> array_info.type ^= Readtable_array
      366 		then call reject_argument(3, not_same_type);
      367 		other_array_ptr = tstack -> temp_ptr(1) -> array_info.array_data_ptr;
      368 		call copy_a_readtable;
      369 		end;
      370 	     end;
      371 
      372 	end;		/* end of if ^ external_array */
      373 	else do;		/* external array - pick up arguments & create array */
      374 
      375 		if stack -> temp_type36(3) & Fixed36 then do;	/* pick up ptr */
      376 			array_ptr = addr(addr(stack -> temp(3))->fixedb)->packed_pointer;
      377 			end;
      378 		else call reject_argument(3, bad_argument);
      379 		stack -> temp_ptr(1) -> array_info.minus_2_times_ndims = 0;	/* ext array flag */
      380 		if stack -> temp_type36(4) & Fixed36 then do;	/* pick up bound */
      381 			array_size = addr(stack -> temp(4))->fixedb;
      382 			end;
      383 		else call reject_argument(4, bad_argument);
      384 		stack -> temp_ptr(1) -> array_info.array_load_sequence(1) =
      385 			unspec(array_size);		/* set up for bounds check (ecch) */
      386 		end;
      387 
      388 	/* array initialization completed.  make the array accessible */
      389 
      390 	stack -> temp_ptr(1) -> array_info.array_data_ptr = array_ptr;
      391 	stack -> temp_ptr(1) -> array_info.type = array_type;
      392 	if array_type ^= Readtable_array
      393 	then stack -> temp_ptr(1) -> array_info.call_array_operator = call_array_operator;
      394 	else stack -> temp_ptr(1) -> array_info.call_array_operator = call_dead_array_operator;	/* readtable - can't subscript*/
      395 
      396 	/* perform any deferred consing. This is done down here because
      397*	   all the various array pointers have to get set up before
      398*	   we can allow a garbage collection.  Yes, it's kludgey */
      399 
      400 	if special_action_flag
      401 	then if array_type = Readtable_array		/* copy more_macros list */
      402 	     then call finish_copying_readtable;
      403 	else if array_type = Obarray_array then do;	/* copy the buckets */
      404 		call finish_copying_obarray;
      405 		end;
      406 
      407 	/* the return value from array or *array is in stack -> temp(1),
      408*	   so these functions will always return the array pointer */
      409 
      410 end make_array;
      411 
      412 /* routines to initialize and copy readtables */
      413 
      414 initialize_a_readtable:  proc;		/* array_ptr -> array_data block to init */
      415 
      416 dcl lisp_static_vars_$quote_macro fixed bin(71) external,
      417    lisp_static_vars_$semicolon_macro fixed bin(71) external,
      418     lisp_static_vars_$vertical_bar_macro fixed bin(71) external,
      419     1 lisp_reader_alm_$initial_readtable aligned external,
      420       2 std_syntax(0:131) bit(18) aligned,
      421       2 std_translation(0:131) fixed bin;
      422 
      423 	array_ptr -> read_table.macro_table(1) = lisp_static_vars_$quote_macro;
      424 	array_ptr -> read_table.macro_table(2) = lisp_static_vars_$semicolon_macro;
      425 	array_ptr -> read_table.macro_table(3) = lisp_static_vars_$vertical_bar_macro;
      426 	do i = 4 to num_macs;
      427 	   array_ptr -> read_table.macro_table(i) = nil;
      428 	   end;
      429 	array_ptr -> read_table.more_macros = nil;
      430 
      431 	array_ptr -> read_table.syntax = std_syntax;
      432 	array_ptr -> read_table.translation = std_translation;
      433 
      434 	array_ptr -> read_table.status_terpri = "0"b;
      435 	array_ptr -> read_table.status_underline = "1"b;
      436 	array_ptr -> read_table.status_ttyread = "1"b;
      437 	array_ptr -> read_table.abbreviate_on_files = "0"b;
      438 	array_ptr -> read_table.abbreviate_on_flat = "1"b;
      439 	unspec(array_ptr -> read_table.words_not_used_yet) = ""b;
      440 end initialize_a_readtable;
      441 
      442 copy_a_readtable:  proc;			/* array_ptr -> new, other_array_ptr -> old */
      443 
      444 	array_ptr -> read_table = other_array_ptr -> read_table;	/* copy whole thing */
      445 	special_action_flag = "1"b;		/* remember to copy more_macros list (KLUDGE) */
      446 
      447 end copy_a_readtable;
      448 
      449 finish_copying_readtable:  proc;		/* called to copy the more_macros list */
      450 
      451 	tstack = stack_ptr;
      452 	stack_ptr = addr(tstack -> temp(4));
      453 	tstack -> temp(1), tstack -> temp(2) = nil;
      454 	tstack -> temp(3) = array_ptr -> read_table.more_macros;
      455 	call lisp_list_utils_$subst;
      456 	stack -> temp_ptr(1) -> array_info.array_data_ptr -> read_table.more_macros = tstack -> temp(1);
      457 end finish_copying_readtable;
      458 
      459 finish_copying_obarray:  proc;		/* copy the buckets so can remob from old array
      460*					   without affecting the new one */
      461 
      462 	tstack = stack_ptr;
      463 	do i = 0 to 638;
      464 	   stack_ptr = addr(tstack -> temp(4));
      465 	   tstack -> temp(1), tstack -> temp(2) = nil;
      466 	   tstack -> temp(3) = stack -> temp_ptr(1) -> array_info.array_data_ptr -> array_data.data(i);
      467 	   call lisp_list_utils_$subst;
      468 	   stack -> temp_ptr(1) -> array_info.array_data_ptr -> array_data.data(i) = tstack -> temp(1);
      469 	   end;
      470 end finish_copying_obarray;
      471 
      472 array:  entry;		/* the LISP array function */
      473 
      474 	stack = addrel(stack_ptr, -2);
      475 	do nargs = 0 repeat (nargs+1) while(stack -> temp_type(1) = Cons);
      476 	   stack_ptr = addr(stack -> temp(nargs+3));
      477 	   stack -> temp(nargs+2) = stack -> temp_ptr(1) -> cons.car;
      478 	   stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr;
      479 	   if nargs > 1 then call lisp_$eval;		/* eval all but first two args */
      480 	   end;
      481 
      482 	nargs = -2*nargs;			/* lsubr compatibility */
      483 
      484 	ustack = unmkd_ptr;
      485 	myname = fn_array;
      486 	star_rearray = "0"b;
      487 	stack -> temp(1) = stack -> temp(2);	/* copy the first argument so it can be returned */
      488 	stack = addr(stack -> temp(2));	/* -> arguments */
      489 	call make_array;			/* call subroutine to do like *array */
      490 	stack = addrel(stack, -2);		/* adjust for extra stack cell */
      491 	if stack -> temp(1) = nil		/* return first argument, or array ptr if it was nil */
      492 	then stack -> temp(1) = stack -> temp(2);
      493 	go to exit;
      494 
      495 star_rearray:  entry;			/* LISP *rearray function */
      496 
      497 	myname = fn_star_rearray;
      498 	star_rearray = "1"b;
      499 	call lsubr_initialization;
      500 	if nargs >= -2 then do;		/* kill existing array */
      501 	   if stack -> temp_type36(1) & Array36 then call kill_array;
      502 	   else do;
      503 	        call get_array_prop;
      504 	        stack -> temp(1) = tstack -> temp(1);
      505 	        if stack -> temp_type36(1) & Array36 then call kill_array;
      506 	        end;
      507 	   if stack -> temp_type36(1) & Array36	/* actually killed it */
      508 	   then stack -> temp(1) = t_atom;	/* return result like remprop */
      509 	   else stack -> temp(1) = nil;
      510 	   go to exit;
      511 	   end;
      512 
      513 	/* *rearray with more than one argument - reformat the array */
      514 
      515 	call make_array;			/* do all work in common code */
      516 	go to exit;
      517 
      518 
      519 /* useful routines used by the above */
      520 
      521 reject_argument:  proc(num, err);
      522 
      523 dcl num fixed bin,			/* number of stack cell containing bad argument */
      524     err fixed bin;		/* error code to use */
      525 
      526 dcl unm pointer,
      527     tstack pointer;
      528 
      529 dcl 1 args_to_lisp_error_on_unmarked_pdl aligned based,
      530     2 errcode (2) fixed bin(35);
      531 
      532 	tstack = stack_ptr;
      533 	stack_ptr = addr(tstack -> temp(2));
      534 	tstack -> temp(1) = stack -> temp(num);
      535 
      536 	unm = unmkd_ptr;
      537 	unmkd_ptr = addrel(unm, 2);
      538 	unm -> errcode(1) = err;
      539 	unm -> errcode(2) = myname;
      540 	call lisp_error_;
      541 	stack -> temp(num) = tstack -> temp(1);	/* in case correctable error */
      542 	stack_ptr = tstack;
      543 end;
      544 
      545 
      546 kill_array:  proc;		/* kill array pointed at by stack -> temp(1) */
      547 
      548 	stack -> temp_ptr(1) -> array_info.type = Dead_array;
      549 	stack -> temp_ptr(1) -> array_info.call_array_operator = call_dead_array_operator;
      550 	stack -> temp_ptr(1) -> array_info.array_data_ptr = null;
      551 end;
      552 
      553 make_array_pointer:  proc;	/* set stack -> temp(1) to an array pointer + initialize array_info */
      554 
      555 	call lisp_static_man_$allocate(array_ptr, size(array_info));
      556 	unspec(stack -> temp(1)) = unspec(array_ptr) | Array36 | Subr36;	/* turn on type bit */
      557 	call kill_array;		/* do some initialization */
      558 end;
      559 
      560 
      561 lsubr_initialization:  proc;
      562 
      563 	stack = addrel(stack_ptr, -2);
      564 	nargs = stack -> fixedb;		/* -2* # of args */
      565 	stack = addrel(stack, nargs);
      566 	ustack = unmkd_ptr;
      567 end lsubr_initialization;
      568 
      569 
      570 get_array_prop_3:  procedure;
      571 	stack = addr(stack -> temp(3));
      572 	call get_array_prop;
      573 	stack = addrel(stack, -4);
      574 end get_array_prop_3;
      575 
      576 get_array_prop:  procedure;
      577 
      578 	tstack = stack_ptr;
      579 	stack_ptr = addr(tstack -> temp(2));
      580 	tstack -> temp(1) = stack -> temp(1);
      581 	if tstack -> temp_type36(1) & Array36 then return;	/* already an array pointer */
      582 	stack_ptr = addr(tstack -> temp(3));
      583 	tstack -> temp(2) = lisp_static_vars_$array_atom;
      584 	call lisp_property_fns_$get;
      585 end get_array_prop;
      586 
      587 /* various array operations, converting from arrays to lists, and initting arrays */
      588 
      589 
      590 fillarray:	entry;		/* fills an array from a list, replicating the last element as necessary */
      591 
      592 	myname = fn_fillarray;
      593 	stack = addrel(stack_ptr, -4);
      594 
      595 	if stack -> temp_type(2) ^= Cons	/* allow (fillarray to-array from-array) */
      596 	then do;				/* by interchanging args & using bltarray */
      597 	     temp_item = stack -> temp(2);
      598 	     stack -> temp(2) = stack -> temp(1);
      599 	     stack -> temp(1) = temp_item;
      600 	     go to fillarray_bltarray_join;
      601 	     end;
      602 
      603 	call get_array_property;
      604 
      605 	if array_type >= Readtable_array
      606 	then call reject_argument(1, store_not_allowed);
      607 
      608 	L = 0;
      609 	stack_ptr = addr(stack -> temp(4));
      610 	do while(stack -> temp(2) ^= nil);	/* until the end of the list argument */
      611 	     stack -> temp(3) = stack -> temp_ptr(2) -> cons.car;
      612 	     if array_type < Fixnum_array		/* S-expression array */
      613 	     then array_ptr -> array_element(L) = stack -> temp(3);
      614 
      615 	     else if array_type = Fixnum_array		/* Fixnum array */
      616 	     then if addr(stack -> temp(3))-> fixnum_fmt.type_info = fixnum_type
      617 		then array_ptr -> fixed_data(L) = addr(stack -> temp(3))-> fixedb;
      618 		else call reject_argument(3, store_not_allowed);
      619 	     else					/* Flonum array */
      620 		if addr(stack -> temp(3))-> flonum_fmt.type_info = flonum_type
      621 		then array_ptr -> float_data(L) = addr(stack -> temp(3))-> floatb;
      622 		else call reject_argument(3, store_not_allowed);
      623 	     stack -> temp(2) = stack -> temp_ptr(2) -> cons.cdr;
      624 	     L = L + 1;
      625 	     if L = array_size then go to done;
      626 	     end;
      627 
      628 	if L = 0 then go to done;
      629 
      630 	/* replicate last element */
      631 
      632 	if array_type < Fixnum_array then do;		/* replicate S-expression */
      633 	   stack -> temp(2) = array_ptr -> array_element(L-1);
      634 	   do L = L repeat (L+1) while (L < array_size);
      635 	      array_ptr -> array_element(L) = stack -> temp(2);
      636 	      end;
      637 	   end;
      638 
      639 	else if array_type = Fixnum_array then do;		/* replicate a fixnum */
      640 	     fix1 = array_ptr -> fixed_data(L-1);
      641 	     do L = L repeat (L+1) while (L < array_size);
      642 		array_ptr -> fixed_data(L) = fix1;
      643 		end;
      644 	     end;
      645 
      646 	else if array_type = Flonum_array then do;		/* replicate a flonum */
      647 	     float1 = array_ptr -> float_data(L-1);
      648 	     do L = L repeat (L+1) while (L < array_size);
      649 		array_ptr -> float_data(L) = float1;
      650 		end;
      651 	     end;
      652 
      653 done:	stack_ptr = addr(stack -> temp(2));
      654 	return;
      655 
      656 
      657 
      658 listarray:	entry;		/* convert an array to a list */
      659 
      660 	myname = fn_listarray;
      661 	call lsubr_initialization;		/* extended to lsubr 74.12.06 */
      662 
      663 	call get_array_property;
      664 	if nargs < -2 then array_size = min(array_size, 		/* argument - limit # elems returned */
      665 			addr(stack -> temp(2)) -> fixedb);
      666 	if array_type = Readtable_array then call reject_argument(1, special_array_type);
      667 
      668 	stack -> temp(1) = stack -> temp(3);		/* save the array-pointer */
      669 	stack = addr(stack -> temp(2));
      670 	stack_ptr = addr(stack -> temp(3));
      671 	stack -> temp(1) = nil;
      672 	do L = array_size - 1 to 0 by -1;	/* start with last array element */
      673 
      674 	     stack -> temp(2) = stack -> temp(1);
      675 	     if array_type < Fixnum_array
      676 	     then stack -> temp(1) = array_ptr -> array_element(L);
      677 
      678 	     else if array_type = Fixnum_array then do;
      679 		stack -> fixnum_fmt.type_info = fixnum_type;
      680 		stack -> fixedb = array_ptr -> fixed_data(L);
      681 		end;
      682 
      683 	     else if array_type = Flonum_array then do;
      684 		stack -> flonum_fmt.type_info = flonum_type;
      685 		stack -> floatb = array_ptr -> float_data(L);
      686 		end;
      687 	     else do;			/* Obarray */
      688 		stack -> temp(1) = array_ptr -> array_element(L);
      689 		end;	/* ncons SCO buckets??? */
      690 	     call lisp_alloc_$cons;
      691 	     array_ptr = stack -> temp_ptr(ZERO) -> array_info.array_data_ptr;	/* in case GC */
      692 	     stack_ptr = addr(stack -> temp(3));	/* readjust stack */
      693 	     end;
      694 	stack = addrel(stack, -2);			/* recover hidden cell */
      695 	stack -> temp(1) = stack -> temp(2);	/* move result down */
      696 	go to done;
      697 
      698 bltarray:  entry;
      699 
      700 	myname = fn_bltarray;
      701 	stack = addrel(stack_ptr, -4);
      702 fillarray_bltarray_join:			/* bltarray is obsolete except fillarray uses it */
      703 	call get_array_property;		/* process 1st arg */
      704 	other_array_type = array_type;
      705 	other_array_size = array_size;
      706 
      707 	stack = addr(stack -> temp(2));	/* process 2nd arg */
      708 	call get_array_property;
      709 	other_array_ptr = stack -> temp_ptr(2) -> array_info.array_data_ptr;	/* have to do this because of GC */
      710 
      711 	if array_type ^= other_array_type
      712 	then if array_type >= Fixnum_array | other_array_type >= Fixnum_array
      713 	then do;		/* types have to match, except can mix S-expr and un-gc */
      714 	     stack_ptr = addr(stack -> temp(3));
      715 	     call lisp_alloc_$ncons;
      716 	     call lisp_alloc_$cons;
      717 	     stack = stack_ptr;
      718 	     call reject_argument(0, not_same_type);
      719 	     end;
      720 
      721 	/* checking is completed, now copy the data */
      722 
      723 	stack = addrel(stack, -2);			/* -> args */
      724 	stack -> temp(1) = stack -> temp(4);		/* array object to be written into.
      725*						   This is also return value */
      726 	array_size = min(array_size, other_array_size);	/* how many elements to copy over */
      727 	if array_type = Readtable_array then do;
      728 	   call copy_a_readtable;
      729 	   call finish_copying_readtable;
      730 	   end;
      731 	else if array_type = Obarray_array then do;
      732 	   array_ptr -> array_element(*) = other_array_ptr -> array_element(*);
      733 	   call finish_copying_obarray;		/* make top-level copies of buckets */
      734 	   end;
      735 	else if array_type >= Fixnum_array	/* copy number array */
      736 	     then array_ptr -> fixed_data(*) = other_array_ptr -> fixed_data(*);
      737 	else array_ptr -> array_element(*) =	/* copy S-expr or un_gc array */
      738 		other_array_ptr -> array_element(*);
      739 	go to done;
      740 
      741 arraydims:  entry;	/* arraydims subr, return list of array type and dimensions */
      742 
      743 	myname = fn_arraydims;
      744 	stack = addrel(stack_ptr, -2);
      745 	call get_array_property;
      746 	ndims = stack -> temp_ptr(3) -> array_info.ndims;
      747 	call lisp_alloc_(4*(ndims+1), stack -> temp_ptr(1));		/* create return list in one fell swoop.
      748*								   this is array won't move later */
      749 	array_ptr = stack -> temp_ptr(3) -> array_info.array_data_ptr;	/* -> dope vector */
      750 
      751 	/* get type of array */
      752 
      753 	if array_type = S_expr_array then stack -> temp_ptr(1) -> temp(1) = t_atom;
      754 	else if array_type = Un_gc_array then stack -> temp_ptr(1) -> temp(1) = nil;
      755 	else if array_type = Fixnum_array then stack -> temp_ptr(1) -> temp(1) = lisp_static_vars_$fixnum;
      756 	else if array_type = Flonum_array then stack -> temp_ptr(1) -> temp(1) = lisp_static_vars_$flonum;
      757 	else if array_type = Readtable_array then stack -> temp_ptr(1) -> temp(1) = lisp_static_vars_$readtable;
      758 	else if array_type = Obarray_array then stack -> temp_ptr(1) -> temp(1) = lisp_static_vars_$obarray;
      759 
      760 	/* copy dimensions and link up the list */
      761 
      762 	if stack -> temp_ptr(3) -> array_info.minus_2_times_ndims ^= 0	/* normal array */
      763 	then do i = 1 by 1 while(i <= ndims);
      764 	   addr(stack -> temp_ptr(1) -> temp(2*i+1))-> fixnum_fmt.type_info = fixnum_type;
      765 	   addr(stack -> temp_ptr(1) -> temp(2*i+1))-> fixedb = array_ptr -> array_data.dope_vector(i-ndims).bounds;
      766 	   stack -> temp_ptr(1) -> temp_ptr(2*i) = addr(stack -> temp_ptr(1) -> temp(2*i+1));
      767 	   end;
      768 	else do;			/* external array */
      769 	   stack -> temp_ptr(1) -> temp_ptr(2) = addr(stack -> temp_ptr(1) -> temp(3));
      770 	   addr(stack -> temp_ptr(1) -> temp(3)) -> fixnum_fmt.type_info = fixnum_type;
      771 	   unspec(addr(stack -> temp_ptr(1) -> temp(3)) -> fixedb) = array_ptr -> array_info.array_load_sequence(1);
      772 	   end;
      773 	stack -> temp_ptr(1) -> temp(2*ndims+2) = nil;		/* end the list */
      774 	stack_ptr = addr(stack -> temp(2));
      775 	return;
      776 
      777 mapatoms:	entry;
      778 
      779 	myname = fn_mapatoms;
      780 	call lsubr_initialization;
      781 	if nargs = -2 then stack -> temp(2) = addr(lisp_static_vars_$obarray) -> based_ptr -> atom.value;
      782 	stack_ptr = addr(stack-> temp(5));
      783 	unmkd_ptr = addrel(ustack,2);
      784 	ustack-> snapcall_args.fn_offset = -8;
      785 	ustack -> snapcall_args.arg_length = -2;
      786 
      787 	do while((stack->temp_type36(2)&Array36) = "0"b);
      788 bad_mapa:
      789 		call reject_argument(2,not_an_array);
      790 	end;
      791 
      792 	if stack->temp_ptr(2)->array_info.type ^= Obarray_array then go to bad_mapa;
      793 
      794 	do i = 0 to 510;
      795 		stack->temp(3) = stack->temp_ptr(2)->array_info.array_data_ptr -> array_element(i);
      796 		do while(stack->temp(3) ^= nil);
      797 			stack->temp(4) = stack->temp_ptr(3)-> cons.car;
      798 			stack->temp(3) = stack->temp_ptr(3)->cons.cdr;
      799 			call lisp_$snapcaller;
      800 		end;
      801 	end;
      802 
      803 	do i = 511 to 638;
      804 		stack->temp(4) = stack->temp_ptr(2)-> array_info.array_data_ptr-> array_element(i);
      805 		if stack->temp(4) ^= nil then call lisp_$snapcaller;
      806 	end;
      807 
      808 	stack->temp(1) = t_atom;
      809 	stack_ptr = addr(stack->temp(2));
      810 	unmkd_ptr = ustack;
      811 	return;
      812 
      813 sort:	entry;			/* major sort entrypoint, taking two lisp args, first is array, second is < predicate */
      814 
      815 	myname = fn_sort;
      816 	entry_id = 0;
      817 
      818 join_sort:
      819 	stack = addrel(stack_ptr, -4);
      820 	ustack = unmkd_ptr;
      821 
      822 	if stack -> temp(2) = lisp_static_vars_$alphalessp_atom
      823 	then go to alphasort;				/* special alphbetic sorting feature for speed */
      824 
      825 	if stack -> temp(1) = nil then go to exit;
      826 	if stack -> temp_type(1)
      827 	then do;
      828 		call get_array_property;
      829 		if array_type < Fixnum_array then;	/* regular old S-expression sort */
      830 		else if array_type = Fixnum_array
      831 		     then if entry_id = 0 then do;
      832 			entry_id = -1;
      833 			type_field = fixnum_type;
      834 			end;
      835 		     else go to cant_sortcar_number_array;
      836 		else if array_type = Flonum_array
      837 		     then if entry_id = 0 then do;
      838 			entry_id = -1;
      839 			type_field = flonum_type;
      840 			end;
      841 		     else go to cant_sortcar_number_array;
      842 		else go to cant_sort_special_array;
      843 		call heapsort;
      844 	     end;
      845 	else call merge_sort;
      846 
      847 
      848 exit:	stack_ptr = addr(stack -> temp(2));
      849 	unmkd_ptr = ustack;
      850 
      851 	return;
      852 
      853 
      854 /* Error exits */
      855 
      856 cant_sort_special_array:
      857 cant_sortcar_number_array:
      858 cant_alphasort_number_array:
      859 	call reject_argument(1, special_array_type);
      860 
      861 sortcar:	entry;
      862 
      863 	myname = fn_sortcar;
      864 	entry_id = 1;
      865 
      866 	go to join_sort;
      867 
      868 alphasort: entry_id = entry_id + 2;		/* indicate special comparison technique */
      869 
      870 alpha_retry:
      871 	if stack -> temp(1) = nil then go to exit;
      872 	if stack -> temp_type(1)
      873 		then do;
      874 		call get_array_property;			/* get the array property, which we must verify as
      875*							   an aplhabetic array */
      876 		if array_type >= Fixnum_array then go to cant_alphasort_number_array;
      877 	
      878 		do L = array_size-1 by -1 to 0;			/* check the whole array */
      879 		  if entry_id = 2 then
      880 		     if addr(array_ptr -> array_element(L)) -> lisp_ptr_type & (Atsym36|String36) then;
      881 		     else do;
      882 	
      883 alpha_loss:		     stack_ptr = addr(stack -> temp(2));
      884 			     unmkd_ptr =addrel(ustack,2);
      885 			     ustack -> error_args.code = not_alpha_array;
      886 	
      887 			     ustack -> error_args.name = myname;
      888 	
      889 			     call lisp_error_;
      890 			     go to alpha_retry;
      891 			end;
      892 		  else if addr(array_ptr -> array_element(L)) -> based_ptr -> lisp_ptr_type & (Atsym36|String36) then;
      893 		       else go to alpha_loss;
      894 	
      895 		end;
      896 	
      897 		call heapsort;
      898 	     end;
      899 
      900 	else do;
      901 
      902 		stack_ptr = addr(stack -> temp(3));	/* set up args for cons */
      903 		stack -> temp(2) = stack -> temp(1);
      904 
      905 		do while(stack -> temp(2) ^= nil);
      906 		  if entry_id = 2 then
      907 		     if stack -> temp_ptr(2) -> lisp_ptr_type & (Atsym36|String36) then;
      908 		     else go to alpha_loss;
      909 		  else if stack -> temp_ptr(2) -> cons_ptrs.car -> lisp_ptr_type & (Atsym36|String36) then;
      910 		     else go to alpha_loss;
      911 		     stack -> temp(2) = stack -> temp_ptr(2) -> cons.cdr;
      912 		end;
      913 
      914 		call merge_sort;
      915 	     end;
      916 
      917 	go to exit;
      918 
      919 heapsort:	proc;			/* algorithm to implent Knuth's heapsort */
      920 
      921 	if array_size <= 1 then go to exit;
      922 
      923 	stack_ptr = addr(stack->temp(5));		/* set up for siftup */
      924 	unmkd_ptr = addrel(ustack,2);
      925 	ustack->snapcall_args.fn_offset = -10;		/* offset of function from top of  stack */
      926 	ustack->snapcall_args.arg_length = -4;		/* -2 * nargs */
      927 
      928 	R = array_size - 1;
      929 
      930 /* Now we enter into Knuth's algorithm proper */
      931 
      932 	do L = divide(array_size,2,17,0)-1 to 0 by -1;
      933 
      934 	     if entry_id >= 0
      935 	     then stack -> temp(4) = array_ptr -> array_element(L);		/* set K */
      936 	     else do;
      937 		addr(stack -> temp(4)) -> fixnum_fmt.type_info = type_field;
      938 		addr(stack -> temp(4)) -> fixedb = array_ptr -> fixed_data(L);
      939 		end;
      940 	     call siftup;
      941 
      942 	end;
      943 
      944 	L = 0;					/* make sure */
      945 
      946 	if entry_id < 0
      947 	then do;
      948 	     addr(stack -> temp(4)) -> fixnum_fmt.type_info = type_field;
      949 	     addr(stack -> temp(4)) -> fixedb = array_ptr -> fixed_data(R);
      950 	     array_ptr -> fixed_data(R) = array_ptr -> fixed_data(0);
      951 	     end;
      952 	else do;
      953 	     stack -> temp(4) = array_ptr -> array_element(R);		/* set K */
      954 	     array_ptr -> array_element(R) = array_ptr -> array_element(0);	/* move next element to final pos */
      955 	     end;
      956 	do R = R-1 to 1 by -1;
      957 
      958 	     call siftup;
      959 	     if entry_id >= 0 then do;
      960 		stack -> temp(4) = array_ptr -> array_element(R);	/* set K */
      961 		array_ptr -> array_element(R) = array_ptr -> array_element(0);	/* move next element to final pos */
      962 		end;
      963 	     else do;
      964 		addr(stack -> temp(4)) -> fixnum_fmt.type_info = type_field;
      965 		addr(stack -> temp(4)) -> fixedb = array_ptr -> fixed_data(R);
      966 		array_ptr -> fixed_data(R) = array_ptr -> fixed_data(0);
      967 		end;
      968 
      969 	end;
      970 	if entry_id >= 0
      971 	then array_ptr -> array_element(0) = stack -> temp(4);
      972 	else array_ptr -> fixed_data(0) = addr(stack -> temp(4)) -> fixedb;
      973 
      974 
      975 
      976 	end heapsort;
      977 
      978 siftup:	proc;		/* the algorithm for ordering the binary tree correctly */
      979 
      980 dcl (I, J) fixed bin;	/* more Knuth variables */
      981 
      982 
      983 	do I = L repeat(J);
      984 
      985 	     J = 2*I+1;
      986 
      987 	     if J > R
      988 	     then do;
      989 pop_out:		if entry_id >= 0
      990 		then array_ptr -> array_element(I) = stack -> temp(4);	/* move K into proper place */
      991 		else array_ptr -> fixed_data(I) = addr(stack -> temp(4)) -> fixedb;
      992 		return;
      993 		end;
      994 
      995 	     if J < R 		/* I.E. there are two sons to node I in the heap, rather than 1. */
      996 	     then do;
      997 		stack_ptr = addr(stack->temp(7));		/* compare elements j and j+1 */
      998 		if entry_id >= 0 then do;
      999 		     stack -> temp(5) = array_ptr ->array_element(J);
     1000 		     stack -> temp(6) = array_ptr -> array_element(J+1);
     1001 		     end;
     1002 		else do;
     1003 		     addr(stack -> temp(5)) -> fixnum_fmt.type_info,
     1004 		      addr(stack -> temp(6)) -> fixnum_fmt.type_info = type_field;
     1005 		     addr(stack -> temp(5)) -> fixedb = array_ptr -> fixed_data(J);
     1006 		     addr(stack -> temp(6)) -> fixedb = array_ptr -> fixed_data(J+1);
     1007 		     end;
     1008 		call compare;		/* call the comparison function */
     1009 		if stack -> temp(5) ^= nil then J = J+1;	/* use the greater valued node */
     1010 		end;
     1011 
     1012 	     stack_ptr = addr(stack -> temp(7));
     1013 	     stack -> temp(5) = stack -> temp(4);		/* first arg to comparator is K */
     1014 	     if entry_id >= 0
     1015 	     then stack -> temp(6) = array_ptr -> array_element(J);	/* second is the larger son of node I */
     1016 	     else do;
     1017 		addr(stack -> temp(6)) -> fixnum_fmt.type_info = type_field;
     1018 		addr(stack -> temp(6)) -> fixedb = array_ptr -> fixed_data(J);
     1019 		end;
     1020 	     call compare;			/* call function */
     1021 
     1022 	     if stack -> temp(5) = nil then go to pop_out;	/* if K larger or equal, we are done */
     1023 
     1024 	     if entry_id >= 0
     1025 	     then array_ptr -> array_element(I) = array_ptr -> array_element(J);
     1026 	     else array_ptr -> fixed_data(I) = array_ptr -> fixed_data(J);
     1027 
     1028 	end;
     1029 
     1030 end siftup;
     1031 
     1032 compare:	procedure;			/* internal procedure for determining the ordering of two elements */
     1033 
     1034 dcl j fixed bin,
     1035     string_ptr(0:1) ptr;
     1036 
     1037 
     1038 	go to comparison(entry_id);		/* branck on which type of sort */
     1039 
     1040 comparison(1):				/* sortcar */
     1041 comparison(3):				/* sortcar (alphalessp) */
     1042 	stack -> temp(5) = stack -> temp_ptr(5) -> cons.car;
     1043 	stack -> temp(6) = stack -> temp_ptr(6) -> cons.car;
     1044 	go to comparison(entry_id-1);
     1045 
     1046 comparison(-1):				/* number sort */
     1047 comparison(0):				/* sort */
     1048 	call lisp_$snapcaller;		/* call evaluator to apply the function,
     1049*					   cleverly remembering the subr property for successive
     1050*					   calls if possible! */
     1051 	if array_ptr ^= null		/* if array sort recompute ptr */
     1052 	then array_ptr = stack -> temp_ptr(3) -> array_info.array_data_ptr;	/* in case gc in predicate */
     1053 	return;
     1054 
     1055 comparison(2):				/* alphasort */
     1056 
     1057 	do j = 0 to 1;			/* get two string pointers */
     1058 	     if stack -> temp_type36(5+j) & String36
     1059 	     then string_ptr(j) = stack -> temp_ptr(5+j);
     1060 	     else string_ptr(j) = addr(stack -> temp_ptr(5+j) -> atom.pnamel);
     1061 	end;
     1062 
     1063 	/* now compare the strings */
     1064 
     1065 	if string_ptr(0) -> lisp_string.string_length >= string_ptr(1) -> lisp_string.string_length
     1066 	then do;
     1067 
     1068 		j = string_ptr(1) -> lisp_string.string_length;	/* min of the lengths */
     1069 		if substr(string_ptr(0) -> lisp_string.string,1, j)
     1070 		   < substr(string_ptr(1) -> lisp_string.string,1,j)
     1071 		then stack -> temp(5) = t_atom;
     1072 		else stack -> temp(5) = nil;
     1073 
     1074 	     end;
     1075 
     1076 	else do;
     1077 
     1078 		j = string_ptr(0) -> lisp_string.string_length;	/* min of the lengths */
     1079 		if substr(string_ptr(0) -> lisp_string.string,1,j)
     1080 		    <= substr(string_ptr(1) -> lisp_string.string,1,j)
     1081 		then stack -> temp(5) = t_atom;
     1082 		else stack -> temp(5) = nil;
     1083 
     1084 	     end;
     1085 
     1086    end compare;
     1087 
     1088 
     1089 get_array_property: procedure;		/* common code to get array property */
     1090 
     1091 /* the following variables are set by this routine from the array in stack -> temp(1):
     1092*	array_ptr		-> data area of array
     1093*	array_size	number of elements in array
     1094*	array_type	type of array
     1095*   stack -> temp(2) is undisturbed
     1096*   stack -> temp(3) is left with the array-pointer (-> array_info)
     1097* */
     1098 
     1099 	stack_ptr = addr(stack -> temp(5));
     1100 retry:
     1101 	stack -> temp(3) = stack -> temp(1);		/* get array property of first arg */
     1102 	if stack -> temp_type36(3) & Array36 then;	/* already got array pointer */
     1103 	else do;					/* get array pointer from array property */
     1104 	     stack -> temp(4) = lisp_static_vars_$array_atom;
     1105 	     call lisp_property_fns_$get;
     1106 	     if stack -> temp_type36(3) & Array36 then;
     1107 	     else do;
     1108 		call reject_argument(1, not_an_array);	/* signal correctable error */
     1109 		go to retry;
     1110 		end;
     1111 	     end;
     1112 
     1113 	array_type = stack -> temp_ptr(3) -> array_info.type;
     1114 	if array_type = Dead_array
     1115 	then call reject_argument(1, dead_array_reference);
     1116 
     1117 	array_ptr = stack -> temp_ptr(3) -> array_info.array_data_ptr;
     1118 	array_size = 1;
     1119 	if stack -> temp_ptr(3) -> array_info.minus_2_times_ndims ^= 0	/* normal array */
     1120 	then do i = - stack -> temp_ptr(3) -> array_info.ndims
     1121 	     repeat (i+1)
     1122 	     while (i < 0);
     1123 	   array_size = array_size * array_ptr -> array_data.dope_vector(i+1).bounds;
     1124 	   end;
     1125 	else unspec(array_size) = stack -> temp_ptr(3) ->
     1126 			array_info.array_load_sequence(1);	/* external array */
     1127 
     1128 end get_array_property;
     1129 
     1130 merge:	proc;		/* procedure to merge two lists */
     1131 
     1132 	if stack -> temp(1) = nil
     1133 	then do;
     1134 		stack -> temp(1) = stack -> temp(2);
     1135 		return;
     1136 	     end;
     1137 
     1138 	if stack -> temp(2) = nil then return;
     1139 
     1140 	stack_ptr = addr(stack -> temp(7));		/* for space we need */
     1141 	stack -> temp(5) = stack -> temp_ptr(1) -> cons.car;
     1142 	stack -> temp(6) = stack -> temp_ptr(2) -> cons.car;
     1143 	call compare;					/* compare heads of lists */
     1144 	if stack -> temp(5) = nil
     1145 	then do;						/* if first list >= second */
     1146 		stack -> temp(3) = stack -> temp(1);
     1147 		stack -> temp(1) = stack -> temp(2);
     1148 	     end;
     1149 
     1150 	else do;
     1151 		stack -> temp(3) = stack -> temp(2);
     1152 		stack -> temp(2) = stack -> temp(1);
     1153 	     end;
     1154 
     1155 	stack -> temp(4) = stack -> temp(2);			/* temp 4 points to cell to rplacd */
     1156 	stack -> temp(2) = stack -> temp_ptr(2) -> cons.cdr;	/* temp 2 contains list we are merging into */
     1157 
     1158 							/* temp 3 contains list we are merging from */
     1159 	do while(stack -> temp(2) ^= nil);
     1160 
     1161 	     stack_ptr = addr(stack->temp(7));
     1162 	     stack -> temp(5) = stack -> temp_ptr(2) -> cons.car;
     1163 	     stack -> temp(6) = stack -> temp_ptr(3) -> cons.car;
     1164 	     call compare;
     1165 	     if stack -> temp(5) = nil			/* if list we are merging into is >=
     1166*							   than list merging from, exchange */
     1167 	     then do;
     1168 		     stack -> temp_ptr(4) -> cons.cdr = stack -> temp(3);
     1169 		     stack -> temp(3) = stack -> temp(2);
     1170 		     stack -> temp(2) = stack -> temp_ptr(4) -> cons.cdr;
     1171 		end;
     1172 
     1173 	     stack -> temp(4) = stack -> temp(2);		/* move down list */
     1174 	     stack -> temp(2) = stack -> temp_ptr(4) -> cons.cdr;
     1175 
     1176 	end;
     1177 
     1178 	stack -> temp_ptr(4) -> cons.cdr = stack -> temp(3);	/* put remainder of list on end */
     1179 
     1180 end merge;
     1181 
     1182 
     1183 merge_sort:proc;						/* procedure to merge sort a list in place */
     1184 
     1185 dcl retv(0:99) fixed bin,				/* return stack, of essentially infinite length */
     1186     sourcep ptr,
     1187     depth fixed bin,
     1188     list_size fixed bin;					/* log of length of current lists */
     1189 
     1190 	array_ptr = null;					/* see compare */
     1191 	stack_ptr = addr(stack -> temp(4));
     1192 	sourcep = stack;
     1193 
     1194 	unmkd_ptr = addrel(ustack,2);
     1195 	ustack -> snapcall_args.fn_offset = -14;
     1196 	ustack -> snapcall_args.arg_length = -4;
     1197 
     1198 	stack -> temp(3) = nil;				/* initial result */
     1199 	depth = 0;					/* initial recursion depth */
     1200 	retv(0) = 0;					/* set return for call to pfx */
     1201 	list_size = -1;
     1202 	stack = stack_ptr;
     1203 	go to pfx;
     1204 
     1205 pfxret(0):	stack = addrel(stack,-2);				/* get back to result, and merge in */
     1206 	stack_ptr = addr(stack -> temp(3));
     1207 	call merge;
     1208 
     1209 	if sourcep -> temp(1) = nil
     1210 	then do;
     1211 		sourcep -> temp(1) = stack -> temp(1);
     1212 		stack = sourcep;
     1213 		goto exit;
     1214 	     end;
     1215 
     1216 	stack = addr(stack -> temp(2));			/* move up again */
     1217 	list_size = list_size + 1;
     1218 	go to pfx;
     1219 
     1220 pfx:							/* routine to obtain sorted prefix of source list */
     1221 	stack_ptr = addr(stack -> temp(2));
     1222 	stack -> temp(1) = sourcep -> temp(1);		/* get source list */
     1223 	if stack -> temp(1) = nil				/* if none left, */
     1224 	then goto pfxret(retv(depth));
     1225 	if list_size <= 0
     1226 	then do;
     1227 		sourcep -> temp(1) = sourcep -> temp_ptr(1) -> cons.cdr;
     1228 		stack -> temp_ptr(1) -> cons.cdr = nil;		/* get list of length 1 */
     1229 		go to pfxret(retv(depth));
     1230 	     end;
     1231 
     1232 	/* otherwise, call pfx recursiviely twice, and merge the two shorter lists */
     1233 
     1234 	list_size = list_size - 1;
     1235 	depth = depth + 1;
     1236 	retv(depth) = 1;			/* set return address */
     1237 	go to pfx;
     1238 
     1239 pfxret(1):retv(depth) = 2;			/* set for next call */
     1240 	stack = addr(stack -> temp(2));
     1241 	ustack -> snapcall_args.fn_offset = ustack -> snapcall_args.fn_offset - 2;
     1242 	go to pfx;
     1243 
     1244 pfxret(2):stack = addrel(stack,-2);
     1245 	depth = depth - 1;
     1246 	list_size = list_size + 1;
     1247 	call merge;
     1248 	ustack -> snapcall_args.fn_offset = ustack -> snapcall_args.fn_offset + 2;
     1249 	go to pfxret(retv(depth));		/* return */
     1250 
     1251 end merge_sort;
     1252 end lisp_array_fcns_;
	SOURCE FILES USED IN THIS COMPILATION.

LINE      NUMBER  DATE MODIFIED     NAME			PATHNAME
             0    06/29/83  1542.2  lisp_array_fcns_.pl1              >special_ldd>on>06/27/83>lisp_array_fcns_.pl1
157          1    03/27/82  0437.1  lisp_array_fmt.incl.pl1           >ldd>include>lisp_array_fmt.incl.pl1
158          2    06/29/83  1425.3  lisp_stack_seg.incl.pl1           >ldd>include>lisp_stack_seg.incl.pl1
159          3    03/27/82  0437.0  lisp_nums.incl.pl1                >ldd>include>lisp_nums.incl.pl1
160          4    03/27/82  0437.0  lisp_readtable.incl.pl1           >ldd>include>lisp_readtable.incl.pl1
161          5    03/27/82  0437.0  lisp_common_vars.incl.pl1         >ldd>include>lisp_common_vars.incl.pl1
162          6    03/27/82  0437.0  lisp_cons_fmt.incl.pl1            >ldd>include>lisp_cons_fmt.incl.pl1
163          7    06/29/83  1425.3  lisp_name_codes.incl.pl1          >ldd>include>lisp_name_codes.incl.pl1
164          8    03/27/82  0437.0  lisp_stack_fmt.incl.pl1           >ldd>include>lisp_stack_fmt.incl.pl1
165          9    03/27/82  0437.0  lisp_ptr_fmt.incl.pl1             >ldd>include>lisp_ptr_fmt.incl.pl1
166         10    03/27/82  0437.1  lisp_atom_fmt.incl.pl1            >ldd>include>lisp_atom_fmt.incl.pl1
167         11    03/27/82  0436.9  lisp_string_fmt.incl.pl1          >ldd>include>lisp_string_fmt.incl.pl1
	NAMES DECLARED IN THIS COMPILATION.

IDENTIFIER	     OFFSET    LOC STORAGE CLASS   DATA TYPE		ATTRIBUTES AND REFERENCES
								(* indicates a set context)

Array                                  internal static bit(9)                   initial unaligned dcl 9-17
Array36                                constant        bit(36)                  initial dcl 9-17 ref 222 342 361 501 505 507 556 581
                                                                                  787 1102 1106
Atomic                                 internal static bit(9)                   initial unaligned dcl 9-17
Atomic36                               internal static bit(36)                  initial dcl 9-17
Atsym                                  internal static bit(9)                   initial unaligned dcl 9-17
Atsym36                                constant        bit(36)                  initial dcl 9-17 ref 208 879 892 906 909
Bigfix                                 internal static bit(9)                   initial unaligned dcl 9-17
Bigfix36                               internal static bit(36)                  initial dcl 9-17
Bignum                                 internal static bit(9)                   initial unaligned dcl 9-17
Bignum36                               internal static bit(36)                  initial dcl 9-17
Cons                                   constant        bit(9)                   initial unaligned dcl 9-17 ref 475 595
Cons36                                 internal static bit(36)                  initial dcl 9-17
Dead_array                             constant        fixed bin(17,0)          initial dcl 1-20 ref 548 1114
File                                   internal static bit(9)                   initial unaligned dcl 9-17
File36                                 internal static bit(36)                  initial dcl 9-17
Fixed                                  internal static bit(9)                   initial unaligned dcl 9-17
Fixed36                                constant        bit(36)                  initial dcl 9-17 ref 264 375 380
Fixnum_array                           constant        fixed bin(17,0)          initial dcl 1-20 ref 190 196 303 313 612 615 632 639
                                                                                  675 678 711 711 735 755 829 830 876
Float                                  internal static bit(9)                   initial unaligned dcl 9-17
Float36                                internal static bit(36)                  initial dcl 9-17
Flonum_array                           constant        fixed bin(17,0)          initial dcl 1-20 ref 191 323 646 683 756 836
I                               000314 automatic       fixed bin(17,0)          dcl 980 set ref 983* 985 989 991 1024 1026*
J                               000315 automatic       fixed bin(17,0)          dcl 980 set ref 985* 987 995 999 1000 1005 1006
                                                                                  1009* 1009 1014 1018 1024 1026 1028
L                               000106 automatic       fixed bin(17,0)          dcl 33 set ref 608* 612 615 619 624* 624 625 628 633
                                                                                  634* 634 634* 635* 636 640 641* 641 641* 642* 643
                                                                                  647 648* 648 648* 649* 650 672* 675 680 685 688*
                                                                                  878* 879 892* 932* 934 938* 944* 983
NotConsOrAtsym36                       internal static bit(36)                  initial dcl 9-17
Numeric                                internal static bit(9)                   initial unaligned dcl 9-17
Numeric36                              internal static bit(36)                  initial dcl 9-17
Obarray_array                          constant        fixed bin(17,0)          initial dcl 1-20 ref 192 333 346 403 731 758 792
R                               000107 automatic       fixed bin(17,0)          dcl 33 set ref 928* 949 950 953 954 956* 956* 960
                                                                                  961 965 966* 987 995
Readtable_array                        constant        fixed bin(17,0)          initial dcl 1-20 ref 193 233 245 261 273 354 365 392
                                                                                  400 605 666 727 757
S_expr_array                           constant        fixed bin(17,0)          initial dcl 1-20 ref 189 753
String                                 internal static bit(9)                   initial unaligned dcl 9-17
String36                               constant        bit(36)                  initial dcl 9-17 ref 879 892 906 909 1058
Subr                                   internal static bit(9)                   initial unaligned dcl 9-17
Subr36                                 constant        bit(36)                  initial dcl 9-17 ref 556
SubrNumeric36                          internal static bit(36)                  initial dcl 9-17
System_Subr                            internal static bit(9)                   initial unaligned dcl 9-17
System_Subr36                          internal static bit(36)                  initial dcl 9-17
Un_gc_array                            constant        fixed bin(17,0)          initial dcl 1-20 ref 188 754
Uncollectable                          internal static bit(9)                   initial unaligned dcl 9-17
Undefined                              internal static bit(72)                  initial unaligned dcl 9-17
ZERO                                   constant        fixed bin(17,0)          initial dcl 1-37 ref 295 337 466 468 691
abbreviate_on_files     435            based           bit(1)                   level 2 dcl 4-11 set ref 437*
abbreviate_on_flat      436            based           bit(1)                   level 2 dcl 4-11 set ref 438*
addr                                                   builtin function         dcl 33 ref 214 266 340 356 376 376 381 452 464 476
                                                                                  488 533 571 579 582 609 615 615 619 619 653 664
                                                                                  669 670 692 707 714 764 765 766 769 770 771 774
                                                                                  781 782 809 848 879 883 892 902 923 937 938 948
                                                                                  949 964 965 972 991 997 1003 1003 1005 1006 1012
                                                                                  1017 1018 1060 1099 1140 1161 1191 1206 1216 1220
                                                                                  1240
addrel                                                 builtin function         dcl 33 ref 260 285 474 490 537 563 565 573 593 694
                                                                                  701 723 744 783 818 884 924 1194 1205 1244
alpha                                  internal static bit(27)                  initial unaligned dcl 4-27
alpha_loss                      001614 constant        label                    dcl 883 ref 893 908 910
alpha_retry                     001557 constant        label                    dcl 870 ref 890
alphasort                       001555 constant        label                    dcl 868 ref 822
arg_length                1            based           fixed bin(17,0)          level 2 dcl 33 set ref 785* 926* 1196*
args_to_lisp_error_on_unmarked_pdl     based           structure                level 1 dcl 529
argument_must_be_array                 defined         fixed bin(17,0)          dcl 113 set ref 211* 344* 363*
array                           000074 constant        entry                    external dcl 472
array_atom                             defined         fixed bin(71,0)          dcl 5-6
array_data                             based           structure                level 1 dcl 1-31
array_data_ptr            2            based           pointer                  level 2 dcl 1-8 set ref 235 287 349 367 390* 456 466
                                                                                  468 550* 691 709 749 795 804 1051 1117
array_element                          based           fixed bin(71,0)          array dcl 149 set ref 306* 306 309* 349* 349 612*
                                                                                  633 635* 675 688 732* 732 737* 737 795 804 879 892
                                                                                  934 953 954* 954 960 961* 961 970* 989* 999 1000
                                                                                  1014 1024* 1024
array_info                             based           structure                level 1 dcl 1-8 set ref 555 555
array_info_for_store    122            based           pointer                  level 2 dcl 2-5 set ref 182*
array_load_sequence             000000 constant        structure                array level 1 dcl 132 in procedure
                                                                                  "lisp_array_fcns_"
array_load_sequence       4            based           bit(36)                  array level 2 in structure "array_info" dcl 1-8
                                                                                  in procedure "lisp_array_fcns_" set ref 250* 384*
                                                                                  771 1125
array_ptr                       000132 automatic       pointer                  dcl 80 set ref 284* 285* 285 292 295 297 306 309 316
                                                                                  319 326 329 337 349 376* 390 423 424 425 427 429
                                                                                  431 432 434 435 436 437 438 439 444 454 555* 556
                                                                                  612 615 619 633 635 640 642 647 649 675 680 685
                                                                                  688 691* 732 735 737 749* 765 771 879 892 934 938
                                                                                  949 950 950 953 954 954 960 961 961 965 966 966
                                                                                  970 972 989 991 999 1000 1005 1006 1014 1018 1024
                                                                                  1024 1026 1026 1051 1051* 1117* 1123 1190*
array_size                      000134 automatic       fixed bin(18,0)          dcl 80 set ref 262* 268* 268 274* 277* 282 305 308
                                                                                  315 318 325 328 349 381* 384 625 634 641 648 664*
                                                                                  664 672 705 726* 726 732 735 737 878 921 928 932
                                                                                  1118* 1123* 1123 1125*
array_too_big                          defined         fixed bin(17,0)          dcl 113 set ref 283*
array_type                      000130 automatic       fixed bin(17,0)          dcl 80 set ref 188* 189* 190* 191* 192* 193* 196*
                                                                                  231 233 245 250 261 273 282 295 303 313 323 333
                                                                                  354 391 392 400 403 605 612 615 632 639 646 666
                                                                                  675 678 683 704 711 711 727 731 735 753 754 755
                                                                                  756 757 758 829 830 836 876 1113* 1114
arraydim                               automatic       fixed bin(17,0)          dcl 33
arraydims                       001037 constant        entry                    external dcl 741
atom                                   based           structure                level 1 dcl 10-5
atom_double_words                      based           structure                level 1 dcl 10-5
atom_ptrs                              based           structure                level 1 dcl 10-5
bad_argument                           defined         fixed bin(17,0)          dcl 113 set ref 200* 207* 226* 267* 270* 378* 383*
bad_mapa                        001312 constant        label                    dcl 788 ref 792
based_ptr                              based           pointer                  dcl 9-16 ref 340 356 781 892
binding_block                          based           structure                level 1 dcl 8-7
binding_top                            defined         pointer                  dcl 5-6
bindings                               based           structure                array level 1 dcl 8-7
bit12                                  internal static bit(27)                  initial unaligned dcl 4-27
blank                                  internal static bit(27)                  initial unaligned dcl 4-27
bltarray                        000662 constant        entry                    external dcl 698
bounds                                 based           fixed bin(35,0)          array level 3 in structure "array_data" dcl 1-31
                                                                                  in procedure "lisp_array_fcns_" set ref 237 292*
                                                                                  765 1123
bounds                                 based           fixed bin(18,0)          array dcl 149 in procedure "lisp_array_fcns_" set
                                                                                  ref 266* 267 268 274* 277* 292 297
call_array_operator       1            based           bit(36)                  level 2 in structure "array_info" dcl 1-8
                                                                                  in procedure "lisp_array_fcns_" set ref 392* 394*
                                                                                  549*
call_array_operator             000033 constant        bit(36)                  initial unaligned dcl 2-68 in procedure
                                                                                  "lisp_array_fcns_" ref 392
call_dead_array_operator        000032 constant        bit(36)                  initial unaligned dcl 2-68 ref 394 549
cant_alphasort_number_array     001526 constant        label                    dcl 856 ref 876
cant_sort_special_array         001526 constant        label                    dcl 856 ref 842
cant_sortcar_number_array       001526 constant        label                    dcl 856 ref 835 841
car                                    based           pointer                  level 2 in structure "cons_ptrs" dcl 6-5
                                                                                  in procedure "lisp_array_fcns_" ref 909
car                                    based           fixed bin(71,0)          level 2 in structure "cons" dcl 6-5 in procedure
                                                                                  "lisp_array_fcns_" ref 477 611 797 1040 1043 1141
                                                                                  1142 1162 1163
catch_frame                            defined         pointer                  dcl 5-6
cdr                       2            based           fixed bin(71,0)          level 2 dcl 6-5 set ref 478 623 798 911 1156 1168*
                                                                                  1170 1174 1178* 1227 1228*
code                                   based           fixed bin(17,0)          level 2 dcl 33 set ref 885*
compare                         004212 constant        entry                    internal dcl 1032 ref 1008 1020 1143 1164
comparison                      000022 constant        label                    array(-1:3) dcl 1040 ref 1038 1044
cons                                   based           structure                level 1 dcl 6-5
cons_ptrs                              based           structure                level 1 dcl 6-5
cons_types                             based           structure                level 1 dcl 6-5
cons_types36                           based           structure                level 1 dcl 6-22
consptr                                automatic       pointer                  dcl 6-5
copy_a_readtable                003370 constant        entry                    internal dcl 442 ref 368 728
data                                   based           fixed bin(71,0)          array level 2 dcl 1-31 set ref 337* 466 468*
dead_array_reference                   defined         fixed bin(17,0)          dcl 113 set ref 1114*
decimal_point                          internal static bit(27)                  initial unaligned dcl 4-27
depth                           000522 automatic       fixed bin(17,0)          dcl 1185 set ref 1199* 1223 1229 1235* 1235 1236
                                                                                  1239 1245* 1245 1249
digit                                  internal static bit(27)                  initial unaligned dcl 4-27
divide                                                 builtin function         dcl 33 ref 184 932
done                            000506 constant        label                    dcl 653 ref 625 628 696 739
dope_vector                            based           structure                array level 2 dcl 1-31
dotted_pair_dot                        internal static bit(27)                  initial unaligned dcl 4-27
entry_id                        000116 automatic       fixed bin(17,0)          dcl 70 set ref 816* 830 832* 836 838* 864* 868* 868
                                                                                  879 906 934 946 959 970 989 998 1014 1024 1038
                                                                                  1044
err                                    parameter       fixed bin(17,0)          dcl 523 ref 521 538
err_frame                              defined         pointer                  dcl 5-6
err_recp                               defined         pointer                  dcl 5-6
errcode                                based           fixed bin(35,0)          array level 2 dcl 529 set ref 538* 539*
error_args                             based           structure                level 1 dcl 33
eval_frame                             defined         pointer                  dcl 5-6
exit                            001517 constant        label                    dcl 848 ref 176 493 510 516 825 870 917 921 1213
extd_alpha                             internal static bit(27)                  initial unaligned dcl 4-27
external_array                  000127 automatic       bit(1)                   unaligned dcl 80 set ref 181* 195* 253
fault_tag_3_number_2            000042 constant        bit(72)                  initial unaligned dcl 128 ref 182
fillarray                       000244 constant        entry                    external dcl 590
fillarray_bltarray_join         000676 constant        label                    dcl 702 ref 600
finish_copying_obarray          003430 constant        entry                    internal dcl 459 ref 404 733
finish_copying_readtable        003401 constant        entry                    internal dcl 449 ref 400 729
fix1                            000136 automatic       fixed bin(35,0)          dcl 96 set ref 640* 642
fix2                                   automatic       fixed bin(35,0)          dcl 96
fixed_data                             based           fixed bin(35,0)          array dcl 149 set ref 316* 316 319* 615* 640 642*
                                                                                  680 735* 735 938 949 950* 950 965 966* 966 972*
                                                                                  991* 1005 1006 1018 1026* 1026
fixedb                    1            based           fixed bin(17,0)          level 2 dcl 3-4 set ref 266 376 381 564 615 664 680*
                                                                                  765* 771* 938* 949* 965* 972 991 1005* 1006* 1018*
fixnum_fmt                             based           structure                level 1 dcl 3-4
fixnum_type                            constant        bit(36)                  initial dcl 3-4 ref 615 679 764 770 833
float1                          000137 automatic       float bin(27)            dcl 96 set ref 647* 649
float2                                 automatic       float bin(27)            dcl 96
float_data                             based           float bin(27)            array dcl 149 set ref 326* 326 329* 619* 647 649*
                                                                                  685
floatb                    1            based           float bin(27)            level 2 dcl 3-4 set ref 619 685*
flonum_fmt                             based           structure                level 1 dcl 3-4
flonum_type                            constant        bit(36)                  initial dcl 3-4 ref 619 684 839
fn_CtoI                                internal static fixed bin(17,0)          initial dcl 7-9
fn_ItoC                                internal static fixed bin(17,0)          initial dcl 7-9
fn_abs                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_add1                                internal static fixed bin(17,0)          initial dcl 7-9
fn_add1_fix                            internal static fixed bin(17,0)          initial dcl 7-9
fn_add1_flo                            internal static fixed bin(17,0)          initial dcl 7-9
fn_alarmclock                          internal static fixed bin(17,0)          initial dcl 7-9
fn_allfiles                            internal static fixed bin(17,0)          initial dcl 7-9
fn_alphalessp                          internal static fixed bin(17,0)          initial dcl 7-9
fn_apply                               internal static fixed bin(17,0)          initial dcl 7-9
fn_arg                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_args                                internal static fixed bin(17,0)          initial dcl 7-9
fn_array                               constant        fixed bin(17,0)          initial dcl 7-9 ref 485
fn_arraydims                           constant        fixed bin(17,0)          initial dcl 7-9 ref 743
fn_ascii                               internal static fixed bin(17,0)          initial dcl 7-9
fn_atan                                internal static fixed bin(17,0)          initial dcl 7-9
fn_baktrace                            internal static fixed bin(17,0)          initial dcl 7-9
fn_bltarray                            constant        fixed bin(17,0)          initial dcl 7-9 ref 700
fn_boole                               internal static fixed bin(17,0)          initial dcl 7-9
fn_boundp                              internal static fixed bin(17,0)          initial dcl 7-9
fn_catch                               internal static fixed bin(17,0)          initial dcl 7-9
fn_catenate                            internal static fixed bin(17,0)          initial dcl 7-9
fn_charpos                             internal static fixed bin(17,0)          initial dcl 7-9
fn_chrct                               internal static fixed bin(17,0)          initial dcl 7-9
fn_clear_input                         internal static fixed bin(17,0)          initial dcl 7-9
fn_cline                               internal static fixed bin(17,0)          initial dcl 7-9
fn_close                               internal static fixed bin(17,0)          initial dcl 7-9
fn_cos                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_cursorpos                           internal static fixed bin(17,0)          initial dcl 7-9
fn_defaultf                            internal static fixed bin(17,0)          initial dcl 7-9
fn_definedp                            internal static fixed bin(17,0)          initial dcl 7-9
fn_defsubr                             internal static fixed bin(17,0)          initial dcl 7-9
fn_defun                               internal static fixed bin(17,0)          initial dcl 7-9
fn_delete                              internal static fixed bin(17,0)          initial dcl 7-9
fn_deletef                             internal static fixed bin(17,0)          initial dcl 7-9
fn_delq                                internal static fixed bin(17,0)          initial dcl 7-9
fn_diff_fix                            internal static fixed bin(17,0)          initial dcl 7-9
fn_diff_flo                            internal static fixed bin(17,0)          initial dcl 7-9
fn_difference                          internal static fixed bin(17,0)          initial dcl 7-9
fn_displace                            internal static fixed bin(17,0)          initial dcl 7-9
fn_do                                  internal static fixed bin(17,0)          initial dcl 7-9
fn_dumparrays                          internal static fixed bin(17,0)          initial dcl 7-9
fn_endpagefn                           internal static fixed bin(17,0)          initial dcl 7-9
fn_eoffn                               internal static fixed bin(17,0)          initial dcl 7-9
fn_eql                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_errframe                            internal static fixed bin(17,0)          initial dcl 7-9
fn_errprint                            internal static fixed bin(17,0)          initial dcl 7-9
fn_errset                              internal static fixed bin(17,0)          initial dcl 7-9
fn_eval                                internal static fixed bin(17,0)          initial dcl 7-9
fn_eval_when                           internal static fixed bin(17,0)          initial dcl 7-9
fn_evalframe                           internal static fixed bin(17,0)          initial dcl 7-9
fn_exp                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_expt                                internal static fixed bin(17,0)          initial dcl 7-9
fn_expt_fix                            internal static fixed bin(17,0)          initial dcl 7-9
fn_expt_flo                            internal static fixed bin(17,0)          initial dcl 7-9
fn_filepos                             internal static fixed bin(17,0)          initial dcl 7-9
fn_fillarray                           constant        fixed bin(17,0)          initial dcl 7-9 ref 592
fn_fix                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_float                               internal static fixed bin(17,0)          initial dcl 7-9
fn_force_output                        internal static fixed bin(17,0)          initial dcl 7-9
fn_freturn                             internal static fixed bin(17,0)          initial dcl 7-9
fn_fsc                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_gcd                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_gensym                              internal static fixed bin(17,0)          initial dcl 7-9
fn_get                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_get_pname                           internal static fixed bin(17,0)          initial dcl 7-9
fn_getchar                             internal static fixed bin(17,0)          initial dcl 7-9
fn_getl                                internal static fixed bin(17,0)          initial dcl 7-9
fn_greaterp                            internal static fixed bin(17,0)          initial dcl 7-9
fn_gt                                  internal static fixed bin(17,0)          initial dcl 7-9
fn_haipart                             internal static fixed bin(17,0)          initial dcl 7-9
fn_haulong                             internal static fixed bin(17,0)          initial dcl 7-9
fn_ifix                                internal static fixed bin(17,0)          initial dcl 7-9
fn_in                                  internal static fixed bin(17,0)          initial dcl 7-9
fn_includef                            internal static fixed bin(17,0)          initial dcl 7-9
fn_index                               internal static fixed bin(17,0)          initial dcl 7-9
fn_inpush                              internal static fixed bin(17,0)          initial dcl 7-9
fn_isqrt                               internal static fixed bin(17,0)          initial dcl 7-9
fn_lessp                               internal static fixed bin(17,0)          initial dcl 7-9
fn_linel                               internal static fixed bin(17,0)          initial dcl 7-9
fn_linenum                             internal static fixed bin(17,0)          initial dcl 7-9
fn_listarray                           constant        fixed bin(17,0)          initial dcl 7-9 ref 660
fn_listify                             internal static fixed bin(17,0)          initial dcl 7-9
fn_loadarrays                          internal static fixed bin(17,0)          initial dcl 7-9
fn_log                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_ls                                  internal static fixed bin(17,0)          initial dcl 7-9
fn_lsh                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_make_atom                           internal static fixed bin(17,0)          initial dcl 7-9
fn_makunbound                          internal static fixed bin(17,0)          initial dcl 7-9
fn_mapatoms                            constant        fixed bin(17,0)          initial dcl 7-9 ref 779
fn_max                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_mergef                              internal static fixed bin(17,0)          initial dcl 7-9
fn_min                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_minus                               internal static fixed bin(17,0)          initial dcl 7-9
fn_minusp                              internal static fixed bin(17,0)          initial dcl 7-9
fn_namelist                            internal static fixed bin(17,0)          initial dcl 7-9
fn_names                               internal static fixed bin(17,0)          initial dcl 7-9
fn_namestring                          internal static fixed bin(17,0)          initial dcl 7-9
fn_nointerrupt                         internal static fixed bin(17,0)          initial dcl 7-9
fn_nth                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_nthcdr                              internal static fixed bin(17,0)          initial dcl 7-9
fn_oddp                                internal static fixed bin(17,0)          initial dcl 7-9
fn_offset                              based           fixed bin(17,0)          level 2 dcl 33 set ref 784* 925* 1195* 1241* 1241
                                                                                  1248* 1248
fn_open                                internal static fixed bin(17,0)          initial dcl 7-9
fn_opena                               internal static fixed bin(17,0)          initial dcl 7-9
fn_openi                               internal static fixed bin(17,0)          initial dcl 7-9
fn_openo                               internal static fixed bin(17,0)          initial dcl 7-9
fn_out                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_pagel                               internal static fixed bin(17,0)          initial dcl 7-9
fn_pagenum                             internal static fixed bin(17,0)          initial dcl 7-9
fn_plus                                internal static fixed bin(17,0)          initial dcl 7-9
fn_plus_fix                            internal static fixed bin(17,0)          initial dcl 7-9
fn_plus_flo                            internal static fixed bin(17,0)          initial dcl 7-9
fn_plusp                               internal static fixed bin(17,0)          initial dcl 7-9
fn_prin1                               internal static fixed bin(17,0)          initial dcl 7-9
fn_princ                               internal static fixed bin(17,0)          initial dcl 7-9
fn_print                               internal static fixed bin(17,0)          initial dcl 7-9
fn_prog                                internal static fixed bin(17,0)          initial dcl 7-9
fn_progv                               internal static fixed bin(17,0)          initial dcl 7-9
fn_putprop                             internal static fixed bin(17,0)          initial dcl 7-9
fn_quot_fix                            internal static fixed bin(17,0)          initial dcl 7-9
fn_quot_flo                            internal static fixed bin(17,0)          initial dcl 7-9
fn_quotient                            internal static fixed bin(17,0)          initial dcl 7-9
fn_random                              internal static fixed bin(17,0)          initial dcl 7-9
fn_read                                internal static fixed bin(17,0)          initial dcl 7-9
fn_read_from_string                    internal static fixed bin(17,0)          initial dcl 7-9
fn_readch                              internal static fixed bin(17,0)          initial dcl 7-9
fn_readstring                          internal static fixed bin(17,0)          initial dcl 7-9
fn_remainder                           internal static fixed bin(17,0)          initial dcl 7-9
fn_remprop                             internal static fixed bin(17,0)          initial dcl 7-9
fn_rename                              internal static fixed bin(17,0)          initial dcl 7-9
fn_rot                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_rplaca                              internal static fixed bin(17,0)          initial dcl 7-9
fn_samepnamep                          internal static fixed bin(17,0)          initial dcl 7-9
fn_save                                internal static fixed bin(17,0)          initial dcl 7-9
fn_set                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_setarg                              internal static fixed bin(17,0)          initial dcl 7-9
fn_setq                                internal static fixed bin(17,0)          initial dcl 7-9
fn_setsyntax                           internal static fixed bin(17,0)          initial dcl 7-9
fn_shortnamestring                     internal static fixed bin(17,0)          initial dcl 7-9
fn_signp                               internal static fixed bin(17,0)          initial dcl 7-9
fn_sin                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_sleep                               internal static fixed bin(17,0)          initial dcl 7-9
fn_sort                                constant        fixed bin(17,0)          initial dcl 7-9 ref 815
fn_sortcar                             constant        fixed bin(17,0)          initial dcl 7-9 ref 863
fn_sqrt                                internal static fixed bin(17,0)          initial dcl 7-9
fn_sstatus                             internal static fixed bin(17,0)          initial dcl 7-9
fn_star_array                          constant        fixed bin(17,0)          initial dcl 7-9 ref 172
fn_star_rearray                        constant        fixed bin(17,0)          initial dcl 7-9 ref 497
fn_star_sstatus                        internal static fixed bin(17,0)          initial dcl 7-9
fn_star_status                         internal static fixed bin(17,0)          initial dcl 7-9
fn_status                              internal static fixed bin(17,0)          initial dcl 7-9
fn_store                               internal static fixed bin(17,0)          initial dcl 7-9
fn_stringlength                        internal static fixed bin(17,0)          initial dcl 7-9
fn_sub1                                internal static fixed bin(17,0)          initial dcl 7-9
fn_sub1_fix                            internal static fixed bin(17,0)          initial dcl 7-9
fn_sub1_flo                            internal static fixed bin(17,0)          initial dcl 7-9
fn_substr                              internal static fixed bin(17,0)          initial dcl 7-9
fn_sxhash                              internal static fixed bin(17,0)          initial dcl 7-9
fn_sysp                                internal static fixed bin(17,0)          initial dcl 7-9
fn_throw                               internal static fixed bin(17,0)          initial dcl 7-9
fn_times                               internal static fixed bin(17,0)          initial dcl 7-9
fn_times_fix                           internal static fixed bin(17,0)          initial dcl 7-9
fn_times_flo                           internal static fixed bin(17,0)          initial dcl 7-9
fn_truename                            internal static fixed bin(17,0)          initial dcl 7-9
fn_tyi                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_tyipeek                             internal static fixed bin(17,0)          initial dcl 7-9
fn_tyo                                 internal static fixed bin(17,0)          initial dcl 7-9
fn_unwind_protect                      internal static fixed bin(17,0)          initial dcl 7-9
fn_zerop                               internal static fixed bin(17,0)          initial dcl 7-9
forcefeed                              internal static bit(27)                  initial unaligned dcl 4-27
gc_mark                   0(18)        based           bit(18)                  level 2 packed unaligned dcl 1-8 set ref 248*
get_array_prop                  003645 constant        entry                    internal dcl 576 ref 209 503 572
get_array_prop_3                003634 constant        entry                    internal dcl 570 ref 341 360
get_array_property              004346 constant        entry                    internal dcl 1089 ref 603 663 702 708 745 828 874
heapsort                        003673 constant        entry                    internal dcl 919 ref 843 897
i                               000135 automatic       fixed bin(18,0)          dcl 80 set ref 236* 237* 263* 264 266 266 267 267
                                                                                  268 270* 282* 283 284* 291* 292 292* 296* 297 297*
                                                                                  305* 306 306* 308* 308 308* 309* 315* 316 316*
                                                                                  318* 318 318* 319* 325* 326 326* 328* 328 328*
                                                                                  329* 335* 337* 426* 427* 463* 466 468* 762* 762*
                                                                                  764 765 765 766 766* 794* 795* 803* 804* 1119*
                                                                                  1119* 1123* 1124
initialize_a_readtable          003301 constant        entry                    internal dcl 414 ref 357
inst                            000000 constant        bit(36)                  initial array level 2 dcl 132 ref 250
j                               000324 automatic       fixed bin(17,0)          dcl 1034 set ref 1055* 1058 1058 1058 1060 1060*
                                                                                  1068* 1069 1069 1078* 1079 1079
join_sort                       001436 constant        label                    dcl 818 ref 866
kill_array                      003554 constant        entry                    internal dcl 546 ref 222 501 505 557
lisp_$eval                      000024 constant        entry                    external dcl 33 ref 479
lisp_$snapcaller                000032 constant        entry                    external dcl 33 ref 799 805 1046
lisp_alloc_                     000022 constant        entry                    external dcl 33 ref 284 747
lisp_alloc_$cons                000014 constant        entry                    external dcl 33 ref 690 716
lisp_alloc_$ncons               000016 constant        entry                    external dcl 33 ref 715
lisp_array_fcns_                000051 constant        entry                    external dcl 6
lisp_error_                     000012 constant        entry                    external dcl 33 ref 540 889
lisp_error_table_$argument_must_be_array
                                000052 external static fixed bin(17,0)          dcl 101 ref 211 211 344 344 363 363
lisp_error_table_$array_too_big 000064 external static fixed bin(17,0)          dcl 101 ref 283 283
lisp_error_table_$bad_argument  000046 external static fixed bin(17,0)          dcl 101 ref 200 200 207 207 226 226 267 267 270 270
                                                                                  378 378 383 383
lisp_error_table_$dead_array_reference
                                000074 external static fixed bin(17,0)          dcl 101 ref 1114 1114
lisp_error_table_$not_alpha_array
                                000072 external static fixed bin(17,0)          dcl 101 ref 885 885
lisp_error_table_$not_an_array  000070 external static fixed bin(17,0)          dcl 101 ref 788 788 1108 1108
lisp_error_table_$not_same_type 000054 external static fixed bin(17,0)          dcl 101 ref 231 231 346 346 365 365 718 718
lisp_error_table_$special_array_type
                                000056 external static fixed bin(17,0)          dcl 101 ref 233 233 666 666 856 856
lisp_error_table_$store_not_allowed
                                000066 external static fixed bin(17,0)          dcl 101 ref 605 605 618 618 622 622
lisp_error_table_$too_few_args  000060 external static fixed bin(17,0)          dcl 101 ref 258 258
lisp_error_table_$too_many_args 000062 external static fixed bin(17,0)          dcl 101 ref 259 259
lisp_error_table_$wrong_external_array_ndims
                                000050 external static fixed bin(17,0)          dcl 101 ref 198 198
lisp_list_utils_$subst          000026 constant        entry                    external dcl 33 ref 455 467
lisp_property_fns_$get          000010 constant        entry                    external dcl 33 ref 584 1105
lisp_property_fns_$putprop      000030 constant        entry                    external dcl 33 ref 217
lisp_ptr                               based           structure                level 1 dcl 9-17
lisp_ptr_type                          based           bit(36)                  dcl 9-17 ref 879 892 906 909
lisp_reader_alm_$initial_readtable
                                000120 external static structure                level 1 dcl 416
lisp_static_man_$allocate       000020 constant        entry                    external dcl 33 ref 555
lisp_static_vars_$alphalessp_atom
                                000034 external static fixed bin(71,0)          dcl 33 ref 822
lisp_static_vars_$array_atom    000106 external static fixed bin(71,0)          dcl 5-6 ref 216 583 1104
lisp_static_vars_$binding_top          external static pointer                  dcl 5-6
lisp_static_vars_$catch_frame          external static pointer                  dcl 5-6
lisp_static_vars_$err_frame            external static pointer                  dcl 5-6
lisp_static_vars_$err_recp             external static pointer                  dcl 5-6
lisp_static_vars_$eval_frame           external static pointer                  dcl 5-6
lisp_static_vars_$external      000040 external static fixed bin(71,0)          dcl 33 ref 194
lisp_static_vars_$fixnum        000042 external static fixed bin(71,0)          dcl 33 ref 190 755
lisp_static_vars_$flonum        000044 external static fixed bin(71,0)          dcl 33 ref 191 756
lisp_static_vars_$iochan_list          external static pointer                  dcl 5-6
lisp_static_vars_$lisp_static_vars_    external static structure                level 1 unaligned dcl 5-6
lisp_static_vars_$nil           000110 external static fixed bin(71,0)          dcl 5-6 ref 188 188 205 205 210 210 309 309 335 335
                                                                                  337 337 355 355 356 356 427 427 429 429 453 453
                                                                                  465 465 491 491 509 509 610 610 671 671 754 754
                                                                                  773 773 796 796 805 805 825 825 870 870 905 905
                                                                                  1009 1009 1022 1022 1072 1072 1082 1082 1132 1132
                                                                                  1138 1138 1144 1144 1159 1159 1165 1165 1198 1198
                                                                                  1209 1209 1223 1223 1228 1228
lisp_static_vars_$obarray       000104 external static fixed bin(71,0)          dcl 5-6 set ref 192 340 758 781
lisp_static_vars_$prog_frame           external static pointer                  dcl 5-6
lisp_static_vars_$quote_macro   000112 external static fixed bin(71,0)          dcl 416 ref 423
lisp_static_vars_$readtable     000036 external static fixed bin(71,0)          dcl 33 set ref 193 356 757
lisp_static_vars_$semicolon_macro
                                000114 external static fixed bin(71,0)          dcl 416 ref 424
lisp_static_vars_$stack_ptr     000076 external static pointer                  dcl 5-6 set ref 214* 214 451 451 452* 452 462 462
                                                                                  464* 464 474 474 476* 476 532 532 533* 533 542*
                                                                                  542 563 563 578 578 579* 579 582* 582 593 593 609*
                                                                                  609 653* 653 670* 670 692* 692 701 701 714* 714
                                                                                  717 717 744 744 774* 774 782* 782 809* 809 818 818
                                                                                  848* 848 883* 883 902* 902 923* 923 997* 997 1012*
                                                                                  1012 1099* 1099 1140* 1140 1161* 1161 1191* 1191
                                                                                  1202 1202 1206* 1206 1220* 1220
lisp_static_vars_$star_rset            external static fixed bin(71,0)          dcl 5-45
lisp_static_vars_$t_atom        000100 external static fixed bin(71,0)          dcl 5-6 ref 189 189 334 334 340 340 357 357 507 507
                                                                                  753 753 808 808 1069 1069 1079 1079
lisp_static_vars_$top_level            external static label variable           dcl 5-6
lisp_static_vars_$tty_input_chan       external static pointer                  dcl 5-6
lisp_static_vars_$tty_output_chan      external static pointer                  dcl 5-6
lisp_static_vars_$unmkd_ptr     000102 external static pointer                  dcl 5-6 set ref 260* 260 484 484 536 536 537* 537
                                                                                  566 566 783* 783 810* 810 820 820 849* 849 884*
                                                                                  884 924* 924 1194* 1194
lisp_static_vars_$unwp_frame           external static pointer                  dcl 5-6
lisp_static_vars_$user_intr_array      external static fixed bin(71,0)          array dcl 5-45
lisp_static_vars_$vertical_bar_macro
                                000116 external static fixed bin(71,0)          dcl 416 ref 425
lisp_string                            based           structure                level 1 dcl 11-6
list_size                       000523 automatic       fixed bin(17,0)          dcl 1185 set ref 1201* 1217* 1217 1225 1234* 1234
                                                                                  1246* 1246
listarray                       000514 constant        entry                    external dcl 658
lparn                                  internal static bit(27)                  initial unaligned dcl 4-27
lsubr_initialization            003616 constant        entry                    internal dcl 561 ref 173 499 661 780
macro                                  internal static bit(27)                  initial unaligned dcl 4-27
macro_table                            based           fixed bin(71,0)          array level 2 dcl 4-11 set ref 423* 424* 425* 427*
make_array                      001720 constant        entry                    internal dcl 178 ref 175 489 515
make_array_pointer              003572 constant        entry                    internal dcl 553 ref 205 213
mapatoms                        001251 constant        entry                    external dcl 777
merge                           004472 constant        entry                    internal dcl 1130 ref 1207 1247
merge_sort                      004605 constant        entry                    internal dcl 1183 ref 845 914
min                                                    builtin function         dcl 33 ref 305 315 325 664 726
minus_2_times_ndims       7(18)        based           fixed bin(17,0)          level 2 packed unaligned dcl 1-8 set ref 247* 379*
                                                                                  762 1119
mod                                                    builtin function         dcl 33 ref 260
more_macros              20            based           fixed bin(71,0)          level 2 dcl 4-11 set ref 429* 454 456*
multiplier                1            based           fixed bin(35,0)          array level 3 dcl 1-31 set ref 295* 297*
myname                          000110 automatic       fixed bin(17,0)          dcl 33 set ref 172* 485* 497* 539 592* 660* 700*
                                                                                  743* 779* 815* 863* 887
name                      1            based           fixed bin(17,0)          level 2 dcl 33 set ref 887*
nargs                           000120 automatic       fixed bin(17,0)          dcl 80 set ref 184 334 355 475* 476 477 479* 480*
                                                                                  482* 482 500 564* 565 664 781
ndims                           000117 automatic       fixed bin(17,0)          dcl 80 in procedure "lisp_array_fcns_" set ref 184*
                                                                                  197* 197 198 245* 246 247 258 259 260 260 263 282
                                                                                  285 291 292 296 297 746* 747 762 765 773
ndims                                  based           fixed bin(17,0)          level 2 in structure "array_info" packed unaligned
                                                                                  dcl 1-8 in procedure "lisp_array_fcns_" set ref
                                                                                  236 237 246* 746 1119
nil                                    defined         fixed bin(71,0)          dcl 5-6 ref 188 205 210 309 335 337 355 356 427 429
                                                                                  453 465 491 509 610 671 754 773 796 805 825 870
                                                                                  905 1009 1022 1072 1082 1132 1138 1144 1159 1165
                                                                                  1198 1209 1223 1228
nil_ptr                                based           pointer                  dcl 5-6
not_alpha_array                        defined         fixed bin(17,0)          dcl 113 ref 885
not_an_array                           defined         fixed bin(17,0)          dcl 113 set ref 788* 1108*
not_same_type                          defined         fixed bin(17,0)          dcl 113 set ref 231* 346* 365* 718*
null                                                   builtin function         dcl 33 ref 550 1051 1190
num                                    parameter       fixed bin(17,0)          dcl 523 ref 521 534 541
num_macs                               constant        fixed bin(17,0)          initial dcl 4-4 ref 426
obarray                                defined         fixed bin(71,0)          dcl 5-6
other_array_ptr                 000124 automatic       pointer                  dcl 80 set ref 235* 237 287* 306 316 326 367* 444
                                                                                  709* 732 735 737
other_array_size                000126 automatic       fixed bin(18,0)          dcl 80 set ref 234* 237* 237 302* 305 315 325 705*
                                                                                  726
other_array_type                000122 automatic       fixed bin(17,0)          dcl 80 set ref 704* 711 711
packed_pointer                         based           pointer                  level 2 packed unaligned dcl 92 ref 376
packed_pointer_aligned                 based           structure                level 1 dcl 92
pdl_ptr_types36                        based           structure                array level 1 dcl 8-7
pfx                             004664 constant        label                    dcl 1220 ref 1203 1218 1237 1242
pfxret                          000027 constant        label                    array(0:2) dcl 1205 ref 1223 1229 1249
plus_minus                             internal static bit(27)                  initial unaligned dcl 4-27
pnamel                    4            based           fixed bin(17,0)          level 2 dcl 10-5 set ref 1060
pop_out                         004060 constant        label                    dcl 989 ref 1022
prog_frame                             defined         pointer                  dcl 5-6
ptr                                                    builtin function         dcl 33 ref 182
push_down_list_ptr_types               based           structure                array level 1 dcl 8-7
read_table                             based           structure                level 1 dcl 4-11 set ref 444* 444
read_table_dim_vector                  internal static fixed bin(17,0)          initial array dcl 4-7
reject_argument                 003506 constant        entry                    internal dcl 521 ref 198 200 207 211 226 231 233 258
                                                                                  259 267 270 283 344 346 363 365 378 383 605 618
                                                                                  622 666 718 788 856 1108 1114
retry                           004353 constant        label                    dcl 1100 ref 1109
retv                            000354 automatic       fixed bin(17,0)          array dcl 1185 set ref 1200* 1223 1229 1236* 1239*
                                                                                  1249
rparn                                  internal static bit(27)                  initial unaligned dcl 4-27
rubout                                 internal static bit(27)                  initial unaligned dcl 4-27
shift_scale                            internal static bit(27)                  initial unaligned dcl 4-27
siftup                          004046 constant        entry                    internal dcl 978 ref 940 958
single_char_object                     internal static bit(27)                  initial unaligned dcl 4-27
size                                                   builtin function         dcl 33 ref 555 555
slash_if_first                         internal static bit(27)                  initial unaligned dcl 4-27
slash_if_not_first                     internal static bit(27)                  initial unaligned dcl 4-27
slash_output                           internal static bit(27)                  initial unaligned dcl 4-27
slashifier                             internal static bit(27)                  initial unaligned dcl 4-27
snapcall_args                          based           structure                level 1 dcl 33
sort                            001426 constant        entry                    external dcl 813
sortcar                         001543 constant        entry                    external dcl 861
sourcep                         000520 automatic       pointer                  dcl 1185 set ref 1192* 1209 1211 1212 1222 1227 1227
special                                internal static bit(27)                  initial unaligned dcl 4-27
special_action_flag             000114 automatic       bit(1)                   unaligned dcl 33 set ref 180* 350* 400 445*
special_array_type                     defined         fixed bin(17,0)          dcl 113 set ref 233* 666* 856*
splice                                 internal static bit(27)                  initial unaligned dcl 4-27
stack                           000100 automatic       pointer                  dcl 33 set ref 188 189 190 191 192 193 194 205 208
                                                                                  212 215 219 222 231 235 236 237 246 247 248 250
                                                                                  264 266 287 334 335 340 340 355 356 356 357 375
                                                                                  376 379 380 381 384 390 391 392 394 456 466 468
                                                                                  474* 475 476 477 477 478 478 487 487 488* 488 490*
                                                                                  490 491 491 491 501 504 505 507 507 509 534 541
                                                                                  548 549 550 556 563* 564 565* 565 571* 571 573*
                                                                                  573 580 593* 595 597 598 598 599 609 610 611 611
                                                                                  612 615 615 619 619 623 623 633 635 653 664 668
                                                                                  668 669* 669 670 671 674 674 675 679 680 684 685
                                                                                  688 691 692 694* 694 695 695 701* 707* 707 709 714
                                                                                  717* 723* 723 724 724 744* 746 747 749 753 754 755
                                                                                  756 757 758 762 764 765 766 766 769 769 770 771
                                                                                  773 774 781 782 787 792 795 795 796 797 797 798
                                                                                  798 804 804 805 808 809 818* 822 825 826 848 870
                                                                                  872 883 902 903 903 905 906 909 911 911 923 934
                                                                                  937 938 948 949 953 960 964 965 970 972 989 991
                                                                                  997 999 1000 1003 1003 1005 1006 1009 1012 1013
                                                                                  1013 1014 1017 1018 1022 1040 1040 1043 1043 1051
                                                                                  1058 1058 1060 1069 1072 1079 1082 1099 1100 1100
                                                                                  1102 1104 1106 1113 1117 1119 1119 1125 1132 1134
                                                                                  1134 1138 1140 1141 1141 1142 1142 1144 1146 1146
                                                                                  1147 1147 1151 1151 1152 1152 1155 1155 1156 1156
                                                                                  1159 1161 1162 1162 1163 1163 1165 1168 1168 1169
                                                                                  1169 1170 1170 1173 1173 1174 1174 1178 1178 1191
                                                                                  1192 1198 1202* 1205* 1205 1206 1211 1212* 1216*
                                                                                  1216 1220 1222 1223 1228 1240* 1240 1244* 1244
stack_ptr                              defined         pointer                  dcl 5-6 set ref 214* 451 452* 462 464* 474 476* 532
                                                                                  533* 542* 563 578 579* 582* 593 609* 653* 670*
                                                                                  692* 701 714* 717 744 774* 782* 809* 818 848* 883*
                                                                                  902* 923* 997* 1012* 1099* 1140* 1161* 1191* 1202
                                                                                  1206* 1220*
stack_seg                              based           structure                level 1 dcl 2-5
star_array                      000060 constant        entry                    external dcl 170
star_rearray                    000175 constant        entry                    external dcl 495
star_rearray                    000121 automatic       bit(1)                   unaligned dcl 80 in procedure "lisp_array_fcns_" set
                                                                                  ref 174* 205 211 222 230 302 486* 498*
star_rset                              defined         fixed bin(71,0)          dcl 5-45
status_terpri           432            based           bit(1)                   level 2 dcl 4-11 set ref 434*
status_ttyread          434            based           bit(1)                   level 2 dcl 4-11 set ref 436*
status_underline        433            based           bit(1)                   level 2 dcl 4-11 set ref 435*
std_syntax                      000120 external static bit(18)                  array level 2 dcl 416 ref 431
std_translation         204     000120 external static fixed bin(17,0)          array level 2 dcl 416 ref 432
store_not_allowed                      defined         fixed bin(17,0)          dcl 113 set ref 605* 618* 622*
string                    1            based           char                     level 2 dcl 11-6 ref 1069 1069 1079 1079
string_length                          based           fixed bin(17,0)          level 2 dcl 11-6 ref 1065 1065 1068 1069 1069 1078
                                                                                  1079 1079
string_ptr                      000326 automatic       pointer                  array dcl 1034 set ref 1058* 1060* 1065 1065 1068
                                                                                  1069 1069 1078 1079 1079
string_quote_exp                       internal static bit(27)                  initial unaligned dcl 4-27
substr                                                 builtin function         dcl 33 ref 1069 1069 1079 1079
syntax                   22            based           bit(27)                  array level 2 dcl 4-11 set ref 431*
t_atom                                 defined         fixed bin(71,0)          dcl 5-6 ref 189 334 340 357 507 753 808 1069 1079
t_atom_ptr                             based           pointer                  dcl 5-6
temp                                   based           fixed bin(71,0)          array dcl 8-7 set ref 188 189 190 191 192 193 194
                                                                                  205 210 212* 212 214 215* 215 216* 219* 219 266
                                                                                  334* 335 340 340* 355* 356 356* 357 376 381 452
                                                                                  453* 453* 454* 456 464 465* 465* 466* 468 476 477*
                                                                                  478* 487* 487 488 491 491* 491 504* 504 507* 509*
                                                                                  533 534* 534 541* 541 556* 571 579 580* 580 582
                                                                                  583* 597 598* 598 599* 609 610 611* 612 615 615
                                                                                  619 619 623* 633* 635 653 664 668* 668 669 670
                                                                                  671* 674* 674 675* 688* 692 695* 695 707 714 724*
                                                                                  724 753* 754* 755* 756* 757* 758* 764 765 766 769
                                                                                  770 771 773* 774 781* 782 795* 796 797* 798* 804*
                                                                                  805 808* 809 822 825 848 870 883 902 903* 903 905
                                                                                  911* 923 934* 937 938 948 949 953* 960* 964 965
                                                                                  970 972 989 991 997 999* 1000* 1003 1003 1005 1006
                                                                                  1009 1012 1013* 1013 1014* 1017 1018 1022 1040*
                                                                                  1043* 1069* 1072* 1079* 1082* 1099 1100* 1100
                                                                                  1104* 1132 1134* 1134 1138 1140 1141* 1142* 1144
                                                                                  1146* 1146 1147* 1147 1151* 1151 1152* 1152 1155*
                                                                                  1155 1156* 1159 1161 1162* 1163* 1165 1168 1169*
                                                                                  1169 1170* 1173* 1173 1174* 1178 1191 1198* 1206
                                                                                  1209 1211* 1211 1216 1220 1222* 1222 1223 1227*
                                                                                  1240
temp_item                       000112 automatic       fixed bin(71,0)          dcl 33 set ref 597* 599
temp_ptr                               based           pointer                  array dcl 8-7 set ref 231 235 236 237 246 247 248
                                                                                  250 287 346 349 365 367 379 384 390 391 392 394
                                                                                  456 466 468 477 478 548 549 550 611 623 691 709
                                                                                  746 747* 749 753 754 755 756 757 758 762 764 765
                                                                                  766* 766 766 769* 769 769 770 771 773 792 795 797
                                                                                  798 804 906 909 911 1040 1043 1051 1058 1060 1113
                                                                                  1117 1119 1119 1125 1141 1142 1156 1162 1163 1168
                                                                                  1170 1174 1178 1227 1228
temp_type                 0(21)        based           bit(9)                   array level 2 packed unaligned dcl 8-7 ref 475 595
                                                                                  826 872
temp_type36                            based           bit(36)                  array level 2 dcl 8-7 ref 208 222 264 342 361 375
                                                                                  380 501 505 507 581 787 1058 1102 1106
too_few_args                           defined         fixed bin(17,0)          dcl 113 set ref 258*
too_many_args                          defined         fixed bin(17,0)          dcl 113 set ref 259*
translation             226            based           fixed bin(17,0)          array level 2 dcl 4-11 set ref 432*
tstack                          000240 automatic       pointer                  dcl 526 in procedure "reject_argument" set ref 532*
                                                                                  533 534 541 542
tstack                          000102 automatic       pointer                  dcl 33 in procedure "lisp_array_fcns_" set ref 210
                                                                                  212 214 215 216 219 342 346 349 361 365 367 451*
                                                                                  452 453 453 454 456 462* 464 465 465 466 468 504
                                                                                  578* 579 580 581 582 583
tty_input_chan                         defined         pointer                  dcl 5-6
tty_output_chan                        defined         pointer                  dcl 5-6
type                      7            based           fixed bin(17,0)          level 2 packed unaligned dcl 1-8 set ref 231 346 365
                                                                                  391* 548* 792 1113
type_field                      000115 automatic       bit(36)                  dcl 70 set ref 833* 839* 937 948 964 1003 1017
type_info                              based           bit(36)                  level 2 in structure "fixnum_fmt" dcl 3-4
                                                                                  in procedure "lisp_array_fcns_" set ref 615 679*
                                                                                  764* 770* 937* 948* 964* 1003* 1003* 1017*
type_info                              based           bit(36)                  level 2 in structure "flonum_fmt" dcl 3-4
                                                                                  in procedure "lisp_array_fcns_" set ref 619 684*
unm                             000236 automatic       pointer                  dcl 526 set ref 536* 537 538 539
unmkd_ptr                              defined         pointer                  dcl 5-6 set ref 260* 484 536 537* 566 783* 810* 820
                                                                                  849* 884* 924* 1194*
unspec                                                 builtin function         dcl 33 set ref 182* 384 439* 556* 556 771* 1125*
unwp_frame                             defined         pointer                  dcl 5-6
user_intr_array                        defined         fixed bin(71,0)          array dcl 5-45
ustack                          000104 automatic       pointer                  dcl 33 set ref 182 260 266 267 268 274 277 292 297
                                                                                  484* 566* 783 784 785 810 820* 849 884 885 887 924
                                                                                  925 926 1194 1195 1196 1241 1241 1248 1248
value                                  based           fixed bin(71,0)          level 2 dcl 10-5 ref 340 356 781
vertical_motion                        internal static bit(27)                  initial unaligned dcl 4-27
words_not_used_yet      437            based           bit(36)                  array level 2 dcl 4-11 set ref 439*
words_per_item                  000034 constant        fixed bin(17,0)          initial array dcl 130 ref 282 295
wrong_external_array_ndims             defined         fixed bin(17,0)          dcl 113 set ref 198*

STORAGE REQUIREMENTS FOR THIS PROGRAM.

	Object	Text	Link	Symbol	Defs	Static
Start          0       0      5510        5632    4753        5520
Length      6426    4753       122         560     534           0

BLOCK NAME	         STACK SIZE     TYPE		WHY NONQUICK/WHO SHARES STACK FRAME
lisp_array_fcns_                    388 external procedure  is an external procedure.  
make_array                              internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
initialize_a_readtable                  internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
copy_a_readtable                        internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
finish_copying_readtable                internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
finish_copying_obarray                  internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
reject_argument                         internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
kill_array                              internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
make_array_pointer                      internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
lsubr_initialization                    internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
get_array_prop_3                        internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
get_array_prop                          internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
heapsort                                internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
siftup                                  internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
compare                                 internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
get_array_property                      internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
merge                                   internal procedure  shares stack frame of external procedure lisp_array_fcns_.  
merge_sort                              internal procedure  shares stack frame of external procedure lisp_array_fcns_.  

STORAGE FOR AUTOMATIC VARIABLES.

STACK FRAME                 LOC IDENTIFIER                  BLOCK NAME
lisp_array_fcns_         000100 stack                       lisp_array_fcns_
                         000102 tstack                      lisp_array_fcns_
                         000104 ustack                      lisp_array_fcns_
                         000106 L                           lisp_array_fcns_
                         000107 R                           lisp_array_fcns_
                         000110 myname                      lisp_array_fcns_
                         000112 temp_item                   lisp_array_fcns_
                         000114 special_action_flag         lisp_array_fcns_
                         000115 type_field                  lisp_array_fcns_
                         000116 entry_id                    lisp_array_fcns_
                         000117 ndims                       lisp_array_fcns_
                         000120 nargs                       lisp_array_fcns_
                         000121 star_rearray                lisp_array_fcns_
                         000122 other_array_type            lisp_array_fcns_
                         000124 other_array_ptr             lisp_array_fcns_
                         000126 other_array_size            lisp_array_fcns_
                         000127 external_array              lisp_array_fcns_
                         000130 array_type                  lisp_array_fcns_
                         000132 array_ptr                   lisp_array_fcns_
                         000134 array_size                  lisp_array_fcns_
                         000135 i                           lisp_array_fcns_
                         000136 fix1                        lisp_array_fcns_
                         000137 float1                      lisp_array_fcns_
                         000236 unm                         reject_argument
                         000240 tstack                      reject_argument
                         000314 I                           siftup
                         000315 J                           siftup
                         000324 j                           compare
                         000326 string_ptr                  compare
                         000354 retv                        merge_sort
                         000520 sourcep                     merge_sort
                         000522 depth                       merge_sort
                         000523 list_size                   merge_sort

THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM.
r_ge_a              call_ext_out        return              mod_fx1             ext_entry

THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM.
lisp_$eval                    lisp_$snapcaller              lisp_alloc_                   lisp_alloc_$cons
lisp_alloc_$ncons             lisp_error_                   lisp_list_utils_$subst        lisp_property_fns_$get
lisp_property_fns_$putprop    lisp_static_man_$allocate

THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM.
lisp_error_table_$argument_must_be_array                    lisp_error_table_$array_too_big
lisp_error_table_$bad_argument                              lisp_error_table_$dead_array_reference
lisp_error_table_$not_alpha_array                           lisp_error_table_$not_an_array
lisp_error_table_$not_same_type                             lisp_error_table_$special_array_type
lisp_error_table_$store_not_allowed                         lisp_error_table_$too_few_args
lisp_error_table_$too_many_args                             lisp_error_table_$wrong_external_array_ndims
lisp_reader_alm_$initial_readtable                          lisp_static_vars_$alphalessp_atom
lisp_static_vars_$array_atom  lisp_static_vars_$external    lisp_static_vars_$fixnum      lisp_static_vars_$flonum
lisp_static_vars_$nil         lisp_static_vars_$obarray     lisp_static_vars_$quote_macro lisp_static_vars_$readtable
lisp_static_vars_$semicolon_macro                           lisp_static_vars_$stack_ptr   lisp_static_vars_$t_atom
lisp_static_vars_$unmkd_ptr   lisp_static_vars_$vertical_bar_macro




   LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC      LINE    LOC   
      6 000050       170 000056       172 000065       173 000067       174 000070       175 000071       176 000072
    472 000073       474 000101       475 000106       476 000113       477 000121       478 000126       479 000131
    480 000140       482 000142       484 000145       485 000151       486 000153       487 000154       488 000157
    489 000161       490 000162       491 000165       493 000173       495 000174       497 000202       498 000204
    499 000206       500 000207       501 000212       503 000217       504 000220       505 000222       507 000226
    509 000235       510 000240       515 000241       516 000242       590 000243       592 000251       593 000253
    595 000260       597 000263       598 000265       599 000267       600 000271       603 000272       605 000273
    608 000311       609 000312       610 000316       611 000323       612 000325       615 000336       618 000346
    619 000361       622 000370       623 000402       624 000406       625 000407       626 000413       628 000414
    632 000417       633 000422       634 000427       635 000435       636 000442       637 000444       639 000445
    640 000446       641 000452       642 000457       643 000462       644 000464       646 000465       647 000467
    648 000473       649 000501       650 000504       653 000506       654 000512       658 000513       660 000521
    661 000523       663 000524       664 000525       666 000536       668 000554       669 000557       670 000561
    671 000564       672 000566       674 000574       675 000577       678 000607       679 000610       680 000612
    681 000615       683 000616       684 000620       685 000622       686 000625       688 000626       690 000632
    691 000637       692 000644       693 000650       694 000653       695 000656       696 000660       698 000661
    700 000667       701 000671       702 000676       704 000677       705 000701       707 000703       708 000706
    709 000707       711 000713       714 000727       715 000733       716 000737       717 000744       718 000750
    723 000761       724 000764       726 000766       727 000773       728 000776       729 000777       730 001000
    731 001001       732 001003       733 001012       734 001013       735 001014       737 001026       739 001035
    741 001036       743 001044       744 001046       745 001053       746 001054       747 001060       749 001074
    753 001100       754 001107       755 001116       756 001125       757 001134       758 001143       762 001151
    764 001165       765 001171       766 001205       767 001217       769 001222       770 001226       771 001231
    773 001234       774 001244       775 001247       777 001250       779 001256       780 001260       781 001261
    782 001271       783 001275       784 001300       785 001302       787 001305       788 001312       790 001325
    792 001326       794 001334       795 001341       796 001346       797 001353       798 001355       799 001360
    800 001364       801 001365       803 001367       804 001375       805 001402       806 001412       808 001414
    809 001417       810 001422       811 001424       813 001425       815 001433       816 001435       818 001436
    820 001443       822 001446       825 001452       826 001456       828 001461       829 001462       830 001466
    832 001471       833 001473       834 001475       835 001476       836 001500       838 001504       839 001506
    840 001510       841 001511       842 001513       843 001514       844 001515       845 001516       848 001517
    849 001523       851 001525       856 001526       861 001541       863 001550       864 001552       866 001554
    868 001555       870 001557       872 001564       874 001567       876 001570       878 001574       879 001602
    883 001614       884 001621       885 001624       887 001626       889 001631       890 001635       891 001636
    892 001637       893 001647       895 001651       897 001654       898 001655       902 001656       903 001661
    905 001663       906 001671       908 001701       909 001703       910 001711       911 001712       912 001715
    914 001716       917 001717       178 001720       180 001721       181 001722       182 001723       184 001727
    188 001733       189 001743       190 001751       191 001757       192 001765       193 001773       194 002001
    195 002004       196 002006       197 002010       198 002012       199 002027       200 002030       205 002042
    207 002052       208 002065       209 002070       210 002071       211 002075       212 002111       213 002113
    214 002114       215 002120       216 002122       217 002124       218 002130       219 002131       222 002133
    225 002141       226 002142       230 002155       231 002157       233 002200       234 002216       235 002220
    236 002224       237 002235       239 002251       245 002253       246 002260       247 002265       248 002272
    250 002275       253 002325       258 002327       259 002345       260 002362       261 002372       262 002375
    263 002377       264 002407       266 002414       267 002423       268 002443       269 002446       270 002447
    271 002463       272 002465       273 002466       274 002467       275 002472       277 002473       282 002476
    283 002506       284 002523       285 002534       287 002541       291 002545       292 002555       293 002565
    295 002567       296 002575       297 002603       298 002612       302 002615       303 002620       305 002623
    306 002635       307 002643       308 002645       309 002651       310 002656       311 002660       313 002661
    315 002662       316 002675       317 002700       318 002702       319 002707       320 002710       321 002712
    323 002713       325 002715       326 002727       327 002732       328 002734       329 002741       330 002744
    331 002746       333 002747       334 002751       335 002760       337 002771       338 003003       340 003006
    341 003014       342 003015       344 003021       346 003034       349 003055       350 003066       352 003070
    354 003071       355 003073       356 003102       357 003112       360 003117       361 003120       363 003124
    365 003137       367 003160       368 003164       372 003165       375 003166       376 003172       377 003174
    378 003175       379 003210       380 003214       381 003220       382 003222       383 003223       384 003236
    390 003242       391 003246       392 003253       394 003263       400 003267       403 003275       404 003277
    410 003300       414 003301       423 003302       424 003305       425 003310       426 003312       427 003321
    428 003327       429 003331       431 003335       432 003353       434 003356       435 003357       436 003361
    437 003362       438 003363       439 003364       440 003367       442 003370       444 003371       445 003376
    447 003400       449 003401       451 003402       452 003406       453 003410       454 003413       455 003416
    456 003422       457 003427       459 003430       462 003431       463 003435       464 003441       465 003445
    466 003450       467 003463       468 003467       469 003503       470 003505       521 003506       532 003510
    533 003514       534 003516       536 003523       537 003526       538 003531       539 003533       540 003535
    541 003541       542 003550       543 003553       546 003554       548 003555       549 003561       550 003565
    551 003571       553 003572       555 003573       556 003606       557 003614       558 003615       561 003616
    563 003617       564 003624       565 003626       566 003630       567 003633       570 003634       571 003635
    572 003640       573 003641       574 003644       576 003645       578 003646       579 003652       580 003654
    581 003656       582 003662       583 003664       584 003666       585 003672       919 003673       921 003674
    923 003700       924 003704       925 003707       926 003711       928 003714       932 003717       934 003726
    937 003736       938 003741       940 003744       942 003745       944 003750       946 003751       948 003753
    949 003756       950 003761       951 003763       953 003764       954 003771       956 003776       958 004003
    959 004004       960 004006       961 004013       962 004020       964 004021       965 004024       966 004027
    969 004031       970 004034       972 004042       976 004045       978 004046       983 004047       985 004052
    987 004056       989 004060       991 004071       992 004075       995 004076       997 004077       998 004103
    999 004105      1000 004111      1001 004116      1003 004117      1005 004122      1006 004125      1008 004130
   1009 004131      1012 004137      1013 004143      1014 004145      1017 004154      1018 004156      1020 004161
   1022 004162      1024 004170      1026 004202      1028 004206      1030 004211      1032 004212      1038 004213
   1040 004215      1043 004220      1044 004222      1046 004224      1051 004231      1053 004241      1055 004242
   1058 004247      1060 004264      1061 004274      1065 004276      1068 004301      1069 004303      1072 004316
   1074 004322      1078 004323      1079 004325      1082 004341      1086 004345      1089 004346      1099 004347
   1100 004353      1102 004356      1104 004362      1105 004365      1106 004371      1108 004376      1109 004411
   1113 004412      1114 004416      1117 004433      1118 004437      1119 004441      1123 004456      1124 004463
   1125 004466      1128 004471      1130 004472      1132 004473      1134 004477      1135 004502      1138 004503
   1140 004510      1141 004512      1142 004514      1143 004516      1144 004517      1146 004524      1147 004526
   1148 004530      1151 004531      1152 004533      1155 004535      1156 004537      1159 004542      1161 004547
   1162 004551      1163 004553      1164 004555      1165 004556      1168 004563      1169 004566      1170 004570
   1173 004573      1174 004575      1176 004600      1178 004601      1180 004604      1183 004605      1190 004606
   1191 004610      1192 004614      1194 004615      1195 004620      1196 004622      1198 004625      1199 004627
   1200 004630      1201 004631      1202 004633      1203 004636      1205 004637      1206 004642      1207 004645
   1209 004646      1211 004652      1212 004654      1213 004656      1216 004657      1217 004662      1218 004663
   1220 004664      1222 004670      1223 004672      1225 004700      1227 004702      1228 004706      1229 004711
   1234 004714      1235 004716      1236 004717      1237 004722      1239 004723      1240 004726      1241 004731
   1242 004733      1244 004734      1245 004737      1246 004741      1247 004742      1248 004743      1249 004745


                                          -----------------------------------------------------------


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