COMPILATION LISTING OF SEGMENT lisp_loadumparrays_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0847.8 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 dumparrays: proc; 7 8 /* lisp_loadumparrays_ 9* * This modules contains the loadarrays and dumparrays subrs for LISP 10* * Written 74.08.09 by DAM 11* * do not compile with the optimize option 12* */ 13 14 15 /* Declarations for format of a dumped array file */ 16 17 dcl 1 dumped_array_file based aligned, 18 2 type fixed bin(17) unaligned, /* negative for pdp-10, positive for Multics */ 19 2 count fixed bin(17) unaligned, /* number of words (10) or characters (Multics) in pname */ 20 2 pname char(p -> dumped_array_file.count) unaligned, 21 2 data; 22 23 /* the above structure is followed by the below, 24* and the pair is repeated once for each array dumped */ 25 26 dcl 1 dumped_array_data based aligned, 27 2 word_count fixed bin(17) unaligned, /* minus number of words in array */ 28 2 array_type fixed bin(17) unaligned, /* 1=fixnum, 2=flonum */ 29 2 data(- p->dumped_array_data.word_count) bit(36); 30 31 /* the following special mark falls after the last dumped array */ 32 33 dcl end_of_file_mark bit(36) static init((5)"0000011"b), 34 word bit(36) aligned based; 35 36 /* pointer to current data in the file */ 37 38 dcl p pointer; 39 40 /* declarations for PDP-10 compatibility */ 41 42 dcl byte7 (0:4) bit(7) unaligned based, 43 44 1 PDP10_flonum based aligned, 45 2 sign bit(1) unaligned, 46 2 exponent fixed bin(7) unaligned, 47 2 mantissa bit(27) unaligned, 48 1 H6180_flonum based aligned, 49 2 exponent fixed bin(7) unaligned, 50 2 mantissa fixed bin(27) unaligned, 51 a_word fixed bin(35) aligned; 52 53 /* flag for Multics format */ 54 55 dcl Multics_flag fixed bin(17) static init(000001100000100100b); /* 014044 octal */ 56 57 58 /* misc dcl */ 59 60 dcl stack pointer, 61 myname fixed bin(35), 62 (i, j, n) fixed bin(18), 63 ch char(1), 64 words (n) bit(36) aligned based, 65 pdp10_compatibility bit(1), 66 convert_flonums bit(1), 67 lisp_property_fns_$get entry, 68 lisp_property_fns_$putprop entry, 69 lisp_get_atom_ entry(char(*), fixed bin(71)), 70 lisp_special_fns_$xcons entry, 71 lisp_special_fns_$cons entry, 72 lisp_array_fcns_$star_array entry, 73 lisp_special_fns_$gensym entry; 74 75 dcl unm pointer, 76 pnamebuf char(i) based(unm); 77 78 dcl hcs_$terminate_noname entry(pointer, fixed bin(35)), 79 hcs_$truncate_seg entry(pointer, fixed bin(18), fixed bin(35)), 80 hcs_$set_bc_seg entry(pointer, fixed bin(24), fixed bin(35)), 81 hcs_$make_seg entry(char(*), char(*), char(*), fixed bin(5), pointer, fixed bin(35)), 82 hcs_$initiate entry(char(*), char(*), char(*), fixed bin(1), fixed bin(2), pointer, fixed bin(35)), 83 expand_path_ entry(pointer, fixed bin, pointer, pointer, fixed bin(35)), 84 dn char(168), 85 en char(32), 86 code fixed bin(35); 87 88 dcl fp pointer, 89 bflonum float bin(27) aligned based, 90 fsign float bin(1); 91 92 /* LISP constants */ 93 94 dcl (lisp_static_vars_$array, 95 lisp_static_vars_$fixnum, 96 lisp_static_vars_$flonum) fixed bin(71) external; 97 98 /* error codes */ 99 100 dcl (lisp_error_table_$bad_argument, 101 lisp_error_table_$file_sys_fun_err, 102 lisp_error_table_$argument_must_be_array, 103 lisp_error_table_$special_array_type) fixed bin(35) external; 104 105 /* Builtin */ 106 107 dcl (addr, addrel, size, unspec, fixed, bit, substr, null, divide, rel, translate) builtin; 108 109 /* include files */ 110 1 1 /* Include file lisp_common_vars.incl.pl1; 1 2* describes the external static variables which may be referenced 1 3* by lisp routines. 1 4* D. Reed 4/1/71 */ 1 5 1 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 1 7 2 cclist_ptr ptr, /* pointer to list of constants kept 1 8* by compiled programs */ 1 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 1 10 1 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 1 12 err_recp ptr defined (lisp_static_vars_$err_recp), 1 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 1 14 lisp_static_vars_$eval_frame ptr ext static, 1 15 lisp_static_vars_$prog_frame ptr ext aligned, 1 16 lisp_static_vars_$err_frame ptr ext aligned, 1 17 lisp_static_vars_$catch_frame ptr ext aligned, 1 18 lisp_static_vars_$unwp_frame ptr ext aligned, 1 19 lisp_static_vars_$stack_ptr ptr ext aligned, 1 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 1 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 1 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 1 23 lisp_static_vars_$binding_top ptr ext aligned, 1 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 1 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 1 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 1 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 1 28 binding_top ptr defined (lisp_static_vars_$binding_top), 1 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 1 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 1 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 1 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 1 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 1 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 1 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 1 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 1 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 1 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 1 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 1 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 1 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 1 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 1 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 1 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 1 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 1 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 1 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 1 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 1 49 1 50 1 51 /* end include file lisp_common_vars.incl.pl1 */ 111 2 1 /* include file lisp_stack_fmt.incl.pl1 -- 2 2* describes the format of the pushdown list 2 3* used by the lisp evaluator and lisp subrs 2 4* for passing arguments, saving atom bindings, 2 5* and as temporaries */ 2 6 2 7 dcl 2 8 temp(10000) fixed bin(71) aligned based, 2 9 2 10 temp_ptr(10000) ptr aligned based, 2 11 1 push_down_list_ptr_types(10000) based aligned, 2 12 2 junk bit(21) unaligned, 2 13 2 temp_type bit(9) unaligned, 2 14 2 more_junk bit(42) unaligned, 2 15 2 16 1 pdl_ptr_types36(10000) based aligned, 2 17 2 temp_type36 bit(36), 2 18 2 junk bit(36), 2 19 2 20 1 binding_block aligned based, 2 21 2 top_block bit(18) unaligned, 2 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 2 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 2 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 2 25 2 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 2 27 2 old_val fixed bin(71) aligned, 2 28 2 atom fixed bin(71) aligned; 2 29 2 30 2 31 2 32 /* end include file lisp_stack_fmt.incl.pl1 */ 112 3 1 /* Include file lisp_cons_fmt.incl.pl1; 3 2* defines the format for a cons within the lisp system 3 3* D.Reed 4/1/71 */ 3 4 3 5 dcl consptr ptr, 3 6 1 cons aligned based (consptr), /* structure defining format for cons */ 3 7 2 car fixed bin(71), 3 8 2 cdr fixed bin(71), 3 9 3 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 3 11 2 car ptr, 3 12 2 cdr ptr, 3 13 3 14 3 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 3 16 2 padding bit(21) unaligned, 3 17 2 car bit(9) unaligned, 3 18 2 padding2 bit(63) unaligned, 3 19 2 cdr bit(9) unaligned, 3 20 2 padend bit(42) unaligned; 3 21 3 22 dcl 1 cons_types36 aligned based, 3 23 2 car bit(36), 3 24 2 pada bit(36), 3 25 2 cdr bit(36), 3 26 2 padd bit(36); 3 27 3 28 3 29 /* end include file lisp_cons_fmt.incl.pl1 */ 113 4 1 /* lisp number format -- overlaid on standard its pointer. */ 4 2 4 3 4 4 dcl 1 fixnum_fmt based aligned, 4 5 2 type_info bit(36) aligned, 4 6 2 fixedb fixed bin, 4 7 4 8 1 flonum_fmt based aligned, 4 9 2 type_info bit(36) aligned, 4 10 2 floatb float bin, 4 11 4 12 fixnum_type bit(36) aligned static init("000000000000000000000100000000100111"b), 4 13 flonum_type bit(36) aligned static init("000000000000000000000010000000100111"b); 4 14 4 15 /* end of lisp number format */ 4 16 114 5 1 /* Include file lisp_ptr_fmt.incl.pl1; 5 2* describes the format of lisp pointers as 5 3* a bit string overlay on the double word ITS pair 5 4* which allows lisp to access some unused bits in 5 5* the standard ITS pointer format. It should be noted that 5 6* this is somewhat of a kludge, since 5 7* it is quite machine dependent. However, to store type 5 8* fields in the pointer, saves 2 words in each cons, 5 9* plus some efficiency problems. 5 10* 5 11* D.Reed 4/1/71 */ 5 12 /* modified to move type field to other half of ptr */ 5 13 /* D.Reed 5/31/72 */ 5 14 5 15 5 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 5 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 5 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 5 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 5 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 5 21 2 type bit(9) unaligned, /* type field */ 5 22 2 itsmod bit(6) unaligned, 5 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 5 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 5 25 5 26 /* manifest constant strings for testing above type field */ 5 27 5 28 ( 5 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 5 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 5 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 5 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 5 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 5 34 Bignum init("000001000"b), /* a multiple-precision number */ 5 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 5 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 5 37* means a special internal uncollectable weird object */ 5 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 5 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 5 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 5 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 5 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 5 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 5 44 ) bit(9) static, 5 45 5 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 5 47 5 48 5 49 ( 5 50 Cons36 init("000000000000000000000000000000"b), 5 51 Fixed36 init("000000000000000000000100000000"b), 5 52 Float36 init("000000000000000000000010000000"b), 5 53 Atsym36 init("000000000000000000000001000000"b), 5 54 Atomic36 init("000000000000000000000111111100"b), 5 55 Bignum36 init("000000000000000000000000001000"b), 5 56 System_Subr36 5 57 init("000000000000000000000000000100"b), 5 58 Bigfix36 init("000000000000000000000000001000"b), 5 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 5 60 NotConsOrAtsym36 5 61 init("000000000000000000000110111111"b), 5 62 SubrNumeric36 5 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 5 64 String36 init("000000000000000000000000100000"b), 5 65 Subr36 init("000000000000000000000000010000"b), 5 66 File36 init("000000000000000000000000000001"b), 5 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 5 68 5 69 /* undefined pointer value is double word of zeros */ 5 70 5 71 Undefined bit(72) static init(""b); 5 72 5 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 115 6 1 /***** BEGIN INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 6 2 6 3 /* This include file defines the format of the "new" LISP arrays. 6 4* Written 74.05.13 by DAM */ 6 5 6 6 /* Info block in static space. pointed at by array ptr */ 6 7 6 8 dcl 1 array_info aligned based structure, /* 8 words long */ 6 9 2 ndims fixed bin(17) unaligned, /* number of dimensions */ 6 10 2 gc_mark bit(18) unaligned, /* alternating bits for garbage coll. */ 6 11 2 call_array_operator bit(36), /* tspbp instruction to array opr */ 6 12 2 array_data_ptr pointer, /* -> array_data structure */ 6 13 2 array_load_sequence(3) bit(36), /* lda, ldq, tra bp|0 */ 6 14 2 type fixed bin(17) unaligned, /* type of array, see dcl below */ 6 15 2 minus_2_times_ndims fixed bin(17) unaligned; /* for convenience of array opr */ 6 16 6 17 /* Codes for the different types of arrays: 6 18* Name Value arg to *array to create one */ 6 19 6 20 dcl (S_expr_array init(0), /* t */ 6 21 Un_gc_array init(1), /* nil */ 6 22 Fixnum_array init(2), /* fixnum */ 6 23 Flonum_array init(3), /* flonum */ 6 24 Readtable_array init(4), /* readtable */ 6 25 Obarray_array init(5), /* obarray */ 6 26 Dead_array init(6) /* (*rearray a) */ 6 27 ) fixed bin(17) static; 6 28 6 29 /* Block of array data and dimensions, in garbage-collected Lists space */ 6 30 6 31 dcl 1 array_data aligned based structure, 6 32 2 dope_vector(ZERO), /* address by dope_vector(i-ndims). no way to dcl in PL/I */ 6 33 3 bounds fixed bin(35), /* 0 <_ subscript < bounds */ 6 34 3 multiplier fixed bin(35), /* multiplier in polynomial-type subscript calc. */ 6 35 2 data(0:1000) fixed bin(71); /* single or double words depending on type of array */ 6 36 6 37 dcl ZERO fixed bin static init(0); /* Circumvent a compiler bug causing reference through null pointer in get_array_size$multf */ 6 38 6 39 /***** END INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 116 7 1 /* Include file lisp_atom_fmt.incl.pl1; 7 2* describes internal format of atoms in the lisp system 7 3* D.Reed 4/1/71 */ 7 4 7 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 7 6 2 value fixed bin(71), /* atom's value */ 7 7 2 plist fixed bin(71), /* property list */ 7 8 2 pnamel fixed bin, /* length of print name */ 7 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 7 10 7 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 7 12 2 value ptr, 7 13 2 plist ptr, 7 14 7 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 7 16 2 value bit(72), 7 17 2 plist bit(72); 7 18 7 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 117 8 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 8 2* describes format of storage for lisp 8 3* character strings. 8 4* D. Reed 4/1/71 */ 8 5 8 6 dcl 1 lisp_string based aligned, 8 7 2 string_length fixed bin, 8 8 2 string char(1 refer(string_length)); 8 9 8 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 118 9 1 9 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 9 3 9 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 9 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 9 6* are used so that the name of the function which is rejecting its argument 9 7* can be printed. Please note that all these codes are negative. */ 9 8 9 9 dcl ( 9 10 fn_do init (-10), 9 11 fn_arg init (-11), 9 12 fn_setarg init (-12), 9 13 fn_status init (-13), 9 14 fn_sstatus init (-14), 9 15 fn_errprint init (-15), 9 16 fn_errframe init (-16), 9 17 fn_evalframe init (-17), 9 18 fn_defaultf init (-18), 9 19 fn_tyo init (-22), 9 20 fn_ascii init (-23), 9 21 fn_rplaca init (-24), 9 22 fn_definedp init (-25), 9 23 fn_setq init (-26), 9 24 fn_set init (-27), 9 25 fn_delete init (-28), 9 26 fn_delq init (-29), 9 27 fn_stringlength init (-30), 9 28 fn_catenate init (-31), 9 29 fn_array init (-32), 9 30 fn_substr init (-33), 9 31 fn_index init (-34), 9 32 fn_get_pname init (-35), 9 33 fn_make_atom init (-36), 9 34 fn_ItoC init (-37), 9 35 fn_CtoI init (-38), 9 36 fn_defsubr init (-39), 9 37 fn_star_array init (-40), 9 38 fn_args init (-41), 9 39 fn_sysp init (-42), 9 40 fn_get init (-43), 9 41 fn_getl init (-44), 9 42 fn_putprop init (-45), 9 43 fn_remprop init (-46), 9 44 fn_save init (-47), 9 45 fn_add1 init (-48), 9 46 fn_sub1 init (-49), 9 47 fn_greaterp init (-50), 9 48 fn_lessp init (-51), 9 49 fn_minus init (-52), 9 50 fn_plus init (-53), 9 51 fn_times init (-54), 9 52 fn_difference init (-55), 9 53 fn_quotient init (-56), 9 54 fn_abs init (-57), 9 55 fn_expt init (-58), 9 56 fn_boole init (-59), 9 57 fn_rot init (-60), 9 58 fn_lsh init (-61), 9 59 fn_signp init (-62), 9 60 fn_fix init (-63), 9 61 fn_float init (-64), 9 62 fn_remainder init (-65), 9 63 fn_max init (-66), 9 64 fn_min init (-67), 9 65 fn_add1_fix init (-68), 9 66 fn_add1_flo init (-69), 9 67 fn_sub1_fix init (-70), 9 68 fn_sub1_flo init (-71), 9 69 fn_plus_fix init (-72), 9 70 fn_plus_flo init (-73), 9 71 fn_times_fix init (-74), 9 72 fn_times_flo init (-75), 9 73 fn_diff_fix init (-76), 9 74 fn_diff_flo init (-77), 9 75 fn_quot_fix init (-78), 9 76 fn_quot_flo init (-79), 9 77 fn_eval init (-80), 9 78 fn_apply init (-81), 9 79 fn_prog init (-82), 9 80 fn_errset init (-83), 9 81 fn_catch init (-84), 9 82 fn_throw init (-85), 9 83 fn_store init (-86), 9 84 fn_defun init (-87), 9 85 fn_baktrace init (-88), 9 86 fn_bltarray init (-89), 9 87 fn_star_rearray init (-90), 9 88 fn_gensym init (-91), 9 89 fn_makunbound init (-92), 9 90 fn_boundp init (-93), 9 91 fn_star_status init (-94), 9 92 fn_star_sstatus init (-95), 9 93 fn_freturn init (-96), 9 94 fn_cos init (-97), 9 95 fn_sin init (-98), 9 96 fn_exp init (-99), 9 97 fn_log init (-100), 9 98 fn_sqrt init (-101), 9 99 fn_isqrt init (-102), 9 100 fn_atan init (-103), 9 101 fn_sleep init (-104), 9 102 fn_oddp init (-105), 9 103 fn_tyipeek init (-106), 9 104 fn_alarmclock init (-107), 9 105 fn_plusp init (-108), 9 106 fn_minusp init (-109), 9 107 fn_ls init (-110), 9 108 fn_eql init (-111), 9 109 fn_gt init (-112), 9 110 fn_alphalessp init (-113), 9 111 fn_samepnamep init (-114), 9 112 fn_getchar init (-115), 9 113 fn_opena init (-116), 9 114 fn_sxhash init (-117), 9 115 fn_gcd init (-118), 9 116 fn_allfiles init (-119), 9 117 fn_chrct init (-120), 9 118 fn_close init (-121), 9 119 fn_deletef init (-122), 9 120 fn_eoffn init (-123), 9 121 fn_filepos init (-124), 9 122 fn_inpush init (-125), 9 123 fn_linel init (-126), 9 124 fn_mergef init (-127), 9 125 fn_namelist init (-128), 9 126 fn_names init (-129), 9 127 fn_namestring init (-130), 9 128 fn_openi init (-131), 9 129 fn_openo init (-132), 9 130 fn_prin1 init (-133), 9 131 fn_princ init (-134), 9 132 fn_print init (-135), 9 133 fn_read init (-136), 9 134 fn_readch init (-137), 9 135 fn_readstring init (-138), 9 136 fn_rename init (-139), 9 137 fn_shortnamestring init (-140), 9 138 fn_tyi init (-141), 9 139 fn_setsyntax init (-142), 9 140 fn_cursorpos init (-143), 9 141 fn_force_output init (-144), 9 142 fn_clear_input init (-145), 9 143 fn_random init (-146), 9 144 fn_haulong init (-147), 9 145 fn_haipart init (-148), 9 146 fn_cline init (-149), 9 147 fn_fillarray init (-150), 9 148 fn_listarray init (-151), 9 149 fn_sort init (-152), 9 150 fn_sortcar init (-153), 9 151 fn_zerop init (-154), 9 152 fn_listify init (-155), 9 153 fn_charpos init (-156), 9 154 fn_pagel init (-157), 9 155 fn_linenum init (-158), 9 156 fn_pagenum init (-159), 9 157 fn_endpagefn init (-160), 9 158 fn_arraydims init (-161), 9 159 fn_loadarrays init (-162), 9 160 fn_dumparrays init (-163), 9 161 fn_expt_fix init (-164), 9 162 fn_expt_flo init (-165), 9 163 fn_nointerrupt init (-166), 9 164 fn_open init (-167), 9 165 fn_in init (-168), 9 166 fn_out init (-169), 9 167 fn_truename init (-170), 9 168 fn_ifix init (-171), 9 169 fn_fsc init (-172), 9 170 fn_progv init (-173), 9 171 fn_mapatoms init (-174), 9 172 fn_unwind_protect init (-175), 9 173 fn_eval_when init (-176), 9 174 fn_read_from_string init (-177), 9 175 fn_displace init (-178), 9 176 fn_nth init (-179), 9 177 fn_nthcdr init (-180), 9 178 fn_includef init (-181) 9 179 ) fixed bin static; 9 180 9 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 119 120 121 /* dumparrays subr. first arg is list of arrays, second is pathname. 122* if pathname is (pdp10 pathname), pdp10 format is used */ 123 124 125 myname = fn_dumparrays; 126 stack = addrel(stack_ptr, -4); /* 2 args */ 127 if stack -> temp_type(2) = Cons then do; 128 if stack -> temp_ptr(2) -> cons_ptrs.car -> atom.pname ^= "pdp10" then go to wta; 129 pdp10_compatibility = "1"b; 130 stack -> temp(2) = stack -> temp_ptr(2) -> cons_ptrs.cdr -> cons.car; 131 end; 132 else pdp10_compatibility = "0"b; 133 134 /* create the output file */ 135 136 if stack -> temp_type36(2) & Atsym36 then p = addr(stack -> temp_ptr(2) -> atom.pnamel); 137 else if stack -> temp_type36(2) & String36 then p = stack -> temp_ptr(2); 138 else go to wta; 139 140 call expand_path_(addr(p -> lisp_string.string), p -> lisp_string.string_length, 141 addr(dn), addr(en), code); 142 if code ^= 0 then go to fserr; 143 call hcs_$make_seg(dn, en, "", 1011b, p, code); 144 if p = null then go to fserr; 145 146 /* begin dumping arrays */ 147 148 do while(stack -> temp(1) ^= nil); 149 stack -> temp(2) = stack -> temp_ptr(1) -> cons.car; /* an array */ 150 151 /* put out the pname */ 152 153 if ^ pdp10_compatibility then do; 154 p -> dumped_array_file.type = Multics_flag; 155 p -> dumped_array_file.count = stack -> temp_ptr(2) -> atom.pnamel; 156 p -> dumped_array_file.pname = stack -> temp_ptr(2) -> atom.pname; 157 p = addr(p -> dumped_array_file.data); 158 end; 159 else do; 160 n = divide(4 + stack -> temp_ptr(2) -> atom.pnamel, 5, 17, 0); 161 p -> dumped_array_file.type = -n; 162 p -> dumped_array_file.count = n; 163 p = addr(p -> dumped_array_file.pname); 164 j = 0; 165 do i = 1 by 1 while(i <= stack -> temp_ptr(2) -> atom.pnamel); 166 ch = substr(stack -> temp_ptr(2) -> atom.pname, i, 1); 167 ch = translate(ch, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 168 "abcdefghijklmnopqrstuvwxyz"); 169 p -> byte7(j) = substr(unspec(ch), 3, 7); 170 j = j + 1; 171 if j > 4 then do; 172 j = 0; 173 p = addrel(p, 1); 174 end; 175 end; 176 end; 177 178 /* put out the array data */ 179 180 stack_ptr = addr(stack -> temp(4)); 181 stack -> temp(3) = lisp_static_vars_$array; 182 call lisp_property_fns_$get; 183 if stack -> temp(2) = nil then call err1(lisp_error_table_$argument_must_be_array); 184 convert_flonums = "0"b; 185 if stack -> temp_ptr(2) -> array_info.type = Fixnum_array then p -> dumped_array_data.array_type = 1; 186 else if stack -> temp_ptr(2) -> array_info.type = Flonum_array then do; 187 p -> dumped_array_data.array_type = 2; 188 convert_flonums = pdp10_compatibility; 189 end; 190 else call err1(lisp_error_table_$special_array_type); 191 192 /* compute array size */ 193 194 n = 1; 195 do i = 1-stack -> temp_ptr(2) -> array_info.ndims by 1 to 0; 196 n = n * stack -> temp_ptr(2) -> array_info.array_data_ptr -> array_data.dope_vector(i).bounds; 197 end; 198 p -> dumped_array_data.word_count = -n; 199 200 /* put it out */ 201 202 /* p -> dumped_array_data.data = stack -> temp_ptr(2) -> array_info.array_data_ptr -> words; */ 203 addr(p -> dumped_array_data.data)->words = stack -> temp_ptr(2) -> array_info.array_data_ptr -> words; 204 if convert_flonums then do i = 1 by 1 while(i <= n); 205 fp = addr(p -> dumped_array_data.data(i)); 206 a_word = 0; 207 if fp -> bflonum ^= 0.0 then do; 208 addr(a_word) -> PDP10_flonum.exponent = 209 fp -> H6180_flonum.exponent + 128; 210 if fp -> H6180_flonum.mantissa >= 0 211 then addr(a_word) -> PDP10_flonum.mantissa = bit(fp -> H6180_flonum.mantissa, 27); 212 else do; 213 if substr(fp -> word, 9) = "1"b then do; 214 addr(a_word)->PDP10_flonum.mantissa = "1"b; 215 addr(a_word) -> PDP10_flonum.exponent = addr(a_word) -> PDP10_flonum.exponent + 1; 216 end; 217 else addr(a_word) -> PDP10_flonum.mantissa = bit(fixed(-fp -> H6180_flonum.mantissa,27),27); 218 a_word = -a_word; 219 end; 220 end; 221 fp -> word = unspec(a_word); 222 end; 223 224 /* advance pointer to after this array's stuff */ 225 226 p = addrel(p, size(dumped_array_data)); 227 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 228 end; 229 230 /* put end of file marker */ 231 232 p -> word = end_of_file_mark; 233 234 n = 1+fixed(rel(p),18); 235 call hcs_$truncate_seg(p, n, code); 236 call hcs_$set_bc_seg(p, 36*n, code); 237 call hcs_$terminate_noname(p, code); 238 exit: stack_ptr = addr(stack -> temp(2)); 239 return; 240 241 loadarrays: entry; 242 243 /* loadarrays subr. arg is pathname. will load either a pdp10 244* or a Multics file. */ 245 246 myname = fn_loadarrays; 247 stack = addrel(stack_ptr, -2); /* 1 arg */ 248 if stack -> temp_type36(1) & Atsym36 then p = addr(stack -> temp_ptr(1) -> atom.pnamel); 249 else if stack -> temp_type36(1) & String36 then p = stack -> temp_ptr(1); 250 else go to wta; 251 252 /* open the file */ 253 254 call expand_path_(addr(p -> lisp_string.string), p -> lisp_string.string_length, addr(dn), addr(en), code); 255 if code ^= 0 then go to fserr; 256 call hcs_$initiate(dn, en, "", 0, 0, p, code); 257 if p = null then go to fserr; 258 259 /* begin processing */ 260 261 pdp10_compatibility = "0"b; 262 if p -> dumped_array_file.type < 0 then pdp10_compatibility = "1"b; 263 stack -> temp(1) = nil; /* initialize return list */ 264 do while(p -> word ^= end_of_file_mark); 265 266 /* get old pname */ 267 268 stack_ptr = addr(stack -> temp(3)); 269 addr(stack -> temp(2)) -> fixnum_fmt.type_info = fixnum_type; 270 addr(stack -> temp(2)) -> fixedb = 0; 271 call lisp_special_fns_$gensym; 272 stack_ptr = addr(stack -> temp(6)); 273 if ^ pdp10_compatibility 274 then do; 275 call lisp_get_atom_(p -> dumped_array_file.pname, stack -> temp(3)); 276 p = addr(p -> dumped_array_file.data); 277 end; 278 else do; 279 unm = unmkd_ptr; 280 unmkd_ptr = addrel(unm, 2*divide(7 + 5* p->dumped_array_file.count, 8, 18, 0)); 281 fp = addr(p -> dumped_array_file.pname); 282 i = 0; 283 do j = 1 to p -> dumped_array_file.count; 284 do n = 0 to 4; 285 if fp -> byte7(n) then do; 286 unspec(ch) = "00"b || fp -> byte7(n); 287 ch = translate(ch, "abcdefghijklmnopqrstuvwxyz", 288 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"); 289 substr(unm -> pnamebuf, i+1, 1) = ch; 290 i = i + 1; 291 end; 292 end; 293 fp = addrel(fp, 1); 294 end; 295 p = addrel(p, j); 296 call lisp_get_atom_(unm -> pnamebuf, stack -> temp(3)); 297 unmkd_ptr = unm; 298 end; 299 stack_ptr = addr(stack -> temp(11)); 300 301 /* compute size & type of array and create it */ 302 303 if p -> dumped_array_data.array_type = 2 304 then do; 305 convert_flonums = pdp10_compatibility; 306 stack -> temp(8) = lisp_static_vars_$flonum; 307 end; 308 else do; 309 convert_flonums = "0"b; 310 stack -> temp(8) = lisp_static_vars_$fixnum; 311 end; 312 addr(stack -> temp(4)) -> fixnum_fmt.type_info, 313 addr(stack -> temp(9)) -> fixnum_fmt.type_info, 314 addr(stack -> temp(10)) -> fixnum_fmt.type_info = fixnum_type; 315 n = - p -> dumped_array_data.word_count; 316 addr(stack -> temp(4)) -> fixedb, 317 addr(stack -> temp(9)) -> fixedb = n; 318 addr(stack -> temp(10)) -> fixedb = -6; /* passing 3 args */ 319 stack -> temp(7) = nil; 320 call lisp_array_fcns_$star_array; 321 /* stack -> temp_ptr(7) -> array_info.array_data_ptr -> words = p -> dumped_array_data.data; */ 322 stack -> temp_ptr(7) -> array_info.array_data_ptr -> words = addr(p -> dumped_array_data.data)->words; 323 if convert_flonums then do i = 1 by 1 while(i <= n); 324 fp = addr(stack -> temp_ptr(7) -> array_info.array_data_ptr -> words(i)); 325 unspec(a_word) = fp -> word; 326 if a_word = 0 then fp -> bflonum = 0.0; 327 else do; 328 if a_word > 0 then do; 329 fsign =1.0; 330 end; 331 else do; 332 fsign = -1.0; 333 a_word = -a_word; 334 end; 335 fp -> H6180_flonum.exponent = addr(a_word) -> PDP10_flonum.exponent - 128; 336 fp -> H6180_flonum.mantissa = fixed(addr(a_word)->PDP10_flonum.mantissa, 27); 337 fp -> bflonum = fp -> bflonum * fsign; 338 end; 339 end; 340 p = addrel(p, size(dumped_array_data)); 341 stack_ptr = addr(stack -> temp(9)); 342 stack -> temp(6) = stack -> temp(2); 343 stack -> temp(8) = lisp_static_vars_$array; 344 call lisp_property_fns_$putprop; 345 346 /* cons up return list */ 347 348 stack_ptr = addr(stack -> temp(6)); 349 stack -> temp(5) = nil; 350 do i = 0 to 2; 351 call lisp_special_fns_$cons; 352 end; 353 call lisp_special_fns_$xcons; 354 end; 355 call hcs_$terminate_noname(p, code); 356 go to exit; 357 358 /* error handlers */ 359 360 dcl 1 error_push aligned based, 361 2 (code1, code2) fixed bin(35), 362 lisp_error_ entry; 363 364 wta: call err(lisp_error_table_$bad_argument); 365 366 fserr: myname = code; 367 call err(lisp_error_table_$file_sys_fun_err); 368 369 err1: proc(ecode); 370 371 stack -> temp(2) = stack -> temp_ptr(1) -> cons.car; /* retrieve the bad array name */ 372 373 err: entry(ecode); 374 375 dcl ecode fixed bin(35); 376 377 unm = unmkd_ptr; 378 unmkd_ptr = addrel(unm, size(error_push)); 379 unm -> code1 = ecode; 380 unm -> code2 = myname; 381 call lisp_error_; 382 383 /* in case it returns, return what it returned */ 384 385 stack -> temp(1) = addrel(stack_ptr, -2) -> temp(1); 386 go to exit; 387 end; 388 389 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.3 lisp_loadumparrays_.pl1 >special_ldd>on>06/27/83>lisp_loadumparrays_.pl1 111 1 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 112 2 03/27/82 0437.0 lisp_stack_fmt.incl.pl1 >ldd>include>lisp_stack_fmt.incl.pl1 113 3 03/27/82 0437.0 lisp_cons_fmt.incl.pl1 >ldd>include>lisp_cons_fmt.incl.pl1 114 4 03/27/82 0437.0 lisp_nums.incl.pl1 >ldd>include>lisp_nums.incl.pl1 115 5 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 116 6 03/27/82 0437.1 lisp_array_fmt.incl.pl1 >ldd>include>lisp_array_fmt.incl.pl1 117 7 03/27/82 0437.1 lisp_atom_fmt.incl.pl1 >ldd>include>lisp_atom_fmt.incl.pl1 118 8 03/27/82 0436.9 lisp_string_fmt.incl.pl1 >ldd>include>lisp_string_fmt.incl.pl1 119 9 06/29/83 1425.3 lisp_name_codes.incl.pl1 >ldd>include>lisp_name_codes.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 5-17 Array36 internal static bit(36) initial dcl 5-17 Atomic internal static bit(9) initial unaligned dcl 5-17 Atomic36 internal static bit(36) initial dcl 5-17 Atsym internal static bit(9) initial unaligned dcl 5-17 Atsym36 constant bit(36) initial dcl 5-17 ref 136 248 Bigfix internal static bit(9) initial unaligned dcl 5-17 Bigfix36 internal static bit(36) initial dcl 5-17 Bignum internal static bit(9) initial unaligned dcl 5-17 Bignum36 internal static bit(36) initial dcl 5-17 Cons constant bit(9) initial unaligned dcl 5-17 ref 127 Cons36 internal static bit(36) initial dcl 5-17 Dead_array internal static fixed bin(17,0) initial dcl 6-20 File internal static bit(9) initial unaligned dcl 5-17 File36 internal static bit(36) initial dcl 5-17 Fixed internal static bit(9) initial unaligned dcl 5-17 Fixed36 internal static bit(36) initial dcl 5-17 Fixnum_array constant fixed bin(17,0) initial dcl 6-20 ref 185 Float internal static bit(9) initial unaligned dcl 5-17 Float36 internal static bit(36) initial dcl 5-17 Flonum_array constant fixed bin(17,0) initial dcl 6-20 ref 186 H6180_flonum based structure level 1 dcl 42 Multics_flag constant fixed bin(17,0) initial dcl 55 ref 154 NotConsOrAtsym36 internal static bit(36) initial dcl 5-17 Numeric internal static bit(9) initial unaligned dcl 5-17 Numeric36 internal static bit(36) initial dcl 5-17 Obarray_array internal static fixed bin(17,0) initial dcl 6-20 PDP10_flonum based structure level 1 dcl 42 Readtable_array internal static fixed bin(17,0) initial dcl 6-20 S_expr_array internal static fixed bin(17,0) initial dcl 6-20 String internal static bit(9) initial unaligned dcl 5-17 String36 constant bit(36) initial dcl 5-17 ref 137 249 Subr internal static bit(9) initial unaligned dcl 5-17 Subr36 internal static bit(36) initial dcl 5-17 SubrNumeric36 internal static bit(36) initial dcl 5-17 System_Subr internal static bit(9) initial unaligned dcl 5-17 System_Subr36 internal static bit(36) initial dcl 5-17 Un_gc_array internal static fixed bin(17,0) initial dcl 6-20 Uncollectable internal static bit(9) initial unaligned dcl 5-17 Undefined internal static bit(72) initial unaligned dcl 5-17 ZERO internal static fixed bin(17,0) initial dcl 6-37 a_word 000102 automatic fixed bin(35,0) dcl 42 set ref 206* 208 210 214 215 215 217 218* 218 221 325* 326 328 333* 333 335 336 addr builtin function dcl 107 ref 136 140 140 140 140 140 140 157 163 180 203 205 208 210 214 215 215 217 238 248 254 254 254 254 254 254 268 269 270 272 276 281 299 312 312 312 316 316 318 322 324 335 336 341 348 addrel builtin function dcl 107 ref 126 173 226 247 280 293 295 340 378 385 array_atom defined fixed bin(71,0) dcl 1-6 array_data based structure level 1 dcl 6-31 array_data_ptr 2 based pointer level 2 dcl 6-8 ref 196 203 322 324 array_info based structure level 1 dcl 6-8 array_type 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 26 set ref 185* 187* 303 atom based structure level 1 dcl 7-5 atom_double_words based structure level 1 dcl 7-5 atom_ptrs based structure level 1 dcl 7-5 based_ptr based pointer dcl 5-16 bflonum based float bin(27) dcl 88 set ref 207 326* 337* 337 binding_block based structure level 1 dcl 2-7 binding_top defined pointer dcl 1-6 bindings based structure array level 1 dcl 2-7 bit builtin function dcl 107 ref 210 217 bounds based fixed bin(35,0) array level 3 dcl 6-31 ref 196 byte7 based bit(7) array unaligned dcl 42 set ref 169* 285 286 car based pointer level 2 in structure "cons_ptrs" dcl 3-5 in procedure "dumparrays" ref 128 car based fixed bin(71,0) level 2 in structure "cons" dcl 3-5 in procedure "dumparrays" ref 130 149 371 catch_frame defined pointer dcl 1-6 cdr 2 based fixed bin(71,0) level 2 in structure "cons" dcl 3-5 in procedure "dumparrays" ref 227 cdr 2 based pointer level 2 in structure "cons_ptrs" dcl 3-5 in procedure "dumparrays" ref 130 ch 000112 automatic char(1) unaligned dcl 60 set ref 166* 167* 167 169 286* 287* 287 289 code 000202 automatic fixed bin(35,0) dcl 78 set ref 140* 142 143* 235* 236* 237* 254* 255 256* 355* 366 code1 based fixed bin(35,0) level 2 dcl 360 set ref 379* code2 1 based fixed bin(35,0) level 2 dcl 360 set ref 380* cons based structure level 1 dcl 3-5 cons_ptrs based structure level 1 dcl 3-5 cons_types based structure level 1 dcl 3-5 cons_types36 based structure level 1 dcl 3-22 consptr automatic pointer dcl 3-5 convert_flonums 000114 automatic bit(1) unaligned dcl 60 set ref 184* 188* 204 305* 309* 323 count 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 17 set ref 155* 156 157 162* 163 275 275 276 280 281 283 data based fixed bin(17,0) level 2 in structure "dumped_array_file" dcl 17 in procedure "dumparrays" set ref 157 276 data 1 based bit(36) array level 2 in structure "dumped_array_data" dcl 26 in procedure "dumparrays" set ref 203 205 322 divide builtin function dcl 107 ref 160 280 dn 000120 automatic char(168) unaligned dcl 78 set ref 140 140 143* 254 254 256* dope_vector based structure array level 2 dcl 6-31 dumparrays 000037 constant entry external dcl 6 dumped_array_data based structure level 1 dcl 26 set ref 226 340 dumped_array_file based structure level 1 dcl 17 ecode parameter fixed bin(35,0) dcl 375 ref 369 373 379 en 000172 automatic char(32) unaligned dcl 78 set ref 140 140 143* 254 254 256* end_of_file_mark 000000 constant bit(36) initial unaligned dcl 33 ref 232 264 err 001475 constant entry internal dcl 373 ref 364 367 err1 001466 constant entry internal dcl 369 ref 183 190 err_frame defined pointer dcl 1-6 err_recp defined pointer dcl 1-6 error_push based structure level 1 dcl 360 set ref 378 eval_frame defined pointer dcl 1-6 exit 000646 constant label dcl 238 ref 356 386 expand_path_ 000040 constant entry external dcl 78 ref 140 254 exponent based fixed bin(7,0) level 2 in structure "H6180_flonum" packed unaligned dcl 42 in procedure "dumparrays" set ref 208 335* exponent 0(01) based fixed bin(7,0) level 2 in structure "PDP10_flonum" packed unaligned dcl 42 in procedure "dumparrays" set ref 208* 215* 215 335 fixed builtin function dcl 107 ref 217 234 336 fixedb 1 based fixed bin(17,0) level 2 dcl 4-4 set ref 270* 316* 316* 318* fixnum_fmt based structure level 1 dcl 4-4 fixnum_type constant bit(36) initial dcl 4-4 ref 269 312 flonum_fmt based structure level 1 dcl 4-4 flonum_type internal static bit(36) initial dcl 4-4 fn_CtoI internal static fixed bin(17,0) initial dcl 9-9 fn_ItoC internal static fixed bin(17,0) initial dcl 9-9 fn_abs internal static fixed bin(17,0) initial dcl 9-9 fn_add1 internal static fixed bin(17,0) initial dcl 9-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 9-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 9-9 fn_alarmclock internal static fixed bin(17,0) initial dcl 9-9 fn_allfiles internal static fixed bin(17,0) initial dcl 9-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 9-9 fn_apply internal static fixed bin(17,0) initial dcl 9-9 fn_arg internal static fixed bin(17,0) initial dcl 9-9 fn_args internal static fixed bin(17,0) initial dcl 9-9 fn_array internal static fixed bin(17,0) initial dcl 9-9 fn_arraydims internal static fixed bin(17,0) initial dcl 9-9 fn_ascii internal static fixed bin(17,0) initial dcl 9-9 fn_atan internal static fixed bin(17,0) initial dcl 9-9 fn_baktrace internal static fixed bin(17,0) initial dcl 9-9 fn_bltarray internal static fixed bin(17,0) initial dcl 9-9 fn_boole internal static fixed bin(17,0) initial dcl 9-9 fn_boundp internal static fixed bin(17,0) initial dcl 9-9 fn_catch internal static fixed bin(17,0) initial dcl 9-9 fn_catenate internal static fixed bin(17,0) initial dcl 9-9 fn_charpos internal static fixed bin(17,0) initial dcl 9-9 fn_chrct internal static fixed bin(17,0) initial dcl 9-9 fn_clear_input internal static fixed bin(17,0) initial dcl 9-9 fn_cline internal static fixed bin(17,0) initial dcl 9-9 fn_close internal static fixed bin(17,0) initial dcl 9-9 fn_cos internal static fixed bin(17,0) initial dcl 9-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 9-9 fn_defaultf internal static fixed bin(17,0) initial dcl 9-9 fn_definedp internal static fixed bin(17,0) initial dcl 9-9 fn_defsubr internal static fixed bin(17,0) initial dcl 9-9 fn_defun internal static fixed bin(17,0) initial dcl 9-9 fn_delete internal static fixed bin(17,0) initial dcl 9-9 fn_deletef internal static fixed bin(17,0) initial dcl 9-9 fn_delq internal static fixed bin(17,0) initial dcl 9-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 9-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 9-9 fn_difference internal static fixed bin(17,0) initial dcl 9-9 fn_displace internal static fixed bin(17,0) initial dcl 9-9 fn_do internal static fixed bin(17,0) initial dcl 9-9 fn_dumparrays constant fixed bin(17,0) initial dcl 9-9 ref 125 fn_endpagefn internal static fixed bin(17,0) initial dcl 9-9 fn_eoffn internal static fixed bin(17,0) initial dcl 9-9 fn_eql internal static fixed bin(17,0) initial dcl 9-9 fn_errframe internal static fixed bin(17,0) initial dcl 9-9 fn_errprint internal static fixed bin(17,0) initial dcl 9-9 fn_errset internal static fixed bin(17,0) initial dcl 9-9 fn_eval internal static fixed bin(17,0) initial dcl 9-9 fn_eval_when internal static fixed bin(17,0) initial dcl 9-9 fn_evalframe internal static fixed bin(17,0) initial dcl 9-9 fn_exp internal static fixed bin(17,0) initial dcl 9-9 fn_expt internal static fixed bin(17,0) initial dcl 9-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 9-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 9-9 fn_filepos internal static fixed bin(17,0) initial dcl 9-9 fn_fillarray internal static fixed bin(17,0) initial dcl 9-9 fn_fix internal static fixed bin(17,0) initial dcl 9-9 fn_float internal static fixed bin(17,0) initial dcl 9-9 fn_force_output internal static fixed bin(17,0) initial dcl 9-9 fn_freturn internal static fixed bin(17,0) initial dcl 9-9 fn_fsc internal static fixed bin(17,0) initial dcl 9-9 fn_gcd internal static fixed bin(17,0) initial dcl 9-9 fn_gensym internal static fixed bin(17,0) initial dcl 9-9 fn_get internal static fixed bin(17,0) initial dcl 9-9 fn_get_pname internal static fixed bin(17,0) initial dcl 9-9 fn_getchar internal static fixed bin(17,0) initial dcl 9-9 fn_getl internal static fixed bin(17,0) initial dcl 9-9 fn_greaterp internal static fixed bin(17,0) initial dcl 9-9 fn_gt internal static fixed bin(17,0) initial dcl 9-9 fn_haipart internal static fixed bin(17,0) initial dcl 9-9 fn_haulong internal static fixed bin(17,0) initial dcl 9-9 fn_ifix internal static fixed bin(17,0) initial dcl 9-9 fn_in internal static fixed bin(17,0) initial dcl 9-9 fn_includef internal static fixed bin(17,0) initial dcl 9-9 fn_index internal static fixed bin(17,0) initial dcl 9-9 fn_inpush internal static fixed bin(17,0) initial dcl 9-9 fn_isqrt internal static fixed bin(17,0) initial dcl 9-9 fn_lessp internal static fixed bin(17,0) initial dcl 9-9 fn_linel internal static fixed bin(17,0) initial dcl 9-9 fn_linenum internal static fixed bin(17,0) initial dcl 9-9 fn_listarray internal static fixed bin(17,0) initial dcl 9-9 fn_listify internal static fixed bin(17,0) initial dcl 9-9 fn_loadarrays constant fixed bin(17,0) initial dcl 9-9 ref 246 fn_log internal static fixed bin(17,0) initial dcl 9-9 fn_ls internal static fixed bin(17,0) initial dcl 9-9 fn_lsh internal static fixed bin(17,0) initial dcl 9-9 fn_make_atom internal static fixed bin(17,0) initial dcl 9-9 fn_makunbound internal static fixed bin(17,0) initial dcl 9-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 9-9 fn_max internal static fixed bin(17,0) initial dcl 9-9 fn_mergef internal static fixed bin(17,0) initial dcl 9-9 fn_min internal static fixed bin(17,0) initial dcl 9-9 fn_minus internal static fixed bin(17,0) initial dcl 9-9 fn_minusp internal static fixed bin(17,0) initial dcl 9-9 fn_namelist internal static fixed bin(17,0) initial dcl 9-9 fn_names internal static fixed bin(17,0) initial dcl 9-9 fn_namestring internal static fixed bin(17,0) initial dcl 9-9 fn_nointerrupt internal static fixed bin(17,0) initial dcl 9-9 fn_nth internal static fixed bin(17,0) initial dcl 9-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 9-9 fn_oddp internal static fixed bin(17,0) initial dcl 9-9 fn_open internal static fixed bin(17,0) initial dcl 9-9 fn_opena internal static fixed bin(17,0) initial dcl 9-9 fn_openi internal static fixed bin(17,0) initial dcl 9-9 fn_openo internal static fixed bin(17,0) initial dcl 9-9 fn_out internal static fixed bin(17,0) initial dcl 9-9 fn_pagel internal static fixed bin(17,0) initial dcl 9-9 fn_pagenum internal static fixed bin(17,0) initial dcl 9-9 fn_plus internal static fixed bin(17,0) initial dcl 9-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 9-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 9-9 fn_plusp internal static fixed bin(17,0) initial dcl 9-9 fn_prin1 internal static fixed bin(17,0) initial dcl 9-9 fn_princ internal static fixed bin(17,0) initial dcl 9-9 fn_print internal static fixed bin(17,0) initial dcl 9-9 fn_prog internal static fixed bin(17,0) initial dcl 9-9 fn_progv internal static fixed bin(17,0) initial dcl 9-9 fn_putprop internal static fixed bin(17,0) initial dcl 9-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 9-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 9-9 fn_quotient internal static fixed bin(17,0) initial dcl 9-9 fn_random internal static fixed bin(17,0) initial dcl 9-9 fn_read internal static fixed bin(17,0) initial dcl 9-9 fn_read_from_string internal static fixed bin(17,0) initial dcl 9-9 fn_readch internal static fixed bin(17,0) initial dcl 9-9 fn_readstring internal static fixed bin(17,0) initial dcl 9-9 fn_remainder internal static fixed bin(17,0) initial dcl 9-9 fn_remprop internal static fixed bin(17,0) initial dcl 9-9 fn_rename internal static fixed bin(17,0) initial dcl 9-9 fn_rot internal static fixed bin(17,0) initial dcl 9-9 fn_rplaca internal static fixed bin(17,0) initial dcl 9-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 9-9 fn_save internal static fixed bin(17,0) initial dcl 9-9 fn_set internal static fixed bin(17,0) initial dcl 9-9 fn_setarg internal static fixed bin(17,0) initial dcl 9-9 fn_setq internal static fixed bin(17,0) initial dcl 9-9 fn_setsyntax internal static fixed bin(17,0) initial dcl 9-9 fn_shortnamestring internal static fixed bin(17,0) initial dcl 9-9 fn_signp internal static fixed bin(17,0) initial dcl 9-9 fn_sin internal static fixed bin(17,0) initial dcl 9-9 fn_sleep internal static fixed bin(17,0) initial dcl 9-9 fn_sort internal static fixed bin(17,0) initial dcl 9-9 fn_sortcar internal static fixed bin(17,0) initial dcl 9-9 fn_sqrt internal static fixed bin(17,0) initial dcl 9-9 fn_sstatus internal static fixed bin(17,0) initial dcl 9-9 fn_star_array internal static fixed bin(17,0) initial dcl 9-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 9-9 fn_star_sstatus internal static fixed bin(17,0) initial dcl 9-9 fn_star_status internal static fixed bin(17,0) initial dcl 9-9 fn_status internal static fixed bin(17,0) initial dcl 9-9 fn_store internal static fixed bin(17,0) initial dcl 9-9 fn_stringlength internal static fixed bin(17,0) initial dcl 9-9 fn_sub1 internal static fixed bin(17,0) initial dcl 9-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 9-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 9-9 fn_substr internal static fixed bin(17,0) initial dcl 9-9 fn_sxhash internal static fixed bin(17,0) initial dcl 9-9 fn_sysp internal static fixed bin(17,0) initial dcl 9-9 fn_throw internal static fixed bin(17,0) initial dcl 9-9 fn_times internal static fixed bin(17,0) initial dcl 9-9 fn_times_fix internal static fixed bin(17,0) initial dcl 9-9 fn_times_flo internal static fixed bin(17,0) initial dcl 9-9 fn_truename internal static fixed bin(17,0) initial dcl 9-9 fn_tyi internal static fixed bin(17,0) initial dcl 9-9 fn_tyipeek internal static fixed bin(17,0) initial dcl 9-9 fn_tyo internal static fixed bin(17,0) initial dcl 9-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 9-9 fn_zerop internal static fixed bin(17,0) initial dcl 9-9 fp 000204 automatic pointer dcl 88 set ref 205* 207 208 210 210 213 217 221 281* 285 286 293* 293 324* 325 326 335 336 337 337 fserr 001454 constant label dcl 366 ref 142 144 255 257 fsign 000206 automatic float bin(1) dcl 88 set ref 329* 332* 337 hcs_$initiate 000036 constant entry external dcl 78 ref 256 hcs_$make_seg 000034 constant entry external dcl 78 ref 143 hcs_$set_bc_seg 000032 constant entry external dcl 78 ref 236 hcs_$terminate_noname 000026 constant entry external dcl 78 ref 237 355 hcs_$truncate_seg 000030 constant entry external dcl 78 ref 235 i 000107 automatic fixed bin(18,0) dcl 60 set ref 165* 165* 166* 195* 196* 204* 204* 205* 282* 289 289 290* 290 296 296 323* 323* 324* 350* j 000110 automatic fixed bin(18,0) dcl 60 set ref 164* 169 170* 170 171 172* 283* 295 lisp_array_fcns_$star_array 000022 constant entry external dcl 60 ref 320 lisp_error_ 000066 constant entry external dcl 360 ref 381 lisp_error_table_$argument_must_be_array 000054 external static fixed bin(35,0) dcl 100 set ref 183* lisp_error_table_$bad_argument 000050 external static fixed bin(35,0) dcl 100 set ref 364* lisp_error_table_$file_sys_fun_err 000052 external static fixed bin(35,0) dcl 100 set ref 367* lisp_error_table_$special_array_type 000056 external static fixed bin(35,0) dcl 100 set ref 190* lisp_get_atom_ 000014 constant entry external dcl 60 ref 275 296 lisp_property_fns_$get 000010 constant entry external dcl 60 ref 182 lisp_property_fns_$putprop 000012 constant entry external dcl 60 ref 344 lisp_ptr based structure level 1 dcl 5-17 lisp_ptr_type based bit(36) dcl 5-17 lisp_special_fns_$cons 000020 constant entry external dcl 60 ref 351 lisp_special_fns_$gensym 000024 constant entry external dcl 60 ref 271 lisp_special_fns_$xcons 000016 constant entry external dcl 60 ref 353 lisp_static_vars_$array 000042 external static fixed bin(71,0) dcl 94 ref 181 343 lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$binding_top external static pointer dcl 1-6 lisp_static_vars_$catch_frame external static pointer dcl 1-6 lisp_static_vars_$err_frame external static pointer dcl 1-6 lisp_static_vars_$err_recp external static pointer dcl 1-6 lisp_static_vars_$eval_frame external static pointer dcl 1-6 lisp_static_vars_$fixnum 000044 external static fixed bin(71,0) dcl 94 ref 310 lisp_static_vars_$flonum 000046 external static fixed bin(71,0) dcl 94 ref 306 lisp_static_vars_$iochan_list external static pointer dcl 1-6 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 1-6 lisp_static_vars_$nil 000064 external static fixed bin(71,0) dcl 1-6 ref 148 148 183 183 263 263 319 319 349 349 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$prog_frame external static pointer dcl 1-6 lisp_static_vars_$stack_ptr 000060 external static pointer dcl 1-6 set ref 126 126 180* 180 238* 238 247 247 268* 268 272* 272 299* 299 341* 341 348* 348 385 385 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 1-45 lisp_static_vars_$t_atom external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$top_level external static label variable dcl 1-6 lisp_static_vars_$tty_input_chan external static pointer dcl 1-6 lisp_static_vars_$tty_output_chan external static pointer dcl 1-6 lisp_static_vars_$unmkd_ptr 000062 external static pointer dcl 1-6 set ref 279 279 280* 280 297* 297 377 377 378* 378 lisp_static_vars_$unwp_frame external static pointer dcl 1-6 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 1-45 lisp_string based structure level 1 dcl 8-6 loadarrays 000654 constant entry external dcl 241 mantissa 0(09) based bit(27) level 2 in structure "PDP10_flonum" packed unaligned dcl 42 in procedure "dumparrays" set ref 210* 214* 217* 336 mantissa 0(08) based fixed bin(27,0) level 2 in structure "H6180_flonum" packed unaligned dcl 42 in procedure "dumparrays" set ref 210 210 217 336* myname 000106 automatic fixed bin(35,0) dcl 60 set ref 125* 246* 366* 380 n 000111 automatic fixed bin(18,0) dcl 60 set ref 160* 161 162 194* 196* 196 198 203 204 234* 235* 236 284* 285 286* 315* 316 322 323 ndims based fixed bin(17,0) level 2 packed unaligned dcl 6-8 ref 195 nil defined fixed bin(71,0) dcl 1-6 ref 148 183 263 319 349 nil_ptr based pointer dcl 1-6 null builtin function dcl 107 ref 144 257 obarray defined fixed bin(71,0) dcl 1-6 p 000100 automatic pointer dcl 38 set ref 136* 137* 140 140 140 143* 144 154 155 156 156 157* 157 157 161 162 163* 163 163 169 173* 173 185 187 198 203 205 226* 226 226 232 234 235* 236* 237* 248* 249* 254 254 254 256* 257 262 264 275 275 275 276* 276 276 280 281 281 283 295* 295 303 315 322 340* 340 340 355* pdl_ptr_types36 based structure array level 1 dcl 2-7 pdp10_compatibility 000113 automatic bit(1) unaligned dcl 60 set ref 129* 132* 153 188 261* 262* 273 305 pname 5 based char level 2 in structure "atom" dcl 7-5 in procedure "dumparrays" ref 128 156 166 pname 1 based char level 2 in structure "dumped_array_file" packed unaligned dcl 17 in procedure "dumparrays" set ref 156* 163 275* 281 pnamebuf based char unaligned dcl 75 set ref 289* 296* pnamel 4 based fixed bin(17,0) level 2 dcl 7-5 set ref 128 136 155 156 160 165 166 248 prog_frame defined pointer dcl 1-6 push_down_list_ptr_types based structure array level 1 dcl 2-7 rel builtin function dcl 107 ref 234 size builtin function dcl 107 ref 226 340 378 stack 000104 automatic pointer dcl 60 set ref 126* 127 128 130 130 136 136 137 137 148 149 149 155 156 160 165 166 180 181 183 185 186 195 196 203 227 227 238 247* 248 248 249 249 263 268 269 270 272 275 296 299 306 310 312 312 312 316 316 318 319 322 324 341 342 342 343 348 349 371 371 385 stack_ptr defined pointer dcl 1-6 set ref 126 180* 238* 247 268* 272* 299* 341* 348* 385 star_rset defined fixed bin(71,0) dcl 1-45 string 1 based char level 2 dcl 8-6 set ref 140 140 254 254 string_length based fixed bin(17,0) level 2 dcl 8-6 set ref 140 140 140* 254 254 254* substr builtin function dcl 107 set ref 166 169 213 289* t_atom defined fixed bin(71,0) dcl 1-6 t_atom_ptr based pointer dcl 1-6 temp based fixed bin(71,0) array dcl 2-7 set ref 130* 148 149* 180 181* 183 227* 238 263* 268 269 270 272 275* 296* 299 306* 310* 312 312 312 316 316 318 319* 341 342* 342 343* 348 349* 371* 385* 385 temp_ptr based pointer array dcl 2-7 ref 128 130 136 137 149 155 156 160 165 166 185 186 195 196 203 227 248 249 322 324 371 temp_type 0(21) based bit(9) array level 2 packed unaligned dcl 2-7 ref 127 temp_type36 based bit(36) array level 2 dcl 2-7 ref 136 137 248 249 translate builtin function dcl 107 ref 167 287 tty_input_chan defined pointer dcl 1-6 tty_output_chan defined pointer dcl 1-6 type based fixed bin(17,0) level 2 in structure "dumped_array_file" packed unaligned dcl 17 in procedure "dumparrays" set ref 154* 161* 262 type 7 based fixed bin(17,0) level 2 in structure "array_info" packed unaligned dcl 6-8 in procedure "dumparrays" ref 185 186 type_info based bit(36) level 2 dcl 4-4 set ref 269* 312* 312* 312* unm 000116 automatic pointer dcl 75 set ref 279* 280 289 296 297 377* 378 379 380 unmkd_ptr defined pointer dcl 1-6 set ref 279 280* 297* 377 378* unspec builtin function dcl 107 set ref 169 221 286* 325* unwp_frame defined pointer dcl 1-6 user_intr_array defined fixed bin(71,0) array dcl 1-45 word based bit(36) dcl 33 set ref 213 221* 232* 264 325 word_count based fixed bin(17,0) level 2 packed unaligned dcl 26 set ref 198* 226 315 340 words based bit(36) array dcl 60 set ref 203* 203 322* 322 324 wta 001446 constant label dcl 364 ref 128 138 250 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2442 2532 2126 2452 Length 3150 2126 70 402 314 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dumparrays 238 external procedure is an external procedure. err1 internal procedure shares stack frame of external procedure dumparrays. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME dumparrays 000100 p dumparrays 000102 a_word dumparrays 000104 stack dumparrays 000106 myname dumparrays 000107 i dumparrays 000110 j dumparrays 000111 n dumparrays 000112 ch dumparrays 000113 pdp10_compatibility dumparrays 000114 convert_flonums dumparrays 000116 unm dumparrays 000120 dn dumparrays 000172 en dumparrays 000202 code dumparrays 000204 fp dumparrays 000206 fsign dumparrays THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. expand_path_ hcs_$initiate hcs_$make_seg hcs_$set_bc_seg hcs_$terminate_noname hcs_$truncate_seg lisp_array_fcns_$star_array lisp_error_ lisp_get_atom_ lisp_property_fns_$get lisp_property_fns_$putprop lisp_special_fns_$cons lisp_special_fns_$gensym lisp_special_fns_$xcons THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lisp_error_table_$argument_must_be_array lisp_error_table_$bad_argument lisp_error_table_$file_sys_fun_err lisp_error_table_$special_array_type lisp_static_vars_$array lisp_static_vars_$fixnum lisp_static_vars_$flonum lisp_static_vars_$nil lisp_static_vars_$stack_ptr lisp_static_vars_$unmkd_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000036 125 000044 126 000046 127 000052 128 000055 129 000065 130 000067 131 000072 132 000073 136 000074 137 000103 138 000111 140 000112 142 000137 143 000142 144 000201 148 000206 149 000212 153 000216 154 000220 155 000223 156 000227 157 000240 158 000250 160 000251 161 000256 162 000262 163 000265 164 000270 165 000271 166 000301 167 000306 169 000315 170 000323 171 000324 172 000327 173 000330 175 000332 180 000334 181 000340 182 000342 183 000346 184 000361 185 000362 186 000374 187 000401 188 000404 189 000406 190 000407 194 000416 195 000420 196 000432 197 000442 198 000444 203 000450 204 000461 205 000471 206 000473 207 000474 208 000476 210 000505 213 000523 214 000527 215 000531 216 000541 217 000542 218 000555 221 000557 222 000561 226 000563 227 000572 228 000576 232 000577 234 000601 235 000605 236 000617 237 000635 238 000646 239 000652 241 000653 246 000661 247 000663 248 000670 249 000677 250 000705 254 000706 255 000733 256 000736 257 001001 261 001006 262 001007 263 001014 264 001017 268 001023 269 001027 270 001031 271 001032 272 001036 273 001042 275 001044 276 001066 277 001076 279 001077 280 001102 281 001114 282 001117 283 001120 284 001131 285 001135 286 001143 287 001153 289 001162 290 001167 292 001170 293 001172 294 001175 295 001177 296 001202 297 001223 299 001226 303 001232 305 001237 306 001241 307 001243 309 001244 310 001245 312 001247 315 001253 316 001260 318 001262 319 001264 320 001266 322 001272 323 001303 324 001313 325 001320 326 001322 328 001327 329 001330 330 001332 332 001333 333 001335 335 001337 336 001347 337 001354 339 001357 340 001361 341 001370 342 001374 343 001376 344 001400 348 001404 349 001410 350 001412 351 001417 352 001424 353 001426 354 001433 355 001434 356 001445 364 001446 366 001454 367 001456 389 001465 369 001466 371 001470 373 001474 377 001477 378 001503 379 001506 380 001510 381 001512 385 001516 386 001524 ----------------------------------------------------------- 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