COMPILATION LISTING OF SEGMENT lisp_reader_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0849.3 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 read: proc; 7 8 /* 9* * lisp_reader_ which does all formatted input for lisp 10* * written 20-JUNE-1972 by David Moon 11* * modified 30 June 72 to make read, readch, and tyi lsubr's DAM 12* * modified to allow quits while reading, 13* * to allow macro characters in readlist -- D A Moon 14 Aug 72 14* * prologue interpreter added 17 Aug 72 D A Moon 15* * eof_retn bug fixed, 7 Sep. 72 by DAM 16* * Major revisions for increased speed and other good things, 27 Nov 1972, DAM 17* * bignum reader added, 14 Jan 1972, dam 18* * new (lsubr) version of tyipeek added, dam, 30 jan 73 19* * modified for new I/O system, 23 Mar 73 by DAM 20* * changed to bind infile, ^q when a file arg is given, 10 June 1973 by dam. 21* * modified 21 October 1973 by DAM for new syntax bits, new iochan format. 22* * modified 18 February 1974 by DAM for the implode function 23* * modified 15 April 1974 by DAM for EIS and to fix bugs in number reader 24* * modified 74.05.30 by DAM for new arrays 25* * modified 74.09.21 by DAM to accept t for the tty as well as nil 26* * modified 28 November 1979 by BSG for top-level splicing macro hacks. 27* * modified 5/2/80 by BSG for read_from_list 28* * modified 08/20/82 by Richard Lamson to fix tyi EOF handling 29* * modified 10/07/82 by Richard Lamson to fix previous fix for tyipeek 30* */ 31 32 33 dcl fb fixed bin aligned, /* ascii code for current character */ 34 1 kludge_structure aligned based(addr(fb)), /* to make b be right-aligned */ 35 2 random_garbage_bits bit(27) unaligned, 36 2 b char(1) unaligned, /* this is really the low 9 bits of fb */ 37 lisp_static_vars_$infile external fixed bin(71), 38 infile fixed bin(71) def (lisp_static_vars_$infile), 39 bb bit(27), /* syntax bits for b */ 40 unm ptr, /* -> unmarked pdl */ 41 unm1 ptr, /* saved value of unm on entry, for eof_retn */ 42 stack ptr, /* -> marked pdl */ 43 errcode(2) fixed bin aligned based, /* for calls to lisp_error_ */ 44 implode_sw bit(1), /* 1 => implode, 0 => maknam */ 45 tyipeeksw bit(1), /* so tyipeek can return 3 (ETX or ^C) on EOF */ 46 special_file bit(1), /* 1 => have binding block for infile, ^q */ 47 eolhacksw bit(1), /* when readlisting, supplies space at end of list */ 48 eofstack ptr, /* -> eofval,,special input file */ 49 origb fixed bin, /* save untranslated char */ 50 pnp ptr, /* -> pname buffer */ 51 pnamelen fixed bin, /* number of chars in pname buffer */ 52 pname_buffer char(pnamelen) aligned based(pnp), 53 (real_io, readlistf, read_from_stringf) bit(1), 54 /* distinguish between read and*/ 55 /* readlist and read re-directed to a read list */ 56 p ptr, 57 inp ptr; /* -> iochan structure for current input channel */ 58 59 dcl newline char(1) static init(" 60 "); 61 62 63 dcl (lisp_static_vars_$quote_macro, lisp_static_vars_$semicolon_macro, lisp_static_vars_$vertical_bar_macro) 64 fixed bin (71) aligned external static; /* special macro indicators */ 65 66 67 dcl (ptr, rel, size, null, substr, addr, addrel, fixed, bit, unspec, divide, string, 68 add, hbound, lbound, length, max, mod, multiply, float) builtin, 69 b2 bit(27), /* for saving bb */ 70 bb_wanted bit(27), /* for tyipeek - matched against bb */ 71 72 /* Number Accumulators */ 73 74 (nn, n4f) fixed bin(35), 75 bign fixed bin(71), 76 bigdn fixed bin(71), 77 n fixed bin(35), 78 dn fixed bin(35), 79 one_word_limit fixed bin(71) static init(11111111111111111111111111111111111b), 80 nmargs fixed bin(35), 81 fn float bin(50), 82 ib fixed bin, 83 ibv fixed bin aligned based(addr( 84 addr(addr(ibase) -> based_ptr -> atom.value) -> fixedb)), /* value of ibase */ 85 fpdigits fixed bin, /* number of digits in fracyion part */ 86 (bit36, bit36a) bit(36) aligned; /* for simulated pdp-10 lsh instructions */ 87 88 dcl i fixed bin, /* random do-loop index */ 89 tblp ptr, /* calculate addr of read_table once only */ 90 char1 char(1) aligned, 91 bfb based fixed bin, 92 inlist ptr, /* to input list for readlist */ 93 iostatus bit(72) aligned; /* for calling ios_ */ 94 dcl code fixed bin; /* implicit argument to internal procedure error */ 95 96 dcl 1 readlist_data_struc based (readlist_data_strucp) aligned, /* for multi-frame readlist/readstringery */ 97 2 inlist ptr, /* ptr to marked pdl slot with readable Lisp object */ 98 2 stringf bit (1) aligned, /* 1 = read_from_string, 0 = readlist */ 99 2 chrct fixed bin (21); /* index of next char to be read */ 100 101 dcl readlist_data_strucp ptr; 102 dcl 1 auto_readlist_data_struc like readlist_data_struc automatic aligned; 103 104 /* entry points called */ 105 106 dcl lisp_$apply ext entry, 107 lisp_property_fns_$putprop ext entry, 108 lisp_list_utils_$subst ext entry, 109 lisp_error_ ext entry, 110 ios_$read ext entry(char(*) , ptr, fixed bin, fixed bin, fixed bin, bit(72) aligned), 111 ioa_ ext entry options(variable), 112 lisp_alloc_$gensym ext entry, 113 lisp_io_man_$free_uread_chan ext entry, 114 make_lisp_subr_block_$make_array ext entry(fixed bin(71) aligned, fixed bin, dim(*) fixed bin, bit(1)), 115 lisp_alloc_ ext entry (fixed bin, pointer), 116 lisp_bignums_$bnread entry, 117 lisp_property_fns_$get entry, 118 lisp_special_fns_$ncons ext entry, 119 lisp_special_fns_$cons ext entry, 120 lisp_array_fcns_$star_array entry; 121 122 123 /* dcl for bignums */ 124 125 dcl 1 fnx aligned based(addr(fn)), /* structure of double floating number - for rou.nding */ 126 2 exp fixed bin(7) unal, 127 2 sign bit(1) unal, 128 2 mantissa bit(28) unal, /* first word + 1 bit for rounding */ 129 2 rest_of_mantissa bit(35) unal; 130 131 132 dcl bnp ptr, 133 bnct fixed bin, 134 bnbp ptr, 135 dpw fixed bin, 136 bnsize fixed bin, 137 bndigs(bnsize) fixed bin(35) aligned based(bnbp); /* array of digits, base bigradix(ib) */ 138 139 140 /* nonstandard argument list for lisp_bignums_$bnread */ 141 142 dcl 1 bnreadargs based aligned, 143 2 array ptr, /* -> bndigs array */ 144 2 size fixed bin(17) unal, /* size of array (in left half) */ 145 2 pad bit(18) unal, 146 2 radix fixed bin(35); /* radix of bndigs array */ 1 1 1 2 /* Include file lisp_bignum_io_data.incl.pl1 1 3* 13 Jan 1973, dam 1 4* This files defines constant arrays needed by the bignum 1 5* reader and printer. 1 6* digsperwd is the maximum number of digits that can fit in 1 7* 35 bits, indexed by the radix. 1 8* bigradix is the radix**digsperwd, indexed by the radix 1 9* It is used as the multiplier for converting an array 1 10* of small nums into a bignum, or the divisor for converting 1 11* a bignum into an array of small nums */ 1 12 1 13 dcl digsperwd (2:36) static fixed binary initial ( 1 14 34, 22, 17, 15, 13, 12, 11, 11, 10, 1 15 10, 9, 9, 9, 8, 8, 8, 8, 8, 8, 1 16 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 1 17 7, 6, 6, 6, 6, 6), 1 18 bigradix(2:36) fixed binary(35) static initial ( 1 19 17179869184, /* 2**34 */ 1 20 31381059609, /* 3**22 */ 1 21 17179869184, /* 4**17 */ 1 22 30517578125, /* 5**15 */ 1 23 13060694016, /* 6**13 */ 1 24 13841287201, /* 7**12 */ 1 25 8589934592, /* 8**11 */ 1 26 31381059609, /* 9**11 */ 1 27 10000000000, /* 10**10 */ 1 28 25937424601, /* 11**10 */ 1 29 5159780352, /* 12**9 */ 1 30 10604499373, /* 13**9 */ 1 31 20661046784, /* 14**9 */ 1 32 2562890625, /* 15**8 */ 1 33 4294967296, /* 16**8 */ 1 34 6975757441, /* 17**8 */ 1 35 11019960576, /* 18**8 */ 1 36 16983563041, /* 19**8 */ 1 37 25600000000, /* 20**8 */ 1 38 1801088541, /* 21**7 */ 1 39 2494357888, /* 22**7 */ 1 40 3404825447, /* 23**7 */ 1 41 4586471424, /* 24**7 */ 1 42 6103515625, /* 25**7 */ 1 43 8031810176, /* 26**7 */ 1 44 10460353203, /* 27**7 */ 1 45 13492928512, /* 28**7 */ 1 46 17249876309, /* 29**7 */ 1 47 21870000000, /* 30**7 */ 1 48 27512614111, /* 31**7 */ 1 49 1073741824, /* 32**6 */ 1 50 1291467969, /* 33**6 */ 1 51 1544804416, /* 34**6 */ 1 52 1838265625, /* 35**6 */ 1 53 2176782336 /* 36**6 */ 1 54 ); 1 55 /* End include file lisp_bignum_io_data.incl.pl1 */ 147 2 1 /* Include file lisp_bignum_fmt.incl.pl1 */ 2 2 2 3 dcl 1 lisp_bignum based aligned, /* structure describing lisp big number */ 2 4 2 sign bit(18) unaligned, /* either all ones, or all zeros */ 2 5 2 prec fixed bin(17) unaligned, /* number of words in this number's precision */ 2 6 2 words(0 refer(lisp_bignum.prec)) fixed bin(35); /* 35 significant bits per word. */ 2 7 2 8 /* End include file lisp_bognum_fmt.incl.pl1 */ 148 149 150 151 /* Declaration of state variables */ 152 153 dcl 1 stacked_variables aligned based(unm), /* stored on unmkd pdl, stacked by ( and ' */ 154 2 exitcode fixed bin, /* specifies where to return from rdobj */ 155 2 dotted_pair_flag bit(1), /* used by list reader to remember presence of dot */ 156 2 left_super fixed bin, 157 2 right_super fixed bin, 158 159 (splice_dot_kludge init(0), 160 topexit init(1), 161 quotexit init(2), /* manifest values for exitcode */ 162 listexit init(3), 163 superexit init(4), /* superexit = listexit except indicates left super parenthesis */ 164 list1exit init(5), /* same as listexit except is for first thing in list */ 165 super1exit init(6)) fixed bin static, /* same as superexit except is for first thing in list */ 166 167 got_splice bit(1), /* indicates splicing macro */ 168 got_macro bit(1), /* indicates current object is result of a character macro */ 169 got_something bit(1), /* indicates that some substantive object was read */ 170 got_list bit(1), /* needed by top level newline kludge , means a list was read */ 171 reading_atsym bit(1), /* for rdbk. */ 172 reading_number bit(1), /* .. */ 173 minus_flag bit(1), /* for number rdr */ 174 forced_num bit(1), /* number introduced by +, containing letters as digits */ 175 shiftscale_flag bit(1), /* indicates fixed point number modifier | or _ was seen */ 176 expon_flag bit(1), /* indicates an exponent was seen */ 177 float_flag bit(1), /* indicates an exponent or a decimal point */ 178 dbnf bit(1), /* decimal overflow flag, make bignum if dot at end of number */ 179 obnf bit(1), /* other base overflow flag, make bignum if no dot at end of number */ 180 tyipeek_t bit(1), /* distinguish (tyipeek t) from other tyipeek */ 181 in_middle bit(1), /* in middle of some objects, helps with eof handling */ 182 dnum bit(1); /* indicates is a decimal number */ 183 184 185 dcl prefsync static bit(1) init("0"b), /* "prefix sync:" see rdtvx: ff. */ 186 lisp_fault_handler_$ctrl_from_reader entry(char(1)aligned); 187 188 189 /* Declaration of stuff in lisp_reader_alm_ */ 190 191 dcl ten_to_the(-38:38) float bin(50) aligned based(addr(lisp_reader_alm_$powers_of_ten)), 192 lisp_reader_alm_$powers_of_ten external static, 193 lisp_reader_alm_$left_shift entry(fixed bin(35), fixed bin(35)); 194 3 1 3 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 3 3 3 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 3 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 3 6* are used so that the name of the function which is rejecting its argument 3 7* can be printed. Please note that all these codes are negative. */ 3 8 3 9 dcl ( 3 10 fn_do init (-10), 3 11 fn_arg init (-11), 3 12 fn_setarg init (-12), 3 13 fn_status init (-13), 3 14 fn_sstatus init (-14), 3 15 fn_errprint init (-15), 3 16 fn_errframe init (-16), 3 17 fn_evalframe init (-17), 3 18 fn_defaultf init (-18), 3 19 fn_tyo init (-22), 3 20 fn_ascii init (-23), 3 21 fn_rplaca init (-24), 3 22 fn_definedp init (-25), 3 23 fn_setq init (-26), 3 24 fn_set init (-27), 3 25 fn_delete init (-28), 3 26 fn_delq init (-29), 3 27 fn_stringlength init (-30), 3 28 fn_catenate init (-31), 3 29 fn_array init (-32), 3 30 fn_substr init (-33), 3 31 fn_index init (-34), 3 32 fn_get_pname init (-35), 3 33 fn_make_atom init (-36), 3 34 fn_ItoC init (-37), 3 35 fn_CtoI init (-38), 3 36 fn_defsubr init (-39), 3 37 fn_star_array init (-40), 3 38 fn_args init (-41), 3 39 fn_sysp init (-42), 3 40 fn_get init (-43), 3 41 fn_getl init (-44), 3 42 fn_putprop init (-45), 3 43 fn_remprop init (-46), 3 44 fn_save init (-47), 3 45 fn_add1 init (-48), 3 46 fn_sub1 init (-49), 3 47 fn_greaterp init (-50), 3 48 fn_lessp init (-51), 3 49 fn_minus init (-52), 3 50 fn_plus init (-53), 3 51 fn_times init (-54), 3 52 fn_difference init (-55), 3 53 fn_quotient init (-56), 3 54 fn_abs init (-57), 3 55 fn_expt init (-58), 3 56 fn_boole init (-59), 3 57 fn_rot init (-60), 3 58 fn_lsh init (-61), 3 59 fn_signp init (-62), 3 60 fn_fix init (-63), 3 61 fn_float init (-64), 3 62 fn_remainder init (-65), 3 63 fn_max init (-66), 3 64 fn_min init (-67), 3 65 fn_add1_fix init (-68), 3 66 fn_add1_flo init (-69), 3 67 fn_sub1_fix init (-70), 3 68 fn_sub1_flo init (-71), 3 69 fn_plus_fix init (-72), 3 70 fn_plus_flo init (-73), 3 71 fn_times_fix init (-74), 3 72 fn_times_flo init (-75), 3 73 fn_diff_fix init (-76), 3 74 fn_diff_flo init (-77), 3 75 fn_quot_fix init (-78), 3 76 fn_quot_flo init (-79), 3 77 fn_eval init (-80), 3 78 fn_apply init (-81), 3 79 fn_prog init (-82), 3 80 fn_errset init (-83), 3 81 fn_catch init (-84), 3 82 fn_throw init (-85), 3 83 fn_store init (-86), 3 84 fn_defun init (-87), 3 85 fn_baktrace init (-88), 3 86 fn_bltarray init (-89), 3 87 fn_star_rearray init (-90), 3 88 fn_gensym init (-91), 3 89 fn_makunbound init (-92), 3 90 fn_boundp init (-93), 3 91 fn_star_status init (-94), 3 92 fn_star_sstatus init (-95), 3 93 fn_freturn init (-96), 3 94 fn_cos init (-97), 3 95 fn_sin init (-98), 3 96 fn_exp init (-99), 3 97 fn_log init (-100), 3 98 fn_sqrt init (-101), 3 99 fn_isqrt init (-102), 3 100 fn_atan init (-103), 3 101 fn_sleep init (-104), 3 102 fn_oddp init (-105), 3 103 fn_tyipeek init (-106), 3 104 fn_alarmclock init (-107), 3 105 fn_plusp init (-108), 3 106 fn_minusp init (-109), 3 107 fn_ls init (-110), 3 108 fn_eql init (-111), 3 109 fn_gt init (-112), 3 110 fn_alphalessp init (-113), 3 111 fn_samepnamep init (-114), 3 112 fn_getchar init (-115), 3 113 fn_opena init (-116), 3 114 fn_sxhash init (-117), 3 115 fn_gcd init (-118), 3 116 fn_allfiles init (-119), 3 117 fn_chrct init (-120), 3 118 fn_close init (-121), 3 119 fn_deletef init (-122), 3 120 fn_eoffn init (-123), 3 121 fn_filepos init (-124), 3 122 fn_inpush init (-125), 3 123 fn_linel init (-126), 3 124 fn_mergef init (-127), 3 125 fn_namelist init (-128), 3 126 fn_names init (-129), 3 127 fn_namestring init (-130), 3 128 fn_openi init (-131), 3 129 fn_openo init (-132), 3 130 fn_prin1 init (-133), 3 131 fn_princ init (-134), 3 132 fn_print init (-135), 3 133 fn_read init (-136), 3 134 fn_readch init (-137), 3 135 fn_readstring init (-138), 3 136 fn_rename init (-139), 3 137 fn_shortnamestring init (-140), 3 138 fn_tyi init (-141), 3 139 fn_setsyntax init (-142), 3 140 fn_cursorpos init (-143), 3 141 fn_force_output init (-144), 3 142 fn_clear_input init (-145), 3 143 fn_random init (-146), 3 144 fn_haulong init (-147), 3 145 fn_haipart init (-148), 3 146 fn_cline init (-149), 3 147 fn_fillarray init (-150), 3 148 fn_listarray init (-151), 3 149 fn_sort init (-152), 3 150 fn_sortcar init (-153), 3 151 fn_zerop init (-154), 3 152 fn_listify init (-155), 3 153 fn_charpos init (-156), 3 154 fn_pagel init (-157), 3 155 fn_linenum init (-158), 3 156 fn_pagenum init (-159), 3 157 fn_endpagefn init (-160), 3 158 fn_arraydims init (-161), 3 159 fn_loadarrays init (-162), 3 160 fn_dumparrays init (-163), 3 161 fn_expt_fix init (-164), 3 162 fn_expt_flo init (-165), 3 163 fn_nointerrupt init (-166), 3 164 fn_open init (-167), 3 165 fn_in init (-168), 3 166 fn_out init (-169), 3 167 fn_truename init (-170), 3 168 fn_ifix init (-171), 3 169 fn_fsc init (-172), 3 170 fn_progv init (-173), 3 171 fn_mapatoms init (-174), 3 172 fn_unwind_protect init (-175), 3 173 fn_eval_when init (-176), 3 174 fn_read_from_string init (-177), 3 175 fn_displace init (-178), 3 176 fn_nth init (-179), 3 177 fn_nthcdr init (-180), 3 178 fn_includef init (-181) 3 179 ) fixed bin static; 3 180 3 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 195 4 1 /* BEGIN INCLUDE FILE lisp_faults.incl.pl1 */ 4 2 4 3 /* 4 4* * Written 14 Aug 72 by D A Moon 4 5* * Fault codes changed 4 Feb 73 by DAM, for user interrupt masking and new alarmclock facility 4 6* * Names changed 16 Dec 1973 by DAM because of a name conflict with lisp_free_storage.incl.pl1 4 7* * Modified 74.06.03 by DAM for new-arrays 4 8* * Modified 74.12.16 by DAM to change meaning of 'masked' 4 9* */ 4 10 dcl (Alarmclock_fault init(2), 4 11 Cput_fault init(1), 4 12 Car_cdr_fault init(6), 4 13 Quit_fault init(4), 4 14 Array_fault init(5), 4 15 Zerodivide_fault init(7), 4 16 Underflow_fault init(8), 4 17 Old_store_fault init(9), /* old/new array compatibility */ 4 18 Pi_fault init(10) /* program_interrupt signal */ 4 19 ) fixed bin static; 4 20 4 21 4 22 /* structure for saving info when a fault or an error ocuurs. 4 23* This structure gets pushed onto the unmkd pdl */ 4 24 4 25 dcl 1 fault_save aligned based (unm), 4 26 2 prev_frame bit(18)unaligned, /* thread */ 4 27 2 stack_ptr bit(18) unaligned, /* rel(stack_ptr) at time frame was created */ 4 28 2 sv_gc_inhibit bit(1) unaligned, /* save lisp_static_vars_$garbage_collect_inhibit */ 4 29 2 sv_masked like masked unaligned, /* save lisp_static_vars_$masked - for err breaks in (nointerrupt t) mode */ 4 30 2 code1 fixed bin, /* error code 1, 0 = not errprintable error */ 4 31 2 code2 fixed bin, /* error code 2, for file system errors */ 4 32 2 sv_array_info ptr, /* save array_info_for_store in stack header */ 4 33 2 sv_rdr_label label, /* -> abnormal return from call to ios_$read */ 4 34 2 sv_rdr_ptr ptr, /* datum used by reader for readlist control */ 4 35 2 sv_rdr_state fixed bin, /* 0=normal, 1=wait for input, 2=readlist */ 4 36 2 sv_array_offset fixed bin(18), /* save array_offset_for_store in stack header */ 4 37 2 padding bit(36), /* make structure an even number of words in size */ 4 38 2 dat_ptr bit(18); /* rel ptr to marked pdl slot containing losing form */ 4 39 /* needed by errprint */ 4 40 /* size(fault_save) must be even */ 4 41 4 42 4 43 /* declarations of the things that get saved here */ 4 44 4 45 dcl lisp_static_vars_$garbage_collect_inhibit bit(1) aligned external, 4 46 1 lisp_static_vars_$masked aligned external like masked, 4 47 lisp_static_vars_$pending_ctrl bit(1) aligned external, /* flag that we are doing stacked-up ctrl chars 4 48* right now, makes sure none get missed if ^G */ 4 49 lisp_static_vars_$deferred_interrupt bit(1) aligned external, /* when we unmask, we test this to */ 4 50 /* see if we must poll interrupts */ 4 51 lisp_static_vars_$rdr_label label external, 4 52 lisp_static_vars_$rdr_ptr ptr external, 4 53 lisp_static_vars_$rdr_state fixed bin external, 4 54 gc_inhibit bit(1) aligned defined(lisp_static_vars_$garbage_collect_inhibit), 4 55 deferred_interrupt bit (1) aligned defined (lisp_static_vars_$deferred_interrupt), 4 56 1 masked aligned based(addr(lisp_static_vars_$masked)), /* defined causes fault in compiler */ 4 57 2 against unaligned, /* things masked against: */ 4 58 3 tty bit(1), /* tty control characters */ 4 59 3 alarm bit(1), /* alarmclock interrupts */ 4 60 pending_ctrl bit(1) aligned defined (lisp_static_vars_$pending_ctrl), 4 61 lisp_fault_handler_$set_mask entry(1 aligned like masked), 4 62 rdr_label label defined (lisp_static_vars_$rdr_label), 4 63 rdr_ptr ptr defined (lisp_static_vars_$rdr_ptr), 4 64 rdr_state fixed bin defined (lisp_static_vars_$rdr_state); 4 65 4 66 4 67 /* END INCLUDE FILE lisp_faults.incl.pl1 */ 4 68 196 197 5 1 /* INCLUDE FILE lisp_io.incl.pl1 */ 5 2 5 3 /* data structures used by the lisp i/o system */ 5 4 6 1 /* BEGIN INCLUDE FILE lisp_iochan.incl.pl1 */ 6 2 6 3 /* This include file describes the format of the 'iochan' block, 6 4* which is used to implement lisp file-objects. The iochan 6 5* is the central data base of the i/o system. When open 6 6* is used, an iochan is created in lisp static storage. 6 7* When the lisp environment is booted, 2 iochans for input and 6 8* output on the tty are created. Iochans are saved and restored 6 9* by the save mechanism */ 6 10 6 11 /* open i/o channel information */ 6 12 6 13 dcl 1 iochan based aligned, /* format of a file object */ 6 14 2 ioindex fixed bin(24), /* 0-origin character position in block */ 6 15 2 iolength fixed bin(24), /* size of block in chars - actual(in), max(out) */ 6 16 2 ioptr pointer, /* -> block */ 6 17 2 thread pointer, /* list of all iochans open; from lisp_static_vars_$iochan_list */ 6 18 2 fcbp pointer, /* for tssi_ */ 6 19 2 aclinfop pointer, /* .. */ 6 20 2 component fixed bin, /* .. */ 6 21 2 charpos fixed bin, /* 0-origin horizontal position on line */ 6 22 2 linel fixed bin, /* (out) line length, 0 => oo */ 6 23 2 flags unaligned, 6 24 3 seg bit(1), /* 1 => msf, 0 => stream */ 6 25 3 read bit(1), /* 0 => openi, 1 => not */ 6 26 3 write bit(1), /* 0 => openo, 1 => not */ 6 27 3 gc_mark bit(1), /* for use by the garbage collector */ 6 28 3 interactive bit(1), /* 1 => input => this is the tty 6 29* output => flush buff after each op */ 6 30 3 must_reopen bit(1), /* 1 => has been saved and not reopend yet */ 6 31 3 nlsync bit(1), /* 1 => there is a NL in the buffer (output streams only) */ 6 32 3 charmode bit(1), /* enables instant ios_$write */ 6 33 3 extra_nl_done bit(1), /* 1 => last char output was extra NL for chrct */ 6 34 3 fixnum_mode bit(1), /* to be used with in and out functions */ 6 35 3 image_mode bit(1), /* just suppresses auto-cr */ 6 36 3 not_yet_used bit(25), 6 37 2 function fixed bin(71), /* EOF function (input), or endpagefn (output) <<< gc-able >>> */ 6 38 2 namelist fixed bin(71), /* list of names, car is directory pathname <<< gc-able >>> */ 6 39 2 name char(32) unaligned, /* stream name or entry name */ 6 40 2 pagel fixed bin, /* number of lines per page */ 6 41 2 linenum fixed bin, /* current line number, starting from 0 */ 6 42 2 pagenum fixed bin, /* current page number, starting from 0 */ 6 43 6 44 flag_reset_mask bit(36) aligned static init( /* anded into flags with each char */ 6 45 "111011110111111111"b); 6 46 6 47 /* END INCLUDE FILE lisp_iochan.incl.pl1 */ 5 5 5 6 5 7 /* masks for checking iochan.flags, seeing if lisp_io_control_$fix_not_ok_iochan should be called */ 5 8 5 9 dcl not_ok_to_read bit(36) static init("0100010001"b), /* mask for checking iochan.flags on input */ 5 10 not_ok_to_write bit(36) static init("0010010001"b);/* mask for checking iochan.flags on output */ 5 11 dcl not_ok_to_read_fixnum bit(36) static init("0100010000"b), 5 12 not_ok_to_write_fixnum bit(36) static init("0010010000"b); 5 13 5 14 5 15 /* miscellaneous global, static variables and atoms used by the I/O system */ 5 16 5 17 dcl lisp_static_vars_$read_print_nl_sync bit(36) ext, 5 18 read_print_nl_sync bit(36) defined (lisp_static_vars_$read_print_nl_sync), 5 19 lisp_static_vars_$ibase ext fixed bin(71), 5 20 ibase fixed bin(71) defined (lisp_static_vars_$ibase), 5 21 5 22 lisp_static_vars_$quote_atom ext fixed bin (71), 5 23 quote_atom fixed bin(71) defined (lisp_static_vars_$quote_atom), 5 24 5 25 lisp_static_vars_$base ext fixed bin(71), 5 26 base fixed bin(71) defined ( lisp_static_vars_$base), 5 27 5 28 lisp_static_vars_$stnopoint ext fixed bin(71), 5 29 stnopoint fixed bin(71) defined (lisp_static_vars_$stnopoint), 5 30 5 31 lisp_static_vars_$tty_atom ext fixed bin(71), 5 32 tty_atom fixed bin(71) defined (lisp_static_vars_$tty_atom), 5 33 lisp_static_vars_$status_gctwa ext fixed bin(71), 5 34 status_gctwa fixed bin(71) defined (lisp_static_vars_$status_gctwa), 5 35 5 36 lisp_static_vars_$s_atom ext fixed bin(71), 5 37 s_atom fixed bin(71) defined (lisp_static_vars_$s_atom), 5 38 5 39 lisp_static_vars_$readtable ext fixed bin(71), 5 40 readtable fixed bin(71) defined (lisp_static_vars_$readtable), 5 41 5 42 lisp_static_vars_$plus_status ext fixed bin(71), 5 43 plus_status fixed bin(71) defined (lisp_static_vars_$plus_status); 5 44 7 1 /* BEGIN INCLUDE FILE lisp_control_chars.incl.pl1 */ 7 2 7 3 /* Last modified D. Reed 6/29/72 */ 7 4 7 5 dcl lisp_static_vars_$ctrlD ext fixed bin(71), 7 6 ctrlD fixed bin(71) defined (lisp_static_vars_$ctrlD); 7 7 7 8 dcl lisp_static_vars_$ctrlQ ext fixed bin(71), 7 9 ctrlQ fixed bin(71) defined (lisp_static_vars_$ctrlQ); 7 10 7 11 dcl lisp_static_vars_$ctrlR ext fixed bin(71), 7 12 ctrlR fixed bin(71) defined (lisp_static_vars_$ctrlR); 7 13 7 14 dcl lisp_static_vars_$ctrlW ext fixed bin(71), 7 15 ctrlW fixed bin(71) defined (lisp_static_vars_$ctrlW); 7 16 7 17 /* END INCLUDE FILE lisp_control_chars.incl.pl1 */ 7 18 5 45 5 46 /* END INCLUDE FILE lisp_io.incl.pl1 */ 5 47 198 8 1 /***** BEGIN INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 8 2 8 3 /* This include file defines the format of the "new" LISP arrays. 8 4* Written 74.05.13 by DAM */ 8 5 8 6 /* Info block in static space. pointed at by array ptr */ 8 7 8 8 dcl 1 array_info aligned based structure, /* 8 words long */ 8 9 2 ndims fixed bin(17) unaligned, /* number of dimensions */ 8 10 2 gc_mark bit(18) unaligned, /* alternating bits for garbage coll. */ 8 11 2 call_array_operator bit(36), /* tspbp instruction to array opr */ 8 12 2 array_data_ptr pointer, /* -> array_data structure */ 8 13 2 array_load_sequence(3) bit(36), /* lda, ldq, tra bp|0 */ 8 14 2 type fixed bin(17) unaligned, /* type of array, see dcl below */ 8 15 2 minus_2_times_ndims fixed bin(17) unaligned; /* for convenience of array opr */ 8 16 8 17 /* Codes for the different types of arrays: 8 18* Name Value arg to *array to create one */ 8 19 8 20 dcl (S_expr_array init(0), /* t */ 8 21 Un_gc_array init(1), /* nil */ 8 22 Fixnum_array init(2), /* fixnum */ 8 23 Flonum_array init(3), /* flonum */ 8 24 Readtable_array init(4), /* readtable */ 8 25 Obarray_array init(5), /* obarray */ 8 26 Dead_array init(6) /* (*rearray a) */ 8 27 ) fixed bin(17) static; 8 28 8 29 /* Block of array data and dimensions, in garbage-collected Lists space */ 8 30 8 31 dcl 1 array_data aligned based structure, 8 32 2 dope_vector(ZERO), /* address by dope_vector(i-ndims). no way to dcl in PL/I */ 8 33 3 bounds fixed bin(35), /* 0 <_ subscript < bounds */ 8 34 3 multiplier fixed bin(35), /* multiplier in polynomial-type subscript calc. */ 8 35 2 data(0:1000) fixed bin(71); /* single or double words depending on type of array */ 8 36 8 37 dcl ZERO fixed bin static init(0); /* Circumvent a compiler bug causing reference through null pointer in get_array_size$multf */ 8 38 8 39 /***** END INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 199 9 1 9 2 /* BEGIN INCLUDE FILE lisp_readtable.incl.pl1 */ 9 3 9 4 dcl num_macs fixed bin static init(8); /* size of efficient portion of macro_table */ 9 5 9 6 /* if changed, the declarations below must also be changed */ 9 7 dcl read_table_dim_vector dimension(1) fixed bin static init(145); /* number of dbl words in read_table data */ 9 8 9 9 9 10 9 11 dcl 1 read_table aligned based(addr(addr(readtable)->based_ptr -> atom.value)->based_ptr -> array_info.array_data_ptr), 9 12 2 macro_table(8) fixed bin(71), /* -> exprs for first few macros */ 9 13 2 more_macros fixed bin(71), /* list of any remaining macros */ 9 14 2 syntax (0:131) bit(27) aligned, /* syntax bits for 128 ascii chars + 4 pseudo chars */ 9 15 2 translation (0:131) fixed bin aligned, /* character translation or index in macro_table */ 9 16 2 status_terpri bit(1) aligned, /* "1"b if (status terpri) is t */ 9 17 2 status_underline bit(1) aligned, /* "1"b if (status _) is t */ 9 18 9 19 2 status_ttyread bit(1) aligned, /* not actually used at present */ 9 20 2 abbreviate_on_files bit(1) aligned, /* (sstatus abbrev 1) */ 9 21 2 abbreviate_on_flat bit(1) aligned, /* (sstatus abbrev 2) */ 9 22 2 words_not_used_yet (3) bit(36) aligned; 9 23 9 24 9 25 /* Manifest constants for syntax bits */ 9 26 9 27 dcl ( 9 28 9 29 forcefeed init("000000100000000000000000000"b), /* used only by ITS lisp */ 9 30 vertical_motion init("000000010000000000000000000"b), /* bit on for NL and NP characters */ 9 31 string_quote_exp init("000000001000000000000000000"b), /* string quote if bit12=1, exponent if bit12 = 0 */ 9 32 special init("000000000100000000000000000"b), /* always slash if in atom */ 9 33 single_char_object init("000000000010000000000000000"b), 9 34 blank init("000000000001000000000000000"b), /* space, tab, comma, nl, etc. */ 9 35 lparn init("000000000000100000000000000"b), /* "(", bit12 => super left paren */ 9 36 dotted_pair_dot init("000000000000010000000000000"b), /* the two uses of "." are kept seperate */ 9 37 rparn init("000000000000001000000000000"b), /* ")", bit12 => super right paren */ 9 38 macro init("000000000000000100000000000"b), 9 39 slashifier init("000000000000000010000000000"b), 9 40 rubout init("000000000000000001000000000"b), /* used only by ITS lisp */ 9 41 slash_if_first init("000000000000000000100000000"b), /* slashify if first char in pname */ 9 42 decimal_point init("000000000000000000010000000"b), 9 43 slash_if_not_first init("000000000000000000001000000"b), /* slashify on output when in pname & not 1st */ 9 44 slash_output init("000000000000000000101000000"b), /* slashify on output when in pname */ 9 45 bit12 init("000000000000000000000100000"b), /* selects from two meanings of certain other bits */ 9 46 /* NOTE: this is not really bit 12 anymore, but keep name */ 9 47 splice init("000000000000000000000100000"b), /* splicing macro */ 9 48 shift_scale init("000000000000000000000010000"b), /* left shift if bit12 = 1 9 49* fixed point scale if bit12 = 0 */ 9 50 plus_minus init("000000000000000000000001000"b), /* + if bit12 = 0, - if bit12 = 1 */ 9 51 digit init("000000000000000000000000100"b), /* decimal digit */ 9 52 extd_alpha init("000000000000000000000000010"b), /* extended alphabetic */ 9 53 alpha init("000000000000000000000000001"b) /* familiar alphabetic */ 9 54 9 55 ) bit(27) static; 9 56 9 57 /* End include file lisp_readtable.incl.pl1 */ 9 58 200 201 202 /* declare combinations of syntax bits that will be needed. 203* this has to be done because the v2pl1 code generator does 204* not do logical-or's of manifest constants at compile time */ 205 206 dcl (nspblnk init ("111111101010111111111111111"b), /* ^( special | blank | vertical_motion ) */ 207 special_blank init ("000000000101000000000000000"b), /* special | blank */ 208 alpha2 init ("000000000000000000000000011"b), /* alpha | extd_alpha */ 209 realchar init ("000000001010110110000011111"b), /* single_char_object | lparn | dotted_pair_dot | macro | 210* slashifier | string_quote_exp | shift_scale | 211* plus_minus | digit | extd_alpha | alpha */ 212 jwnumchar init ("000000000000000000000001111"b), /* plus_minus | digit | extd_alpha | alpha */ 213 jwnumchar2 init ("000000000000000000000000101"b), /* digit | alpha */ 214 bothdots init ("000000000000010000010000000"b), /* dotted_pair_dot | decimal_point */ 215 goodbegin init ("000000001001100110000001111"b), /* blank | lparn | macro | slashifier | string_quote_exp | 216* plus_minus | digit | extd_alpha | alpha */ 217 brkchr1 init ("000000001011111100000000000"b), /* single_char_object | blank | lparn | dotted_pair_dot | 218* rparn | macro | string_quote_exp */ 219 nbrkchr init ("000000000000000010010011111"b) /* slashifier | shift_scale | plus_minus | digit | decimal_point | 220* extd_alpha | alpha */ 221 ) bit(27) static; 222 10 1 /* include file lisp_stack_fmt.incl.pl1 -- 10 2* describes the format of the pushdown list 10 3* used by the lisp evaluator and lisp subrs 10 4* for passing arguments, saving atom bindings, 10 5* and as temporaries */ 10 6 10 7 dcl 10 8 temp(10000) fixed bin(71) aligned based, 10 9 10 10 temp_ptr(10000) ptr aligned based, 10 11 1 push_down_list_ptr_types(10000) based aligned, 10 12 2 junk bit(21) unaligned, 10 13 2 temp_type bit(9) unaligned, 10 14 2 more_junk bit(42) unaligned, 10 15 10 16 1 pdl_ptr_types36(10000) based aligned, 10 17 2 temp_type36 bit(36), 10 18 2 junk bit(36), 10 19 10 20 1 binding_block aligned based, 10 21 2 top_block bit(18) unaligned, 10 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 10 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 10 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 10 25 10 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 10 27 2 old_val fixed bin(71) aligned, 10 28 2 atom fixed bin(71) aligned; 10 29 10 30 10 31 10 32 /* end include file lisp_stack_fmt.incl.pl1 */ 223 11 1 /* Include file lisp_common_vars.incl.pl1; 11 2* describes the external static variables which may be referenced 11 3* by lisp routines. 11 4* D. Reed 4/1/71 */ 11 5 11 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 11 7 2 cclist_ptr ptr, /* pointer to list of constants kept 11 8* by compiled programs */ 11 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 11 10 11 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 11 12 err_recp ptr defined (lisp_static_vars_$err_recp), 11 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 11 14 lisp_static_vars_$eval_frame ptr ext static, 11 15 lisp_static_vars_$prog_frame ptr ext aligned, 11 16 lisp_static_vars_$err_frame ptr ext aligned, 11 17 lisp_static_vars_$catch_frame ptr ext aligned, 11 18 lisp_static_vars_$unwp_frame ptr ext aligned, 11 19 lisp_static_vars_$stack_ptr ptr ext aligned, 11 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 11 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 11 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 11 23 lisp_static_vars_$binding_top ptr ext aligned, 11 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 11 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 11 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 11 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 11 28 binding_top ptr defined (lisp_static_vars_$binding_top), 11 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 11 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 11 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 11 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 11 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 11 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 11 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 11 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 11 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 11 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 11 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 11 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 11 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 11 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 11 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 11 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 11 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 11 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 11 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 11 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 11 49 11 50 11 51 /* end include file lisp_common_vars.incl.pl1 */ 224 12 1 /* lisp number format -- overlaid on standard its pointer. */ 12 2 12 3 12 4 dcl 1 fixnum_fmt based aligned, 12 5 2 type_info bit(36) aligned, 12 6 2 fixedb fixed bin, 12 7 12 8 1 flonum_fmt based aligned, 12 9 2 type_info bit(36) aligned, 12 10 2 floatb float bin, 12 11 12 12 fixnum_type bit(36) aligned static init("000000000000000000000100000000100111"b), 12 13 flonum_type bit(36) aligned static init("000000000000000000000010000000100111"b); 12 14 12 15 /* end of lisp number format */ 12 16 225 13 1 /* Include file lisp_cons_fmt.incl.pl1; 13 2* defines the format for a cons within the lisp system 13 3* D.Reed 4/1/71 */ 13 4 13 5 dcl consptr ptr, 13 6 1 cons aligned based (consptr), /* structure defining format for cons */ 13 7 2 car fixed bin(71), 13 8 2 cdr fixed bin(71), 13 9 13 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 13 11 2 car ptr, 13 12 2 cdr ptr, 13 13 13 14 13 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 13 16 2 padding bit(21) unaligned, 13 17 2 car bit(9) unaligned, 13 18 2 padding2 bit(63) unaligned, 13 19 2 cdr bit(9) unaligned, 13 20 2 padend bit(42) unaligned; 13 21 13 22 dcl 1 cons_types36 aligned based, 13 23 2 car bit(36), 13 24 2 pada bit(36), 13 25 2 cdr bit(36), 13 26 2 padd bit(36); 13 27 13 28 13 29 /* end include file lisp_cons_fmt.incl.pl1 */ 226 14 1 /* Include file lisp_ptr_fmt.incl.pl1; 14 2* describes the format of lisp pointers as 14 3* a bit string overlay on the double word ITS pair 14 4* which allows lisp to access some unused bits in 14 5* the standard ITS pointer format. It should be noted that 14 6* this is somewhat of a kludge, since 14 7* it is quite machine dependent. However, to store type 14 8* fields in the pointer, saves 2 words in each cons, 14 9* plus some efficiency problems. 14 10* 14 11* D.Reed 4/1/71 */ 14 12 /* modified to move type field to other half of ptr */ 14 13 /* D.Reed 5/31/72 */ 14 14 14 15 14 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 14 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 14 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 14 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 14 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 14 21 2 type bit(9) unaligned, /* type field */ 14 22 2 itsmod bit(6) unaligned, 14 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 14 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 14 25 14 26 /* manifest constant strings for testing above type field */ 14 27 14 28 ( 14 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 14 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 14 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 14 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 14 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 14 34 Bignum init("000001000"b), /* a multiple-precision number */ 14 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 14 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 14 37* means a special internal uncollectable weird object */ 14 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 14 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 14 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 14 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 14 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 14 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 14 44 ) bit(9) static, 14 45 14 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 14 47 14 48 14 49 ( 14 50 Cons36 init("000000000000000000000000000000"b), 14 51 Fixed36 init("000000000000000000000100000000"b), 14 52 Float36 init("000000000000000000000010000000"b), 14 53 Atsym36 init("000000000000000000000001000000"b), 14 54 Atomic36 init("000000000000000000000111111100"b), 14 55 Bignum36 init("000000000000000000000000001000"b), 14 56 System_Subr36 14 57 init("000000000000000000000000000100"b), 14 58 Bigfix36 init("000000000000000000000000001000"b), 14 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 14 60 NotConsOrAtsym36 14 61 init("000000000000000000000110111111"b), 14 62 SubrNumeric36 14 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 14 64 String36 init("000000000000000000000000100000"b), 14 65 Subr36 init("000000000000000000000000010000"b), 14 66 File36 init("000000000000000000000000000001"b), 14 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 14 68 14 69 /* undefined pointer value is double word of zeros */ 14 70 14 71 Undefined bit(72) static init(""b); 14 72 14 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 227 15 1 /* Include file lisp_atom_fmt.incl.pl1; 15 2* describes internal format of atoms in the lisp system 15 3* D.Reed 4/1/71 */ 15 4 15 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 15 6 2 value fixed bin(71), /* atom's value */ 15 7 2 plist fixed bin(71), /* property list */ 15 8 2 pnamel fixed bin, /* length of print name */ 15 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 15 10 15 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 15 12 2 value ptr, 15 13 2 plist ptr, 15 14 15 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 15 16 2 value bit(72), 15 17 2 plist bit(72); 15 18 15 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 228 16 1 16 2 /* BEGIN INCLUDE FILE lisp_error_codes.incl.pl1 */ 16 3 16 4 /* This contains codes to be stored on the unmkd pdl before calling 16 5* lisp_error_. These codes, at ab|-2,x7, are used by lisp_error_ 16 6* as an index into lisp_error_table_. */ 16 7 16 8 dcl ( 16 9 undefined_atom init(100), /* - correctable */ 16 10 undefined_function init(101), /* - correctable */ 16 11 too_many_args init(102), /* uncorrectable */ 16 12 too_few_args init(103), /* .. */ 16 13 file_system_error init(104), /* (obsolete) */ 16 14 bad_argument init(105), /* uncorrectable arg reject */ 16 15 undefined_subr init(106), 16 16 bad_function init(107), /* "bad functional form" */ 16 17 bad_bv init(108), /* attempt to bind non-variable */ 16 18 unseen_go_tag init(109), /* correctable -> unevaled new tag */ 16 19 throw_to_no_catch init(110), /* .. */ 16 20 nonfixedarg init(111), /* correctable */ 16 21 parenmissing init(112), /* uncorr reader error */ 16 22 doterror init(113), /* .. */ 16 23 illobj init(114), /* .. */ 16 24 badmacro init(115), /* .. */ 16 25 shortreadlist init(116), /* .. */ 16 26 badreadlist init(117), /* .. */ 16 27 array_bound_error init(118), /* corr -> (array sub1 sub2...) */ 16 28 car_cdr_error init(119), /* uncorr - car or cdr of number */ 16 29 bad_arg_correctable init(120), /* correctable arg reject */ 16 30 bad_prog_op init(121), /* uncorr fail-act: go or return */ 16 31 no_lexpr init(122), /* uncorr fail-act: args or setarg */ 16 32 wrong_no_args init(123), /* correctable wna -> new expr value */ 16 33 bad_ibase init(124), /* corr */ 16 34 bad_base init(125), /* corr */ 16 35 bad_input_source init(126), /* corr - retry i/o */ 16 36 bad_output_dest init(127), /* .. */ 16 37 nihil_ex_nihile init(128), /* uncorr - attempt to setq nil */ 16 38 not_pdl_ptr init(131), /* corr arg reject - for pdl ptr args */ 16 39 bad_f_fcn init(134), /* compiled call to fsubr with evaled args */ 16 40 overflow_err init(135), /* arithmetic overflow. */ 16 41 mismatch_super_parens init(136), /* uncorr reader error */ 16 42 no_left_super_paren init(137), /* .. */ 16 43 flonum_too_big init(138), /* .. */ 16 44 quoterror init(139), /* .. */ 16 45 badreadtable init(140), /* .. */ 16 46 badobarray init(141), /* .. */ 16 47 atan_0_0_err init(142), /* (atan 0 0) doesn't work */ 16 48 unable_to_float init(143), /* corr arg reject - (float x) */ 16 49 division_by_zero init(144), /* uncorr (should really be corr) */ 16 50 eof_in_object init(145), /* corr fail-act -> keep reading anyway */ 16 51 cant_filepos init(146), /* corr fail-act -> new expr value */ 16 52 filepos_oob init(147), /* .. */ 16 53 file_sys_fun_err init(148), /* corr f.s. err -> new expr value */ 16 54 stars_left_in_name init(149), /* .. */ 16 55 io_wrong_direction init(150), /* .. */ 16 56 file_is_closed init(151), /* .. */ 16 57 reopen_inconsistent init(152), /* .. */ 16 58 bad_entry_name init(153), /* .. */ 16 59 bad_do_format init(154), /* bad do format in interp. */ 16 60 not_an_array init(155), /* bad array-type arg */ 16 61 not_alpha_array init(156), /* bad all-alphabetic array */ 16 62 include_file_error init(157), /* %include barfed */ 16 63 stack_loss_error init(158), /* stack overflew */ 16 64 underflow_fault init(159), 16 65 zerodivide_fault init(160), 16 66 bad_array_subscript init(161), 16 67 store_not_allowed init(162), 16 68 dead_array_reference init(163), 16 69 cant_subscript_readtable init(164), 16 70 not_same_type init(165), 16 71 special_array_type init(166), 16 72 array_too_big init(167), 16 73 argument_must_be_array init(168), 16 74 store_function_misused init(169) 16 75 ) fixed bin static; 16 76 16 77 /* END INCLUDE FILE lisp_error_codes.incl.pl1 */ 229 17 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 17 2* describes format of storage for lisp 17 3* character strings. 17 4* D. Reed 4/1/71 */ 17 5 17 6 dcl 1 lisp_string based aligned, 17 7 2 string_length fixed bin, 17 8 2 string char(1 refer(string_length)); 17 9 17 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 230 231 232 /* fancy entry points to the reader */ 233 234 /*read: entry; /* lisp read function */ 235 236 tyipeeksw = "0"b; 237 eolhacksw = "1"b; 238 call eof_hack; 239 readlistf = "0"b; 240 call set_inp; /* find current input channel */ 241 call set_tblp; 242 readcom: unm = unmkd_ptr; 243 unmkd_ptr = addrel(unm, 4); /* set up toplevel stacked variables */ 244 245 /* Make sure the obarray is really an obarray, since much lossage could otherwise result */ 246 247 call verify_obarray; 248 249 exitcode = topexit; 250 rdcom1: stack_ptr = addr(stack -> temp(2)); /* room in which to work */ 251 go to rdobj0; /* go get something */ 252 exit(1): 253 if got_macro & got_splice /* top level splicing macro */ 254 then if stack -> temp_type (1) = Cons /* Atoms mean naught */ 255 then if stack -> temp_ptr (1) -> cons_types.cdr = Cons 256 then do; 257 code = badmacro; /* 2 or more objs at top level ng */ 258 call error; 259 end; 260 else stack -> temp (1) = stack -> temp_ptr (1) -> cons.car; /* Take 1st elmt */ 261 else go to rdobj0; /* "those nasty splicing read macros at top level " */ 262 if ^got_something then go to rdobj0; /* ignore junk like extra right parens */ 263 264 if readlistf then do; /* end of readlist/read-from-string */ 265 inlist -> temp(1) = stack -> temp(1); /* move return value down */ 266 stack_ptr = addr(inlist -> temp(2)); 267 unm = err_recp; 268 rdr_state = sv_rdr_state; 269 rdr_label = sv_rdr_label; 270 rdr_ptr = sv_rdr_ptr; 271 err_recp = ptr(unm, fault_save.prev_frame); 272 unmkd_ptr = unm; 273 return; 274 end; 275 276 if got_list then if fb=10 then go to drop_nl; /* drop newline after list for MACLISP 277* compatiblity -- unlike Multics, the PDP-10 needs no newline after ")" */ 278 if bb & nspblnk 279 280 /* nondisposable break char - save it */ 281 282 then if real_io 283 then inp -> iochan.ioindex = inp -> iochan.ioindex - 1; /* back up buffer */ 284 else if readlist_data_struc.stringf 285 then readlist_data_struc.chrct = readlist_data_struc.chrct - 1; 286 else do; /* cons the character back onto the list */ 287 stack_ptr = addr(stack -> temp(4)); 288 stack -> temp(3) = inlist -> temp(1); 289 addr(stack -> temp(2))-> fixnum_fmt.type_info = fixnum_type; 290 addr(stack -> temp(2))-> fixedb = fb; 291 call lisp_special_fns_$cons; 292 inlist -> temp(1) = stack -> temp(2); 293 end; 294 295 drop_nl: 296 eofstack -> temp(1) = stack -> temp(1); /* value to be returned */ 297 298 eof_retn: 299 if special_file then call eofhack_unbind; /* restore infile, ^q */ 300 unmkd_ptr = unm1; 301 stack_ptr = addr(eofstack -> temp(2)); 302 return; 303 304 read_from_string: entry; /* 5/2/80 BSG */ 305 read_from_stringf = "1"b; 306 go to readlist_join; 307 308 readlist: entry; 309 310 read_from_stringf = "0"b; 311 readlist_join: 312 tyipeeksw = "0"b; 313 readlistf = "1"b; /* for return */ 314 special_file = "0"b; 315 call set_tblp; 316 stack = stack_ptr; 317 inlist = addrel(stack, -2); /* underneath the working stack is our arg */ 318 rfs_retry: 319 if read_from_stringf 320 then if ^(inlist -> temp_type(1) = String 321 | inlist -> temp_type(1) = Atsym) then do; 322 unm = unmkd_ptr; /* bad_arg_correctable error */ 323 unmkd_ptr = addrel(unm, 2); 324 unm -> errcode(1) = bad_arg_correctable; 325 unm -> errcode(2) = fn_read_from_string; 326 call lisp_error_; /* the bad arg is already on stack */ 327 go to rfs_retry; /* Error Recovery -- new value for arg is on stack */ 328 end; 329 330 if ^read_from_stringf & inlist -> temp(1) = nil 331 then do; /* special case (readlist nil) => (ascii 0) */ 332 fb = 0; 333 stack = inlist; 334 call get_sing_char; 335 return; 336 end; 337 338 /* save the state of the reader in case this readlist is in a macro-char function */ 339 340 unm = unmkd_ptr; 341 unmkd_ptr = addrel(unm, size(fault_save)); 342 fault_save.prev_frame = rel(err_recp); 343 fault_save.stack_ptr = rel(stack); 344 fault_save.sv_gc_inhibit = gc_inhibit; 345 fault_save.code1 = 0; /* indicate no error associated with this fault_save */ 346 fault_save.sv_array_info = null(); /* we're not in the middle of an array opertaion */ 347 sv_rdr_label = rdr_label; 348 sv_rdr_ptr = rdr_ptr; 349 sv_rdr_state = rdr_state; 350 err_recp = unm; 351 352 readlist_data_strucp = addr (auto_readlist_data_struc); 353 readlist_data_struc.inlist = inlist; 354 readlist_data_struc.stringf = read_from_stringf; 355 readlist_data_struc.chrct = 1; 356 rdr_ptr = addr (readlist_data_struc); 357 rdr_state = 2; /* so that macros will read from the readlist */ 358 real_io = "0"b; 359 eolhacksw = "1"b; /* so no need be supplied to terminate an atom */ 360 go to readcom; 361 362 maknam: entry; 363 364 implode_sw = "0"b; 365 go to maknam_joint; 366 367 implode: entry; 368 369 implode_sw = "1"b; 370 maknam_joint: 371 372 stack = addrel(stack_ptr, -2); /* -> arg which is list of chars */ 373 unm = unmkd_ptr; 374 call pnamesetup; 375 do while (stack -> temp_type(1) = Cons); 376 if stack -> temp_ptr(1) -> cons_types36.car & Fixed36 377 then do; /* number is ascii code for char */ 378 fb = addr(stack -> temp_ptr(1) -> cons.car) -> fixedb; 379 if fb < 0 then go to maknamloss; 380 if fb >= 128 then go to maknamloss; 381 end; 382 else if stack -> temp_ptr(1) -> cons_types36.car & Atsym36 383 then b = substr(stack -> temp_ptr(1) -> cons_ptrs.car -> atom.pname, 1, 1); 384 else go to maknamloss; 385 386 call pnameput; /* deposit character into pname buffer */ 387 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 388 /* advance input list */ 389 390 end; 391 if implode_sw then call get_atom; 392 else call make_name; 393 unmkd_ptr = pnp; /* clear unmkd pdl */ 394 return; 395 396 /* come here in the even of of an error while maknam'ing */ 397 398 maknamloss: 399 stack -> temp(1) = stack -> temp_ptr(1) -> cons.car; /* the losing "character" */ 400 go to err_2; 401 402 403 readstring: entry; /* Here is the lisp 'readline' function, formerly called readstring */ 404 405 tyipeeksw = "0"b; 406 eolhacksw = "1"b; 407 call eof_hack; 408 call char_read_setup; 409 call set_inp; 410 call pnamesetup; 411 rs_loop: 412 call rdinch; 413 if b = newline then do; 414 call lisp_alloc_(divide(pnamelen+7, 4, 17, 0), stack -> temp_ptr(1)); 415 stack -> temp_type(1) = String; 416 stack -> temp_ptr(1) -> lisp_string.string_length = pnamelen; 417 stack -> temp_ptr(1) -> lisp_string.string = pname_buffer; 418 go to drop_nl; /* return it */ 419 end; 420 /* normal character, put it in */ 421 422 in_middle = "1"b; /* we are now really reading something */ 423 call pnameput; 424 go to rs_loop; 425 426 char_read_setup: proc; 427 428 in_middle = "0"b; 429 reading_atsym, reading_number = "0"b; 430 unm = unmkd_ptr; 431 unmkd_ptr = addrel(unm, size(stacked_variables)); 432 exitcode = 1; /* necessary to make end of file in readline work properly */ 433 call set_tblp; /* required by rdinch */ 434 end; 435 436 /* come here to read in one object */ 437 438 rdobj0: /* reset all the state variables that need to be reset */ 439 440 got_macro, 441 got_something, 442 got_list, 443 reading_atsym, 444 reading_number, 445 minus_flag, 446 forced_num, 447 expon_flag, 448 float_flag, 449 in_middle, 450 dnum, 451 dotted_pair_flag, 452 shiftscale_flag = "0"b; 453 454 rdobj1: call rdchar; 455 rdobj: 456 if bb & blank then go to rdobj1; /* skip over blanks */ 457 458 459 else if bb & alpha2 then do; /* atomic symbol */ 460 call pnamesetup; 461 obtain_pname: call pnameput; 462 rdnumo_aa: reading_atsym = "1"b; /* so rdchar will know what to do with break char */ 463 read_Atloop: call rdchar; 464 call pnameput; 465 go to read_Atloop; 466 467 /* rdchar jumps to here when the break char is detected */ 468 469 rdaend: got_something = "1"b; /* because of random 'goto rdaend' somewhere */ 470 reading_atsym = "0"b; 471 call get_atom; /* find the atom in hash table */ 472 call reset_tblp; /* garbage collector may have moved readtable */ 473 unmkd_ptr = pnp; /* flush the pname buffer */ 474 go to exit(exitcode); 475 476 /* come here when a number is discovered to be really an atomic symbol */ 477 478 rdnumo: reading_number, 479 minus_flag, 480 expon_flag, 481 float_flag, 482 dnum = "0"b; 483 go to rdnumo_aa; 484 end; 485 486 /* LIST READER */ 487 488 else if bb & lparn then do; 489 unm = unmkd_ptr; /* push stacked-variables */ 490 unmkd_ptr = addrel(unm, 4); 491 if bb & bit12 then do; 492 left_super = origb; 493 right_super = fb; /* expected matching right super parenthesis */ 494 exitcode = super1exit; 495 end; 496 else exitcode = list1exit; 497 dotted_pair_flag = "0"b; 498 stack -> temp(1) = nil; /* initially no list has been read */ 499 call rdchar; /* skip over the left parenthesis */ 500 501 rdlst3x: stack_ptr = addr(stack -> temp(4)); /* stack contains: 502* 1 -> list being read. 503* 2 -> last cons in list being read, to be rplacd'ed 504* 3 = temp storage for object being read in list 505* */ 506 stack = addr(stack -> temp(3)); 507 508 rdlst3a: go to rdobj; 509 510 511 512 /* come back here after reading an element of any kind of list */ 513 514 exit(3): 515 exit(4): 516 exit(5): 517 exit(6): 518 519 if dotted_pair_flag then go to rdlst4; 520 if got_macro then do; 521 got_macro = "0"b; /* Turn off flag */ 522 if ^got_splice then go to rdlst2; 523 else do; /* ^splicing is regular stuff */ 524 got_something = "0"b; /* in case it is nothing */ 525 if stack -> temp_type(1) then go to rdlst3a; /* if it is nothing, go away */ 526 527 /* copy the list to be spliced in and remember its ending cons */ 528 /* only have to copy top level */ 529 530 stack = addrel(stack, -4); 531 stack_ptr = addr(stack -> temp(7)); 532 stack -> temp(4) = nil; 533 do while (stack -> temp_type(3) = Cons); 534 stack -> temp(6) = stack -> temp_ptr(3) -> cons.car; 535 stack -> temp(3) = stack -> temp_ptr(3) -> cons.cdr; 536 537 call lisp_special_fns_$ncons; 538 call reset_tblp; /* garbage collector may have moved readtable */ 539 if stack -> temp(4) = nil then /* remember start of list */ 540 stack -> temp(4) = stack -> temp(6); 541 else stack -> temp_ptr(5) -> cons.cdr = stack -> temp(6); 542 /* or chain list together */ 543 stack -> temp(5) = stack -> temp(6); /* remember last cons in list */ 544 end; 545 stack -> temp(3) = stack -> temp(5); 546 splice_it_in: 547 /* 548* 1 -> list being built up 549* 2 -> last cons in that list, unless first time 550* 3 -> new last cons 551* 4 -> cons to be added to end of list (usually same as 3) 552* */ 553 if exitcode >= list1exit /* if first time */ 554 then do; 555 exitcode = exitcode - 2; /* is no longer first time */ 556 stack -> temp(1) = stack -> temp(3); /* set ptr to 1st cons in list */ 557 end; 558 else stack -> temp_ptr(2) -> cons.cdr = stack -> temp(4); 559 stack -> temp(2) = stack -> temp(3); /* new last cons in list */ 560 got_something = "0"b; 561 go to rdlst3x; /* keep on reading list */ 562 end; 563 end; 564 565 else if got_something then do; 566 rdlst2: stack = addrel(stack, -4); /* get back our own stack */ 567 stack_ptr = addr(stack -> temp(4)); 568 call lisp_special_fns_$ncons; 569 call reset_tblp; /* garbage collector may have moved readtable */ 570 stack_ptr = addr(stack -> temp(5)); 571 stack -> temp(4) = stack -> temp(3); 572 go to splice_it_in; 573 end; 574 575 576 else if bb & rparn then /* some kind of right parenthesis */ 577 rparn_proc: if bb & bit12 then do; 578 579 /* RIGHT SUPER-PARENTHESIS */ 580 581 if exitcode = listexit then go to supply_right; 582 if exitcode = list1exit then go to supply_right; 583 if exitcode = superexit then go to check_super_match; 584 if exitcode = super1exit then 585 check_super_match: if right_super ^= fb then 586 587 /* mismatched super parentheses -- barf! */ 588 589 go to err_mmsp; 590 else go to rdlst_r_p; /* matches left-super */ 591 592 go to err_nlsp; /* matches quote or toplevel, error */ 593 /* ignores leading ) but not leading ] */ 594 595 /* (...] causes ) to be inserted before the ] */ 596 597 supply_right: got_something = "1"b; 598 stack = addrel(stack, -4); /* pop back */ 599 stack_ptr = addr(stack -> temp(2)); 600 unmkd_ptr = unm; 601 unm = addrel(unm, -4); 602 got_list = "1"b; 603 if exitcode < listexit /* returning to toplevel or quote, 604* enough )'s have been supplied */ 605 then go to rdex; 606 else go to exit(exitcode); /* returning to list, keep on supplying )'s */ 607 end; 608 else do; 609 /* REGULAR RIGHT PARENTHESIS */ 610 611 if exitcode = superexit then go to supply_left; 612 if exitcode = super1exit then go to supply_left; 613 614 rdlst_r_p: stack = addrel(stack, -4); /* pop back */ 615 stack_ptr = addr(stack -> temp(2)); 616 unmkd_ptr = unm; 617 unm = addrel(unm, -4); 618 619 /* put in a pseudo space as next char so no read off end of file */ 620 621 rdex: bb = ^nspblnk; 622 fb = 128; /* doesn't matter */ 623 got_something = "1"b; 624 got_list = "1"b; 625 go to exit(exitcode); 626 627 /* [ ... ) --> [(...) 628* that is, a left super parenthesis may only match a right super parenthesis, not a ) */ 629 630 supply_left: stack = addrel(stack , -4); 631 stack_ptr = addr(stack -> temp(3)); 632 stack -> temp(2) = nil; 633 call lisp_special_fns_$cons; /* make list with present list as 1st elem */ 634 call reset_tblp; /* garbage collector may have moved readtable */ 635 exitcode = superexit; /* have read first thing now. */ 636 call rdchar; /* skip over the right paren */ 637 go to rdlst3x; /* keep reading looking for right super paren */ 638 end; 639 640 /* must be right paren missing */ 641 642 parn_missing: code = parenmissing; 643 644 call error; 645 646 647 /* dotted pair processor */ 648 649 rdlst4: if got_macro 650 then if got_splice 651 then if stack -> temp_type (1) = Cons 652 then if stack -> temp_ptr (1) -> cons_types.cdr = Cons 653 then go to dot_loses; /* no multi-lists */ 654 else stack -> temp (1) = stack -> temp_ptr (1) -> cons.car; 655 else do; /* Got nothing */ 656 got_macro, got_something = "0"b; 657 go to rdobj; 658 end; 659 got_macro = "0"b; 660 if ^got_something then go to dot_loses; /* (a.) not allowed */ 661 if exitcode >= list1exit then go to dot_loses; /* (. not allowed */ 662 /* if exitcode = super1exit then go to dot_loses; /* [. not allowed */ 663 664 /* OK, attach to end of list */ 665 666 stack = addrel(stack, -4); 667 rdlst39: stack -> temp_ptr(2) -> cons.cdr = stack -> temp(3); 668 rdlst40: 669 if bb & rparn then do; 670 stack = addrel(stack, 4); /* put back where we found it */ 671 go to rparn_proc; /* and go handle the right paren in the usual way */ 672 end; 673 674 if bb & realchar then; 675 else do; 676 call rdchar; 677 go to rdlst40; 678 end; 679 680 /* check for splicing macro at end of dotted list, move it up to before the dot */ 681 682 if bb & macro then if bb & splice then do; 683 684 got_splice = "1"b; 685 stack_ptr = addr(stack -> temp(5)); 686 stack = addr(stack -> temp(4)); 687 unm = unmkd_ptr; 688 unmkd_ptr = addrel(unm, 4); /* push stacked-variables */ 689 exitcode = splice_dot_kludge; /* set to come back after expanding macro */ 690 go to proc_macro; 691 exit(0): 692 unmkd_ptr = unm; 693 unm = addrel(unm, -4); 694 stack = addrel(stack, -6); 695 696 /* contents of stack: 697* temp(1) - list being built (first) 698* temp(2) - list being built (last) 699* temp(3) - cdr of dotted pair 700* temp(4) - value of splicing macro 701* */ 702 703 got_something, got_splice = "0"b; 704 if stack -> temp_type(4) = Cons then do; /* really splice (if atom, dotted pair already set up on end of list) */ 705 stack_ptr = addr(stack -> temp(4)); 706 go to dot_loses; 707 end; 708 call reset_tblp; /* garbage collector may have moved readtable */ 709 go to rdlst39; 710 end; 711 712 /* loser forgot to put right paren after dotted pair */ 713 714 code = parenmissing; 715 call error; 716 717 718 719 end; 720 else if bb & digit then go to rdnum; 721 722 723 else if bb & plus_minus then do; /* object begins with a + or a - */ 724 call pnamesetup; /* in case it turns out to be an atomic symbol */ 725 call pnameput; /* save the + or the - */ 726 if bb & bit12 then minus_flag = "1"b; 727 in_middle = "1"b; 728 call rdchar; 729 in_middle = "0"b; 730 731 /* if (status +) is t, use White's base>10 "+" hack */ 732 733 if plus_status = nil then 734 if bb & jwnumchar then 735 if bb & digit then go to rdnum2; /* yes, it really seems to be a number */ 736 else /* no, it's actually an atomic symbol */ 737 do; 738 minus_flag = "0"b; 739 go to obtain_pname; /* so read rest of it */ 740 end; 741 else; 742 else if bb & jwnumchar2 then do; /* White's + hack, forces it to be a number */ 743 forced_num = "1"b; 744 go to rdnum2; 745 end; 746 747 748 /* plus not followed by digit or letter */ 749 750 if bb & decimal_point then do; 751 in_middle = "1"b; 752 call rdchar; 753 in_middle = "0"b; 754 if bb & digit then go to rdobj5; /* -.d floating point */ 755 end; 756 else if bb & special then /* just + by itself */ 757 do; 758 minus_flag = "0"b; /* turn off flag */ 759 go to rdaend; 760 end; 761 762 /* not a recognizable form */ 763 764 go to ill_obj; 765 end; 766 767 768 769 else if bb & dotted_pair_dot then do; 770 b2 = bb; /* save the dot or decimal point */ 771 in_middle = "1"b; 772 call rdchar; /* and look ahead a little */ 773 in_middle = "0"b; 774 if bb & digit then 775 if b2 & decimal_point then do; /* .d floating point */ 776 777 rdobj5: dnum, float_flag = "1"b; 778 n4f = 0; /* set up to get fraction part */ 779 go to rdnum; 780 end; 781 782 /* OK, must be a dotted pair */ 783 784 if dotted_pair_flag then go to dot_loses; /* can't have two dotted pairs in a row */ 785 /* i.e a dotted triple */ 786 dotted_pair_flag = "1"b; 787 if bb & goodbegin then; 788 else 789 dot_loses: do; code = doterror; call error; end; 790 791 go to rdobj; /* OK, go get second half of dotted pair */ 792 end; 793 794 else if bb & decimal_point /* period with syntax as decimal point but not dotted pair dot */ 795 then go to rdnum; /* rdnum will decide if it is flonum or atomic symbol */ 796 797 else if bb & string_quote_exp then if bb & bit12 then do; /* read a string */ 798 in_middle = "1"b; 799 call pnamesetup; /* make a buffer */ 800 stringer: call rdinch; 801 bb = tblp -> syntax(fb); /* We want to see slashes! */ 802 if bb & string_quote_exp then if bb & bit12 then go to end_maybe; 803 put_stringer: 804 call pnameput; 805 go to stringer; 806 807 end_maybe: call rdinch; /* in case "" which means " inside string */ 808 bb = tblp -> syntax(fb); 809 if bb & string_quote_exp then if bb & bit12 then go to put_stringer; 810 811 /* really end of string */ 812 813 in_middle = "0"b; 814 call lisp_alloc_(1+divide(pnamelen+3, 4, 17, 0), p); 815 p -> string_length = pnamelen; 816 p -> lisp_string.string = pnp -> pname_buffer; 817 stack -> temp_ptr(1) = p; 818 stack -> temp_type(1) = String; 819 got_something = "1"b; /* we read something substantial */ 820 unmkd_ptr = pnp; /* remove pname buffer from unmkd pdl */ 821 call reset_tblp; /* garbage collector may have moved readtable */ 822 823 /* pretend current char was read by rdchar instead of rdinch */ 824 825 origb = fb; 826 fb = tblp -> translation(fb); 827 828 go to exit(exitcode); 829 end; 830 else; /* PROPER BALANCE OF IF CLAUSES IS IMPERATIVE */ 831 832 833 834 else if bb & macro then do; /* macro character */ 835 if bb & splice then got_splice = "1"b; 836 else got_splice = "0"b; 837 proc_macro: 838 /* b=index in macro_table (unless someone clobbered it) */ 839 if fb <= 0 then go to bad_mac; 840 if fb <= num_macs then stack -> temp(1) = tblp -> macro_table(fb); 841 else do; /* have to search list */ 842 stack -> temp(1) = tblp -> more_macros; 843 do fb = -fb by 1 to -10; /* take a sufficient number of cdrs */ 844 845 if stack -> temp(1) = nil then go to bad_mac; 846 if stack -> temp_type(1) then go to bad_mac; 847 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 848 end; 849 if stack -> temp(1) = nil then go to bad_mac; 850 if stack -> temp_type(1) then goto bad_mac; 851 stack -> temp(1) = stack -> temp_ptr(1) -> cons.car; 852 end; 853 stack_ptr = addr(stack -> temp(3)); 854 if stack -> temp(1) = lisp_static_vars_$quote_macro /* check for internal macros */ 855 then go to special_quote_macro; 856 else if stack -> temp(1) = lisp_static_vars_$semicolon_macro 857 then go to special_semicolon_macro; 858 else if stack -> temp(1) = lisp_static_vars_$vertical_bar_macro 859 then go to special_vertical_bar_macro; 860 stack -> temp(2) = nil; 861 call lisp_$apply; /* apply macro function to nil */ 862 /* It's easy now that those delayed read macros have been flushed */ 863 call set_inp; /* in case the macro fcn changed the input dev. on us */ 864 call set_tblp; /* in case bastard changed readtable */ 865 semicolon_macro_join: 866 if tyipeeksw then go to tyipeek_proc_macro_ret; 867 fb = 131; /* pseudo-space */ 868 bb = special_blank; 869 special_macro_join: 870 got_macro, got_something = "1"b; /* got_splice already set */ 871 go to exit(exitcode); 872 873 bad_mac: fb = origb; 874 call get_sing_char; /* convert to an atom with pname of the macro char */ 875 do; code = badmacro; call error; end; 876 877 end; 878 879 880 else if bb & single_char_object then do; 881 call get_sing_char; 882 go to rdex; 883 end; 884 885 886 /* not good object begin char, just return it and let our caller figure it out */ 887 888 go to exit(exitcode); 889 890 rdchar: proc; /* get a char, return numeric code in fb, syntax bits in bb */ 891 892 893 get_another: 894 895 call rdinch; 896 origb = fb; /* save untranslated char code */ 897 fb = tblp -> translation(fb); /* translate char code */ 898 if bb & special then; 899 else return; /* ordinary char */ 900 901 /* see if it's a break char */ 902 903 if bb & brkchr1 then go to rdbk; 904 /* Yes */ 905 else if bb & nbrkchr 906 then if bb & slashifier then do; 907 /* slash - make next char look like extd_alpha */ 908 909 call rdinch; 910 bb = extd_alpha; 911 return; 912 end; 913 else return; /* alpha or something with special somehow set */ 914 else go to get_another; /* worthless - skip it */ 915 916 917 rdbk: /* we read a break character - want to do something about it? */ 918 919 if reading_atsym then go to rdaend; /* these tests _m_u_s_t be in this order */ 920 else if reading_number then go to rdnum4; 921 else return; 922 923 924 925 end rdchar; 926 927 /* all this proc does is get a char in fb and set bb to its syntax */ 928 rdinch: proc; 929 930 dcl unm ptr, 931 sco char (1), 932 cde fixed bin, 933 lisp_io_control_$fix_not_ok_iochan entry(ptr, bit(1) aligned) returns(bit(1)aligned), 934 lisp_io_control_$end_of_block entry (ptr, fixed bin(71), fixed bin), 935 input_buffer_overlay char(inp -> iochan.iolength) aligned based(inp -> iochan.ioptr); 936 937 938 rdinch_aa: 939 fb = 0; /* clear bits in fb not set by setting b */ 940 if real_io then do; 941 942 if string(inp -> iochan.flags) & not_ok_to_read then 943 if lisp_io_control_$fix_not_ok_iochan(inp, "0"b) then do; /* get new input source */ 944 call set_inp; 945 call reset_tblp; /* garbage collector may have moved readtable */ 946 go to rdinch_aa; 947 end; 948 if inp -> iochan.ioindex >= inp -> iochan.iolength then do; /* ran out of chars, do something */ 949 950 call lisp_io_control_$end_of_block(inp, eofstack -> temp(1), cde); 951 call reset_tblp; /* garbage collector may have moved readtable */ 952 go to tv(cde); /* action to take depends on what lisp_io_control_ did */ 953 tv(2): if tyipeeksw then do; 954 tyipeek_eof: fb = 3; 955 go to tyicom; 956 end; 957 if eofstack -> temp_type36(1) & Float36 then /* top level loop - as a conveneneince, */ 958 if eofstack -> fixedb = 0 then /* check for eof in middle of object even for cde=2 */ 959 go to tv(1); 960 go to eof_retn; 961 962 tv(-1): call set_inp; 963 go to rdinch_aa; 964 965 tv(0): if inp -> iochan.interactive then read_print_nl_sync = "1"b; /* tty is at left margin now */ 966 go to rdinch_aa; /* OK, process next block */ 967 968 tv(1): /* err if in middle of object (EOF) */ 969 970 if tyipeeksw then go to tyipeek_eof; 971 972 if in_middle then go to g0001; 973 else if exitcode ^= 1 then 974 g0001: do; 975 unm = unmkd_ptr; 976 unmkd_ptr = addrel(unm, 2); 977 unm -> errcode(1) = eof_in_object; 978 call lisp_error_; 979 call reset_tblp; /* garbage collector may have moved readtable */ 980 go to tv1cont; /* user interrupt function said to continue anyway */ 981 end; 982 if cde = 1 then if reading_atsym | reading_number then do; 983 fb = 131; /* pseudo-space - break out of this atom */ 984 bb = special_blank; 985 return; 986 end; 987 tv1cont: 988 if cde = 2 then go to eof_retn; /* see tv(2): */ 989 call set_inp; 990 go to rdinch_aa; /* not in an object, continue reading */ 991 992 end; 993 994 inp -> iochan.ioindex = inp -> iochan.ioindex + 1; 995 b = substr(input_buffer_overlay, inp -> iochan.ioindex, 1); 996 if fb >= 128 then go to rdinch_aa; /*** ignore non-ascii characters */ 997 998 /* this kludge is so that bsg's ec's can input control characters. 999* If a \036=\r=^|^| is seen, it is taken as a prefix and 1000* the following char is a ctrl char unless it is 036 too. */ 1001 1002 if fb = 030 /* 036 octal */ 1003 then if prefsync then prefsync = "0"b; /* double -- let it through */ 1004 else do; 1005 prefsync = "1"b; /* so come back here on next character */ 1006 go to rdinch_aa; 1007 end; 1008 else if prefsync then do; /* character following prefix = fb */ 1009 prefsync = "0"b; 1010 if b = "?" then /* handle this one specially */ 1011 if inp = tty_input_chan then call ioa_(";reading from terminal."); 1012 else call ioa_(";reading from file."); 1013 else call lisp_fault_handler_$ctrl_from_reader((b)); 1014 call set_inp; /* input source may have been changed */ 1015 call reset_tblp; /* garbage collector may have moved readtable */ 1016 go to rdinch_aa; 1017 end; 1018 1019 /* vertical motion checking */ 1020 1021 bb = tblp -> syntax(fb); /* get syntax for here and elsewhere's use */ 1022 if bb & vertical_motion 1023 then if ^ tyipeeksw 1024 then call proc_vertical_motion; 1025 1026 return; 1027 end; 1028 1029 else /* fake io */; 1030 1031 if readlist_data_struc.stringf then do; /* read from string */ 1032 if inlist -> temp_type(1) & Atsym then do; 1033 if readlist_data_struc.chrct > inlist -> temp_ptr(1) -> atom.pnamel then go to readlist_eof; 1034 sco = substr (inlist -> temp_ptr(1) -> atom.pname, readlist_data_struc.chrct, 1); 1035 end; 1036 else do; 1037 if readlist_data_struc.chrct > inlist -> temp_ptr(1) -> lisp_string.string_length then go to readlist_eof; 1038 sco = substr (inlist -> temp_ptr(1) -> lisp_string.string, readlist_data_struc.chrct, 1); 1039 1040 end; 1041 if ^tyipeeksw then readlist_data_struc.chrct = readlist_data_struc.chrct + 1; 1042 fb = fixed (unspec (sco), 9); 1043 bb = tblp -> syntax (fb); 1044 return; 1045 end; 1046 if inlist -> temp_type(1) then /* EOF */ 1047 readlist_eof: 1048 if tyipeeksw then do; /* could be tyipeek in readlist in char macro */ 1049 fb = 3; 1050 go to tyicom; 1051 end; 1052 else if eolhacksw then do; 1053 1054 /* for readlist, supply one pseudo-space at end of list so atoms will terminate */ 1055 1056 eolhacksw = "0"b; /* do this once only, in case parentheses mismatch */ 1057 supply_pseudo_space: 1058 fb = 131; 1059 bb = special_blank; 1060 return; 1061 end; 1062 else go to err_1; /* Mustn't call error except from immediately containing lexical block */ 1063 1064 if inlist -> temp_ptr(1) -> cons_types.car & Fixed then do; 1065 fb = addr(inlist -> temp_ptr(1) -> cons.car) -> fixedb; 1066 if fb < 0 then go to readlistloses; 1067 else if fb > 131 then go to readlistloses; 1068 end; 1069 1070 else if inlist -> temp_ptr(1) -> cons_types.car & Atsym then do; 1071 /*Atomic Symbol, use first char of pname */ 1072 1073 b = substr(inlist -> temp_ptr(1) -> cons_ptrs.car -> atom.pname, 1, 1); 1074 end; 1075 else do; /* loser in input list */ 1076 readlistloses: 1077 inlist -> temp(1) = inlist -> temp_ptr(1) -> cons.car; /* the losing elem */ 1078 stack_ptr = addr(inlist -> temp(2)); 1079 go to err_2; 1080 end; 1081 1082 /* set syntax for this character that we just read */ 1083 1084 bb = tblp -> syntax(fb); 1085 1086 /* read a char, so advance input list to next */ 1087 1088 if ^tyipeeksw then 1089 inlist -> temp(1) = inlist -> temp_ptr(1) -> cons.cdr; 1090 return; 1091 end rdinch; 1092 1093 set_inp: proc; /* to find the input file to be used and set the pointer inp 1094* to point to its iochan block. In the event 1095* of a re-entry to a readlist (e.g. because of a call to read 1096* from inside the function called by a macro character found 1097* in a readlist), real_io and inlist are set up */ 1098 1099 1100 if ^special_file then /* be sure to allow read macro fcn to escape to tty with (read nil) */ 1101 if rdr_state = 2 then do; /* re-entry to readlist */ 1102 real_io = "0"b; 1103 readlist_data_strucp = rdr_ptr; 1104 inlist = readlist_data_struc.inlist; /* -> stack cell containing ptr to list being read from */ 1105 return; 1106 end; 1107 1108 if addr(ctrlQ)->based_ptr -> atom.value = nil then /* input from tty */ 1109 inp = tty_input_chan; 1110 else if addr(infile)->based_ptr -> atom.value = nil | /* input from tty anyway */ 1111 addr(infile)->based_ptr -> atom.value = t_atom then do; 1112 default_to_tty: inp = tty_input_chan; 1113 if ^special_file then addr(ctrlQ)->based_ptr -> atom.value = nil; /* make toplevel win */ 1114 end; 1115 else if addr( 1116 addr(infile)->based_ptr -> atom.value 1117 )->lisp_ptr_type & File36 then inp = addr(infile)->based_ptr -> atom_ptrs.value; /* take from file */ 1118 else go to default_to_tty; /* infile set bad, just take from tty */ 1119 1120 real_io = "1"b; /* reading from iochan pointed at by inp */ 1121 1122 1123 return; 1124 1125 end set_inp; 1126 1127 increment_input_ptr: 1128 proc; 1129 if ^ real_io then 1130 if readlist_data_struc.stringf then readlist_data_struc.chrct = readlist_data_struc.chrct + 1; 1131 else inlist -> temp(1) = inlist -> temp_ptr(1) -> cons.cdr; 1132 else if bb & vertical_motion then call proc_vertical_motion; 1133 end increment_input_ptr; 1134 1135 1136 proc_vertical_motion: proc; /* character with vertical_motion syntax in fb, do all good things */ 1137 1138 if ^ real_io then return; 1139 inp -> iochan.charpos = 0; /* NL and NP always cause return to left margin */ 1140 inp -> iochan.nlsync = "1"b; 1141 if fb = 12 then go to new_page; /* NP character */ 1142 1143 inp -> iochan.linenum = inp -> iochan.linenum + 1; /* NL character */ 1144 if inp -> iochan.pagel = 0 then return; /* infinite pages */ 1145 if inp -> iochan.pagel > inp -> iochan.linenum /* or page not yet exceeded */ 1146 then return; 1147 new_page: 1148 inp -> iochan.linenum = 0; 1149 inp -> iochan.pagenum = inp -> iochan.pagenum + 1; /* advance to top of a new page */ 1150 1151 return; /* no endpagefn's on input files */ 1152 1153 end proc_vertical_motion; 1154 1155 /* internal proc to get readtable, make tblp point at it */ 1156 1157 set_tblp: proc; 1158 1159 dcl stack ptr; 1160 1161 /* make sure readtable is an array */ 1162 1163 if addr( 1164 addr(readtable) -> based_ptr -> atom.value) 1165 -> lisp_ptr_type & Array36 then; 1166 else go to err; 1167 1168 /* make sure it is a Readtable array */ 1169 1170 if addr(readtable)-> based_ptr -> atom_ptrs.value 1171 -> array_info.type ^= Readtable_array then go to err; 1172 1173 reset_tblp: entry; 1174 1175 tblp = addr(read_table); /* set ptr to array structure for later use */ 1176 return; 1177 1178 err: /* bad readtable, attempt to fix it then signal error */ 1179 1180 stack = stack_ptr; 1181 stack_ptr = addr(stack -> temp(3)); 1182 stack -> temp(1) = readtable; /* get array property of readtable, */ 1183 stack -> temp(2) = array_atom; /* which should be the original readtable */ 1184 call lisp_property_fns_$get; 1185 if stack -> temp(1) ^= nil then 1186 addr(readtable) -> based_ptr -> atom.value = stack -> temp(1); 1187 1188 code = badreadtable; 1189 call error; 1190 1191 end set_tblp; 1192 1193 1194 /* declaration of obarray, and internal proc to make sure that the 1195* value of the atom obarray is really an obarray */ 1196 1197 dcl htptr ptr, /* temp pointer to hash table */ 1198 1199 1 obarray_struct based(htptr) aligned, 1200 2 hash_table(0:510) fixed bin(71), 1201 2 char_objects(0:127) fixed bin(71); 1202 1203 1204 verify_obarray: proc; 1205 1206 dcl stack ptr; 1207 1208 if addr( 1209 addr(obarray)->based_ptr -> atom.value) 1210 -> lisp_ptr_type & Array36 then; 1211 else go to err; /* not an array, barf */ 1212 1213 if addr(obarray)->based_ptr -> atom_ptrs.value -> array_info.type ^= Obarray_array 1214 then go to err; 1215 1216 return; /* obarray is OK */ 1217 1218 err: /* bad obarray, attempt to fix it then signal error */ 1219 1220 stack = stack_ptr; 1221 stack_ptr = addr(stack -> temp(3)); 1222 stack -> temp(1) = obarray; /* get the array prop of obarray, which should be the initial obarray */ 1223 stack -> temp(2) = array_atom; 1224 call lisp_property_fns_$get; 1225 if stack -> temp(1) ^= nil then 1226 addr(obarray)->based_ptr -> atom.value = stack -> temp(1); 1227 1228 code = badobarray; 1229 call error; /* uncorrectable error - for now */ 1230 1231 end verify_obarray; 1232 1233 1234 /* Single - Character Readers */ 1235 1236 real_tyi: entry; 1237 1238 tyipeeksw = "0"b; 1239 eolhacksw = "0"b; 1240 call eof_hack; 1241 call char_read_setup; 1242 call set_inp; 1243 call rdinch; 1244 if special_file then call eofhack_unbind; 1245 tyicom: stack_ptr = addr(eofstack -> temp(2)); 1246 eofstack -> fixnum_fmt.type_info = fixnum_type; 1247 eofstack -> fixedb = fb; 1248 unmkd_ptr = unm1; 1249 return; 1250 1251 real_tyipeek: entry; 1252 1253 special_file = "0"b; /* fix a lotta things - BSG 5/4/80 */ 1254 tyipeek_t = "0"b; 1255 tyipeeksw = "1"b; 1256 eolhacksw = "0"b; 1257 unm1 = unmkd_ptr; /* We will need this later. */ 1258 call char_read_setup; 1259 stack = addrel(stack_ptr, -2); /* lsubr - get argcount */ 1260 nmargs = stack -> fixedb; 1261 eofstack = addrel(stack, nmargs); 1262 stack_ptr = addr(eofstack -> temp(4)); 1263 stack = addr(eofstack -> temp(3)); 1264 if nmargs = -2 then go to tyipeek_wierd; /* we have an argument, go do strange things */ 1265 eofstack -> temp(1) = t_atom; 1266 call set_inp; 1267 1268 call rdinch; 1269 typk5: if real_io then inp -> iochan.ioindex = inp -> iochan.ioindex - 1; 1270 go to tyicom; 1271 1272 1273 tyipeek_wierd: 1274 stack -> temp(1) = eofstack -> temp(1); /* our arg */ 1275 eofstack -> temp(1) = t_atom; 1276 call set_inp; /* input from default input source, in tyipeek mode (eof sp.) */ 1277 1278 tyipw_retry: 1279 if stack -> temp(1) = t_atom then do; 1280 nmargs = 177806848; /* 1246217000 octal */ 1281 tyipeek_t = "1"b; 1282 end; 1283 1284 else do; 1285 if stack -> fixnum_fmt.type_info ^= fixnum_type then do; /* bad arg - barf */ 1286 unm = unmkd_ptr; 1287 unmkd_ptr = addrel(unm, 2); 1288 unm -> errcode(1) = bad_arg_correctable; 1289 unm -> errcode(2) = fn_tyipeek; 1290 call lisp_error_; 1291 call reset_tblp; /* garbage collector may have moved readtable */ 1292 go to tyipw_retry; 1293 end; 1294 nmargs = stack -> fixedb; /* fetch argument */ 1295 end; 1296 if nmargs >= 512 /* "1000"b3 */ then go to tyipeek_really_wierd; 1297 1298 /* search for the character n, position read ptr just before it */ 1299 1300 tyipw_loop: 1301 call rdinch; /* get a character */ 1302 if fb = nmargs then go to typk5; /* if this is the one we want go finish up */ 1303 if ^real_io then 1304 if readlist_data_struc.stringf then readlist_data_struc.chrct = readlist_data_struc.chrct + 1; 1305 else inlist -> temp(1) = inlist -> temp_ptr(1) -> cons.cdr; /* patch up for readlist macro */ 1306 else if bb & vertical_motion then call proc_vertical_motion; 1307 go to tyipw_loop; 1308 1309 tyipeek_really_wierd: 1310 1311 /* searching for character of specified syntax */ 1312 1313 bb_wanted = substr(unspec(nmargs), 1, 27); /* nmargs is syntax bits * 1000 octal */ 1314 /* align and change to a bit string */ 1315 1316 tyipww_loop: 1317 call rdinch; /* get a character */ 1318 if tyipeek_t then if bb & macro then if bb & splice then do; 1319 call increment_input_ptr; 1320 got_splice = "1"b; 1321 fb = tblp -> translation(fb); 1322 go to proc_macro; 1323 tyipeek_proc_macro_ret: 1324 go to tyipww_loop; 1325 end; 1326 if bb & bb_wanted then go to typk5; /* found what we were looking for */ 1327 call increment_input_ptr; 1328 go to tyipww_loop; 1329 1330 1331 real_readch: entry; 1332 1333 tyipeeksw = "0"b; 1334 eolhacksw = "0"b; 1335 call eof_hack; 1336 call char_read_setup; 1337 call set_inp; 1338 call rdinch; 1339 if special_file then call eofhack_unbind; 1340 stack = eofstack; 1341 stack_ptr = addr(stack -> temp(2)); 1342 call get_sing_char; 1343 unmkd_ptr = unm1; 1344 return; 1345 1346 /* The lisp ascii function which converts a number to an atomic symbol */ 1347 1348 ascii: entry; 1349 1350 ascii_retry: 1351 call set_tblp; 1352 stack = addrel(stack_ptr, -2); 1353 if stack -> temp_type36(1) & Fixed36 then; /* winner */ 1354 else do; 1355 ascii_err: 1356 unm = unmkd_ptr; /* bad_arg_correctable error */ 1357 unmkd_ptr = addrel(unm, 2); 1358 unm -> errcode(1) = bad_arg_correctable; 1359 unm -> errcode(2) = fn_ascii; 1360 call lisp_error_; /* the bad arg is already on stack */ 1361 go to ascii_retry; /* Error Recovery -- new value for arg is on stack */ 1362 end; 1363 1364 fb = stack -> fixedb; 1365 if fb < 0 then go to ascii_err; 1366 else if fb > 511 then go to ascii_err; 1367 call get_sing_char; 1368 return; 1369 1370 1371 1372 1373 /* THE NUMBER READER */ 1374 1375 1376 rdnum: 1377 call pnamesetup; /* in case it's really an atomic symbol */ 1378 1379 /* obtain value of ibase */ 1380 rdnum2: 1381 get_ibase: 1382 if addr(addr(ibase)->based_ptr -> atom.value) -> temp_type36(1) & Fixed36 then; 1383 else 1384 bad_ibase_: begin; 1385 dcl unmm ptr; 1386 unmm = unmkd_ptr; 1387 unmkd_ptr = addrel(unmm, 2); 1388 unmm -> errcode(1) = bad_ibase; 1389 call lisp_error_; 1390 call reset_tblp; /* garbage collector may have moved readtable */ 1391 go to get_ibase; 1392 end; 1393 ib = ibv; /* ... the value of ibase */ 1394 if ib < 2 then go to bad_ibase_; /* check range since going to use ib as index into arrays */ 1395 if ib >= 37 then go to bad_ibase_; /* bigradix and digsperwd */ 1396 1397 call pnameput; 1398 n = 0; /* number to base ibase is accumulated here */ 1399 dn = 0; /* number to base 10 is accumulated here */ 1400 dbnf, obnf = "0"b; /* clear overflow flags */ 1401 fpdigits = 0; 1402 reading_number = "1"b; 1403 1404 rdnum1a: if bb & digit then do; 1405 /* found a digit -- accumulate the number */ 1406 1407 rdnum5: fb = fb - 48; 1408 bigdn = add(dn*10, fb, 71, 0); /* check for overflow */ 1409 if bigdn > one_word_limit then dbnf = "1"b; /* and if so, have decimal bignum */ 1410 else do; 1411 dn = bigdn; /* we can legally assign here */ 1412 fpdigits = fpdigits + 1; /* in case we are in a fraction part */ 1413 end; 1414 bign = add(n*ib, fb, 71, 0); /* check for overflow */ 1415 if bign > one_word_limit then obnf = "1"b; /* again check for legal assignment. */ 1416 else n = bign; 1417 /* Fall into rdnum1 */ 1418 rdnum1: call rdchar; 1419 call pnameput; 1420 go to rdnum1a; 1421 end; 1422 1423 else if bb & decimal_point then 1424 1425 proc_dec_point: 1426 if dnum then go to ill_obj; /* can't be a decimal point */ 1427 else if expon_flag then if shiftscale_flag then; /* allow . in fixed point scale, */ 1428 else go to ill_obj; /* but not in floating exponent */ 1429 else do; 1430 b2 = bb; 1431 dnum = "1"b; /* in case break char follows, will go to rdnum4 */ 1432 if ^ real_io then stack -> temp(1) = inlist -> temp(1); 1433 call rdchar; /* look ahead & find out what kind of decimal point */ 1434 call pnameput; /* don't lose the character */ 1435 if bb & digit then 1436 if shiftscale_flag then go to ill_obj; /* loser tried to shift fractional bits */ 1437 else do; 1438 float_flag, dnum = "1"b; /* make floating number of form ddd.ddd */ 1439 n4f = dn; /* save integer part */ 1440 dn = 0; 1441 fpdigits = 0; 1442 go to rdnum5; 1443 end; 1444 else if bb & string_quote_exp then 1445 if bb & bit12 then; 1446 else go to make_fake_mantissa; /* ddd.Ennn floating number */ 1447 else if bb & shift_scale then do; 1448 n = dn; /* shift or scale a decimal number */ 1449 go to rdnumss; 1450 end; 1451 1452 /* randomness after a decimal point, might really be a dotted pair */ 1453 1454 if b2 & dotted_pair_dot then do; 1455 dnum = "0"b; /* wasn't really a decimal point */ 1456 if real_io then 1457 inp -> iochan.ioindex = inp -> iochan.ioindex - 1; /* back up to the dot */ 1458 else if readlist_data_struc.stringf then readlist_data_struc.chrct = readlist_data_struc.chrct - 1; 1459 else inlist -> temp(1) = stack -> temp(1); 1460 /* This counteracts the lookahead */ 1461 /* that we did before */ 1462 bb = b2 & ^decimal_point; 1463 go to rdnum4; /* finish number, later dotted pair will be found */ 1464 end; 1465 else go to not_really_a_number; 1466 end; 1467 1468 else if bb & string_quote_exp then 1469 if bb & bit12 then go to rdnumalph; 1470 else if forced_num then go to rdnumalph; /* in this case, e is digit not exponent mark */ 1471 else do; 1472 /* exponent marker */ 1473 if expon_flag then go to ill_obj; /* sorry, only one to a customer */ 1474 if shiftscale_flag then go to ill_obj; /* .. */ 1475 if ^float_flag then do; /* fake the fraction part */ 1476 1477 make_fake_mantissa: n4f = dn; 1478 dn = 0; 1479 fpdigits = 0; 1480 end; 1481 if minus_flag then do; 1482 minus_flag = "0"b; 1483 n4f = -n4f; 1484 dn = -dn; 1485 end; 1486 float_flag, expon_flag, dnum = "1"b; 1487 if fpdigits < lbound(ten_to_the, 1) then go to flonum_out_of_range; 1488 if fpdigits >= 1+hbound(ten_to_the, 1) then go to flonum_out_of_range; 1489 fn = float(n4f, 50) + float(dn, 50) * ten_to_the(-fpdigits); 1490 n, dn = 0; 1491 go to rdnewnum; /* go get the exponent */ 1492 end; 1493 else 1494 rdnumalph: if bb & alpha then /* letter in a number */ 1495 if forced_num then do; /* The + hack, take it as a digit */ 1496 if fb < 96 then fb = fb - 7; /* so A comes out as 10 */ 1497 else fb = fb - 39; /* so a comes out as 10 */ 1498 go to rdnum5; /* just as if it were a digit */ 1499 end; 1500 else go to rdnumo; /* surprise, it really was an atomic symbol */ 1501 1502 1503 else if bb & shift_scale then do; 1504 if shiftscale_flag then go to ill_obj; 1505 1506 rdnumss: shiftscale_flag = "1"b; /******** SHOULD DO BIGNUM SCALING HERE **********/ 1507 if minus_flag then do; 1508 minus_flag = "0"b; 1509 n = -n; 1510 end; 1511 if bb & bit12 then; else expon_flag = "1"b; /* scale */ 1512 if dnum then nn = dn; else nn = n; /* have the thing to be shifted or scaled */ 1513 dnum = "0"b; 1514 1515 n, dn = 0; /* go read shift factor or scale factor */ 1516 go to rdnewnum; 1517 end; 1518 1519 1520 else /* some random crud in number */ 1521 not_really_a_number: if forced_num then go to ill_obj; 1522 else go to rdnumo; /* so make it an atomic symbol instead */ 1523 1524 rdnewnum: call rdchar; 1525 call pnameput; 1526 if bb & plus_minus then do; 1527 if bb & bit12 then minus_flag = "1"b; 1528 go to rdnum1; 1529 end; 1530 go to rdnum1a; 1531 1532 1533 1534 /* break char found */ 1535 1536 rdnum4: if bb & decimal_point then go to proc_dec_point; /* don't want decimal points to 1537* be break characters when in a number */ 1538 if shiftscale_flag then do; /* perform a shift/scale operation that was requested earlier */ 1539 if dnum then n = dn; /* if decimal shift factor */ 1540 shiftscale_flag, dnum = "0"b; 1541 if minus_flag then go to ill_obj; /* It would be easy to do, but for some reason MACLISP 1542* doesn't allow it */ 1543 if expon_flag then do; 1544 1545 /* SCALE */ 1546 1547 expon_flag = "0"b; 1548 do i = 1 to n; /* fastest way since n is small unless the user is also a loser */ 1549 nn = nn * ib; 1550 end; 1551 end; 1552 else do; 1553 1554 call lisp_reader_alm_$left_shift(nn, n); 1555 end; 1556 1557 ret_fix: stack -> fixedb = nn; 1558 stack -> fixnum_fmt.type_info = fixnum_type; 1559 1560 ret_num: forced_num = "0"b; 1561 got_something = "1"b; /* so they know we returned something */ 1562 unmkd_ptr = pnp; /* flush pname buffer */ 1563 reading_number = "0"b; 1564 go to exit(exitcode); 1565 end; 1566 else if expon_flag then do; /* the rest has already been floated and put in fn */ 1567 1568 expon_flag, float_flag, dnum = "0"b; 1569 if minus_flag then do; 1570 minus_flag = "0"b; 1571 dn = -dn; 1572 end; 1573 if dn < lbound(ten_to_the, 1) then go to flonum_out_of_range_1; 1574 if dn >= 1+hbound(ten_to_the, 1) then go to flonum_out_of_range_1; 1575 fn = fn * ten_to_the(dn); 1576 ret_float: 1577 /* round the mantissa by using a based overlay on fn */ 1578 1579 if fn >= 0 then do; 1580 nn = fixed(fnx.mantissa)+1; /* add 1 to first bit beyond first word of mantissa */ 1581 if substr(unspec(nn), 8, 1) then do; /* overflow, renormalize */ 1582 unspec(nn) = "0"b||unspec(nn); /* right shift mantissa 1 place */ 1583 n = fnx.exp + 1; /* and add one to exponent */ 1584 if n >= 128 then go to flonum_out_of_range; /* if exp overflows */ 1585 fnx.exp = n; /* if no overflow, put new exp back */ 1586 end; 1587 fnx.mantissa = substr(unspec(nn), 9, 28); /* put rounded mantissa back in fn */ 1588 end; 1589 1590 else do; /* same code for negative number */ 1591 nn = fixed(fnx.mantissa)+1; 1592 if substr(unspec(nn), 9, 1) then do; /* must renormalize */ 1593 unspec(nn) = "0"b||unspec(nn); 1594 n = fnx.exp + 1; 1595 if n >= 128 then go to flonum_out_of_range; 1596 fnx.exp = n; 1597 end; 1598 fnx.mantissa = substr(unspec(nn), 9, 28); 1599 end; 1600 1601 stack -> floatb = fn; 1602 stack -> flonum_fmt.type_info = flonum_type; 1603 go to ret_num; 1604 end; 1605 1606 else if float_flag then do; /* ddd.ddd with no exponent */ 1607 1608 float_flag, dnum = "0"b; 1609 if fpdigits < lbound(ten_to_the, 1) then go to flonum_out_of_range_2; 1610 if fpdigits >= 1+hbound(ten_to_the, 1) then go to flonum_out_of_range_2; 1611 fn = float(n4f, 50) + float(dn, 50) * ten_to_the(-fpdigits); 1612 if minus_flag then do; 1613 fn = -fn; 1614 minus_flag = "0"b; 1615 end; 1616 go to ret_float; 1617 end; 1618 1619 else if dnum then do; 1620 dnum = "0"b; 1621 if dbnf then go to decimal_bignum; 1622 nn = dn; 1623 go to rfx; 1624 end; 1625 1626 /* just an ordinary number */ 1627 1628 if obnf then go to read_bignum; 1629 nn = n; 1630 rfx: if minus_flag then do; 1631 nn = -nn; 1632 minus_flag = "0"b; 1633 end; 1634 go to ret_fix; 1635 1636 1637 1638 /* come here when floating number has exponent out of bounds */ 1639 1640 flonum_out_of_range: 1641 flonum_out_of_range_1: 1642 flonum_out_of_range_2: 1643 1644 code = flonum_too_big; 1645 call error; 1646 1647 /* bignum reader */ 1648 1649 /* extract the bignum from the pname buffer, convert it first to a larger base such 1650* that each digit almost fills up a word, then call the lisp_bignums_ module 1651* to convert the bignum to the proper internal form */ 1652 1653 decimal_bignum: 1654 ib = 10; 1655 1656 read_bignum: 1657 bnct = 0; 1658 bnp = pnp; 1659 1660 /* check if there is a sign at the beginning that has to be dropped */ 1661 1662 fb = 0; 1663 b = substr(pname_buffer, 1, 1); 1664 if b >= "a" then if b <= "z" then go to rdbn1; /* valid digit (in some bases) */ 1665 if b >= "A" then if b <= "Z" then go to rdbn1; /* .. */ 1666 if b >= "0" then if b <= "9" then go to rdbn1; /* .. */ 1667 call getbnc; /* random char at beginning, skip over it */ 1668 pnamelen = pnamelen - 1; 1669 1670 /* set up array into which to put digits to base bigradix(ib) */ 1671 1672 rdbn1: bnbp = unmkd_ptr; /* allocate the array on the unmkd pdl */ 1673 dpw = digsperwd(ib); 1674 bnsize = divide(pnamelen+dpw-1, dpw, 17, 0); /* size of array */ 1675 n = bnsize; 1676 if substr(unspec(n), 36, 1) then n=n+1; /* make even */ 1677 unmkd_ptr = addrel(bnbp, n); 1678 1679 nn = (bnsize-1) * dpw; /* number of full words */ 1680 dn = 0; 1681 do i = 1 to pnamelen - nn; /* do the first word, which may contain less than dpw digits */ 1682 call getbnc; 1683 dn = dn*ib + fb; 1684 end; 1685 bndigs(1) = dn; /* put first word into array */ 1686 1687 /* now do the rest of the digits */ 1688 1689 do nn = 2 to bnsize; /* loop for each word in bndigs, except the first one */ 1690 dn = 0; 1691 do i = 1 to dpw; /* loop for each digit going to go into this word */ 1692 call getbnc; 1693 dn = dn*ib + fb; 1694 end; 1695 bndigs(nn) = dn; 1696 end; 1697 1698 /* now call bignum module to add and multiply by bigradix to convert this to a real bignum */ 1699 1700 stack_ptr = stack; /* the bignum will be pushed on */ 1701 bnp = unmkd_ptr; 1702 unmkd_ptr = addrel(bnp, size(bnreadargs)); 1703 bnp -> bnreadargs.array = bnbp; 1704 bnp -> bnreadargs.radix = bigradix(ib); 1705 bnp -> bnreadargs.size = bnsize; 1706 call lisp_bignums_$bnread; 1707 unmkd_ptr = pnp; /* clear all this garbage off the unmkd pdl */ 1708 if minus_flag then do; /* make the bignum negative if necc. */ 1709 minus_flag = "0"b; 1710 if stack -> temp_ptr(1) -> lisp_bignum.prec = 2 /* check for special case */ 1711 then if stack -> temp_ptr(1) -> lisp_bignum.words(1) = 0 1712 then if stack -> temp_ptr(1) -> lisp_bignum.words(2) = 1 1713 then do; 1714 stack -> fixnum_fmt.type_info = fixnum_type; 1715 unspec(stack -> fixedb) = "100000000000000000000000000000000000"b; 1716 go to done_negating; 1717 end; 1718 stack -> temp_ptr(1) -> lisp_bignum.sign = (18)"1"b; 1719 done_negating: 1720 end; 1721 else stack -> temp_ptr(1) -> lisp_bignum.sign = (18)"0"b; 1722 1723 forced_num, reading_number = "0"b; 1724 got_something = "1"b; 1725 call reset_tblp; /* garbage collector may have moved readtable */ 1726 go to exit(exitcode); 1727 1728 1729 1730 /* routine to get char from pname buffer for bignum. Returns digit value in fb */ 1731 1732 getbnc: proc; 1733 1734 fb = 0; 1735 bnct = bnct+1; 1736 b = substr(bnp -> pname_buffer, bnct, 1); 1737 if fb < 64 then fb = fb - 48; /* 0 to 9 */ 1738 else if fb < 96 then fb = fb - 55; /* A to Z */ 1739 else fb = fb - 87; /* a to z */ 1740 return; 1741 end getbnc; 1742 1743 /* pname - buffer handlers */ 1744 1745 pnamesetup: proc; /* init pname buffer */ 1746 1747 pnamelen = 0; 1748 pnp = unmkd_ptr; /* put pname buffer in the unmarked pdl */ 1749 unmkd_ptr = addrel(pnp, 2); 1750 end; 1751 1752 pnameput: proc; /* deposit byte into pname buffer */ 1753 1754 pnamelen = pnamelen+1; 1755 substr(pname_buffer, pnamelen, 1) = b; 1756 if (unspec(pnamelen) & "000000000000000000000000000000000111"b) = (36)"0"b 1757 then do; /* need another double word */ 1758 unmkd_ptr = addrel(unmkd_ptr, 2); 1759 end; 1760 end; 1761 1762 /* fast routines for the two builtin macro characters */ 1763 1764 special_quote_macro: 1765 1766 unm = unmkd_ptr; 1767 unmkd_ptr = addrel(unm, 4); 1768 exitcode = quotexit; 1769 go to rdcom1; /* read the S-expression to be quoted */ 1770 1771 exit(2): 1772 if got_macro & got_splice then /* here we go again */ 1773 if stack -> temp_type (1) = Cons 1774 then if stack -> temp_ptr (1) -> cons_types.cdr = Cons 1775 then go to err_qm; 1776 else stack -> temp (1) = stack -> temp_ptr (1) -> cons.car; 1777 else do; 1778 got_something, got_macro = "0"b; 1779 go to rdobj; 1780 end; 1781 if ^ got_something then go to err_qm; /* ') is illegal */ 1782 /* and cons up a list of it */ 1783 stack_ptr = addr(stack -> temp(4)); 1784 stack -> temp(3) = nil; 1785 stack -> temp(2) = stack -> temp(1); 1786 stack -> temp(1) = quote_atom; 1787 call lisp_special_fns_$cons; 1788 call lisp_special_fns_$cons; 1789 unmkd_ptr = unm; /* pop */ 1790 unm = addrel(unm, -4); 1791 got_splice = "0"b; /* bug... */ 1792 call reset_tblp; /* garbage collector may have moved readtable */ 1793 go to special_macro_join; 1794 1795 special_semicolon_macro: 1796 1797 read_1_line: call rdinch; 1798 if fb = 10 /* ascii newline */ then do; 1799 stack -> temp(1) = nil; /* splice () is a no-op */ 1800 stack_ptr = addr(stack -> temp(2)); 1801 go to semicolon_macro_join; 1802 end; 1803 else go to read_1_line; 1804 1805 special_vertical_bar_macro: 1806 dcl firstfb fixed bin; 1807 firstfb = origb; 1808 in_middle = "1"b; 1809 call pnamesetup; 1810 call rdinch; 1811 1812 do while(fb ^= firstfb); /* | */ 1813 if fb ^= 10 /* newline */ 1814 then do; 1815 if bb & slashifier then call rdinch; /* slash protects next char */ 1816 call pnameput; 1817 end; 1818 call rdinch; 1819 end; 1820 1821 in_middle = "0"b; 1822 call get_atom; /* get an atom in */ 1823 unmkd_ptr = pnp; 1824 got_splice = "0"b; 1825 call reset_tblp; 1826 fb = 131; 1827 bb = special_blank; 1828 go to special_macro_join; 1829 1830 eof_hack: proc; /* processes the arguments to read, etc lsubrs */ 1831 1832 stack = addrel(stack_ptr, -2); /* -> argcount*-2 */ 1833 eofstack = addrel(stack, stack -> fixedb); /* -> args */ 1834 stack_ptr = addr(eofstack -> temp(4)); 1835 if stack -> fixedb = 0 then do; /* no args */ 1836 eofstack -> temp(1) = nil; /* no eofval */ 1837 special_file = "0"b; /* no bindings */ 1838 end; 1839 else if stack -> fixedb = -2 then /* 1 arg */ 1840 if eofstack -> temp_type36(1) & File36 then go to g0002; 1841 else if eofstack -> temp(1) = t_atom then go to g0002; 1842 else if eofstack -> temp(1) = nil then do; 1843 g0002: eofstack -> temp(2) = eofstack -> temp(1); /* special input source */ 1844 eofstack -> temp(1) = nil; /* no eofval */ 1845 go to special_inp; 1846 end; 1847 else special_file = "0"b; /* eofval given, but no special input source */ 1848 else /* 2 args */ 1849 if eofstack -> temp_type36(2) & File36 then go to special_inp; /* 1st arg is eofval, 2nd is file */ 1850 else if eofstack -> temp(2) = nil then go to special_inp; /* .. */ 1851 else if eofstack -> temp(2) = t_atom then go to special_inp; /* .. */ 1852 else do; /* interchange args */ 1853 eofstack -> temp(3) = eofstack -> temp(1); 1854 eofstack -> temp(1) = eofstack -> temp(2); 1855 eofstack -> temp(2) = eofstack -> temp(3); 1856 if eofstack -> temp(2) = nil then go to special_inp; /* yes, 2nd arg is file */ 1857 else if eofstack -> temp_type36(2) & File36 then go to special_inp; 1858 special_file = "0"b; /* no of those four goto's went, so ignore extra arg */ 1859 end; 1860 1861 stack = addr(eofstack -> temp(3)); /* initial free slot */ 1862 unm1 = unmkd_ptr; /* save unmkd_ptr so can restore when done */ 1863 return; 1864 1865 special_inp: /* bind infile to arg in eofstack -> temp(2), ^q to t */ 1866 1867 special_file = "1"b; /* remember to get rid of binding block before returning */ 1868 stack_ptr = addr(eofstack -> temp(7)); /* room for binding block plus eofval cell plus temp(6) cell */ 1869 stack = addrel(eofstack, 2); /* -> bindings */ 1870 eofstack -> temp(6) = eofstack -> temp(2); /* save value to bind infile to */ 1871 stack -> bindings(1).atom = infile; 1872 stack -> bindings(2).atom = ctrlQ; 1873 stack -> bindings(1).old_val = addr(stack -> bindings(1).atom)->based_ptr -> atom.value; 1874 stack -> bindings(2).old_val = addr(stack -> bindings(2).atom)->based_ptr -> atom.value; 1875 unm1 = unmkd_ptr; 1876 unmkd_ptr = addrel(unm1, 2); 1877 unm1 -> binding_block.bot_block = rel(stack); 1878 unm1 -> binding_block.top_block = rel(addr(stack -> bindings(3))); 1879 unm1 -> binding_block.back_ptr = rel(binding_top); 1880 unm1 -> binding_block.rev_ptr = ""b; 1881 binding_top = unm1; 1882 1883 addr(infile)->based_ptr -> atom.value = eofstack -> temp(6); /* specified input source */ 1884 addr(ctrlQ)->based_ptr -> atom.value = t_atom; /* enable it */ 1885 1886 stack = addr(eofstack -> temp(6)); /* first cell available to program */ 1887 end; 1888 1889 1890 eofhack_unbind: proc; /* get rid of binding block created above */ 1891 /* called shortly before returning if special_file is found to be 1 */ 1892 1893 stack = ptr(stack_ptr, binding_top -> binding_block.bot_block); /* -> bindings on marked pdl */ 1894 addr(stack -> bindings(1).atom)->based_ptr -> atom.value = 1895 stack -> bindings(1).old_val; 1896 addr(stack -> bindings(2).atom)->based_ptr -> atom.value = 1897 stack -> bindings(2).old_val; /* this better not be somebody else's bindings ! */ 1898 binding_top = ptr(binding_top, binding_top -> binding_block.back_ptr); 1899 end; /* caller will flush stacks */ 1900 1901 err_1: code = shortreadlist; 1902 call error; 1903 1904 err_2: code = badreadlist; 1905 call error; 1906 1907 err_mmsp: code = mismatch_super_parens; 1908 call get_sing_char; /* actual right paren */ 1909 stack = addrel(stack, 2); 1910 stack_ptr = addr(stack -> temp(2)); 1911 fb = right_super; /* expected right paren */ 1912 call get_sing_char; 1913 call lisp_special_fns_$cons; /* so user can see them */ 1914 call error; 1915 1916 err_nlsp: code = no_left_super_paren; 1917 call error; 1918 1919 err_qm: code = quoterror; 1920 call error; 1921 1922 ill_obj: code = illobj; 1923 call error; 1924 1925 tma_err: code = too_many_args; 1926 call error; 1927 1928 /* ERROR INTERFACE */ 1929 1930 error: proc; 1931 1932 unm = unmkd_ptr; 1933 unmkd_ptr = addrel(unm, 2); 1934 unm -> errcode(1) = code; 1935 call lisp_error_; 1936 end; 1937 1938 /* The LISP makreadtable function, which copies the read table */ 1939 1940 makreadtable: entry; /* just a write-around to *array now */ 1941 1942 /* check for an arg of nil, which he have to replace with a gensym'ed atom */ 1943 1944 stack = addrel(stack_ptr, -2); 1945 obnf = "0"b; 1946 if stack -> temp(1) = nil then do; 1947 makgensym: stack -> fixnum_fmt.type_info = fixnum_type; 1948 stack -> fixedb = 0; /* gensym is an lsubr */ 1949 call lisp_alloc_$gensym; 1950 end; 1951 else if stack -> temp(1) = t_atom then do; /* (makreadtable t) - copy initial onto a gensym */ 1952 obnf = "1"b; 1953 go to makgensym; 1954 end; 1955 1956 stack_ptr = addr(stack -> temp(6)); 1957 stack -> temp(2) = stack -> temp(1); 1958 stack -> temp(3) = lisp_static_vars_$readtable; 1959 if obnf 1960 then stack -> temp(4) = t_atom; 1961 else stack -> temp(4) = nil; 1962 addr(stack -> temp(5)) -> fixnum_fmt.type_info = fixnum_type; 1963 addr(stack -> temp(5)) -> fixedb = -6; 1964 call lisp_array_fcns_$star_array; 1965 1966 stack_ptr = addr(stack -> temp(2)); /* return the atom which is still sitting under here */ 1967 return; 1968 1969 lisp_get_atom_: entry (name, location); 1970 1971 /* procedure to find an atom by name, and intern it on the current obarray. 1972* Redone completely for the unsharing of nil and the PL/I null pointer. 1973* New hash function, 16 Nov 1972, DAM */ 1974 1975 dcl name char(*) aligned, 1976 extra_stuff bit(36) aligned based(addrel(pnp, namelen)), /* last word in pname */ 1977 kludgey_mask (1:4) static bit(36) aligned initial( /* for clearing extra bits at end of pname */ 1978 "777000000000"b3, /* 1 mod 4, 3 extra chars */ 1979 "777777000000"b3, /* 2 mod 4, 2 extra chars */ 1980 "777777777000"b3, /* 3 mod 4, 1 extra char */ 1981 "777777777777"b3), /* 4 chars in last word */ 1982 namelen fixed bin, 1983 location fixed bin(71) aligned, 1984 1985 1986 indx fixed bin, 1987 name_word fixed bin (35) aligned based, 1988 cnt fixed bin, 1989 stac ptr; 1990 1991 call verify_obarray; /* make sure user hasn't bound obarray to nil or something */ 1992 pnamelen = length(name); 1993 pnp = addr(name); 1994 stack = addr(location); /* where to put the ptr to atom */ 1995 call get_atom; 1996 return; 1997 1998 get_atom: proc; 1999 2000 dcl esw fixed bin, maknamsw bit(1) init("0"b); 2001 2002 2003 /* gets an atom whose name is of length pnamelen beginning at loc pnp, 2004* a pointer 2005* to the resulting atom is put in stack -> temp(1) */ 2006 2007 2008 esw = 1; 2009 2010 get_atom_join: 2011 2012 /* hash code name */ 2013 2014 /* add up all words in name, does not rely on knowing 2015* that unused chars are filled with \\000 */ 2016 2017 2018 /* NB: there is a copy of this algorithm 2 pages further on, 2019* under the entry hash_fcn. */ 2020 2021 if pnamelen = 0 then indx = 511; /* ascii 0 is in char_objects(0) */ 2022 else if pnamelen = 1 & rank (substr(pname_buffer, 1, 1)) <= 127 2023 then indx = 511 + rank (substr(pname_buffer, 1, 1)); /* char_objects(fb) */ 2024 else do; 2025 namelen = divide(pnamelen-1, 4, 17, 0); /* length of pname - 1 */ 2026 unspec(indx) = extra_stuff & kludgey_mask(pnamelen - 4*namelen); /* get last word */ 2027 do cnt = 0 to namelen-1; /* add up all words except last word */ 2028 indx = indx + addrel(pnp, cnt) -> name_word; 2029 end; 2030 indx = mod(indx, 509); 2031 end; 2032 2033 /* get hash table pointer */ 2034 2035 htptr = addr(obarray)->based_ptr->atom_ptrs.value -> array_info.array_data_ptr; 2036 2037 2038 /* now lookup in bucket */ 2039 2040 if indx >= 511 then do; /* if in char_objects array, is not a bucket!! */ 2041 stack -> temp(1) = char_objects(indx-511); 2042 if stack -> temp(1) = nil then go to make_new; /* if no atom yet interned in this slot */ 2043 go to atom_rtn(esw); 2044 end; 2045 else do; /* in a bucket, have to go through the bucket - searching code */ 2046 stac = stack_ptr; 2047 2048 stack_ptr = addr(stac -> temp(3)); 2049 2050 2051 do stac -> temp(1) = hash_table(indx) repeat stac -> temp_ptr(1) -> cons.cdr 2052 while(stac -> temp(1) ^= nil); 2053 2054 stac -> temp(2) = stac -> temp_ptr(1) -> cons.car; 2055 if stac -> temp_ptr(2) -> atom.pnamel = pnamelen 2056 then if substr(stac->temp_ptr(2)->atom.pname,1,pnamelen) = substr(pname_buffer,1,pnamelen) 2057 then do; 2058 stack -> temp(1) = stac -> temp(2); 2059 stack_ptr = stac; 2060 go to atom_rtn(esw); 2061 end; 2062 end; 2063 end; 2064 2065 2066 /* not found, so make a new atom */ 2067 2068 make_new: 2069 call lisp_alloc_(divide(pnamelen+23,4,17,0),stack->temp_ptr(1)); 2070 2071 stack -> temp_type(1) = Atsym; 2072 2073 2074 stack -> temp_ptr(1) -> atom_double_words.value = Undefined; 2075 stack -> temp_ptr(1) -> atom.pnamel = pnamelen; 2076 substr(stack -> temp_ptr(1) -> atom.pname,1,pnamelen) = substr(pname_buffer,1,pnamelen); 2077 stack -> temp_ptr(1) -> atom.plist = nil; 2078 if maknamsw then return; /* if entered via make_name */ 2079 if indx >= 511 then char_objects(indx-511) = stack -> temp(1); /* put in proper place in obarray */ 2080 else do; 2081 stac -> temp(1) = stack -> temp(1); 2082 htptr = addr(obarray)->based_ptr->atom_ptrs.value -> array_info.array_data_ptr; 2083 stac -> temp(2) = hash_table(indx); 2084 call lisp_special_fns_$cons; 2085 htptr = addr(obarray)->based_ptr->atom_ptrs.value -> array_info.array_data_ptr; 2086 hash_table(indx) = stac -> temp(1); 2087 stack_ptr = stac; 2088 end; 2089 go to atom_rtn(esw); 2090 2091 atom_rtn(1): 2092 return; 2093 get_sing_char: entry; 2094 2095 dcl a_char char(1); 2096 dcl char_obj fixed bin(71) aligned based(charobjp), 2097 charobjp ptr; 2098 2099 htptr = addr(obarray)->based_ptr->atom_ptrs.value -> array_info.array_data_ptr; 2100 if fb > 127 then go to make_new_sing_char; 2101 charobjp = addr(char_objects(fb)); 2102 if char_obj = nil then 2103 do; 2104 make_new_sing_char: if fb = 0 then pnamelen = 0; /* so (ascii 0) will be the null pname */ 2105 else pnamelen = 1; 2106 a_char = byte (fb); 2107 pnp = addr(a_char); 2108 esw = 2; 2109 go to get_atom_join; 2110 atom_rtn(2): if fb < 128 2111 then char_obj = stack -> temp(1); /* save for later use */ 2112 end; 2113 else stack -> temp(1) = char_obj; 2114 call reset_tblp; /* garbage collector may have moved readtable */ 2115 return; 2116 2117 make_name: entry; /* for maknam, make uninterned atomic symbol */ 2118 2119 maknamsw = "1"b; 2120 go to make_new; 2121 2122 2123 end get_atom; 2124 2125 /* ext entry to compute hash function - used by lisp_obarray_utils_ */ 2126 /****** KLUDGE: unlike lisp_get_atom_, this entry assumes that the extra 2127* bits in the last word of the pname have already been zeroed *******/ 2128 2129 hash_fcn: entry(name, a_indx); 2130 2131 dcl a_indx fixed bin; /* name char(*) aligned */ 2132 2133 pnp = addr(name); 2134 if length(name) = 0 then indx = 511; 2135 else if length(name) = 1 & rank (substr (name, 1, 1)) <= 127 2136 then indx = 511 + rank (substr (name, 1, 1)); 2137 else do; 2138 indx = 0; 2139 do cnt = 0 to divide(length(name)-1, 4, 17, 0); 2140 indx = indx + addrel(pnp, cnt) -> name_word; 2141 end; 2142 indx = mod(indx, 509); 2143 end; 2144 a_indx = indx; 2145 return; 2146 2147 end; 2148 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.4 lisp_reader_.pl1 >special_ldd>on>06/27/83>lisp_reader_.pl1 147 1 03/27/82 0437.0 lisp_bignum_io_data.incl.pl1 >ldd>include>lisp_bignum_io_data.incl.pl1 148 2 03/27/82 0437.0 lisp_bignum_fmt.incl.pl1 >ldd>include>lisp_bignum_fmt.incl.pl1 195 3 06/29/83 1425.3 lisp_name_codes.incl.pl1 >ldd>include>lisp_name_codes.incl.pl1 196 4 03/27/82 0437.0 lisp_faults.incl.pl1 >ldd>include>lisp_faults.incl.pl1 198 5 03/27/82 0437.0 lisp_io.incl.pl1 >ldd>include>lisp_io.incl.pl1 5-5 6 03/27/82 0437.0 lisp_iochan.incl.pl1 >ldd>include>lisp_iochan.incl.pl1 5-45 7 03/27/82 0437.0 lisp_control_chars.incl.pl1 >ldd>include>lisp_control_chars.incl.pl1 199 8 03/27/82 0437.1 lisp_array_fmt.incl.pl1 >ldd>include>lisp_array_fmt.incl.pl1 200 9 03/27/82 0437.0 lisp_readtable.incl.pl1 >ldd>include>lisp_readtable.incl.pl1 223 10 03/27/82 0437.0 lisp_stack_fmt.incl.pl1 >ldd>include>lisp_stack_fmt.incl.pl1 224 11 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 225 12 03/27/82 0437.0 lisp_nums.incl.pl1 >ldd>include>lisp_nums.incl.pl1 226 13 03/27/82 0437.0 lisp_cons_fmt.incl.pl1 >ldd>include>lisp_cons_fmt.incl.pl1 227 14 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 228 15 03/27/82 0437.1 lisp_atom_fmt.incl.pl1 >ldd>include>lisp_atom_fmt.incl.pl1 229 16 03/27/82 0437.0 lisp_error_codes.incl.pl1 >ldd>include>lisp_error_codes.incl.pl1 230 17 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) Alarmclock_fault internal static fixed bin(17,0) initial dcl 4-10 Array internal static bit(9) initial unaligned dcl 14-17 Array36 constant bit(36) initial dcl 14-17 ref 1163 1208 Array_fault internal static fixed bin(17,0) initial dcl 4-10 Atomic internal static bit(9) initial unaligned dcl 14-17 Atomic36 internal static bit(36) initial dcl 14-17 Atsym constant bit(9) initial unaligned dcl 14-17 ref 318 1032 1070 2071 Atsym36 constant bit(36) initial dcl 14-17 ref 382 Bigfix internal static bit(9) initial unaligned dcl 14-17 Bigfix36 internal static bit(36) initial dcl 14-17 Bignum internal static bit(9) initial unaligned dcl 14-17 Bignum36 internal static bit(36) initial dcl 14-17 Car_cdr_fault internal static fixed bin(17,0) initial dcl 4-10 Cons constant bit(9) initial unaligned dcl 14-17 ref 252 252 375 533 649 649 704 1771 1771 Cons36 internal static bit(36) initial dcl 14-17 Cput_fault internal static fixed bin(17,0) initial dcl 4-10 Dead_array internal static fixed bin(17,0) initial dcl 8-20 File internal static bit(9) initial unaligned dcl 14-17 File36 constant bit(36) initial dcl 14-17 ref 1115 1839 1848 1857 Fixed constant bit(9) initial unaligned dcl 14-17 ref 1064 Fixed36 constant bit(36) initial dcl 14-17 ref 376 1353 1380 Fixnum_array internal static fixed bin(17,0) initial dcl 8-20 Float internal static bit(9) initial unaligned dcl 14-17 Float36 constant bit(36) initial dcl 14-17 ref 957 Flonum_array internal static fixed bin(17,0) initial dcl 8-20 NotConsOrAtsym36 internal static bit(36) initial dcl 14-17 Numeric internal static bit(9) initial unaligned dcl 14-17 Numeric36 internal static bit(36) initial dcl 14-17 Obarray_array constant fixed bin(17,0) initial dcl 8-20 ref 1213 Old_store_fault internal static fixed bin(17,0) initial dcl 4-10 Pi_fault internal static fixed bin(17,0) initial dcl 4-10 Quit_fault internal static fixed bin(17,0) initial dcl 4-10 Readtable_array constant fixed bin(17,0) initial dcl 8-20 ref 1170 S_expr_array internal static fixed bin(17,0) initial dcl 8-20 String constant bit(9) initial unaligned dcl 14-17 ref 318 415 818 String36 internal static bit(36) initial dcl 14-17 Subr internal static bit(9) initial unaligned dcl 14-17 Subr36 internal static bit(36) initial dcl 14-17 SubrNumeric36 internal static bit(36) initial dcl 14-17 System_Subr internal static bit(9) initial unaligned dcl 14-17 System_Subr36 internal static bit(36) initial dcl 14-17 Un_gc_array internal static fixed bin(17,0) initial dcl 8-20 Uncollectable internal static bit(9) initial unaligned dcl 14-17 Undefined 000022 constant bit(72) initial unaligned dcl 14-17 ref 2074 Underflow_fault internal static fixed bin(17,0) initial dcl 4-10 ZERO internal static fixed bin(17,0) initial dcl 8-37 Zerodivide_fault internal static fixed bin(17,0) initial dcl 4-10 a_char 000406 automatic char(1) unaligned dcl 2095 set ref 2106* 2107 a_indx parameter fixed bin(17,0) dcl 2131 set ref 2129 2144* add builtin function dcl 67 ref 1408 1414 addr builtin function dcl 67 ref 250 266 287 289 290 301 352 356 378 382 413 501 506 531 567 570 599 615 631 685 686 705 853 995 1010 1013 1065 1073 1078 1108 1110 1110 1113 1115 1115 1115 1163 1163 1170 1175 1175 1175 1181 1185 1208 1208 1213 1221 1225 1245 1262 1263 1341 1380 1380 1393 1393 1393 1487 1488 1489 1573 1574 1575 1580 1583 1585 1587 1591 1594 1596 1598 1609 1610 1611 1663 1664 1664 1665 1665 1666 1666 1736 1755 1783 1800 1834 1861 1868 1873 1874 1878 1883 1884 1886 1894 1896 1910 1956 1962 1963 1966 1993 1994 2035 2048 2082 2085 2099 2101 2107 2133 addrel builtin function dcl 67 ref 243 317 323 341 370 431 490 530 566 598 601 614 617 630 666 670 688 693 694 976 1259 1261 1287 1352 1357 1387 1677 1702 1749 1758 1767 1790 1832 1833 1869 1876 1909 1933 1944 2026 2028 2140 alpha constant bit(27) initial unaligned dcl 9-27 ref 1493 alpha2 constant bit(27) initial unaligned dcl 206 ref 459 argument_must_be_array internal static fixed bin(17,0) initial dcl 16-8 array based pointer level 2 dcl 142 set ref 1703* array_atom defined fixed bin(71,0) dcl 11-6 ref 1183 1223 array_bound_error internal static fixed bin(17,0) initial dcl 16-8 array_data based structure level 1 dcl 8-31 array_data_ptr 2 based pointer level 2 dcl 8-8 ref 1175 2035 2082 2085 2099 array_info based structure level 1 dcl 8-8 array_too_big internal static fixed bin(17,0) initial dcl 16-8 ascii 002377 constant entry external dcl 1348 ascii_err 002416 constant label dcl 1355 ref 1365 1366 ascii_retry 002404 constant label dcl 1350 ref 1361 atan_0_0_err internal static fixed bin(17,0) initial dcl 16-8 atom based structure level 1 dcl 15-5 in procedure "read" atom 2 based fixed bin(71,0) array level 2 in structure "bindings" dcl 10-7 in procedure "read" set ref 1871* 1872* 1873 1874 1894 1896 atom_double_words based structure level 1 dcl 15-5 atom_ptrs based structure level 1 dcl 15-5 atom_rtn 000013 constant label array(2) dcl 2091 ref 2043 2060 2089 auto_readlist_data_struc 000164 automatic structure level 1 dcl 102 set ref 352 b 0(27) based char(1) level 2 packed unaligned dcl 33 set ref 382* 413 995* 1010 1013 1073* 1663* 1664 1664 1665 1665 1666 1666 1736* 1755 b2 000132 automatic bit(27) unaligned dcl 67 set ref 770* 774 1430* 1454 1462 back_ptr 1 based bit(18) level 2 packed unaligned dcl 10-7 set ref 1879* 1898 bad_arg_correctable constant fixed bin(17,0) initial dcl 16-8 ref 324 1288 1358 bad_argument internal static fixed bin(17,0) initial dcl 16-8 bad_array_subscript internal static fixed bin(17,0) initial dcl 16-8 bad_base internal static fixed bin(17,0) initial dcl 16-8 bad_bv internal static fixed bin(17,0) initial dcl 16-8 bad_do_format internal static fixed bin(17,0) initial dcl 16-8 bad_entry_name internal static fixed bin(17,0) initial dcl 16-8 bad_f_fcn internal static fixed bin(17,0) initial dcl 16-8 bad_function internal static fixed bin(17,0) initial dcl 16-8 bad_ibase constant fixed bin(17,0) initial dcl 16-8 ref 1388 bad_ibase_ 002456 constant label dcl 1383 ref 1394 1395 bad_input_source internal static fixed bin(17,0) initial dcl 16-8 bad_mac 002074 constant label dcl 873 ref 837 845 846 849 850 bad_output_dest internal static fixed bin(17,0) initial dcl 16-8 bad_prog_op internal static fixed bin(17,0) initial dcl 16-8 badmacro constant fixed bin(17,0) initial dcl 16-8 ref 257 875 badobarray constant fixed bin(17,0) initial dcl 16-8 ref 1228 badreadlist constant fixed bin(17,0) initial dcl 16-8 ref 1904 badreadtable constant fixed bin(17,0) initial dcl 16-8 ref 1188 base defined fixed bin(71,0) dcl 5-17 based_ptr based pointer dcl 14-16 ref 1108 1110 1110 1113 1115 1115 1163 1170 1175 1175 1185 1208 1213 1225 1380 1393 1873 1874 1883 1884 1894 1896 2035 2082 2085 2099 bb 000101 automatic bit(27) unaligned dcl 33 set ref 278 455 459 488 491 576 576 621* 668 674 682 682 720 723 726 733 733 742 750 754 756 769 770 774 787 794 797 797 801* 802 802 808* 809 809 834 835 868* 880 898 903 905 905 910* 984* 1021* 1022 1043* 1059* 1084* 1132 1306 1318 1318 1326 1404 1423 1430 1435 1444 1444 1447 1462* 1468 1468 1493 1503 1511 1526 1527 1536 1815 1827* bb_wanted 000133 automatic bit(27) unaligned dcl 67 set ref 1309* 1326 bfb based fixed bin(17,0) dcl 88 bigdn 000140 automatic fixed bin(71,0) dcl 67 set ref 1408* 1409 1411 bign 000136 automatic fixed bin(71,0) dcl 67 set ref 1414* 1415 1416 bigradix 000030 constant fixed bin(35,0) initial array dcl 1-13 ref 1704 binding_block based structure level 1 dcl 10-7 binding_top defined pointer dcl 11-6 set ref 1879 1881* 1893 1898* 1898 1898 bindings based structure array level 1 dcl 10-7 set ref 1878 bit builtin function dcl 67 bit12 constant bit(27) initial unaligned dcl 9-27 ref 491 576 726 797 802 809 1444 1468 1511 1527 bit36 automatic bit(36) dcl 67 bit36a automatic bit(36) dcl 67 blank constant bit(27) initial unaligned dcl 9-27 ref 455 bnbp 000174 automatic pointer dcl 132 set ref 1672* 1677 1685 1695 1703 bnct 000172 automatic fixed bin(17,0) dcl 132 set ref 1656* 1735* 1735 1736 bndigs based fixed bin(35,0) array dcl 132 set ref 1685* 1695* bnp 000170 automatic pointer dcl 132 set ref 1658* 1701* 1702 1703 1704 1705 1736 bnreadargs based structure level 1 dcl 142 set ref 1702 bnsize 000177 automatic fixed bin(17,0) dcl 132 set ref 1674* 1675 1679 1689 1705 bot_block 0(18) based bit(18) level 2 packed unaligned dcl 10-7 set ref 1877* 1893 bothdots internal static bit(27) initial unaligned dcl 206 brkchr1 constant bit(27) initial unaligned dcl 206 ref 903 byte builtin function ref 2106 cant_filepos internal static fixed bin(17,0) initial dcl 16-8 cant_subscript_readtable internal static fixed bin(17,0) initial dcl 16-8 car based pointer level 2 in structure "cons_ptrs" dcl 13-5 in procedure "read" ref 382 1073 car based fixed bin(71,0) level 2 in structure "cons" dcl 13-5 in procedure "read" set ref 260 378 398 534 654 851 1065 1076 1776 2054 car 0(21) based bit(9) level 2 in structure "cons_types" packed unaligned dcl 13-5 in procedure "read" ref 1064 1070 car based bit(36) level 2 in structure "cons_types36" dcl 13-22 in procedure "read" ref 376 382 car_cdr_error internal static fixed bin(17,0) initial dcl 16-8 catch_frame defined pointer dcl 11-6 cde 000265 automatic fixed bin(17,0) dcl 930 set ref 950* 952 982 987 cdr 2 based fixed bin(71,0) level 2 in structure "cons" dcl 13-5 in procedure "read" set ref 387 535 541* 558* 667* 847 1088 1131 1305 2062 cdr 2(21) based bit(9) level 2 in structure "cons_types" packed unaligned dcl 13-5 in procedure "read" ref 252 649 1771 char1 automatic char(1) dcl 88 char_obj based fixed bin(71,0) dcl 2096 set ref 2102 2110* 2113 char_objects 1776 based fixed bin(71,0) array level 2 dcl 1197 set ref 2041 2079* 2101 char_read_setup 004310 constant entry internal dcl 426 ref 408 1241 1258 1336 charobjp 000410 automatic pointer dcl 2096 set ref 2101* 2102 2110 2113 charpos 13 based fixed bin(17,0) level 2 dcl 6-13 set ref 1139* check_super_match 001243 constant label dcl 584 ref 583 chrct 3 based fixed bin(21,0) level 2 dcl 96 set ref 284* 284 355* 1033 1034 1037 1038 1041* 1041 1129* 1129 1303* 1303 1458* 1458 cnt 000225 automatic fixed bin(17,0) dcl 1975 set ref 2027* 2028* 2139* 2140* code 000160 automatic fixed bin(17,0) dcl 94 set ref 257* 642* 714* 789* 875* 1188* 1228* 1640* 1901* 1904* 1907* 1916* 1919* 1922* 1925* 1934 code1 2 based fixed bin(17,0) level 2 dcl 4-25 set ref 345* cons based structure level 1 dcl 13-5 cons_ptrs based structure level 1 dcl 13-5 cons_types based structure level 1 dcl 13-5 cons_types36 based structure level 1 dcl 13-22 consptr automatic pointer dcl 13-5 ctrlD defined fixed bin(71,0) dcl 7-5 ctrlQ defined fixed bin(71,0) dcl 7-8 set ref 1108 1113 1872 1884 ctrlR defined fixed bin(71,0) dcl 7-11 ctrlW defined fixed bin(71,0) dcl 7-14 dbnf 000213 automatic bit(1) unaligned dcl 153 set ref 1400* 1409* 1621 dead_array_reference internal static fixed bin(17,0) initial dcl 16-8 decimal_bignum 003362 constant label dcl 1653 ref 1621 decimal_point constant bit(27) initial unaligned dcl 9-27 ref 750 774 794 1423 1462 1536 default_to_tty 005104 constant label dcl 1112 ref 1118 deferred_interrupt defined bit(1) dcl 4-45 digit constant bit(27) initial unaligned dcl 9-27 ref 720 733 754 774 1404 1435 digsperwd 000073 constant fixed bin(17,0) initial array dcl 1-13 ref 1673 divide builtin function dcl 67 ref 414 414 814 1674 2025 2068 2068 2139 division_by_zero internal static fixed bin(17,0) initial dcl 16-8 dn 000143 automatic fixed bin(35,0) dcl 67 set ref 1399* 1408 1411* 1439 1440* 1448 1477 1478* 1484* 1484 1489 1490* 1512 1515* 1539 1571* 1571 1573 1574 1575 1611 1622 1680* 1683* 1683 1685 1690* 1693* 1693 1695 dnum 000217 automatic bit(1) unaligned dcl 153 set ref 438* 478* 777* 1423 1431* 1438* 1455* 1486* 1512 1513* 1539 1540* 1568* 1608* 1619 1620* done_negating 003641 constant label dcl 1719 ref 1716 dot_loses 001626 constant label dcl 788 ref 649 660 661 706 784 doterror constant fixed bin(17,0) initial dcl 16-8 ref 789 dotted_pair_dot constant bit(27) initial unaligned dcl 9-27 ref 769 1454 dotted_pair_flag 1 based bit(1) level 2 dcl 153 set ref 438* 497* 514 784 786* dpw 000176 automatic fixed bin(17,0) dcl 132 set ref 1673* 1674 1674 1679 1691 drop_nl 000350 constant label dcl 295 set ref 276 418 end_maybe 001660 constant label dcl 807 ref 802 eof_hack 005416 constant entry internal dcl 1830 ref 238 407 1240 1335 eof_in_object constant fixed bin(17,0) initial dcl 16-8 ref 977 eof_retn 000352 constant label dcl 298 ref 960 987 eofhack_unbind 005604 constant entry internal dcl 1890 ref 298 1244 1339 eofstack 000114 automatic pointer dcl 33 set ref 295 301 950 957 957 1245 1246 1247 1261* 1262 1263 1265 1273 1275 1340 1833* 1834 1836 1839 1841 1842 1843 1843 1844 1848 1850 1851 1853 1853 1854 1854 1855 1855 1856 1857 1861 1868 1869 1870 1870 1883 1886 eolhacksw 000113 automatic bit(1) unaligned dcl 33 set ref 237* 359* 406* 1052 1056* 1239* 1256* 1334* err 005235 constant label dcl 1178 in procedure "set_tblp" ref 1166 1170 err 005306 constant label dcl 1218 in procedure "verify_obarray" ref 1211 1213 err_1 004020 constant label dcl 1901 ref 1062 err_2 004023 constant label dcl 1904 ref 400 1079 err_frame defined pointer dcl 11-6 err_mmsp 004026 constant label dcl 1907 ref 584 err_nlsp 004051 constant label dcl 1916 ref 592 err_qm 004054 constant label dcl 1919 ref 1771 1781 err_recp defined pointer dcl 11-6 set ref 267 271* 342 350* errcode based fixed bin(17,0) array dcl 33 set ref 324* 325* 977* 1288* 1289* 1358* 1359* 1388* 1934* error 005632 constant entry internal dcl 1930 ref 258 644 715 789 875 1189 1229 1645 1902 1905 1914 1917 1920 1923 1926 esw 000404 automatic fixed bin(17,0) dcl 2000 set ref 2008* 2043 2060 2089 2108* eval_frame defined pointer dcl 11-6 exit 000000 constant label array(0:6) dcl 252 ref 474 606 625 828 871 888 1564 1726 exitcode based fixed bin(17,0) level 2 dcl 153 set ref 249* 432* 474 494* 496* 546 555* 555 581 582 583 584 603 606 611 612 625 635* 661 689* 828 871 888 973 1564 1726 1768* exp based fixed bin(7,0) level 2 packed unaligned dcl 125 set ref 1583 1585* 1594 1596* expon_flag 000211 automatic bit(1) unaligned dcl 153 set ref 438* 478* 1427 1473 1486* 1511* 1543 1547* 1566 1568* extd_alpha constant bit(27) initial unaligned dcl 9-27 ref 910 extra_stuff based bit(36) dcl 1975 ref 2026 fault_save based structure level 1 dcl 4-25 set ref 341 fb 000100 automatic fixed bin(17,0) dcl 33 set ref 276 290 332* 378* 379 380 382 413 493 584 622* 801 808 825 826* 826 837 840 840 843* 843* 867* 873* 896 897* 897 938* 954* 983* 995 996 1002 1010 1013 1021 1042* 1043 1049* 1057* 1065* 1066 1067 1073 1084 1141 1247 1302 1321* 1321 1364* 1365 1366 1407* 1407 1408 1414 1496 1496* 1496 1497* 1497 1662* 1663 1664 1664 1665 1665 1666 1666 1683 1693 1734* 1736 1737 1737* 1737 1738 1738* 1738 1739* 1739 1755 1798 1812 1813 1826* 1911* 2100 2101 2104 2106 2110 file_is_closed internal static fixed bin(17,0) initial dcl 16-8 file_sys_fun_err internal static fixed bin(17,0) initial dcl 16-8 file_system_error internal static fixed bin(17,0) initial dcl 16-8 filepos_oob internal static fixed bin(17,0) initial dcl 16-8 firstfb 000222 automatic fixed bin(17,0) dcl 1805 set ref 1807* 1812 fixed builtin function dcl 67 ref 1042 1580 1591 fixedb 1 based fixed bin(17,0) level 2 dcl 12-4 set ref 290* 378 957 1065 1247* 1260 1294 1364 1393 1557* 1715* 1833 1835 1839 1948* 1963* fixnum_fmt based structure level 1 dcl 12-4 fixnum_type constant bit(36) initial dcl 12-4 ref 289 1246 1285 1558 1714 1947 1962 flag_reset_mask internal static bit(36) initial dcl 6-13 flags 15 based structure level 2 packed unaligned dcl 6-13 set ref 942 float builtin function dcl 67 ref 1489 1489 1611 1611 float_flag 000212 automatic bit(1) unaligned dcl 153 set ref 438* 478* 777* 1438* 1475 1486* 1568* 1606 1608* floatb 1 based float bin(27) level 2 dcl 12-4 set ref 1601* flonum_fmt based structure level 1 dcl 12-4 flonum_out_of_range 003357 constant label dcl 1640 ref 1487 1488 1584 1595 flonum_out_of_range_1 003357 constant label dcl 1640 ref 1573 1574 flonum_out_of_range_2 003357 constant label dcl 1640 ref 1609 1610 flonum_too_big constant fixed bin(17,0) initial dcl 16-8 ref 1640 flonum_type constant bit(36) initial dcl 12-4 ref 1602 fn 000146 automatic float bin(50) dcl 67 set ref 1489* 1575* 1575 1576 1580 1583 1585 1587 1591 1594 1596 1598 1601 1611* 1613* 1613 fn_CtoI internal static fixed bin(17,0) initial dcl 3-9 fn_ItoC internal static fixed bin(17,0) initial dcl 3-9 fn_abs internal static fixed bin(17,0) initial dcl 3-9 fn_add1 internal static fixed bin(17,0) initial dcl 3-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 3-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 3-9 fn_alarmclock internal static fixed bin(17,0) initial dcl 3-9 fn_allfiles internal static fixed bin(17,0) initial dcl 3-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 3-9 fn_apply internal static fixed bin(17,0) initial dcl 3-9 fn_arg internal static fixed bin(17,0) initial dcl 3-9 fn_args internal static fixed bin(17,0) initial dcl 3-9 fn_array internal static fixed bin(17,0) initial dcl 3-9 fn_arraydims internal static fixed bin(17,0) initial dcl 3-9 fn_ascii constant fixed bin(17,0) initial dcl 3-9 ref 1359 fn_atan internal static fixed bin(17,0) initial dcl 3-9 fn_baktrace internal static fixed bin(17,0) initial dcl 3-9 fn_bltarray internal static fixed bin(17,0) initial dcl 3-9 fn_boole internal static fixed bin(17,0) initial dcl 3-9 fn_boundp internal static fixed bin(17,0) initial dcl 3-9 fn_catch internal static fixed bin(17,0) initial dcl 3-9 fn_catenate internal static fixed bin(17,0) initial dcl 3-9 fn_charpos internal static fixed bin(17,0) initial dcl 3-9 fn_chrct internal static fixed bin(17,0) initial dcl 3-9 fn_clear_input internal static fixed bin(17,0) initial dcl 3-9 fn_cline internal static fixed bin(17,0) initial dcl 3-9 fn_close internal static fixed bin(17,0) initial dcl 3-9 fn_cos internal static fixed bin(17,0) initial dcl 3-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 3-9 fn_defaultf internal static fixed bin(17,0) initial dcl 3-9 fn_definedp internal static fixed bin(17,0) initial dcl 3-9 fn_defsubr internal static fixed bin(17,0) initial dcl 3-9 fn_defun internal static fixed bin(17,0) initial dcl 3-9 fn_delete internal static fixed bin(17,0) initial dcl 3-9 fn_deletef internal static fixed bin(17,0) initial dcl 3-9 fn_delq internal static fixed bin(17,0) initial dcl 3-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 3-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 3-9 fn_difference internal static fixed bin(17,0) initial dcl 3-9 fn_displace internal static fixed bin(17,0) initial dcl 3-9 fn_do internal static fixed bin(17,0) initial dcl 3-9 fn_dumparrays internal static fixed bin(17,0) initial dcl 3-9 fn_endpagefn internal static fixed bin(17,0) initial dcl 3-9 fn_eoffn internal static fixed bin(17,0) initial dcl 3-9 fn_eql internal static fixed bin(17,0) initial dcl 3-9 fn_errframe internal static fixed bin(17,0) initial dcl 3-9 fn_errprint internal static fixed bin(17,0) initial dcl 3-9 fn_errset internal static fixed bin(17,0) initial dcl 3-9 fn_eval internal static fixed bin(17,0) initial dcl 3-9 fn_eval_when internal static fixed bin(17,0) initial dcl 3-9 fn_evalframe internal static fixed bin(17,0) initial dcl 3-9 fn_exp internal static fixed bin(17,0) initial dcl 3-9 fn_expt internal static fixed bin(17,0) initial dcl 3-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 3-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 3-9 fn_filepos internal static fixed bin(17,0) initial dcl 3-9 fn_fillarray internal static fixed bin(17,0) initial dcl 3-9 fn_fix internal static fixed bin(17,0) initial dcl 3-9 fn_float internal static fixed bin(17,0) initial dcl 3-9 fn_force_output internal static fixed bin(17,0) initial dcl 3-9 fn_freturn internal static fixed bin(17,0) initial dcl 3-9 fn_fsc internal static fixed bin(17,0) initial dcl 3-9 fn_gcd internal static fixed bin(17,0) initial dcl 3-9 fn_gensym internal static fixed bin(17,0) initial dcl 3-9 fn_get internal static fixed bin(17,0) initial dcl 3-9 fn_get_pname internal static fixed bin(17,0) initial dcl 3-9 fn_getchar internal static fixed bin(17,0) initial dcl 3-9 fn_getl internal static fixed bin(17,0) initial dcl 3-9 fn_greaterp internal static fixed bin(17,0) initial dcl 3-9 fn_gt internal static fixed bin(17,0) initial dcl 3-9 fn_haipart internal static fixed bin(17,0) initial dcl 3-9 fn_haulong internal static fixed bin(17,0) initial dcl 3-9 fn_ifix internal static fixed bin(17,0) initial dcl 3-9 fn_in internal static fixed bin(17,0) initial dcl 3-9 fn_includef internal static fixed bin(17,0) initial dcl 3-9 fn_index internal static fixed bin(17,0) initial dcl 3-9 fn_inpush internal static fixed bin(17,0) initial dcl 3-9 fn_isqrt internal static fixed bin(17,0) initial dcl 3-9 fn_lessp internal static fixed bin(17,0) initial dcl 3-9 fn_linel internal static fixed bin(17,0) initial dcl 3-9 fn_linenum internal static fixed bin(17,0) initial dcl 3-9 fn_listarray internal static fixed bin(17,0) initial dcl 3-9 fn_listify internal static fixed bin(17,0) initial dcl 3-9 fn_loadarrays internal static fixed bin(17,0) initial dcl 3-9 fn_log internal static fixed bin(17,0) initial dcl 3-9 fn_ls internal static fixed bin(17,0) initial dcl 3-9 fn_lsh internal static fixed bin(17,0) initial dcl 3-9 fn_make_atom internal static fixed bin(17,0) initial dcl 3-9 fn_makunbound internal static fixed bin(17,0) initial dcl 3-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 3-9 fn_max internal static fixed bin(17,0) initial dcl 3-9 fn_mergef internal static fixed bin(17,0) initial dcl 3-9 fn_min internal static fixed bin(17,0) initial dcl 3-9 fn_minus internal static fixed bin(17,0) initial dcl 3-9 fn_minusp internal static fixed bin(17,0) initial dcl 3-9 fn_namelist internal static fixed bin(17,0) initial dcl 3-9 fn_names internal static fixed bin(17,0) initial dcl 3-9 fn_namestring internal static fixed bin(17,0) initial dcl 3-9 fn_nointerrupt internal static fixed bin(17,0) initial dcl 3-9 fn_nth internal static fixed bin(17,0) initial dcl 3-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 3-9 fn_oddp internal static fixed bin(17,0) initial dcl 3-9 fn_open internal static fixed bin(17,0) initial dcl 3-9 fn_opena internal static fixed bin(17,0) initial dcl 3-9 fn_openi internal static fixed bin(17,0) initial dcl 3-9 fn_openo internal static fixed bin(17,0) initial dcl 3-9 fn_out internal static fixed bin(17,0) initial dcl 3-9 fn_pagel internal static fixed bin(17,0) initial dcl 3-9 fn_pagenum internal static fixed bin(17,0) initial dcl 3-9 fn_plus internal static fixed bin(17,0) initial dcl 3-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 3-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 3-9 fn_plusp internal static fixed bin(17,0) initial dcl 3-9 fn_prin1 internal static fixed bin(17,0) initial dcl 3-9 fn_princ internal static fixed bin(17,0) initial dcl 3-9 fn_print internal static fixed bin(17,0) initial dcl 3-9 fn_prog internal static fixed bin(17,0) initial dcl 3-9 fn_progv internal static fixed bin(17,0) initial dcl 3-9 fn_putprop internal static fixed bin(17,0) initial dcl 3-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 3-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 3-9 fn_quotient internal static fixed bin(17,0) initial dcl 3-9 fn_random internal static fixed bin(17,0) initial dcl 3-9 fn_read internal static fixed bin(17,0) initial dcl 3-9 fn_read_from_string constant fixed bin(17,0) initial dcl 3-9 ref 325 fn_readch internal static fixed bin(17,0) initial dcl 3-9 fn_readstring internal static fixed bin(17,0) initial dcl 3-9 fn_remainder internal static fixed bin(17,0) initial dcl 3-9 fn_remprop internal static fixed bin(17,0) initial dcl 3-9 fn_rename internal static fixed bin(17,0) initial dcl 3-9 fn_rot internal static fixed bin(17,0) initial dcl 3-9 fn_rplaca internal static fixed bin(17,0) initial dcl 3-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 3-9 fn_save internal static fixed bin(17,0) initial dcl 3-9 fn_set internal static fixed bin(17,0) initial dcl 3-9 fn_setarg internal static fixed bin(17,0) initial dcl 3-9 fn_setq internal static fixed bin(17,0) initial dcl 3-9 fn_setsyntax internal static fixed bin(17,0) initial dcl 3-9 fn_shortnamestring internal static fixed bin(17,0) initial dcl 3-9 fn_signp internal static fixed bin(17,0) initial dcl 3-9 fn_sin internal static fixed bin(17,0) initial dcl 3-9 fn_sleep internal static fixed bin(17,0) initial dcl 3-9 fn_sort internal static fixed bin(17,0) initial dcl 3-9 fn_sortcar internal static fixed bin(17,0) initial dcl 3-9 fn_sqrt internal static fixed bin(17,0) initial dcl 3-9 fn_sstatus internal static fixed bin(17,0) initial dcl 3-9 fn_star_array internal static fixed bin(17,0) initial dcl 3-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 3-9 fn_star_sstatus internal static fixed bin(17,0) initial dcl 3-9 fn_star_status internal static fixed bin(17,0) initial dcl 3-9 fn_status internal static fixed bin(17,0) initial dcl 3-9 fn_store internal static fixed bin(17,0) initial dcl 3-9 fn_stringlength internal static fixed bin(17,0) initial dcl 3-9 fn_sub1 internal static fixed bin(17,0) initial dcl 3-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 3-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 3-9 fn_substr internal static fixed bin(17,0) initial dcl 3-9 fn_sxhash internal static fixed bin(17,0) initial dcl 3-9 fn_sysp internal static fixed bin(17,0) initial dcl 3-9 fn_throw internal static fixed bin(17,0) initial dcl 3-9 fn_times internal static fixed bin(17,0) initial dcl 3-9 fn_times_fix internal static fixed bin(17,0) initial dcl 3-9 fn_times_flo internal static fixed bin(17,0) initial dcl 3-9 fn_truename internal static fixed bin(17,0) initial dcl 3-9 fn_tyi internal static fixed bin(17,0) initial dcl 3-9 fn_tyipeek constant fixed bin(17,0) initial dcl 3-9 ref 1289 fn_tyo internal static fixed bin(17,0) initial dcl 3-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 3-9 fn_zerop internal static fixed bin(17,0) initial dcl 3-9 fnx based structure level 1 dcl 125 forced_num 000207 automatic bit(1) unaligned dcl 153 set ref 438* 743* 1470 1493 1520 1560* 1723* forcefeed internal static bit(27) initial unaligned dcl 9-27 fpdigits 000151 automatic fixed bin(17,0) dcl 67 set ref 1401* 1412* 1412 1441* 1479* 1487 1488 1489 1609 1610 1611 g0001 004504 constant label dcl 973 ref 972 g0002 005456 constant label dcl 1843 ref 1839 1841 gc_inhibit defined bit(1) dcl 4-45 ref 344 get_another 004330 constant label dcl 893 ref 914 get_atom 005655 constant entry internal dcl 1998 ref 391 471 1822 1995 get_atom_join 005661 constant label dcl 2010 ref 2109 get_ibase 002450 constant label dcl 1380 ref 1391 get_sing_char 006154 constant entry internal dcl 2093 ref 334 874 881 1342 1367 1908 1912 getbnc 005336 constant entry internal dcl 1732 ref 1667 1682 1692 goodbegin 000025 constant bit(27) initial unaligned dcl 206 ref 787 got_list 000203 automatic bit(1) unaligned dcl 153 set ref 276 438* 602* 624* got_macro 000201 automatic bit(1) unaligned dcl 153 set ref 252 438* 520 521* 649 656* 659* 869* 1771 1778* got_something 000202 automatic bit(1) unaligned dcl 153 set ref 262 438* 469* 524* 560* 565 597* 623* 656* 660 703* 819* 869* 1561* 1724* 1778* 1781 got_splice 000200 automatic bit(1) unaligned dcl 153 set ref 252 522 649 684* 703* 835* 836* 1320* 1771 1791* 1824* hash_fcn 004216 constant entry external dcl 2129 hash_table based fixed bin(71,0) array level 2 dcl 1197 set ref 2051 2083 2086* hbound builtin function dcl 67 ref 1488 1574 1610 htptr 000220 automatic pointer dcl 1197 set ref 2035* 2041 2051 2079 2082* 2083 2085* 2086 2099* 2101 i 000152 automatic fixed bin(17,0) dcl 88 set ref 1548* 1681* 1691* ib 000150 automatic fixed bin(17,0) dcl 67 set ref 1393* 1394 1395 1414 1549 1653* 1673 1683 1693 1704 ibase defined fixed bin(71,0) dcl 5-17 set ref 1380 1393 ibv based fixed bin(17,0) dcl 67 ref 1393 ill_obj 004057 constant label dcl 1922 ref 764 1423 1428 1435 1473 1474 1504 1520 1541 illobj constant fixed bin(17,0) initial dcl 16-8 ref 1922 implode 000565 constant entry external dcl 367 implode_sw 000110 automatic bit(1) unaligned dcl 33 set ref 364* 369* 391 in_middle 000216 automatic bit(1) unaligned dcl 153 set ref 422* 428* 438* 727* 729* 751* 753* 771* 773* 798* 813* 972 1808* 1821* include_file_error internal static fixed bin(17,0) initial dcl 16-8 increment_input_ptr 005133 constant entry internal dcl 1127 ref 1319 1327 indx 000224 automatic fixed bin(17,0) dcl 1975 set ref 2010* 2022* 2026* 2028* 2028 2030* 2030 2040 2041 2051 2079 2079 2083 2086 2134* 2135* 2138* 2140* 2140 2142* 2142 2144 infile defined fixed bin(71,0) dcl 33 set ref 1110 1110 1115 1115 1871 1883 inlist based pointer level 2 in structure "readlist_data_struc" dcl 96 in procedure "read" set ref 353* 1104 inlist 000156 automatic pointer dcl 88 in procedure "read" set ref 265 266 288 292 317* 318 318 330 333 353 1032 1033 1034 1037 1038 1046 1064 1065 1070 1073 1076 1076 1078 1088 1088 1104* 1131 1131 1305 1305 1432 1459 inp 000130 automatic pointer dcl 33 set ref 278 278 942 942* 948 948 950* 965 994 994 995 995 995 1010 1108* 1112* 1115* 1139 1140 1143 1143 1144 1145 1145 1147 1149 1149 1269 1269 1456 1456 input_buffer_overlay based char dcl 930 ref 995 interactive 15(04) based bit(1) level 3 packed unaligned dcl 6-13 ref 965 io_wrong_direction internal static fixed bin(17,0) initial dcl 16-8 ioa_ 000026 constant entry external dcl 106 ref 1010 1012 iochan based structure level 1 dcl 6-13 ioindex based fixed bin(24,0) level 2 dcl 6-13 set ref 278* 278 948 994* 994 995 1269* 1269 1456* 1456 iolength 1 based fixed bin(24,0) level 2 dcl 6-13 ref 948 995 ioptr 2 based pointer level 2 dcl 6-13 ref 995 ios_$read 000000 constant entry external dcl 106 iostatus automatic bit(72) dcl 88 jwnumchar constant bit(27) initial unaligned dcl 206 ref 733 jwnumchar2 constant bit(27) initial unaligned dcl 206 ref 742 kludge_structure based structure level 1 dcl 33 kludgey_mask 000015 constant bit(36) initial array dcl 1975 ref 2026 lbound builtin function dcl 67 ref 1487 1573 1609 left_super 2 based fixed bin(17,0) level 2 dcl 153 set ref 492* length builtin function dcl 67 ref 1992 2134 2135 2139 linenum 33 based fixed bin(17,0) level 2 dcl 6-13 set ref 1143* 1143 1145 1147* lisp_$apply 000022 constant entry external dcl 106 ref 861 lisp_alloc_ 000032 constant entry external dcl 106 ref 414 814 2068 lisp_alloc_$gensym 000030 constant entry external dcl 106 ref 1949 lisp_array_fcns_$star_array 000044 constant entry external dcl 106 ref 1964 lisp_bignum based structure level 1 dcl 2-3 lisp_bignums_$bnread 000034 constant entry external dcl 106 ref 1706 lisp_error_ 000024 constant entry external dcl 106 ref 326 978 1290 1360 1389 1935 lisp_fault_handler_$ctrl_from_reader 000046 constant entry external dcl 185 ref 1013 lisp_fault_handler_$set_mask 000000 constant entry external dcl 4-45 lisp_get_atom_ 004165 constant entry external dcl 1969 lisp_io_control_$end_of_block 000124 constant entry external dcl 930 ref 950 lisp_io_control_$fix_not_ok_iochan 000122 constant entry external dcl 930 ref 942 lisp_io_man_$free_uread_chan 000000 constant entry external dcl 106 lisp_list_utils_$subst 000000 constant entry external dcl 106 lisp_property_fns_$get 000036 constant entry external dcl 106 ref 1184 1224 lisp_property_fns_$putprop 000000 constant entry external dcl 106 lisp_ptr based structure level 1 dcl 14-17 lisp_ptr_type based bit(36) dcl 14-17 ref 1115 1163 1208 lisp_reader_alm_$left_shift 000052 constant entry external dcl 191 ref 1554 lisp_reader_alm_$powers_of_ten 000050 external static fixed bin(17,0) dcl 191 set ref 1487 1488 1489 1573 1574 1575 1609 1610 1611 lisp_special_fns_$cons 000042 constant entry external dcl 106 ref 291 633 1787 1788 1913 2084 lisp_special_fns_$ncons 000040 constant entry external dcl 106 ref 537 568 lisp_static_vars_$array_atom 000114 external static fixed bin(71,0) dcl 11-6 ref 1183 1183 1223 1223 lisp_static_vars_$base external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$binding_top 000110 external static pointer dcl 11-6 set ref 1879 1879 1881* 1881 1893 1893 1898* 1898 1898 1898 1898 1898 lisp_static_vars_$catch_frame external static pointer dcl 11-6 lisp_static_vars_$ctrlD external static fixed bin(71,0) dcl 7-5 lisp_static_vars_$ctrlQ 000076 external static fixed bin(71,0) dcl 7-8 ref 1108 1108 1113 1113 1872 1872 1884 1884 lisp_static_vars_$ctrlR external static fixed bin(71,0) dcl 7-11 lisp_static_vars_$ctrlW external static fixed bin(71,0) dcl 7-14 lisp_static_vars_$deferred_interrupt external static bit(1) dcl 4-45 lisp_static_vars_$err_frame external static pointer dcl 11-6 lisp_static_vars_$err_recp 000100 external static pointer dcl 11-6 set ref 267 267 271* 271 342 342 350* 350 lisp_static_vars_$eval_frame external static pointer dcl 11-6 lisp_static_vars_$garbage_collect_inhibit 000054 external static bit(1) dcl 4-45 ref 344 344 lisp_static_vars_$ibase 000066 external static fixed bin(71,0) dcl 5-17 ref 1380 1380 1393 1393 lisp_static_vars_$infile 000012 external static fixed bin(71,0) dcl 33 ref 1110 1110 1110 1110 1115 1115 1115 1115 1871 1871 1883 1883 lisp_static_vars_$iochan_list external static pointer dcl 11-6 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 11-6 lisp_static_vars_$masked external static structure level 1 dcl 4-45 lisp_static_vars_$nil 000116 external static fixed bin(71,0) dcl 11-6 ref 330 330 498 498 532 532 539 539 632 632 733 733 845 845 849 849 860 860 1108 1108 1110 1110 1113 1113 1185 1185 1225 1225 1784 1784 1799 1799 1836 1836 1842 1842 1844 1844 1850 1850 1856 1856 1946 1946 1961 1961 2042 2042 2051 2051 2077 2077 2102 2102 lisp_static_vars_$obarray 000112 external static fixed bin(71,0) dcl 11-6 ref 1208 1208 1213 1213 1222 1222 1225 1225 2035 2035 2082 2082 2085 2085 2099 2099 lisp_static_vars_$pending_ctrl external static bit(1) dcl 4-45 lisp_static_vars_$plus_status 000074 external static fixed bin(71,0) dcl 5-17 ref 733 733 lisp_static_vars_$prog_frame external static pointer dcl 11-6 lisp_static_vars_$quote_atom 000070 external static fixed bin(71,0) dcl 5-17 ref 1786 1786 lisp_static_vars_$quote_macro 000014 external static fixed bin(71,0) dcl 63 ref 854 lisp_static_vars_$rdr_label 000056 external static label variable dcl 4-45 set ref 269* 269 347 347 lisp_static_vars_$rdr_ptr 000060 external static pointer dcl 4-45 set ref 270* 270 348 348 356* 356 1103 1103 lisp_static_vars_$rdr_state 000062 external static fixed bin(17,0) dcl 4-45 set ref 268* 268 349 349 357* 357 1100 1100 lisp_static_vars_$read_print_nl_sync 000064 external static bit(36) unaligned dcl 5-17 set ref 965* 965 lisp_static_vars_$readtable 000072 external static fixed bin(71,0) dcl 5-17 ref 1163 1163 1170 1170 1175 1175 1182 1182 1185 1185 1958 lisp_static_vars_$s_atom external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$semicolon_macro 000016 external static fixed bin(71,0) dcl 63 ref 856 lisp_static_vars_$stack_ptr 000102 external static pointer dcl 11-6 set ref 250* 250 266* 266 287* 287 301* 301 316 316 370 370 501* 501 531* 531 567* 567 570* 570 599* 599 615* 615 631* 631 685* 685 705* 705 853* 853 1078* 1078 1178 1178 1181* 1181 1218 1218 1221* 1221 1245* 1245 1259 1259 1262* 1262 1341* 1341 1352 1352 1700* 1700 1783* 1783 1800* 1800 1832 1832 1834* 1834 1868* 1868 1893 1893 1910* 1910 1944 1944 1956* 1956 1966* 1966 2046 2046 2048* 2048 2059* 2059 2087* 2087 lisp_static_vars_$star_rset external static fixed bin(71,0) dcl 11-45 lisp_static_vars_$status_gctwa external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$stnopoint external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$t_atom 000104 external static fixed bin(71,0) dcl 11-6 ref 1110 1110 1265 1265 1275 1275 1278 1278 1841 1841 1851 1851 1884 1884 1951 1951 1959 1959 lisp_static_vars_$top_level external static label variable dcl 11-6 lisp_static_vars_$tty_atom external static fixed bin(71,0) dcl 5-17 lisp_static_vars_$tty_input_chan 000120 external static pointer dcl 11-6 ref 1010 1010 1108 1108 1112 1112 lisp_static_vars_$tty_output_chan external static pointer dcl 11-6 lisp_static_vars_$unmkd_ptr 000106 external static pointer dcl 11-6 set ref 242 242 243* 243 272* 272 300* 300 322 322 323* 323 340 340 341* 341 373 373 393* 393 430 430 431* 431 473* 473 489 489 490* 490 600* 600 616* 616 687 687 688* 688 691* 691 820* 820 975 975 976* 976 1248* 1248 1257 1257 1286 1286 1287* 1287 1343* 1343 1355 1355 1357* 1357 1386 1386 1387* 1387 1562* 1562 1672 1672 1677* 1677 1701 1701 1702* 1702 1707* 1707 1748 1748 1749* 1749 1758* 1758 1758 1758 1764 1764 1767* 1767 1789* 1789 1823* 1823 1862 1862 1875 1875 1876* 1876 1932 1932 1933* 1933 lisp_static_vars_$unwp_frame external static pointer dcl 11-6 lisp_static_vars_$user_intr_array external static fixed bin(71,0) array dcl 11-45 lisp_static_vars_$vertical_bar_macro 000020 external static fixed bin(71,0) dcl 63 ref 858 lisp_string based structure level 1 dcl 17-6 list1exit constant fixed bin(17,0) initial dcl 153 ref 496 546 582 661 listexit constant fixed bin(17,0) initial dcl 153 ref 581 603 location parameter fixed bin(71,0) dcl 1975 set ref 1969 1994 lparn constant bit(27) initial unaligned dcl 9-27 ref 488 macro constant bit(27) initial unaligned dcl 9-27 ref 682 834 1318 macro_table based fixed bin(71,0) array level 2 dcl 9-11 set ref 840 make_fake_mantissa 002705 constant label dcl 1477 ref 1446 make_lisp_subr_block_$make_array 000000 constant entry external dcl 106 make_name 006226 constant entry internal dcl 2117 ref 392 make_new 006034 constant label dcl 2068 ref 2042 2120 make_new_sing_char 006176 constant label dcl 2104 ref 2100 makgensym 004105 constant label dcl 1947 ref 1953 maknam 000555 constant entry external dcl 362 maknam_joint 000574 constant label dcl 370 ref 365 maknamloss 000662 constant label dcl 398 ref 379 380 384 maknamsw 000405 automatic bit(1) initial unaligned dcl 2000 set ref 2000* 2078 2119* makreadtable 004067 constant entry external dcl 1940 mantissa 0(09) based bit(28) level 2 packed unaligned dcl 125 set ref 1580 1587* 1591 1598* masked based structure level 1 dcl 4-45 max builtin function dcl 67 minus_flag 000206 automatic bit(1) unaligned dcl 153 set ref 438* 478* 726* 738* 758* 1481 1482* 1507 1508* 1527* 1541 1569 1570* 1612 1614* 1630 1632* 1708 1709* mismatch_super_parens constant fixed bin(17,0) initial dcl 16-8 ref 1907 mod builtin function dcl 67 ref 2030 2142 more_macros 20 based fixed bin(71,0) level 2 dcl 9-11 set ref 842 multiply builtin function dcl 67 n 000142 automatic fixed bin(35,0) dcl 67 set ref 1398* 1414 1416* 1448* 1490* 1509* 1509 1512 1515* 1539* 1548 1554* 1583* 1584 1585 1594* 1595 1596 1629 1675* 1676 1676* 1676 1677 n4f 000135 automatic fixed bin(35,0) dcl 67 set ref 778* 1439* 1477* 1483* 1483 1489 1611 name parameter char dcl 1975 set ref 1969 1992 1993 2129 2133 2134 2135 2135 2135 2139 name_word based fixed bin(35,0) dcl 1975 ref 2028 2140 namelen 000223 automatic fixed bin(17,0) dcl 1975 set ref 2025* 2026 2026 2027 nbrkchr 000024 constant bit(27) initial unaligned dcl 206 ref 905 new_page 005201 constant label dcl 1147 ref 1141 newline constant char(1) initial unaligned dcl 59 ref 413 nihil_ex_nihile internal static fixed bin(17,0) initial dcl 16-8 nil defined fixed bin(71,0) dcl 11-6 ref 330 498 532 539 632 733 845 849 860 1108 1110 1113 1185 1225 1784 1799 1836 1842 1844 1850 1856 1946 1961 2042 2051 2077 2102 nil_ptr based pointer dcl 11-6 nlsync 15(06) based bit(1) level 3 packed unaligned dcl 6-13 set ref 1140* nmargs 000144 automatic fixed bin(35,0) dcl 67 set ref 1260* 1261 1264 1280* 1294* 1296 1302 1309 nn 000134 automatic fixed bin(35,0) dcl 67 set ref 1512* 1512* 1549* 1549 1554* 1557 1580* 1581 1582* 1582 1587 1591* 1592 1593* 1593 1598 1622* 1629* 1631* 1631 1679* 1681 1689* 1695* no_left_super_paren constant fixed bin(17,0) initial dcl 16-8 ref 1916 no_lexpr internal static fixed bin(17,0) initial dcl 16-8 nonfixedarg internal static fixed bin(17,0) initial dcl 16-8 not_alpha_array internal static fixed bin(17,0) initial dcl 16-8 not_an_array internal static fixed bin(17,0) initial dcl 16-8 not_ok_to_read constant bit(36) initial unaligned dcl 5-9 ref 942 not_ok_to_read_fixnum internal static bit(36) initial unaligned dcl 5-11 not_ok_to_write internal static bit(36) initial unaligned dcl 5-9 not_ok_to_write_fixnum internal static bit(36) initial unaligned dcl 5-11 not_pdl_ptr internal static fixed bin(17,0) initial dcl 16-8 not_really_a_number 003030 constant label dcl 1520 ref 1465 not_same_type internal static fixed bin(17,0) initial dcl 16-8 nspblnk 000027 constant bit(27) initial unaligned dcl 206 ref 278 621 null builtin function dcl 67 ref 346 num_macs constant fixed bin(17,0) initial dcl 9-4 ref 840 obarray defined fixed bin(71,0) dcl 11-6 set ref 1208 1213 1222 1225 2035 2082 2085 2099 obarray_struct based structure level 1 dcl 1197 obnf 000214 automatic bit(1) unaligned dcl 153 set ref 1400* 1415* 1628 1945* 1952* 1959 obtain_pname 000776 constant label dcl 461 ref 739 old_val based fixed bin(71,0) array level 2 dcl 10-7 set ref 1873* 1874* 1894 1896 one_word_limit 000136 constant fixed bin(71,0) initial dcl 67 ref 1409 1415 origb 000116 automatic fixed bin(17,0) dcl 33 set ref 492 825* 873 896* 1807 overflow_err internal static fixed bin(17,0) initial dcl 16-8 p 000126 automatic pointer dcl 33 set ref 814* 815 816 817 pagel 32 based fixed bin(17,0) level 2 dcl 6-13 ref 1144 1145 pagenum 34 based fixed bin(17,0) level 2 dcl 6-13 set ref 1149* 1149 parenmissing constant fixed bin(17,0) initial dcl 16-8 ref 642 714 parn_missing 001352 constant label dcl 642 pdl_ptr_types36 based structure array level 1 dcl 10-7 pending_ctrl defined bit(1) dcl 4-45 plist 2 based fixed bin(71,0) level 2 dcl 15-5 set ref 2077* plus_minus constant bit(27) initial unaligned dcl 9-27 ref 723 1526 plus_status defined fixed bin(71,0) dcl 5-17 ref 733 pname 5 based char level 2 dcl 15-5 set ref 382 1034 1073 2055 2076* pname_buffer based char dcl 33 set ref 417 816 1663 1736 1755* 2022 2022 2055 2076 pnamel 4 based fixed bin(17,0) level 2 dcl 15-5 set ref 382 1033 1034 1073 2055 2055 2075* 2076 pnamelen 000122 automatic fixed bin(17,0) dcl 33 set ref 414 414 416 417 814 815 816 1663 1668* 1668 1674 1681 1736 1747* 1754* 1754 1755 1755 1756 1992* 2010 2022 2022 2022 2025 2026 2055 2055 2055 2055 2068 2068 2075 2076 2076 2076 2104* 2105* pnameput 005376 constant entry internal dcl 1752 ref 386 423 461 464 725 803 1397 1419 1434 1525 1816 pnamesetup 005364 constant entry internal dcl 1745 ref 374 410 460 724 799 1376 1809 pnp 000120 automatic pointer dcl 33 set ref 393 417 473 816 820 1562 1658 1663 1707 1748* 1749 1755 1823 1993* 2022 2022 2026 2028 2055 2076 2107* 2133* 2140 prec 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 2-3 ref 1710 prefsync 000010 internal static bit(1) initial unaligned dcl 185 set ref 1002 1002* 1005* 1008 1009* prev_frame based bit(18) level 2 packed unaligned dcl 4-25 set ref 271 342* proc_dec_point 002557 constant label dcl 1423 ref 1536 proc_macro 001753 constant label dcl 837 ref 690 1322 proc_vertical_motion 005155 constant entry internal dcl 1136 ref 1022 1132 1306 prog_frame defined pointer dcl 11-6 ptr builtin function dcl 67 ref 271 1893 1898 push_down_list_ptr_types based structure array level 1 dcl 10-7 put_stringer 001656 constant label dcl 803 ref 809 quote_atom defined fixed bin(71,0) dcl 5-17 ref 1786 quoterror constant fixed bin(17,0) initial dcl 16-8 ref 1919 quotexit constant fixed bin(17,0) initial dcl 153 ref 1768 radix 3 based fixed bin(35,0) level 2 dcl 142 set ref 1704* rank builtin function ref 2022 2022 2135 2135 rdaend 001004 constant label dcl 469 ref 759 917 rdbk 004360 constant label dcl 917 ref 903 rdbn1 003434 constant label dcl 1672 ref 1664 1665 1666 rdchar 004327 constant entry internal dcl 890 ref 454 463 499 636 676 728 752 772 1418 1433 1524 rdcom1 000214 constant label dcl 250 ref 1769 rdex 001317 constant label dcl 621 ref 603 882 rdinch 004367 constant entry internal dcl 928 ref 411 800 807 893 909 1243 1268 1300 1316 1338 1795 1810 1815 1818 rdinch_aa 004370 constant label dcl 938 ref 946 963 966 990 996 1006 1016 rdlst2 001174 constant label dcl 566 ref 522 rdlst39 001414 constant label dcl 667 ref 709 rdlst3a 001062 constant label dcl 508 ref 525 rdlst3x 001054 constant label dcl 501 ref 561 637 rdlst4 001355 constant label dcl 649 ref 514 rdlst40 001420 constant label dcl 668 ref 677 rdlst_r_p 001305 constant label dcl 614 ref 590 rdnewnum 003034 constant label dcl 1524 ref 1491 1516 rdnum 002447 constant label dcl 1376 ref 720 779 794 rdnum1 002552 constant label dcl 1418 ref 1528 rdnum1a 002520 constant label dcl 1404 ref 1420 1530 rdnum2 002450 constant label dcl 1380 ref 733 744 rdnum4 003047 constant label dcl 1536 ref 920 1463 rdnum5 002523 constant label dcl 1407 ref 1442 1498 rdnumalph 002754 constant label dcl 1493 ref 1468 1470 rdnumo 001016 constant label dcl 478 ref 1500 1522 rdnumo_aa 000777 constant label dcl 462 ref 483 rdnumss 003000 constant label dcl 1506 ref 1449 rdobj 000767 constant label dcl 455 ref 508 657 791 1779 rdobj0 000750 constant label dcl 438 ref 251 261 262 rdobj1 000766 constant label dcl 454 ref 455 rdobj5 001607 constant label dcl 777 ref 754 rdr_label defined label variable dcl 4-45 set ref 269* 347 rdr_ptr defined pointer dcl 4-45 set ref 270* 348 356* 1103 rdr_state defined fixed bin(17,0) dcl 4-45 set ref 268* 349 357* 1100 read 000166 constant entry external dcl 6 read_1_line 003746 constant label dcl 1795 ref 1803 read_Atloop 001001 constant label dcl 463 ref 465 read_bignum 003364 constant label dcl 1656 set ref 1628 read_from_string 000365 constant entry external dcl 304 read_from_stringf 000125 automatic bit(1) unaligned dcl 33 set ref 305* 310* 318 330 354 read_print_nl_sync defined bit(36) unaligned dcl 5-17 set ref 965* read_table based structure level 1 dcl 9-11 set ref 1175 read_table_dim_vector internal static fixed bin(17,0) initial array dcl 9-7 readcom 000202 constant label dcl 242 ref 360 reading_atsym 000204 automatic bit(1) unaligned dcl 153 set ref 429* 438* 462* 470* 917 982 reading_number 000205 automatic bit(1) unaligned dcl 153 set ref 429* 438* 478* 920 982 1402* 1563* 1723* readlist 000376 constant entry external dcl 308 readlist_data_struc based structure level 1 dcl 96 set ref 356 readlist_data_strucp 000162 automatic pointer dcl 101 set ref 284 284 284 352* 353 354 355 356 1031 1033 1034 1037 1038 1041 1041 1103* 1104 1129 1129 1129 1303 1303 1303 1458 1458 1458 readlist_eof 004744 constant label dcl 1046 ref 1033 1037 readlist_join 000404 constant label dcl 311 ref 306 readlistf 000124 automatic bit(1) unaligned dcl 33 set ref 239* 264 313* readlistloses 005017 constant label dcl 1076 ref 1066 1067 readstring 000667 constant entry external dcl 403 readtable defined fixed bin(71,0) dcl 5-17 set ref 1163 1170 1175 1182 1185 real_io 000123 automatic bit(1) unaligned dcl 33 set ref 278 358* 940 1102* 1120* 1129 1138 1269 1303 1432 1456 real_readch 002345 constant entry external dcl 1331 real_tyi 002112 constant entry external dcl 1236 real_tyipeek 002144 constant entry external dcl 1251 realchar 000026 constant bit(27) initial unaligned dcl 206 ref 674 rel builtin function dcl 67 ref 342 343 1877 1878 1879 reopen_inconsistent internal static fixed bin(17,0) initial dcl 16-8 reset_tblp 005225 constant entry internal dcl 1173 ref 472 538 569 634 708 821 945 951 979 1015 1291 1390 1725 1792 1825 2114 ret_fix 003120 constant label dcl 1557 ref 1634 ret_float 003170 constant label dcl 1576 ref 1616 ret_num 003125 constant label dcl 1560 ref 1603 rev_ptr 1(18) based bit(18) level 2 packed unaligned dcl 10-7 set ref 1880* rfs_retry 000420 constant label dcl 318 ref 327 rfx 003351 constant label dcl 1630 ref 1623 right_super 3 based fixed bin(17,0) level 2 dcl 153 set ref 493* 584 1911 rparn constant bit(27) initial unaligned dcl 9-27 ref 576 668 rparn_proc 001221 constant label dcl 576 ref 671 rs_loop 000703 constant label dcl 411 ref 424 rubout internal static bit(27) initial unaligned dcl 9-27 s_atom defined fixed bin(71,0) dcl 5-17 sco 000264 automatic char(1) unaligned dcl 930 set ref 1034* 1038* 1042 semicolon_macro_join 002060 constant label dcl 865 ref 1801 set_inp 005042 constant entry internal dcl 1093 ref 240 409 863 944 962 989 1014 1242 1266 1276 1337 set_tblp 005204 constant entry internal dcl 1157 ref 241 315 433 864 1350 shift_scale constant bit(27) initial unaligned dcl 9-27 ref 1447 1503 shiftscale_flag 000210 automatic bit(1) unaligned dcl 153 set ref 438* 1427 1435 1474 1504 1506* 1538 1540* shortreadlist constant fixed bin(17,0) initial dcl 16-8 ref 1901 sign based bit(18) level 2 packed unaligned dcl 2-3 set ref 1718* 1721* single_char_object constant bit(27) initial unaligned dcl 9-27 ref 880 size 2 based fixed bin(17,0) level 2 in structure "bnreadargs" packed unaligned dcl 142 in procedure "read" set ref 1705* size builtin function dcl 67 in procedure "read" ref 341 431 1702 slash_if_first internal static bit(27) initial unaligned dcl 9-27 slash_if_not_first internal static bit(27) initial unaligned dcl 9-27 slash_output internal static bit(27) initial unaligned dcl 9-27 slashifier constant bit(27) initial unaligned dcl 9-27 ref 905 1815 special constant bit(27) initial unaligned dcl 9-27 ref 756 898 special_array_type internal static fixed bin(17,0) initial dcl 16-8 special_blank constant bit(27) initial unaligned dcl 206 ref 868 984 1059 1827 special_file 000112 automatic bit(1) unaligned dcl 33 set ref 298 314* 1100 1113 1244 1253* 1339 1837* 1847* 1858* 1865* special_inp 005526 constant label dcl 1865 ref 1845 1848 1850 1851 1856 1857 special_macro_join 002067 constant label dcl 869 ref 1793 1828 special_quote_macro 003654 constant label dcl 1764 ref 854 special_semicolon_macro 003746 constant label dcl 1795 ref 856 special_vertical_bar_macro 003762 constant label dcl 1805 ref 858 splice constant bit(27) initial unaligned dcl 9-27 ref 682 835 1318 splice_dot_kludge constant fixed bin(17,0) initial dcl 153 ref 689 splice_it_in 001151 constant label dcl 546 ref 572 stac 000226 automatic pointer dcl 1975 set ref 2046* 2048 2051 2051 2054 2054 2055 2055 2058 2059 2062 2081 2083 2086 2087 stack 000326 automatic pointer dcl 1206 in procedure "verify_obarray" set ref 1218* 1221 1222 1223 1225 1225 stack 000106 automatic pointer dcl 33 in procedure "read" set ref 250 252 252 260 260 265 287 288 289 290 292 295 316* 317 333* 343 370* 375 376 378 382 382 387 387 398 398 414 415 416 417 498 501 506* 506 525 530* 530 531 532 533 534 534 535 535 539 539 539 541 541 543 543 545 545 556 556 558 558 559 559 566* 566 567 570 571 571 598* 598 599 614* 614 615 630* 630 631 632 649 649 654 654 666* 666 667 667 670* 670 685 686* 686 694* 694 704 705 817 818 840 842 845 846 847 847 849 850 851 851 853 854 856 858 860 1259* 1260 1261 1263* 1273 1278 1285 1294 1340* 1341 1352* 1353 1364 1432 1459 1557 1558 1601 1602 1700 1710 1710 1710 1714 1715 1718 1721 1771 1771 1776 1776 1783 1784 1785 1785 1786 1799 1800 1832* 1833 1833 1835 1839 1861* 1869* 1871 1872 1873 1873 1874 1874 1877 1878 1886* 1893* 1894 1894 1896 1896 1909* 1909 1910 1944* 1946 1947 1948 1951 1956 1957 1957 1958 1959 1961 1962 1963 1966 1994* 2041 2042 2058 2068 2071 2074 2075 2076 2077 2079 2081 2110 2113 stack 000316 automatic pointer dcl 1159 in procedure "set_tblp" set ref 1178* 1181 1182 1183 1185 1185 stack_loss_error internal static fixed bin(17,0) initial dcl 16-8 stack_ptr defined pointer dcl 11-6 in procedure "read" set ref 250* 266* 287* 301* 316 370 501* 531* 567* 570* 599* 615* 631* 685* 705* 853* 1078* 1178 1181* 1218 1221* 1245* 1259 1262* 1341* 1352 1700* 1783* 1800* 1832 1834* 1868* 1893 1910* 1944 1956* 1966* 2046 2048* 2059* 2087* stack_ptr 0(18) based bit(18) level 2 in structure "fault_save" packed unaligned dcl 4-25 in procedure "read" set ref 343* stacked_variables based structure level 1 dcl 153 set ref 431 star_rset defined fixed bin(71,0) dcl 11-45 stars_left_in_name internal static fixed bin(17,0) initial dcl 16-8 status_gctwa defined fixed bin(71,0) dcl 5-17 stnopoint defined fixed bin(71,0) dcl 5-17 store_function_misused internal static fixed bin(17,0) initial dcl 16-8 store_not_allowed internal static fixed bin(17,0) initial dcl 16-8 string 1 based char level 2 in structure "lisp_string" dcl 17-6 in procedure "read" set ref 417* 816* 1038 string builtin function dcl 67 in procedure "read" ref 942 string_length based fixed bin(17,0) level 2 dcl 17-6 set ref 416* 417 815* 816 1037 1038 string_quote_exp constant bit(27) initial unaligned dcl 9-27 ref 797 802 809 1444 1468 stringer 001644 constant label dcl 800 set ref 805 stringf 2 based bit(1) level 2 dcl 96 set ref 284 354* 1031 1129 1303 1458 substr builtin function dcl 67 set ref 382 995 1034 1038 1073 1309 1581 1587 1592 1598 1663 1676 1736 1755* 2022 2022 2055 2055 2076* 2076 2135 2135 super1exit constant fixed bin(17,0) initial dcl 153 ref 494 584 612 superexit constant fixed bin(17,0) initial dcl 153 ref 583 611 635 supply_left 001331 constant label dcl 630 ref 611 612 supply_pseudo_space 004754 constant label dcl 1057 supply_right 001252 constant label dcl 597 ref 581 582 sv_array_info 4 based pointer level 2 dcl 4-25 set ref 346* sv_gc_inhibit 1 based bit(1) level 2 packed unaligned dcl 4-25 set ref 344* sv_rdr_label 6 based label variable level 2 dcl 4-25 set ref 269 347* sv_rdr_ptr 12 based pointer level 2 dcl 4-25 set ref 270 348* sv_rdr_state 14 based fixed bin(17,0) level 2 dcl 4-25 set ref 268 349* syntax 22 based bit(27) array level 2 dcl 9-11 set ref 801 808 1021 1043 1084 t_atom defined fixed bin(71,0) dcl 11-6 ref 1110 1265 1275 1278 1841 1851 1884 1951 1959 t_atom_ptr based pointer dcl 11-6 tblp 000154 automatic pointer dcl 88 set ref 801 808 826 840 842 897 1021 1043 1084 1175* 1321 temp based fixed bin(71,0) array dcl 10-7 set ref 250 260* 265* 265 266 287 288* 288 289 290 292* 292 295* 295 301 330 387* 398* 498* 501 506 531 532* 534* 535* 539 539* 539 541 543* 543 545* 545 556* 556 558 559* 559 567 570 571* 571 599 615 631 632* 654* 667 685 686 705 840* 842* 845 847* 849 851* 853 854 856 858 860* 950* 1076* 1078 1088* 1131* 1181 1182* 1183* 1185 1185 1221 1222* 1223* 1225 1225 1245 1262 1263 1265* 1273* 1273 1275* 1278 1305* 1341 1432* 1432 1459* 1459 1776* 1783 1784* 1785* 1785 1786* 1799* 1800 1834 1836* 1841 1842 1843* 1843 1844* 1850 1851 1853* 1853 1854* 1854 1855* 1855 1856 1861 1868 1870* 1870 1883 1886 1910 1946 1951 1956 1957* 1957 1958* 1959* 1961* 1962 1963 1966 2041* 2042 2048 2051* 2051* 2054* 2058* 2058* 2079 2081* 2081 2083* 2086 2110 2113* temp_ptr based pointer array dcl 10-7 set ref 252 260 376 378 382 382 387 398 414* 416 417 534 535 541 558 649 654 667 817* 847 851 1033 1034 1037 1038 1064 1065 1070 1073 1076 1088 1131 1305 1710 1710 1710 1718 1721 1771 1776 2054 2055 2055 2062 2068* 2074 2075 2076 2077 temp_type 0(21) based bit(9) array level 2 packed unaligned dcl 10-7 set ref 252 318 318 375 415* 525 533 649 704 818* 846 850 1032 1046 1771 2071* temp_type36 based bit(36) array level 2 dcl 10-7 ref 957 1353 1380 1839 1848 1857 ten_to_the based float bin(50) array dcl 191 ref 1487 1488 1489 1573 1574 1575 1609 1610 1611 throw_to_no_catch internal static fixed bin(17,0) initial dcl 16-8 tma_err 004062 constant label dcl 1925 too_few_args internal static fixed bin(17,0) initial dcl 16-8 too_many_args constant fixed bin(17,0) initial dcl 16-8 ref 1925 top_block based bit(18) level 2 packed unaligned dcl 10-7 set ref 1878* topexit constant fixed bin(17,0) initial dcl 153 ref 249 translation 226 based fixed bin(17,0) array level 2 dcl 9-11 set ref 826 897 1321 tty_atom defined fixed bin(71,0) dcl 5-17 tty_input_chan defined pointer dcl 11-6 ref 1010 1108 1112 tty_output_chan defined pointer dcl 11-6 tv 000007 constant label array(-1:2) dcl 953 ref 952 957 tv1cont 004536 constant label dcl 987 ref 980 tyicom 002130 constant label dcl 1245 ref 955 1050 1270 tyipeek_eof 004446 constant label dcl 954 ref 968 tyipeek_proc_macro_ret 002335 constant label dcl 1323 ref 865 tyipeek_really_wierd 002312 constant label dcl 1309 ref 1296 tyipeek_t 000215 automatic bit(1) unaligned dcl 153 set ref 1254* 1281* 1318 tyipeek_wierd 002215 constant label dcl 1273 ref 1264 tyipeeksw 000111 automatic bit(1) unaligned dcl 33 set ref 236* 311* 405* 865 953 968 1022 1041 1046 1088 1238* 1255* 1333* tyipw_loop 002264 constant label dcl 1300 ref 1307 tyipw_retry 002222 constant label dcl 1278 ref 1292 tyipww_loop 002315 constant label dcl 1316 ref 1323 1328 type 7 based fixed bin(17,0) level 2 packed unaligned dcl 8-8 ref 1170 1213 type_info based bit(36) level 2 in structure "fixnum_fmt" dcl 12-4 in procedure "read" set ref 289* 1246* 1285 1558* 1714* 1947* 1962* type_info based bit(36) level 2 in structure "flonum_fmt" dcl 12-4 in procedure "read" set ref 1602* typk5 002210 constant label dcl 1269 ref 1302 1326 unable_to_float internal static fixed bin(17,0) initial dcl 16-8 undefined_atom internal static fixed bin(17,0) initial dcl 16-8 undefined_function internal static fixed bin(17,0) initial dcl 16-8 undefined_subr internal static fixed bin(17,0) initial dcl 16-8 underflow_fault internal static fixed bin(17,0) initial dcl 16-8 unm 000102 automatic pointer dcl 33 in procedure "read" set ref 242* 243 249 267* 268 269 270 271 271 272 322* 323 324 325 340* 341 341 342 343 344 345 346 347 348 349 350 373* 430* 431 431 432 438 474 489* 490 492 493 494 496 497 514 546 555 555 581 582 583 584 584 600 601* 601 603 606 611 612 616 617* 617 625 635 661 687* 688 689 691 693* 693 784 786 828 871 888 973 1286* 1287 1288 1289 1355* 1357 1358 1359 1564 1726 1764* 1767 1768 1789 1790* 1790 1911 1932* 1933 1934 unm 000262 automatic pointer dcl 930 in procedure "rdinch" set ref 975* 976 977 unm1 000104 automatic pointer dcl 33 set ref 300 1248 1257* 1343 1862* 1875* 1876 1877 1878 1879 1880 1881 unmkd_ptr defined pointer dcl 11-6 set ref 242 243* 272* 300* 322 323* 340 341* 373 393* 430 431* 473* 489 490* 600* 616* 687 688* 691* 820* 975 976* 1248* 1257 1286 1287* 1343* 1355 1357* 1386 1387* 1562* 1672 1677* 1701 1702* 1707* 1748 1749* 1758* 1758 1764 1767* 1789* 1823* 1862 1875 1876* 1932 1933* unmm 000330 automatic pointer dcl 1385 set ref 1386* 1387 1388 unseen_go_tag internal static fixed bin(17,0) initial dcl 16-8 unspec builtin function dcl 67 set ref 1042 1309 1581 1582* 1582 1587 1592 1593* 1593 1598 1676 1715* 1756 2026* unwp_frame defined pointer dcl 11-6 user_intr_array defined fixed bin(71,0) array dcl 11-45 value based fixed bin(71,0) level 2 in structure "atom" dcl 15-5 in procedure "read" set ref 1108 1110 1110 1113* 1115 1163 1175 1185* 1208 1225* 1380 1393 1873 1874 1883* 1884* 1894* 1896* value based pointer level 2 in structure "atom_ptrs" dcl 15-5 in procedure "read" ref 1115 1170 1213 2035 2082 2085 2099 value based bit(72) level 2 in structure "atom_double_words" dcl 15-5 in procedure "read" set ref 2074* verify_obarray 005265 constant entry internal dcl 1204 ref 247 1991 vertical_motion constant bit(27) initial unaligned dcl 9-27 ref 1022 1132 1306 words 1 based fixed bin(35,0) array level 2 dcl 2-3 ref 1710 1710 wrong_no_args internal static fixed bin(17,0) initial dcl 16-8 zerodivide_fault internal static fixed bin(17,0) initial dcl 16-8 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 7020 7146 6242 7030 Length 10112 6242 126 730 555 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME read 310 external procedure is an external procedure. char_read_setup internal procedure shares stack frame of external procedure read. rdchar internal procedure shares stack frame of external procedure read. rdinch internal procedure shares stack frame of external procedure read. set_inp internal procedure shares stack frame of external procedure read. increment_input_ptr internal procedure shares stack frame of external procedure read. proc_vertical_motion internal procedure shares stack frame of external procedure read. set_tblp internal procedure shares stack frame of external procedure read. verify_obarray internal procedure shares stack frame of external procedure read. begin block on line 1383 begin block shares stack frame of external procedure read. getbnc internal procedure shares stack frame of external procedure read. pnamesetup internal procedure shares stack frame of external procedure read. pnameput internal procedure shares stack frame of external procedure read. eof_hack internal procedure shares stack frame of external procedure read. eofhack_unbind internal procedure shares stack frame of external procedure read. error internal procedure shares stack frame of external procedure read. get_atom internal procedure shares stack frame of external procedure read. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 prefsync read STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME read 000100 fb read 000101 bb read 000102 unm read 000104 unm1 read 000106 stack read 000110 implode_sw read 000111 tyipeeksw read 000112 special_file read 000113 eolhacksw read 000114 eofstack read 000116 origb read 000120 pnp read 000122 pnamelen read 000123 real_io read 000124 readlistf read 000125 read_from_stringf read 000126 p read 000130 inp read 000132 b2 read 000133 bb_wanted read 000134 nn read 000135 n4f read 000136 bign read 000140 bigdn read 000142 n read 000143 dn read 000144 nmargs read 000146 fn read 000150 ib read 000151 fpdigits read 000152 i read 000154 tblp read 000156 inlist read 000160 code read 000162 readlist_data_strucp read 000164 auto_readlist_data_struc read 000170 bnp read 000172 bnct read 000174 bnbp read 000176 dpw read 000177 bnsize read 000200 got_splice read 000201 got_macro read 000202 got_something read 000203 got_list read 000204 reading_atsym read 000205 reading_number read 000206 minus_flag read 000207 forced_num read 000210 shiftscale_flag read 000211 expon_flag read 000212 float_flag read 000213 dbnf read 000214 obnf read 000215 tyipeek_t read 000216 in_middle read 000217 dnum read 000220 htptr read 000222 firstfb read 000223 namelen read 000224 indx read 000225 cnt read 000226 stac read 000262 unm rdinch 000264 sco rdinch 000265 cde rdinch 000316 stack set_tblp 000326 stack verify_obarray 000330 unmm begin block on line 1383 000404 esw get_atom 000405 maknamsw get_atom 000406 a_char get_atom 000410 charobjp get_atom THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 r_e_as r_le_a call_ext_out_desc call_ext_out return mod_fx1 ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_ lisp_$apply lisp_alloc_ lisp_alloc_$gensym lisp_array_fcns_$star_array lisp_bignums_$bnread lisp_error_ lisp_fault_handler_$ctrl_from_reader lisp_io_control_$end_of_block lisp_io_control_$fix_not_ok_iochan lisp_property_fns_$get lisp_reader_alm_$left_shift lisp_special_fns_$cons lisp_special_fns_$ncons THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lisp_reader_alm_$powers_of_ten lisp_static_vars_$array_atom lisp_static_vars_$binding_top lisp_static_vars_$ctrlQ lisp_static_vars_$err_recp lisp_static_vars_$garbage_collect_inhibit lisp_static_vars_$ibase lisp_static_vars_$infile lisp_static_vars_$nil lisp_static_vars_$obarray lisp_static_vars_$plus_status lisp_static_vars_$quote_atom lisp_static_vars_$quote_macro lisp_static_vars_$rdr_label lisp_static_vars_$rdr_ptr lisp_static_vars_$rdr_state lisp_static_vars_$read_print_nl_sync lisp_static_vars_$readtable lisp_static_vars_$semicolon_macro lisp_static_vars_$stack_ptr lisp_static_vars_$t_atom lisp_static_vars_$tty_input_chan 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 000165 236 000173 237 000174 238 000176 239 000177 240 000200 241 000201 242 000202 243 000206 247 000211 249 000212 250 000214 251 000220 252 000221 257 000234 258 000236 259 000237 260 000240 261 000244 262 000245 264 000250 265 000252 266 000254 267 000260 268 000263 269 000265 270 000272 271 000274 272 000301 273 000302 276 000303 278 000311 284 000321 287 000327 288 000333 289 000335 290 000337 291 000341 292 000345 295 000350 298 000352 300 000355 301 000360 302 000363 304 000364 305 000372 306 000374 308 000375 310 000403 311 000404 313 000405 314 000407 315 000410 316 000411 317 000415 318 000420 322 000437 323 000443 324 000446 325 000450 326 000452 327 000456 330 000457 332 000470 333 000471 334 000473 335 000474 340 000475 341 000500 342 000503 343 000507 344 000512 345 000516 346 000517 347 000521 348 000526 349 000531 350 000533 352 000534 353 000536 354 000540 355 000542 356 000544 357 000546 358 000550 359 000551 360 000553 362 000554 364 000562 365 000563 367 000564 369 000572 370 000574 373 000601 374 000604 375 000605 376 000611 378 000615 379 000621 380 000623 381 000626 382 000627 384 000642 386 000643 387 000644 390 000650 391 000651 392 000655 393 000656 394 000661 398 000662 400 000665 403 000666 405 000674 406 000675 407 000677 408 000700 409 000701 410 000702 411 000703 413 000704 414 000710 415 000725 416 000731 417 000734 418 000743 422 000744 423 000746 424 000747 438 000750 454 000766 455 000767 459 000773 460 000775 461 000776 462 000777 463 001001 464 001002 465 001003 469 001004 470 001006 471 001007 472 001010 473 001011 474 001014 478 001016 483 001023 488 001024 489 001026 490 001032 491 001035 492 001037 493 001041 494 001043 495 001045 496 001046 497 001050 498 001051 499 001053 501 001054 506 001060 508 001062 514 001063 520 001067 521 001071 522 001072 524 001075 525 001076 530 001102 531 001105 532 001110 533 001112 534 001116 535 001120 537 001123 538 001130 539 001131 541 001141 543 001144 544 001146 545 001147 546 001151 555 001154 556 001156 557 001161 558 001162 559 001166 560 001170 561 001171 565 001172 566 001174 567 001177 568 001202 569 001206 570 001207 571 001213 572 001215 576 001216 581 001224 582 001230 583 001234 584 001240 590 001250 592 001251 597 001252 598 001254 599 001257 600 001262 601 001264 602 001266 603 001267 606 001273 611 001275 612 001301 614 001305 615 001310 616 001313 617 001315 621 001317 622 001322 623 001324 624 001326 625 001327 630 001331 631 001334 632 001337 633 001341 634 001345 635 001346 636 001350 637 001351 642 001352 644 001354 649 001355 654 001372 656 001376 657 001400 659 001401 660 001402 661 001405 666 001411 667 001414 668 001420 670 001423 671 001426 674 001427 676 001432 677 001433 682 001434 684 001440 685 001442 686 001446 687 001450 688 001453 689 001456 690 001460 691 001461 693 001464 694 001466 703 001471 704 001473 705 001476 706 001500 708 001501 709 001502 714 001503 715 001505 719 001506 720 001507 723 001512 724 001514 725 001515 726 001516 727 001523 728 001525 729 001526 733 001527 738 001541 739 001542 741 001543 742 001544 743 001547 744 001551 750 001552 751 001554 752 001556 753 001557 754 001560 755 001564 756 001565 758 001567 759 001570 764 001571 769 001572 770 001574 771 001575 772 001577 773 001600 774 001601 777 001607 778 001612 779 001613 784 001614 786 001620 787 001622 789 001626 789 001630 791 001631 794 001632 797 001635 798 001641 799 001643 800 001644 801 001645 802 001651 803 001656 805 001657 807 001660 808 001661 809 001665 813 001672 814 001673 815 001711 816 001713 817 001721 818 001722 819 001726 820 001730 821 001732 825 001733 826 001735 828 001740 830 001742 834 001743 835 001745 836 001752 837 001753 840 001756 842 001765 843 001770 845 001775 846 002002 847 002006 848 002012 849 002014 850 002021 851 002025 853 002030 854 002034 856 002040 858 002044 860 002050 861 002052 863 002056 864 002057 865 002060 867 002063 868 002065 869 002067 871 002072 873 002074 874 002076 875 002077 875 002101 877 002102 880 002103 881 002105 882 002106 888 002107 1236 002111 1238 002117 1239 002120 1240 002121 1241 002122 1242 002123 1243 002124 1244 002125 1245 002130 1246 002134 1247 002136 1248 002140 1249 002142 1251 002143 1253 002151 1254 002152 1255 002153 1256 002155 1257 002156 1258 002162 1259 002163 1260 002170 1261 002172 1262 002175 1263 002177 1264 002201 1265 002204 1266 002206 1268 002207 1269 002210 1270 002214 1273 002215 1275 002217 1276 002221 1278 002222 1280 002226 1281 002230 1282 002232 1285 002233 1286 002236 1287 002241 1288 002244 1289 002246 1290 002250 1291 002254 1292 002255 1294 002256 1296 002261 1300 002264 1302 002265 1303 002271 1305 002300 1306 002305 1307 002311 1309 002312 1316 002315 1318 002316 1319 002325 1320 002326 1321 002330 1322 002334 1323 002335 1326 002336 1327 002342 1328 002343 1331 002344 1333 002352 1334 002353 1335 002354 1336 002355 1337 002356 1338 002357 1339 002360 1340 002363 1341 002365 1342 002371 1343 002372 1344 002375 1348 002376 1350 002404 1352 002405 1353 002412 1355 002416 1357 002422 1358 002425 1359 002427 1360 002431 1361 002435 1364 002436 1365 002440 1366 002442 1367 002445 1368 002446 1376 002447 1380 002450 1386 002456 1387 002462 1388 002465 1389 002467 1390 002473 1391 002474 1393 002475 1394 002502 1395 002505 1397 002510 1398 002511 1399 002512 1400 002513 1401 002515 1402 002516 1404 002520 1407 002523 1408 002525 1409 002531 1411 002536 1412 002537 1414 002540 1415 002544 1416 002551 1418 002552 1419 002553 1420 002554 1423 002555 1427 002562 1428 002567 1430 002571 1431 002573 1432 002575 1433 002601 1434 002602 1435 002603 1438 002611 1439 002614 1440 002616 1441 002617 1442 002620 1444 002621 1446 002626 1447 002630 1448 002632 1449 002634 1454 002635 1455 002640 1456 002641 1458 002646 1459 002654 1462 002656 1463 002662 1465 002663 1466 002664 1468 002665 1470 002672 1473 002675 1474 002700 1475 002703 1477 002705 1478 002707 1479 002710 1481 002711 1482 002713 1483 002714 1484 002716 1486 002720 1487 002724 1488 002730 1489 002734 1490 002751 1491 002753 1493 002754 1496 002761 1497 002767 1498 002771 1500 002772 1503 002773 1504 002775 1506 003000 1507 003002 1508 003004 1509 003005 1511 003007 1511 003013 1512 003015 1512 003022 1513 003024 1515 003025 1516 003027 1520 003030 1522 003033 1524 003034 1525 003035 1526 003036 1527 003041 1528 003045 1530 003046 1536 003047 1538 003053 1539 003055 1540 003061 1541 003063 1543 003066 1547 003070 1548 003071 1549 003101 1550 003104 1551 003106 1554 003107 1557 003120 1558 003123 1560 003125 1561 003126 1562 003130 1563 003133 1564 003134 1566 003136 1568 003140 1569 003143 1570 003145 1571 003146 1573 003150 1574 003154 1575 003160 1576 003170 1580 003172 1581 003177 1582 003202 1583 003206 1584 003212 1585 003215 1587 003221 1588 003227 1591 003230 1592 003235 1593 003240 1594 003244 1595 003250 1596 003253 1598 003257 1601 003265 1602 003270 1603 003272 1606 003273 1608 003275 1609 003277 1610 003303 1611 003307 1612 003324 1613 003326 1614 003331 1616 003332 1619 003333 1620 003335 1621 003336 1622 003341 1623 003343 1628 003344 1629 003347 1630 003351 1631 003353 1632 003355 1634 003356 1640 003357 1645 003361 1653 003362 1656 003364 1658 003365 1662 003367 1663 003370 1664 003373 1665 003405 1666 003417 1667 003431 1668 003432 1672 003434 1673 003440 1674 003443 1675 003447 1676 003450 1677 003457 1679 003462 1680 003466 1681 003467 1682 003504 1683 003505 1684 003511 1685 003513 1689 003515 1690 003525 1691 003526 1692 003535 1693 003536 1694 003542 1695 003544 1696 003550 1700 003555 1701 003560 1702 003563 1703 003566 1704 003570 1705 003573 1706 003576 1707 003602 1708 003605 1709 003607 1710 003610 1714 003627 1715 003631 1716 003634 1718 003635 1719 003641 1721 003642 1723 003645 1724 003647 1725 003651 1726 003652 1764 003654 1767 003657 1768 003662 1769 003664 1771 003665 1776 003701 1778 003705 1779 003707 1781 003710 1783 003713 1784 003717 1785 003721 1786 003723 1787 003725 1788 003731 1789 003736 1790 003741 1791 003743 1792 003744 1793 003745 1795 003746 1798 003747 1799 003752 1800 003755 1801 003760 1803 003761 1807 003762 1808 003764 1809 003766 1810 003767 1812 003770 1813 003773 1815 003775 1816 004001 1818 004002 1819 004003 1821 004004 1822 004005 1823 004006 1824 004011 1825 004012 1826 004013 1827 004015 1828 004017 1901 004020 1902 004022 1904 004023 1905 004025 1907 004026 1908 004030 1909 004031 1910 004034 1911 004037 1912 004042 1913 004043 1914 004050 1916 004051 1917 004053 1919 004054 1920 004056 1922 004057 1923 004061 1925 004062 1926 004064 1940 004065 1944 004074 1945 004101 1946 004102 1947 004105 1948 004107 1949 004111 1950 004116 1951 004117 1952 004122 1953 004124 1956 004125 1957 004131 1958 004133 1959 004135 1961 004142 1962 004144 1963 004146 1964 004150 1966 004154 1967 004160 1969 004161 1991 004200 1992 004201 1993 004203 1994 004206 1995 004210 1996 004211 2129 004212 2133 004231 2134 004234 2135 004241 2138 004260 2139 004261 2140 004271 2141 004277 2142 004301 2144 004305 2145 004307 426 004310 428 004311 429 004312 430 004314 431 004320 432 004323 433 004325 434 004326 890 004327 893 004330 896 004331 897 004333 898 004336 899 004342 903 004343 905 004346 909 004352 910 004353 911 004355 913 004356 914 004357 917 004360 920 004363 921 004366 928 004367 938 004370 940 004371 942 004373 944 004417 945 004420 946 004421 948 004422 950 004426 951 004441 952 004442 953 004444 954 004446 955 004450 957 004451 960 004460 962 004461 963 004462 965 004463 966 004472 968 004473 972 004476 973 004501 975 004504 976 004510 977 004513 978 004515 979 004521 980 004522 982 004523 983 004531 984 004533 985 004535 987 004536 989 004542 990 004543 994 004544 995 004545 996 004552 1002 004556 1005 004565 1006 004567 1007 004570 1008 004571 1009 004574 1010 004575 1012 004621 1013 004640 1014 004651 1015 004652 1016 004653 1021 004654 1022 004657 1026 004664 1031 004665 1032 004670 1033 004675 1034 004703 1035 004712 1037 004713 1038 004720 1041 004727 1042 004732 1043 004735 1044 004740 1046 004741 1049 004746 1050 004750 1052 004751 1056 004753 1057 004754 1059 004756 1060 004760 1062 004761 1064 004762 1065 004770 1066 004774 1067 004776 1068 005001 1070 005002 1073 005010 1074 005016 1076 005017 1078 005022 1079 005026 1084 005027 1088 005033 1090 005041 1093 005042 1100 005043 1102 005051 1103 005052 1104 005055 1105 005057 1108 005060 1110 005071 1112 005104 1113 005110 1114 005115 1115 005116 1118 005127 1120 005130 1123 005132 1127 005133 1129 005134 1131 005143 1132 005150 1133 005154 1136 005155 1138 005156 1139 005161 1140 005163 1141 005165 1143 005171 1144 005172 1145 005175 1147 005201 1149 005202 1151 005203 1157 005204 1163 005205 1166 005213 1170 005214 1173 005224 1175 005226 1176 005234 1178 005235 1181 005240 1182 005242 1183 005244 1184 005246 1185 005252 1188 005261 1189 005263 1191 005264 1204 005265 1208 005266 1211 005274 1213 005275 1216 005305 1218 005306 1221 005311 1222 005313 1223 005315 1224 005317 1225 005323 1228 005332 1229 005334 1231 005335 1732 005336 1734 005337 1735 005340 1736 005341 1737 005346 1738 005354 1739 005361 1740 005363 1745 005364 1747 005365 1748 005366 1749 005372 1750 005375 1752 005376 1754 005377 1755 005400 1756 005405 1758 005410 1760 005415 1830 005416 1832 005417 1833 005424 1834 005430 1835 005432 1836 005434 1837 005436 1838 005437 1839 005440 1841 005447 1842 005453 1843 005456 1844 005460 1845 005462 1847 005463 1848 005465 1850 005471 1851 005475 1853 005501 1854 005503 1855 005505 1856 005507 1857 005513 1858 005517 1861 005520 1862 005522 1863 005525 1865 005526 1868 005530 1869 005532 1870 005535 1871 005537 1872 005541 1873 005543 1874 005545 1875 005547 1876 005552 1877 005555 1878 005560 1879 005563 1880 005567 1881 005571 1883 005572 1884 005575 1886 005600 1887 005603 1890 005604 1893 005605 1894 005615 1896 005617 1898 005621 1899 005631 1930 005632 1932 005633 1933 005637 1934 005642 1935 005644 1936 005650 2000 005652 1998 005655 2008 005657 2010 005661 2022 005666 2025 005705 2026 005710 2027 005723 2028 005731 2029 005737 2030 005741 2035 005745 2040 005753 2041 005755 2042 005760 2043 005764 2046 005766 2048 005771 2051 005773 2054 006004 2055 006010 2058 006023 2059 006025 2060 006026 2062 006030 2068 006034 2071 006051 2074 006055 2075 006062 2076 006066 2077 006074 2078 006101 2079 006104 2081 006114 2082 006116 2083 006123 2084 006130 2085 006134 2086 006142 2087 006147 2089 006151 2091 006153 2093 006154 2099 006156 2100 006164 2101 006170 2102 006173 2104 006176 2105 006202 2106 006204 2107 006207 2108 006211 2109 006213 2110 006214 2112 006221 2113 006222 2114 006224 2115 006225 2117 006226 2119 006230 2120 006232 ----------------------------------------------------------- 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