COMPILATION LISTING OF SEGMENT lisp_status_fns_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 06/30/83 0851.5 mst Thu Options: map single_symbol_list 1 /* ************************************************************** 2* * * 3* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 4* * * 5* ************************************************************** */ 6 status: proc; 7 8 /* 9* * lisp_status_fns_ contains the MACLISP functions status, sstatus, gctwa, *rset 10* * D. A. Moon 29-JUN-72 11* * lsubr versions status_, sstatus_ for compiled code added 1/17/72 DAM 12* * modified for new I/O system, and new status fns charmode and system, 24 Mar 73, DAM 13* * added tabsize, crfile, ttyread, newreadtable 7 Apr 73 DAM 14* * new function setsyntax added 17 May 1973 by dam 15* * (status features) added 7/12/73 by DAM 16* * status functions uuolinks, divov, abbreviate, and dow added 16 Oct 1973 by DAM, and 17* * tty, *nopoint, *rset, nouuo, noret, chrct, linel, and rct removed. 18* * at the same time it was converted to use 27 syntax bits instead of 18. 19* * modified 74.02.18 by DAM to add (status newline), (status status), 20* * (status sstatus), and (status feature) 21* * modified 74.05.31 by DAM for new arrays, (sstatus feature), (sstatus nofeature), 22* * (status linmode), and (sstatus uuolinks t) 23* * modified 74.12.06 by DAM for cleanup feature 24* * modified 1/5/78 by B. Greenberg for status/sstatus mulquit/mulpi 25* */ 26 27 dcl stack ptr, 28 lispversion fixed bin static init(3), 29 unm ptr, 30 pnamep ptr, 31 1 lisp_reader_alm_$initial_readtable external aligned, 32 2 std_syntax(0:131) bit(27), 33 2 std_translation(0:131) fixed bin, 34 myname fixed bin, 35 rdr_save_f bit(1), 36 char4 char(4) aligned, 37 char4b char(4) aligned based, 38 char4a char(4) aligned, 39 based_fxb17 fixed bin (17) aligned based, 40 LOWER_CASES char (26) options (constant) static init 41 ("abcdefghijklmnopqrstuvwxyz"), 42 UPPER_CASES char (26) options (constant) static init 43 ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"), 44 NullChar char(1) static init(""), /* \000 character */ 45 i fixed bin, 46 j fixed bin, 47 ssf bit(1), /* sstatus if 1, status if 0 */ 48 lsubf bit(1), /* 1 if lsubr entry, 0 if fsubr entry */ 49 nargs fixed bin, /* -2 times number of arguments */ 50 sw bit(1), /* random switch */ 51 switch fixed bin, /* transfer vector switch */ 52 m fixed bin(35), 53 mm fixed bin, 54 n fixed bin(35), 55 fn float bin, 56 lisp_static_vars_$no_snapped_links bit(1) external aligned, 57 (lisp_static_vars_$first_value_atom, lisp_static_vars_$value_atom, 58 lisp_static_vars_$divov_flag, 59 lisp_static_vars_$old_io_defaults, lisp_static_vars_$last_value_atom) fixed bin(71) ext, 60 lisp_static_vars_$semicolon_macro fixed bin(71) external, /* has (status features) as its value */ 61 lisp_static_vars_$cleanup_list fixed bin(71) external, 62 lisp_static_vars_$cleanup_list_exists bit(1) aligned external, 63 lisp_static_vars_$evalhook_status bit(36) aligned external, 64 lisp_$evalhook_off_status bit(36) aligned external, 65 lisp_$evalhook_on_status bit(36) aligned external, 66 lisp_static_vars_$crunit_atom fixed bin(71) external, 67 lisp_static_vars_$uread_atom external pointer, 68 lisp_static_vars_$uwrite_atom external pointer, 69 uread fixed bin(71) based(addr(lisp_static_vars_$uread_atom -> atom.value)), 70 uwrite fixed bin(71) based(addr(lisp_static_vars_$uwrite_atom -> atom.value)), 71 mulquit_mulpi_value_ptr ptr, 72 arg2pn char(1) aligned; 73 74 /* status/sstatus names table - first 4 chars of pname of first arg */ 75 76 dcl nnames fixed bin static init(51), 77 names(51) char(4) aligned internal static init( 78 "chtr", 79 "ioc", /* padded with an ascii 000 character */ 80 "macr", 81 "synt", 82 "topl", 83 "urea", 84 "uwri", 85 "+", /* padded with three ascii 000 characters */ 86 "date", 87 "dayt", 88 "runt", 89 "time", 90 "inte", 91 "spcn", /* spcnames - used to be tty */ 92 "crun", 93 "()()", /* used to be *nopoint - was flushed */ 94 "()()", /* used to be *rset - was flushed */ 95 "gcti", 96 "spcs", /* spcsize - used to be nouuo */ 97 "pdls", /* pdlsize - used to be noret */ 98 "pdlr", /* pdlroom - used to be chrct */ 99 "pdlm", /* pdlmax - used to be linel */ 100 "lisp", /* lispversion */ 101 "pagi", 102 "unam", 103 "jcl", /* padded with \000 */ 104 "arg", /* padded with \000.*/ 105 "terp", 106 "_", /* padded with 3 \\000's */ 107 "()()", /* used to be (status rct) but we flushed that */ 108 "syst", 109 "char", 110 "tabs", 111 "crfi", 112 "ttyr", 113 "udir", 114 "feat", 115 "()()", /* used to be breakloop - was flushed */ 116 "uuol", 117 "divo", 118 "abbr", 119 "dow", /* padded with \000 */ 120 "stat", 121 "ssta", 122 "newl", 123 "nofe", /* nofeature */ 124 "linm", /* linmode */ 125 "clea", /* cleanup */ 126 "eval", /* evalhook */ 127 "mulq", /* mulquit */ 128 "mulp" /* mulpi */ 129 ), 130 131 /* action control bits */ 132 ( 133 illeg init("10000"b), /* can't be done */ 134 eval2 init("01000"b), /* eval 2nd arg */ 135 pname2 init("00100"b), /* get 1st char of pname of 2nd arg */ 136 eval3 init("00010"b), /* eval 3rd arg */ 137 stoval init("00001"b), /* store into ssatoms(i) */ 138 t_or_nil init("000001"b) /* if non-nil, store t */ 139 ) bit(6) aligned static, 140 141 ssbit bit(6) aligned, /* copy of an elem from one of the arrays below */ 142 ssbits(51) bit(6) aligned static init( /* for sstatus */ 143 "001100"b, /* chtran */ 144 "000000"b, /* ioc */ 145 "001100"b, /* macro */ 146 "001100"b, /* syntax */ 147 "010010"b, /* toplevel */ 148 "000000"b, /* uread */ 149 "000000"b, /* uwrite */ 150 "010011"b, /* + */ 151 "100000"b, /* date */ 152 "100000"b, /* daytime */ 153 "100000"b, /* runtime */ 154 "100000"b, /* time */ 155 "010100"b, /* interrupt */ 156 "1"b, /* spcnames - can't change */ 157 "000000"b, /* crunit */ 158 "1"b, /* *nopoint - flushed */ 159 "1"b, /* *rset - flushed */ 160 "010000"b, /* gctime */ 161 "1"b, /* spcsize - can't change */ 162 "1"b, /* pdlsize - can't change */ 163 "1"b, /* pdlroom - can't set */ 164 "010100"b, /* pdlmax */ 165 "100000"b, /* lispversion - can't change */ 166 "100000"b, /* pagin - can' change */ 167 "100000"b, /* uname - can't change */ 168 "1"b, /* jcl- read only */ 169 "1"b, /* arg- read only */ 170 "010001"b, /* terpri */ 171 "010001"b, /* _ */ 172 "1"b, /* rct - flushed */ 173 "1"b, /* system - can't sstatus */ 174 "010101"b, /* charmode */ 175 "1"b, /* tabsize - can't be changed */ 176 "000000"b, /* crfile */ 177 "010001"b, /* ttyread */ 178 "1"b, /* udir */ 179 "000000"b, /* feature */ 180 "1"b, /* was breakloop - flushed */ 181 "010001"b, /* uuolinks */ 182 "010011"b, /* divov */ 183 "010000"b, /* abbreviate */ 184 "1"b, /* dow */ 185 "1"b, /* status */ 186 "1"b, /* sstatus */ 187 "1"b, /* newline */ 188 "000000"b, /* nofeature */ 189 "1"b, /* linmode */ 190 "010000"b, /* cleanup */ 191 "010000"b, /* evalhook */ 192 "010000"b, /* mulquit */ 193 "010000"b /* mulpi */ 194 ), 195 sbits(51) bit(6) aligned static init( /* for status */ 196 "001000"b, /* chtran */ 197 "001000"b, /* ioc */ 198 "001000"b, /* macro */ 199 "001000"b, /* syntax */ 200 "000010"b, /* toplevel */ 201 "000000"b, /* uread */ 202 "000000"b, /* uwrite */ 203 "000010"b, /* + */ 204 "000000"b, /* date */ 205 "000000"b, /* daytime */ 206 "000000"b, /* runtime */ 207 "000000"b, /* time */ 208 "010000"b, /* interrupt */ 209 "000000"b, /* spcnames */ 210 "000000"b, /* crunit */ 211 "1"b, /* *nopoint - flushed */ 212 "1"b, /* *rset - flushed */ 213 "000000"b, /* gctime */ 214 "010000"b, /* spcsize */ 215 "010000"b, /* pdlsize */ 216 "010000"b, /* pdlroom */ 217 "010000"b, /* pdlmax */ 218 "000000"b, /* lispversion */ 219 "000000"b, /* paging -> (list pf pp) */ 220 "000000"b, /* uname -> interned atom person/.proj */ 221 "000000"b, /* jcl - explode of 2nd arg to lisp cmd */ 222 "010000"b, /* arg - list of 2nd - nth args to lisp cmd */ 223 "000000"b, /* terpri */ 224 "000000"b, /* _ */ 225 "1"b, /* rct - flushed */ 226 "010000"b, /* system */ 227 "010000"b, /* charmode */ 228 "000000"b, /* tabsize */ 229 "000000"b, /* crfile */ 230 "000000"b, /* ttyread */ 231 "000000"b, /* udir */ 232 "000000"b, /* feature */ 233 "1"b, /* was breakloop - flushed */ 234 "000000"b, /* uuolinks */ 235 "000010"b, /* divov */ 236 "000000"b, /* abbreviate */ 237 "000000"b, /* dow */ 238 "000000"b, /* status */ 239 "000000"b, /* sstatus */ 240 "000000"b, /* newline */ 241 "1"b, /* nofeature */ 242 "000000"b, /* linmode */ 243 "000010"b, /* cleanup */ 244 "000000"b, /* evalhook */ 245 "000000"b, /* mulquit */ 246 "000000"b /* mulpi */ 247 ), 248 249 250 /* atoms whose values are to be mainpulated */ 251 252 ssatoms (51) pointer static init((51)null), 253 initss bit(1) static init("1"b); /* signal for prologue to be executed to init ssatoms */ 254 255 dcl errcode(2) fixed bin aligned based; 256 257 dcl (addr, addrel, bit, divide, fixed, float, hbound, lbound, length, max, min, null, substr, 258 index, reverse, verify, unspec) builtin; 259 260 /* entry points called */ 261 262 dcl lisp_$eval ext entry, 263 lisp_load_$unsnap_all_links entry, 264 lisp_prelinker_ entry, 265 lisp_fault_handler_$ioc entry, 266 lisp_prog_fns_$lisp_err entry(bit(1)aligned), 267 lisp_$apply entry, 268 lisp_io_fns_$names entry, 269 lisp_defsubr_$sysp entry, 270 lisp_special_fns_$cons entry, 271 lisp_get_atom_ ext entry(char(*) aligned, fixed bin(71) aligned), 272 lisp_list_utils_$nreverse entry, 273 lisp_special_fns_$xcons entry, 274 cu_$arg_ptr_rel ext entry(fixed bin, ptr, fixed bin, fixed bin, ptr), 275 argptr ptr, 276 arglen fixed bin, 277 arg_buffer char(200) aligned, /* lisp_get_atom_ wants to see an aligned string */ 278 aligned_arg char(arglen) based(addr(arg_buffer)) aligned, 279 arg char(arglen) based(argptr) unaligned, 280 code fixed bin, 281 lisp_error_ ext entry; 282 283 284 /* declare things in lisp_static_vars_ */ 285 286 dcl ( lisp_static_vars_$nouuo_flag, 287 lisp_static_vars_$dsk_atom, 288 lisp_static_vars_$noret_flag 289 ) fixed bin(71) aligned external, 290 ( lisp_static_vars_$mulquit_state, 291 lisp_static_vars_$mulpi_state 292 ) fixed bin (17) external, 293 lisp_static_vars_$arg_list_ptr external pointer; 294 295 296 dcl 1 pointr aligned based, /* special kludge to set indir modifier in ssatoms that 297* are pointers to pointers to atoms, instead of pointers 298* to internal status flags */ 299 2 segment bit(18) unal, 300 2 junk bit(12) unal, 301 2 its bit(6) unal, 302 2 offset bit(18) unal, 303 2 junk2 bit(12) unal, 304 2 mod bit(6) unal; /* This is the crucial one. */ 1 1 /* Include file lisp_common_vars.incl.pl1; 1 2* describes the external static variables which may be referenced 1 3* by lisp routines. 1 4* D. Reed 4/1/71 */ 1 5 1 6 dcl 1 lisp_static_vars_$lisp_static_vars_ external, 1 7 2 cclist_ptr ptr, /* pointer to list of constants kept 1 8* by compiled programs */ 1 9 2 garbage_collect_soon bit(1) aligned, /* if this is on we should garbage collect soon */ 1 10 1 11 lisp_static_vars_$err_recp ptr ext aligned, /* pointer to error data */ 1 12 err_recp ptr defined (lisp_static_vars_$err_recp), 1 13 eval_frame ptr defined (lisp_static_vars_$eval_frame), /* info kept by eval if *rset t */ 1 14 lisp_static_vars_$eval_frame ptr ext static, 1 15 lisp_static_vars_$prog_frame ptr ext aligned, 1 16 lisp_static_vars_$err_frame ptr ext aligned, 1 17 lisp_static_vars_$catch_frame ptr ext aligned, 1 18 lisp_static_vars_$unwp_frame ptr ext aligned, 1 19 lisp_static_vars_$stack_ptr ptr ext aligned, 1 20 lisp_static_vars_$t_atom fixed bin(71) ext aligned, 1 21 lisp_static_vars_$top_level label ext, /* top level read_eval_print loop */ 1 22 lisp_static_vars_$unmkd_ptr ptr ext aligned, 1 23 lisp_static_vars_$binding_top ptr ext aligned, 1 24 lisp_static_vars_$obarray fixed bin(71) aligned ext, 1 25 obarray fixed bin(71) defined (lisp_static_vars_$obarray), 1 26 lisp_static_vars_$array_atom fixed bin(71) aligned ext, 1 27 array_atom fixed bin(71) defined (lisp_static_vars_$array_atom), 1 28 binding_top ptr defined (lisp_static_vars_$binding_top), 1 29 unmkd_ptr ptr defined (lisp_static_vars_$unmkd_ptr), 1 30 stack_ptr ptr defined (lisp_static_vars_$stack_ptr), 1 31 lisp_static_vars_$nil ext static fixed bin(71) aligned, 1 32 nil fixed bin(71) defined (lisp_static_vars_$nil), 1 33 lisp_static_vars_$tty_input_chan ext static ptr, /* used by the reader */ 1 34 lisp_static_vars_$tty_output_chan ext static ptr, /*used by print*/ 1 35 tty_input_chan ptr def (lisp_static_vars_$tty_input_chan), 1 36 tty_output_chan ptr def (lisp_static_vars_$tty_output_chan), 1 37 lisp_static_vars_$iochan_list external pointer, /* list of all open iochans */ 1 38 nil_ptr ptr based(addr(lisp_static_vars_$nil)) aligned, 1 39 prog_frame ptr def (lisp_static_vars_$prog_frame), /* 3 ptrs for use of lisp_prog_fns_ */ 1 40 err_frame ptr def (lisp_static_vars_$err_frame), /* they point out frames in unmkd pdl */ 1 41 catch_frame ptr def (lisp_static_vars_$catch_frame), 1 42 unwp_frame ptr def (lisp_static_vars_$unwp_frame), 1 43 t_atom_ptr ptr aligned based(addr(lisp_static_vars_$t_atom)), 1 44 t_atom fixed bin(71) defined (lisp_static_vars_$t_atom); /* pointer to atom t */ 1 45 dcl lisp_static_vars_$user_intr_array(20) fixed bin(71) aligned ext static, /* -> atoms whose values are intr service functions */ 1 46 user_intr_array (20) fixed bin(71) aligned def (lisp_static_vars_$user_intr_array), 1 47 lisp_static_vars_$star_rset fixed bin(71) aligned ext static, 1 48 star_rset fixed bin(71) aligned def (lisp_static_vars_$star_rset); 1 49 1 50 1 51 /* end include file lisp_common_vars.incl.pl1 */ 305 2 1 /* BEGIN INCLUDE FILE lisp_initial_atoms.incl.pl1 */ 2 2 2 3 dcl lisp_static_vars_$toplevel ext fixed bin(71), 2 4 toplevel fixed bin(71) defined (lisp_static_vars_$toplevel), 2 5 2 6 lisp_static_vars_$errlist ext fixed bin(71), 2 7 errlist fixed bin(71) defined (lisp_static_vars_$errlist), 2 8 2 9 lisp_static_vars_$STAR ext fixed bin(71), 2 10 STAR fixed bin(71) defined (lisp_static_vars_$STAR), 2 11 lisp_static_vars_$PLUS fixed bin(71) external, 2 12 PLUS fixed bin(71) defined (lisp_static_vars_$PLUS), 2 13 lisp_static_vars_$MINUS fixed bin(71) external, 2 14 MINUS fixed bin(71) defined (lisp_static_vars_$MINUS), 2 15 lisp_static_vars_$SLASH fixed bin(71) external, 2 16 SLASH fixed bin(71) defined (lisp_static_vars_$SLASH); 2 17 2 18 /* END INCLUDE FILE lisp_initial_atoms.incl.pl1 */ 306 3 1 /* INCLUDE FILE lisp_io.incl.pl1 */ 3 2 3 3 /* data structures used by the lisp i/o system */ 3 4 4 1 /* BEGIN INCLUDE FILE lisp_iochan.incl.pl1 */ 4 2 4 3 /* This include file describes the format of the 'iochan' block, 4 4* which is used to implement lisp file-objects. The iochan 4 5* is the central data base of the i/o system. When open 4 6* is used, an iochan is created in lisp static storage. 4 7* When the lisp environment is booted, 2 iochans for input and 4 8* output on the tty are created. Iochans are saved and restored 4 9* by the save mechanism */ 4 10 4 11 /* open i/o channel information */ 4 12 4 13 dcl 1 iochan based aligned, /* format of a file object */ 4 14 2 ioindex fixed bin(24), /* 0-origin character position in block */ 4 15 2 iolength fixed bin(24), /* size of block in chars - actual(in), max(out) */ 4 16 2 ioptr pointer, /* -> block */ 4 17 2 thread pointer, /* list of all iochans open; from lisp_static_vars_$iochan_list */ 4 18 2 fcbp pointer, /* for tssi_ */ 4 19 2 aclinfop pointer, /* .. */ 4 20 2 component fixed bin, /* .. */ 4 21 2 charpos fixed bin, /* 0-origin horizontal position on line */ 4 22 2 linel fixed bin, /* (out) line length, 0 => oo */ 4 23 2 flags unaligned, 4 24 3 seg bit(1), /* 1 => msf, 0 => stream */ 4 25 3 read bit(1), /* 0 => openi, 1 => not */ 4 26 3 write bit(1), /* 0 => openo, 1 => not */ 4 27 3 gc_mark bit(1), /* for use by the garbage collector */ 4 28 3 interactive bit(1), /* 1 => input => this is the tty 4 29* output => flush buff after each op */ 4 30 3 must_reopen bit(1), /* 1 => has been saved and not reopend yet */ 4 31 3 nlsync bit(1), /* 1 => there is a NL in the buffer (output streams only) */ 4 32 3 charmode bit(1), /* enables instant ios_$write */ 4 33 3 extra_nl_done bit(1), /* 1 => last char output was extra NL for chrct */ 4 34 3 fixnum_mode bit(1), /* to be used with in and out functions */ 4 35 3 image_mode bit(1), /* just suppresses auto-cr */ 4 36 3 not_yet_used bit(25), 4 37 2 function fixed bin(71), /* EOF function (input), or endpagefn (output) <<< gc-able >>> */ 4 38 2 namelist fixed bin(71), /* list of names, car is directory pathname <<< gc-able >>> */ 4 39 2 name char(32) unaligned, /* stream name or entry name */ 4 40 2 pagel fixed bin, /* number of lines per page */ 4 41 2 linenum fixed bin, /* current line number, starting from 0 */ 4 42 2 pagenum fixed bin, /* current page number, starting from 0 */ 4 43 4 44 flag_reset_mask bit(36) aligned static init( /* anded into flags with each char */ 4 45 "111011110111111111"b); 4 46 4 47 /* END INCLUDE FILE lisp_iochan.incl.pl1 */ 3 5 3 6 3 7 /* masks for checking iochan.flags, seeing if lisp_io_control_$fix_not_ok_iochan should be called */ 3 8 3 9 dcl not_ok_to_read bit(36) static init("0100010001"b), /* mask for checking iochan.flags on input */ 3 10 not_ok_to_write bit(36) static init("0010010001"b);/* mask for checking iochan.flags on output */ 3 11 dcl not_ok_to_read_fixnum bit(36) static init("0100010000"b), 3 12 not_ok_to_write_fixnum bit(36) static init("0010010000"b); 3 13 3 14 3 15 /* miscellaneous global, static variables and atoms used by the I/O system */ 3 16 3 17 dcl lisp_static_vars_$read_print_nl_sync bit(36) ext, 3 18 read_print_nl_sync bit(36) defined (lisp_static_vars_$read_print_nl_sync), 3 19 lisp_static_vars_$ibase ext fixed bin(71), 3 20 ibase fixed bin(71) defined (lisp_static_vars_$ibase), 3 21 3 22 lisp_static_vars_$quote_atom ext fixed bin (71), 3 23 quote_atom fixed bin(71) defined (lisp_static_vars_$quote_atom), 3 24 3 25 lisp_static_vars_$base ext fixed bin(71), 3 26 base fixed bin(71) defined ( lisp_static_vars_$base), 3 27 3 28 lisp_static_vars_$stnopoint ext fixed bin(71), 3 29 stnopoint fixed bin(71) defined (lisp_static_vars_$stnopoint), 3 30 3 31 lisp_static_vars_$tty_atom ext fixed bin(71), 3 32 tty_atom fixed bin(71) defined (lisp_static_vars_$tty_atom), 3 33 lisp_static_vars_$status_gctwa ext fixed bin(71), 3 34 status_gctwa fixed bin(71) defined (lisp_static_vars_$status_gctwa), 3 35 3 36 lisp_static_vars_$s_atom ext fixed bin(71), 3 37 s_atom fixed bin(71) defined (lisp_static_vars_$s_atom), 3 38 3 39 lisp_static_vars_$readtable ext fixed bin(71), 3 40 readtable fixed bin(71) defined (lisp_static_vars_$readtable), 3 41 3 42 lisp_static_vars_$plus_status ext fixed bin(71), 3 43 plus_status fixed bin(71) defined (lisp_static_vars_$plus_status); 3 44 5 1 /* BEGIN INCLUDE FILE lisp_control_chars.incl.pl1 */ 5 2 5 3 /* Last modified D. Reed 6/29/72 */ 5 4 5 5 dcl lisp_static_vars_$ctrlD ext fixed bin(71), 5 6 ctrlD fixed bin(71) defined (lisp_static_vars_$ctrlD); 5 7 5 8 dcl lisp_static_vars_$ctrlQ ext fixed bin(71), 5 9 ctrlQ fixed bin(71) defined (lisp_static_vars_$ctrlQ); 5 10 5 11 dcl lisp_static_vars_$ctrlR ext fixed bin(71), 5 12 ctrlR fixed bin(71) defined (lisp_static_vars_$ctrlR); 5 13 5 14 dcl lisp_static_vars_$ctrlW ext fixed bin(71), 5 15 ctrlW fixed bin(71) defined (lisp_static_vars_$ctrlW); 5 16 5 17 /* END INCLUDE FILE lisp_control_chars.incl.pl1 */ 5 18 3 45 3 46 /* END INCLUDE FILE lisp_io.incl.pl1 */ 3 47 307 6 1 /* include file lisp_stack_fmt.incl.pl1 -- 6 2* describes the format of the pushdown list 6 3* used by the lisp evaluator and lisp subrs 6 4* for passing arguments, saving atom bindings, 6 5* and as temporaries */ 6 6 6 7 dcl 6 8 temp(10000) fixed bin(71) aligned based, 6 9 6 10 temp_ptr(10000) ptr aligned based, 6 11 1 push_down_list_ptr_types(10000) based aligned, 6 12 2 junk bit(21) unaligned, 6 13 2 temp_type bit(9) unaligned, 6 14 2 more_junk bit(42) unaligned, 6 15 6 16 1 pdl_ptr_types36(10000) based aligned, 6 17 2 temp_type36 bit(36), 6 18 2 junk bit(36), 6 19 6 20 1 binding_block aligned based, 6 21 2 top_block bit(18) unaligned, 6 22 2 bot_block bit(18) unaligned, /* these two are rel pointers into the marked PDL */ 6 23 2 back_ptr bit(18) unaligned, /* relative pointer into unmarked PDL for last binding block. */ 6 24 2 rev_ptr bit(18) unaligned, /* relative pointer to reversal bb which reversed this one, init to 0 */ 6 25 6 26 1 bindings(10000) based aligned, /* format fof bindings on stack */ 6 27 2 old_val fixed bin(71) aligned, 6 28 2 atom fixed bin(71) aligned; 6 29 6 30 6 31 6 32 /* end include file lisp_stack_fmt.incl.pl1 */ 308 7 1 /* Include file lisp_cons_fmt.incl.pl1; 7 2* defines the format for a cons within the lisp system 7 3* D.Reed 4/1/71 */ 7 4 7 5 dcl consptr ptr, 7 6 1 cons aligned based (consptr), /* structure defining format for cons */ 7 7 2 car fixed bin(71), 7 8 2 cdr fixed bin(71), 7 9 7 10 1 cons_ptrs aligned based (consptr), /* for using car and cdr as pointers */ 7 11 2 car ptr, 7 12 2 cdr ptr, 7 13 7 14 7 15 1 cons_types aligned based (consptr), /* structure for extracting types out of cons */ 7 16 2 padding bit(21) unaligned, 7 17 2 car bit(9) unaligned, 7 18 2 padding2 bit(63) unaligned, 7 19 2 cdr bit(9) unaligned, 7 20 2 padend bit(42) unaligned; 7 21 7 22 dcl 1 cons_types36 aligned based, 7 23 2 car bit(36), 7 24 2 pada bit(36), 7 25 2 cdr bit(36), 7 26 2 padd bit(36); 7 27 7 28 7 29 /* end include file lisp_cons_fmt.incl.pl1 */ 309 8 1 /* Include file lisp_ptr_fmt.incl.pl1; 8 2* describes the format of lisp pointers as 8 3* a bit string overlay on the double word ITS pair 8 4* which allows lisp to access some unused bits in 8 5* the standard ITS pointer format. It should be noted that 8 6* this is somewhat of a kludge, since 8 7* it is quite machine dependent. However, to store type 8 8* fields in the pointer, saves 2 words in each cons, 8 9* plus some efficiency problems. 8 10* 8 11* D.Reed 4/1/71 */ 8 12 /* modified to move type field to other half of ptr */ 8 13 /* D.Reed 5/31/72 */ 8 14 8 15 8 16 dcl based_ptr ptr aligned based; /* for dealing with lisp values as pointers */ 8 17 dcl lisp_ptr_type bit(36) aligned based, /* for more efficient checking of type bits */ 8 18 1 lisp_ptr based aligned, /* structure of double word pointer in lisp */ 8 19 2 segno bit(18) unaligned, /* segment number pointed to by pointer */ 8 20 2 ringnum bit(3) unaligned, /* ring mumber for validation */ 8 21 2 type bit(9) unaligned, /* type field */ 8 22 2 itsmod bit(6) unaligned, 8 23 2 offset fixed bin(17) unaligned, /* offset in segment of object pointed to */ 8 24 2 chain bit(18) unaligned, /* normally 0, but may be set to chain pointers together */ 8 25 8 26 /* manifest constant strings for testing above type field */ 8 27 8 28 ( 8 29 Cons init("000000000"b), /* a pointer to a list has a zero type field */ 8 30 Fixed init("100000000"b), /* a fixed point number, stored in second word of the ptr */ 8 31 Float init("010000000"b), /* a floating number, also stored in the second word of the ptr */ 8 32 Atsym init("001000000"b), /* this bit on means a ptr to an atomic symbol */ 8 33 Atomic init("111111111"b), /* any bit on means an atomic data type */ 8 34 Bignum init("000001000"b), /* a multiple-precision number */ 8 35 Bigfix init("000001000"b), /* a fixed point bignum (only kind for now) */ 8 36 Numeric init("110000000"b), /* either type immediate number. Both bits on 8 37* means a special internal uncollectable weird object */ 8 38 Uncollectable init("110000000"b), /* not looked through by garbage collector */ 8 39 String init("000100000"b), /* pointer to lisp character string - length word, chars */ 8 40 Subr init("000010000"b), /* pointer to compiled (or builtin) subroutine (linkage) code */ 8 41 System_Subr init("000000100"b), /* Subr bit must be on too, indicates ptr into lisp_subr_tv_ */ 8 42 Array init("000000010"b), /* Subr bit must be on too, indicates ptr to a lisp array */ 8 43 File init("000000001"b) /* pointer to a file object (iochan block) */ 8 44 ) bit(9) static, 8 45 8 46 /* 36 bit manifest constant strings for testing lisp_ptr_type */ 8 47 8 48 8 49 ( 8 50 Cons36 init("000000000000000000000000000000"b), 8 51 Fixed36 init("000000000000000000000100000000"b), 8 52 Float36 init("000000000000000000000010000000"b), 8 53 Atsym36 init("000000000000000000000001000000"b), 8 54 Atomic36 init("000000000000000000000111111100"b), 8 55 Bignum36 init("000000000000000000000000001000"b), 8 56 System_Subr36 8 57 init("000000000000000000000000000100"b), 8 58 Bigfix36 init("000000000000000000000000001000"b), 8 59 Numeric36 init("000000000000000000000110000000"b), /* does not check for bignum */ 8 60 NotConsOrAtsym36 8 61 init("000000000000000000000110111111"b), 8 62 SubrNumeric36 8 63 init("000000000000000000000110010000"b), /* used in garbage collector, for quick check */ 8 64 String36 init("000000000000000000000000100000"b), 8 65 Subr36 init("000000000000000000000000010000"b), 8 66 File36 init("000000000000000000000000000001"b), 8 67 Array36 init("000000000000000000000000000010"b)) bit(36) aligned static, 8 68 8 69 /* undefined pointer value is double word of zeros */ 8 70 8 71 Undefined bit(72) static init(""b); 8 72 8 73 /* end of include file lisp_ptr_fmt.incl.pl1 */ 310 9 1 9 2 /* BEGIN INCLUDE FILE lisp_error_codes.incl.pl1 */ 9 3 9 4 /* This contains codes to be stored on the unmkd pdl before calling 9 5* lisp_error_. These codes, at ab|-2,x7, are used by lisp_error_ 9 6* as an index into lisp_error_table_. */ 9 7 9 8 dcl ( 9 9 undefined_atom init(100), /* - correctable */ 9 10 undefined_function init(101), /* - correctable */ 9 11 too_many_args init(102), /* uncorrectable */ 9 12 too_few_args init(103), /* .. */ 9 13 file_system_error init(104), /* (obsolete) */ 9 14 bad_argument init(105), /* uncorrectable arg reject */ 9 15 undefined_subr init(106), 9 16 bad_function init(107), /* "bad functional form" */ 9 17 bad_bv init(108), /* attempt to bind non-variable */ 9 18 unseen_go_tag init(109), /* correctable -> unevaled new tag */ 9 19 throw_to_no_catch init(110), /* .. */ 9 20 nonfixedarg init(111), /* correctable */ 9 21 parenmissing init(112), /* uncorr reader error */ 9 22 doterror init(113), /* .. */ 9 23 illobj init(114), /* .. */ 9 24 badmacro init(115), /* .. */ 9 25 shortreadlist init(116), /* .. */ 9 26 badreadlist init(117), /* .. */ 9 27 array_bound_error init(118), /* corr -> (array sub1 sub2...) */ 9 28 car_cdr_error init(119), /* uncorr - car or cdr of number */ 9 29 bad_arg_correctable init(120), /* correctable arg reject */ 9 30 bad_prog_op init(121), /* uncorr fail-act: go or return */ 9 31 no_lexpr init(122), /* uncorr fail-act: args or setarg */ 9 32 wrong_no_args init(123), /* correctable wna -> new expr value */ 9 33 bad_ibase init(124), /* corr */ 9 34 bad_base init(125), /* corr */ 9 35 bad_input_source init(126), /* corr - retry i/o */ 9 36 bad_output_dest init(127), /* .. */ 9 37 nihil_ex_nihile init(128), /* uncorr - attempt to setq nil */ 9 38 not_pdl_ptr init(131), /* corr arg reject - for pdl ptr args */ 9 39 bad_f_fcn init(134), /* compiled call to fsubr with evaled args */ 9 40 overflow_err init(135), /* arithmetic overflow. */ 9 41 mismatch_super_parens init(136), /* uncorr reader error */ 9 42 no_left_super_paren init(137), /* .. */ 9 43 flonum_too_big init(138), /* .. */ 9 44 quoterror init(139), /* .. */ 9 45 badreadtable init(140), /* .. */ 9 46 badobarray init(141), /* .. */ 9 47 atan_0_0_err init(142), /* (atan 0 0) doesn't work */ 9 48 unable_to_float init(143), /* corr arg reject - (float x) */ 9 49 division_by_zero init(144), /* uncorr (should really be corr) */ 9 50 eof_in_object init(145), /* corr fail-act -> keep reading anyway */ 9 51 cant_filepos init(146), /* corr fail-act -> new expr value */ 9 52 filepos_oob init(147), /* .. */ 9 53 file_sys_fun_err init(148), /* corr f.s. err -> new expr value */ 9 54 stars_left_in_name init(149), /* .. */ 9 55 io_wrong_direction init(150), /* .. */ 9 56 file_is_closed init(151), /* .. */ 9 57 reopen_inconsistent init(152), /* .. */ 9 58 bad_entry_name init(153), /* .. */ 9 59 bad_do_format init(154), /* bad do format in interp. */ 9 60 not_an_array init(155), /* bad array-type arg */ 9 61 not_alpha_array init(156), /* bad all-alphabetic array */ 9 62 include_file_error init(157), /* %include barfed */ 9 63 stack_loss_error init(158), /* stack overflew */ 9 64 underflow_fault init(159), 9 65 zerodivide_fault init(160), 9 66 bad_array_subscript init(161), 9 67 store_not_allowed init(162), 9 68 dead_array_reference init(163), 9 69 cant_subscript_readtable init(164), 9 70 not_same_type init(165), 9 71 special_array_type init(166), 9 72 array_too_big init(167), 9 73 argument_must_be_array init(168), 9 74 store_function_misused init(169) 9 75 ) fixed bin static; 9 76 9 77 /* END INCLUDE FILE lisp_error_codes.incl.pl1 */ 311 10 1 10 2 /* BEGIN INCLUDE FILE lisp_name_codes.incl.pl1 */ 10 3 10 4 /* These are codes for the names of functions which are stored into ab|-1,x7 before 10 5* calling lisp_error_ for a bad_argument or bad_arg_correctable error. They 10 6* are used so that the name of the function which is rejecting its argument 10 7* can be printed. Please note that all these codes are negative. */ 10 8 10 9 dcl ( 10 10 fn_do init (-10), 10 11 fn_arg init (-11), 10 12 fn_setarg init (-12), 10 13 fn_status init (-13), 10 14 fn_sstatus init (-14), 10 15 fn_errprint init (-15), 10 16 fn_errframe init (-16), 10 17 fn_evalframe init (-17), 10 18 fn_defaultf init (-18), 10 19 fn_tyo init (-22), 10 20 fn_ascii init (-23), 10 21 fn_rplaca init (-24), 10 22 fn_definedp init (-25), 10 23 fn_setq init (-26), 10 24 fn_set init (-27), 10 25 fn_delete init (-28), 10 26 fn_delq init (-29), 10 27 fn_stringlength init (-30), 10 28 fn_catenate init (-31), 10 29 fn_array init (-32), 10 30 fn_substr init (-33), 10 31 fn_index init (-34), 10 32 fn_get_pname init (-35), 10 33 fn_make_atom init (-36), 10 34 fn_ItoC init (-37), 10 35 fn_CtoI init (-38), 10 36 fn_defsubr init (-39), 10 37 fn_star_array init (-40), 10 38 fn_args init (-41), 10 39 fn_sysp init (-42), 10 40 fn_get init (-43), 10 41 fn_getl init (-44), 10 42 fn_putprop init (-45), 10 43 fn_remprop init (-46), 10 44 fn_save init (-47), 10 45 fn_add1 init (-48), 10 46 fn_sub1 init (-49), 10 47 fn_greaterp init (-50), 10 48 fn_lessp init (-51), 10 49 fn_minus init (-52), 10 50 fn_plus init (-53), 10 51 fn_times init (-54), 10 52 fn_difference init (-55), 10 53 fn_quotient init (-56), 10 54 fn_abs init (-57), 10 55 fn_expt init (-58), 10 56 fn_boole init (-59), 10 57 fn_rot init (-60), 10 58 fn_lsh init (-61), 10 59 fn_signp init (-62), 10 60 fn_fix init (-63), 10 61 fn_float init (-64), 10 62 fn_remainder init (-65), 10 63 fn_max init (-66), 10 64 fn_min init (-67), 10 65 fn_add1_fix init (-68), 10 66 fn_add1_flo init (-69), 10 67 fn_sub1_fix init (-70), 10 68 fn_sub1_flo init (-71), 10 69 fn_plus_fix init (-72), 10 70 fn_plus_flo init (-73), 10 71 fn_times_fix init (-74), 10 72 fn_times_flo init (-75), 10 73 fn_diff_fix init (-76), 10 74 fn_diff_flo init (-77), 10 75 fn_quot_fix init (-78), 10 76 fn_quot_flo init (-79), 10 77 fn_eval init (-80), 10 78 fn_apply init (-81), 10 79 fn_prog init (-82), 10 80 fn_errset init (-83), 10 81 fn_catch init (-84), 10 82 fn_throw init (-85), 10 83 fn_store init (-86), 10 84 fn_defun init (-87), 10 85 fn_baktrace init (-88), 10 86 fn_bltarray init (-89), 10 87 fn_star_rearray init (-90), 10 88 fn_gensym init (-91), 10 89 fn_makunbound init (-92), 10 90 fn_boundp init (-93), 10 91 fn_star_status init (-94), 10 92 fn_star_sstatus init (-95), 10 93 fn_freturn init (-96), 10 94 fn_cos init (-97), 10 95 fn_sin init (-98), 10 96 fn_exp init (-99), 10 97 fn_log init (-100), 10 98 fn_sqrt init (-101), 10 99 fn_isqrt init (-102), 10 100 fn_atan init (-103), 10 101 fn_sleep init (-104), 10 102 fn_oddp init (-105), 10 103 fn_tyipeek init (-106), 10 104 fn_alarmclock init (-107), 10 105 fn_plusp init (-108), 10 106 fn_minusp init (-109), 10 107 fn_ls init (-110), 10 108 fn_eql init (-111), 10 109 fn_gt init (-112), 10 110 fn_alphalessp init (-113), 10 111 fn_samepnamep init (-114), 10 112 fn_getchar init (-115), 10 113 fn_opena init (-116), 10 114 fn_sxhash init (-117), 10 115 fn_gcd init (-118), 10 116 fn_allfiles init (-119), 10 117 fn_chrct init (-120), 10 118 fn_close init (-121), 10 119 fn_deletef init (-122), 10 120 fn_eoffn init (-123), 10 121 fn_filepos init (-124), 10 122 fn_inpush init (-125), 10 123 fn_linel init (-126), 10 124 fn_mergef init (-127), 10 125 fn_namelist init (-128), 10 126 fn_names init (-129), 10 127 fn_namestring init (-130), 10 128 fn_openi init (-131), 10 129 fn_openo init (-132), 10 130 fn_prin1 init (-133), 10 131 fn_princ init (-134), 10 132 fn_print init (-135), 10 133 fn_read init (-136), 10 134 fn_readch init (-137), 10 135 fn_readstring init (-138), 10 136 fn_rename init (-139), 10 137 fn_shortnamestring init (-140), 10 138 fn_tyi init (-141), 10 139 fn_setsyntax init (-142), 10 140 fn_cursorpos init (-143), 10 141 fn_force_output init (-144), 10 142 fn_clear_input init (-145), 10 143 fn_random init (-146), 10 144 fn_haulong init (-147), 10 145 fn_haipart init (-148), 10 146 fn_cline init (-149), 10 147 fn_fillarray init (-150), 10 148 fn_listarray init (-151), 10 149 fn_sort init (-152), 10 150 fn_sortcar init (-153), 10 151 fn_zerop init (-154), 10 152 fn_listify init (-155), 10 153 fn_charpos init (-156), 10 154 fn_pagel init (-157), 10 155 fn_linenum init (-158), 10 156 fn_pagenum init (-159), 10 157 fn_endpagefn init (-160), 10 158 fn_arraydims init (-161), 10 159 fn_loadarrays init (-162), 10 160 fn_dumparrays init (-163), 10 161 fn_expt_fix init (-164), 10 162 fn_expt_flo init (-165), 10 163 fn_nointerrupt init (-166), 10 164 fn_open init (-167), 10 165 fn_in init (-168), 10 166 fn_out init (-169), 10 167 fn_truename init (-170), 10 168 fn_ifix init (-171), 10 169 fn_fsc init (-172), 10 170 fn_progv init (-173), 10 171 fn_mapatoms init (-174), 10 172 fn_unwind_protect init (-175), 10 173 fn_eval_when init (-176), 10 174 fn_read_from_string init (-177), 10 175 fn_displace init (-178), 10 176 fn_nth init (-179), 10 177 fn_nthcdr init (-180), 10 178 fn_includef init (-181) 10 179 ) fixed bin static; 10 180 10 181 /* END INCLUDE FILE lisp_name_codes.incl.pl1 */ 312 11 1 /***** BEGIN INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 11 2 11 3 /* This include file defines the format of the "new" LISP arrays. 11 4* Written 74.05.13 by DAM */ 11 5 11 6 /* Info block in static space. pointed at by array ptr */ 11 7 11 8 dcl 1 array_info aligned based structure, /* 8 words long */ 11 9 2 ndims fixed bin(17) unaligned, /* number of dimensions */ 11 10 2 gc_mark bit(18) unaligned, /* alternating bits for garbage coll. */ 11 11 2 call_array_operator bit(36), /* tspbp instruction to array opr */ 11 12 2 array_data_ptr pointer, /* -> array_data structure */ 11 13 2 array_load_sequence(3) bit(36), /* lda, ldq, tra bp|0 */ 11 14 2 type fixed bin(17) unaligned, /* type of array, see dcl below */ 11 15 2 minus_2_times_ndims fixed bin(17) unaligned; /* for convenience of array opr */ 11 16 11 17 /* Codes for the different types of arrays: 11 18* Name Value arg to *array to create one */ 11 19 11 20 dcl (S_expr_array init(0), /* t */ 11 21 Un_gc_array init(1), /* nil */ 11 22 Fixnum_array init(2), /* fixnum */ 11 23 Flonum_array init(3), /* flonum */ 11 24 Readtable_array init(4), /* readtable */ 11 25 Obarray_array init(5), /* obarray */ 11 26 Dead_array init(6) /* (*rearray a) */ 11 27 ) fixed bin(17) static; 11 28 11 29 /* Block of array data and dimensions, in garbage-collected Lists space */ 11 30 11 31 dcl 1 array_data aligned based structure, 11 32 2 dope_vector(ZERO), /* address by dope_vector(i-ndims). no way to dcl in PL/I */ 11 33 3 bounds fixed bin(35), /* 0 <_ subscript < bounds */ 11 34 3 multiplier fixed bin(35), /* multiplier in polynomial-type subscript calc. */ 11 35 2 data(0:1000) fixed bin(71); /* single or double words depending on type of array */ 11 36 11 37 dcl ZERO fixed bin static init(0); /* Circumvent a compiler bug causing reference through null pointer in get_array_size$multf */ 11 38 11 39 /***** END INCLUDE FILE lisp_array_fmt.incl.pl1 *****/ 313 12 1 12 2 /* BEGIN INCLUDE FILE lisp_readtable.incl.pl1 */ 12 3 12 4 dcl num_macs fixed bin static init(8); /* size of efficient portion of macro_table */ 12 5 12 6 /* if changed, the declarations below must also be changed */ 12 7 dcl read_table_dim_vector dimension(1) fixed bin static init(145); /* number of dbl words in read_table data */ 12 8 12 9 12 10 12 11 dcl 1 read_table aligned based(addr(addr(readtable)->based_ptr -> atom.value)->based_ptr -> array_info.array_data_ptr), 12 12 2 macro_table(8) fixed bin(71), /* -> exprs for first few macros */ 12 13 2 more_macros fixed bin(71), /* list of any remaining macros */ 12 14 2 syntax (0:131) bit(27) aligned, /* syntax bits for 128 ascii chars + 4 pseudo chars */ 12 15 2 translation (0:131) fixed bin aligned, /* character translation or index in macro_table */ 12 16 2 status_terpri bit(1) aligned, /* "1"b if (status terpri) is t */ 12 17 2 status_underline bit(1) aligned, /* "1"b if (status _) is t */ 12 18 12 19 2 status_ttyread bit(1) aligned, /* not actually used at present */ 12 20 2 abbreviate_on_files bit(1) aligned, /* (sstatus abbrev 1) */ 12 21 2 abbreviate_on_flat bit(1) aligned, /* (sstatus abbrev 2) */ 12 22 2 words_not_used_yet (3) bit(36) aligned; 12 23 12 24 12 25 /* Manifest constants for syntax bits */ 12 26 12 27 dcl ( 12 28 12 29 forcefeed init("000000100000000000000000000"b), /* used only by ITS lisp */ 12 30 vertical_motion init("000000010000000000000000000"b), /* bit on for NL and NP characters */ 12 31 string_quote_exp init("000000001000000000000000000"b), /* string quote if bit12=1, exponent if bit12 = 0 */ 12 32 special init("000000000100000000000000000"b), /* always slash if in atom */ 12 33 single_char_object init("000000000010000000000000000"b), 12 34 blank init("000000000001000000000000000"b), /* space, tab, comma, nl, etc. */ 12 35 lparn init("000000000000100000000000000"b), /* "(", bit12 => super left paren */ 12 36 dotted_pair_dot init("000000000000010000000000000"b), /* the two uses of "." are kept seperate */ 12 37 rparn init("000000000000001000000000000"b), /* ")", bit12 => super right paren */ 12 38 macro init("000000000000000100000000000"b), 12 39 slashifier init("000000000000000010000000000"b), 12 40 rubout init("000000000000000001000000000"b), /* used only by ITS lisp */ 12 41 slash_if_first init("000000000000000000100000000"b), /* slashify if first char in pname */ 12 42 decimal_point init("000000000000000000010000000"b), 12 43 slash_if_not_first init("000000000000000000001000000"b), /* slashify on output when in pname & not 1st */ 12 44 slash_output init("000000000000000000101000000"b), /* slashify on output when in pname */ 12 45 bit12 init("000000000000000000000100000"b), /* selects from two meanings of certain other bits */ 12 46 /* NOTE: this is not really bit 12 anymore, but keep name */ 12 47 splice init("000000000000000000000100000"b), /* splicing macro */ 12 48 shift_scale init("000000000000000000000010000"b), /* left shift if bit12 = 1 12 49* fixed point scale if bit12 = 0 */ 12 50 plus_minus init("000000000000000000000001000"b), /* + if bit12 = 0, - if bit12 = 1 */ 12 51 digit init("000000000000000000000000100"b), /* decimal digit */ 12 52 extd_alpha init("000000000000000000000000010"b), /* extended alphabetic */ 12 53 alpha init("000000000000000000000000001"b) /* familiar alphabetic */ 12 54 12 55 ) bit(27) static; 12 56 12 57 /* End include file lisp_readtable.incl.pl1 */ 12 58 314 13 1 /* lisp number format -- overlaid on standard its pointer. */ 13 2 13 3 13 4 dcl 1 fixnum_fmt based aligned, 13 5 2 type_info bit(36) aligned, 13 6 2 fixedb fixed bin, 13 7 13 8 1 flonum_fmt based aligned, 13 9 2 type_info bit(36) aligned, 13 10 2 floatb float bin, 13 11 13 12 fixnum_type bit(36) aligned static init("000000000000000000000100000000100111"b), 13 13 flonum_type bit(36) aligned static init("000000000000000000000010000000100111"b); 13 14 13 15 /* end of lisp number format */ 13 16 315 14 1 /* Include file lisp_atom_fmt.incl.pl1; 14 2* describes internal format of atoms in the lisp system 14 3* D.Reed 4/1/71 */ 14 4 14 5 dcl 1 atom aligned based, /* overlay for atom fomat */ 14 6 2 value fixed bin(71), /* atom's value */ 14 7 2 plist fixed bin(71), /* property list */ 14 8 2 pnamel fixed bin, /* length of print name */ 14 9 2 pname char(1 refer(pnamel)), /* print name of atom */ 14 10 14 11 1 atom_ptrs based aligned, /* for use of plist and value of atom as ptrs */ 14 12 2 value ptr, 14 13 2 plist ptr, 14 14 14 15 1 atom_double_words based aligned, /* overlay for atom pointer checking */ 14 16 2 value bit(72), 14 17 2 plist bit(72); 14 18 14 19 /* end of include file lisp_atom_fmt.incl.pl1 */ 316 15 1 /***** BEGIN INCLUDE FILE lisp_string_fmt.incl.pl1 ***** 15 2* describes format of storage for lisp 15 3* character strings. 15 4* D. Reed 4/1/71 */ 15 5 15 6 dcl 1 lisp_string based aligned, 15 7 2 string_length fixed bin, 15 8 2 string char(1 refer(string_length)); 15 9 15 10 /***** END INCLUDE FILE lisp_string_fmt.incl.pl1 */ 317 318 319 320 321 /* 322*status: entry; /* lisp status function */ 323 324 ssf = "0"b; 325 lsubf = "0"b; 326 go to JOIN; 327 328 329 sstatus: entry; /* lisp sstatus function */ 330 331 ssf = "1"b; 332 lsubf = "0"b; 333 go to JOIN; 334 335 status_: entry; /* lsubr version of status, for compiled code only 336* since some of the error checking is omitted */ 337 ssf = "0"b; 338 lsubf = "1"b; 339 go to JOIN; 340 341 sstatus_: entry; /* lsubr version of sstatus, .. */ 342 343 ssf = "1"b; 344 lsubf = "1"b; 345 go to JOIN; 346 347 348 349 JOIN: if initss then do; /* do this prologue once only */ 350 ssatoms(5) = addr(toplevel); 351 ssatoms(8) = addr(plus_status); 352 ssatoms(40) = addr(lisp_static_vars_$divov_flag); 353 ssatoms(48) = addr(lisp_static_vars_$cleanup_list); 354 /* More will be added later */ 355 initss = "0"b; 356 end; 357 358 stack = addrel(stack_ptr, -2); 359 stack_ptr = addr(stack -> temp(6)); 360 361 if lsubf then do; /* initial set up for lsubr ves sion. First arg is number which 362* is index in names table of first arg for fsubr version */ 363 nargs = stack -> fixedb; /* get arg count */ 364 argptr = stack; 365 stack = addrel(stack, nargs); /* -> arguments */ 366 check_j: j = stack -> fixedb; /* first arg tells which function to do */ 367 if j >= 1 then if j < nnames+1 then go to j_ok; /* Check bounds, shouldn't make dangerous assumptions */ 368 i = 1; 369 call bad_arg; 370 go to check_j; 371 j_ok: 372 stack_ptr = addr(stack -> temp(6)); 373 do while (argptr ^= stack_ptr); /* nil out any arguments which were not supplied */ 374 argptr -> temp(1) = nil; 375 argptr = addr(argptr -> temp(2)); 376 end; 377 if ssf then ssbit = ssbits(j); 378 else ssbit = sbits(j); 379 if ssbit & pname2 then do; /* make sure second arg is in bounds */ 380 l_retry_2: if stack -> temp_type36(2) & Fixed36 then; 381 else go to l_loss_2; 382 m = addr(stack -> temp(2)) -> fixedb; 383 if m < 0 then go to l_loss_2; 384 if m >= 132 then go to l_loss_2; 385 end; /* WIN */ 386 if ssf then if ssbit & eval3 then do; 387 if j = 1 then do; /* special hack for sstatus chtran */ 388 n = m; 389 ssbit = ssbit & ^eval3; 390 stack -> temp(2) = stack -> temp(3); 391 go to l_retry_2; 392 end; 393 end; 394 go to lsub_join; /* args are already in proper slots on stack */ 395 l_loss_2: 396 i = 2; 397 call bad_arg; 398 go to l_retry_2; 399 end; 400 401 retry: /* error checking */ 402 403 call check_arg; 404 405 stack -> temp(2) = stack -> temp(5); /* get first arg */ 406 retry_1: if stack -> temp_type36(2) & Atsym36 then; 407 else do; 408 loss_1: i = 2; /* first arg is here */ 409 call bad_arg; 410 go to retry_1; 411 end; 412 413 /* look up first 4 letters of pname of first arg in table */ 414 415 char4 = addr(stack -> temp_ptr(2) -> atom.pname) -> char4b; 416 do j = 1 to nnames; 417 if char4 = names(j) then go to got_it; 418 end; 419 go to loss_1; 420 421 422 got_it: 423 if ssf then ssbit = ssbits(j); 424 else ssbit = sbits(j); /* different bits for status & sstatus */ 425 426 if ssbit & illeg then go to loss_1; 427 if ssbit & (eval2 | pname2) then; /* a 2nd arg is wanted */ 428 else go to no_2nd_arg; /* 2nd arg not wanted -- don't check for it */ 429 call check_arg; /* get 2nd arg in stack -> temp(5) */ 430 if ssbit & eval2 then do; 431 call lisp_$eval; 432 stack -> temp(2) = stack -> temp(5); 433 end; 434 else if ssbit & pname2 then 435 retry_2: if stack -> temp_type36(5) & Atsym36 then /* winner! */ 436 m = fixed(unspec(substr(stack -> temp_ptr(5) -> atom.pname, 1, 1)), 9); 437 else do; /* allow a number in place of a character */ 438 call lisp_$eval; /* eval 2nd arg which is in stack -> temp(5) */ 439 if stack -> temp_type36(5) & Fixed36 then do; /* number, check range */ 440 m = addr(stack -> temp(5)) -> fixedb; 441 if m >= 0 & m < 132 then go to ok2; 442 end; 443 i = 5; 444 call bad_arg; 445 go to retry_2; 446 end; 447 448 449 ok2: if ssf then if ssbit & eval3 then do; 450 call check_arg; /* make sure there is a 3rd arg to be evaled */ 451 if j = 1 then do; /* sstatus chtran, we want to allow a pname atom as 3rd arg too */ 452 ssbit = ssbit & ^eval3; /* avoid loop */ 453 n = m; /* save 2nd arg -- NB: ssaction(1) hence gets its args backwards */ 454 go to retry_2; /* go process pname arg, go to ssaction(1) with it in m */ 455 end; 456 call lisp_$eval; 457 stack -> temp(3) = stack -> temp(5); 458 end; 459 lsub_join: 460 if ssbit & t_or_nil then 461 if stack -> temp(2) ^= nil then stack -> temp(2) = t_atom; /* use only nil or t */ 462 no_2nd_arg: 463 if ssbit & stoval then do; 464 if ssf then ssatoms(j) -> temp(1) = stack -> temp(2); /* set new value */ 465 stack -> temp(1) = ssatoms(j) -> temp(1); /* return value of the atom or internal flag */ 466 go to exit; 467 end; 468 469 if ssf then go to ssaction(j); /* perform special action */ 470 else go to saction(j); 471 472 473 /* useful internal procs */ 474 475 check_arg: proc; /* make sure there is one more arg */ 476 477 if stack -> temp(1) = nil then go to too_few; 478 else if stack -> temp_type(1) then 479 too_few: stack -> temp(5) = nil; /* If no arg given, use nil. */ 480 else do; 481 stack -> temp(5) = stack -> temp_ptr(1) -> cons.car; 482 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 483 end; 484 485 end check_arg; 486 487 488 verify_num: proc; 489 490 re_verify_num: 491 if stack -> temp_type36(i) & Fixed36 then do; 492 n = addr(stack -> temp(i)) -> fixedb; 493 return; 494 end; 495 else /* error - wrong type arg */; 496 497 call ill_arg; 498 go to re_verify_num; 499 500 end; 501 502 bad_arg: 503 /* Called when a bad arg is detected. It signals a correctable error 504* and tries to get a replacement arg that is better. 505* i is the loc on the stack of the bad arg */ 506 ill_arg: proc; /* call lisp_error_ to get a better arg */ 507 508 if ssf then if lsubf then myname = fn_star_sstatus; 509 else myname = fn_sstatus; 510 else if lsubf then myname = fn_star_status; 511 else myname = fn_status; 512 513 ill_arg_nsm: entry; /* myname is already set */ 514 515 unm = unmkd_ptr; 516 unmkd_ptr = addrel(unm, 2); 517 unm -> errcode(1) = bad_arg_correctable; 518 unm -> errcode(2) = myname; 519 stack_ptr = addr(stack -> temp(7)); 520 stack -> temp(6) = stack -> temp(i); 521 call lisp_error_; 522 stack -> temp(i) = stack -> temp(6); /* move corrected arg back */ 523 stack_ptr = addr(stack -> temp(6)); 524 end; 525 526 rset: entry; /* the lisp *rset function, which just does a (sstatus *rset arg) */ 527 528 stack = addrel(stack_ptr, -2); 529 if stack -> temp(1) ^= nil then stack -> temp(1) = t_atom; 530 addr(star_rset) -> based_ptr -> atom.value = stack -> temp(1); 531 return; 532 533 534 535 noret: entry; /* the lisp noret function which is the same as (sstatus noret arg) */ 536 537 stack = addrel(stack_ptr, -2); 538 if stack -> temp(1) ^= nil then stack -> temp(1) = t_atom; 539 addr(lisp_static_vars_$noret_flag)->based_ptr -> atom.value = stack -> temp(1); 540 return; 541 542 /* special action routines */ 543 544 545 ssaction(1): /* sstatus chtran m n */ 546 sw = "0"b; 547 i = m; /* args are interchanged, so put them back the way */ 548 m = n; /* rdtbl wants them to be */ 549 n = i; 550 go to rdtbl1; 551 552 ssaction(4): /* sstatus syntax m n */ 553 sw = "1"b; 554 555 rdtbl: 556 i = 3; 557 call verify_num; 558 rdtbl1: call del_macro; /* remove any previous macro property */ 559 if sw then syntax(m) = bit(fixed(n, 27), 27); 560 else translation(m) = n; 561 go to ret_fix; 562 563 564 565 saction(1): /* status chtran m */ 566 if syntax(m) & macro then n = m; 567 else n = translation(m); 568 go to ret_fix; 569 570 saction(4): /* status syntax m */ 571 n = fixed(syntax(m), 27); 572 /* and fall into ret_fix */ 573 574 ret_fix: stack -> fixnum_fmt.type_info = fixnum_type; 575 stack -> fixedb = n; 576 go to exit; 577 578 del_macro: proc; /* removes the macro property of the character m */ 579 580 dcl newsyntax bit(27); /* temp reg */ 581 582 if syntax(m) & macro 583 then do; 584 newsyntax = std_syntax(m); /* set back to original syntax */ 585 mm = translation(m); /* remember which macro it was */ 586 if newsyntax & macro then do; 587 newsyntax = extd_alpha | slash_output; /* unless that was a macro too */ 588 translation(m) = m; 589 end; 590 else translation(m) = std_translation(m); /* initial chtran too */ 591 syntax(m) = newsyntax; 592 end; 593 else return; /* if not a macro, easy to unmacro it */ 594 if mm <= num_macs then do; /* easy kind */ 595 macro_table(mm) = nil; 596 end; 597 else do; /* hard kind - have to take off list & fake out other macros */ 598 stack -> temp(4) = more_macros; 599 stack -> temp(5) = nil; 600 do i = num_macs+1 to mm; /* scan down the more_macros list */ 601 stack -> temp(5) = stack -> temp(4); 602 stack -> temp(4) = stack -> temp_ptr(4) -> cons.cdr; 603 end; 604 if stack -> temp(5) = nil then 605 more_macros = stack -> temp_ptr(4) -> cons.cdr; 606 else 607 stack -> temp_ptr(5) -> cons.cdr = stack -> temp_ptr(4) -> cons.cdr; 608 609 /* now fudge all macros greater than mm to move down one */ 610 611 do i = 0 to 131; 612 if syntax(i) & macro then if translation(i) > mm then 613 translation(i) = translation(i) - 1; 614 end; 615 end; 616 end; 617 618 /*** the setsyntax subr for munging the readtable ***/ 619 620 setsyntax: entry; 621 622 stack = addrel(stack_ptr, -6); /* 3 args */ 623 myname = fn_setsyntax; 624 625 /* first arg specifies character, put ascii code in m */ 626 627 snx1a: if stack -> fixnum_fmt.type_info = fixnum_type 628 then if stack -> fixedb >= 0 629 then if stack -> fixedb < 128 630 then m = stack -> fixedb; 631 else go to snx1; 632 else go to snx1; 633 else if stack -> temp_type36(1) & String36 634 then m = fixed(unspec(substr(stack -> temp_ptr(1) -> lisp_string.string, 1, 1)), 9); 635 else if stack -> temp_type36(1) & Atsym36 636 then m = fixed(unspec(substr(stack -> temp_ptr(1) -> atom.pname, 1, 1)), 9); 637 else do; 638 snx1: i = 1; 639 call ill_arg_nsm; 640 go to snx1a; 641 end; 642 643 /* in any case, get rid of m's previous macro property */ 644 645 call del_macro; 646 647 /* second arg is nil or syntax specifier, put syntax bits in n or -1 or jump away */ 648 649 650 snx2a: if addr(stack -> temp(2))->fixnum_fmt.type_info = fixnum_type 651 then n = addr(stack -> temp(2))->fixedb; 652 else if stack -> temp(2) = nil then n = -1; /* meaning no-change */ 653 else if stack -> temp_type36(2) & String36 then do; 654 pnamep = stack -> temp_ptr(2); 655 snx2jsa: 656 if pnamep -> lisp_string.string_length < 2 then do; /* 1 or 0 - for the null pname - is a character */ 657 n = fixed(unspec(substr(pnamep -> lisp_string.string, 1, 1)), 9); 658 if n < 0 then go to snx2; 659 if n >= 128 then go to snx2; 660 n = fixed(std_syntax(n)); /* pick up original syntax for char */ 661 end; 662 else do; /* decode special names here */ 663 char4 = addrel(pnamep, 1) -> char4b; /* pick up first word of pname */ 664 if char4 = "sing" then n = 110000000101000000b; /* single char obj -- 600500 octal */ 665 else if char4 = "macr" then go to snxmacro; 666 else if char4 = "spli" then go to snxsplice; 667 else go to snx2; 668 end; 669 end; 670 else if stack -> temp_type36(2) & Atsym36 then do; 671 pnamep = addr(stack -> temp_ptr(2) -> atom.pnamel); 672 go to snx2jsa; /* common code with strings */ 673 end; 674 else do; 675 snx2: i = 2; 676 call ill_arg_nsm; 677 go to snx2a; 678 end; 679 680 /* third arg specifies chtran, ascii code (or -1 for no change) is put in mm */ 681 682 snx3a: if addr(stack -> temp(3))->fixnum_fmt.type_info = fixnum_type 683 then if addr(stack -> temp(3))->fixedb >= 0 684 then if addr(stack -> temp(3))->fixedb < 128 685 then mm = addr(stack -> temp(3))->fixedb; 686 else go to snx3; 687 else go to snx3; 688 else if stack -> temp_type36(3) & String36 689 then mm = fixed(unspec(substr(stack -> temp_ptr(3) -> lisp_string.string, 1, 1)), 9); 690 else if stack -> temp(3) = nil then mm = -1; /* no-change */ 691 else if stack -> temp_type36(3) & Atsym36 692 then mm = fixed(unspec(substr(stack -> temp_ptr(3) -> atom.pname, 1, 1)), 9); 693 else do; 694 snx3: i = 3; 695 call ill_arg_nsm; 696 go to snx3a; 697 end; 698 699 /* at last, we're ready to actually do it - char = m, syntax = n, chtran = mm */ 700 701 if n >= 0 then syntax(m) = bit(fixed(n, 27), 27); /* pack fx into bs */ 702 if mm >= 0 then translation(m) = mm; 703 return_t: stack -> temp(1) = t_atom; 704 go to exit; 705 706 /* special versions of setsyntax for macros - entered by goto from arg 2 decode above */ 707 708 snxmacro: if stack -> temp(3) = nil then go to return_t; /* macro property has already been deleted */ 709 syntax(m) = special | macro | slash_output; 710 stack_ptr = addr(stack -> temp(6)); /* compat with old sstatus macro form */ 711 go to ssa3a; /* go join with (sstatus macro) code */ 712 713 snxsplice: 714 if stack -> temp(3) = nil then go to return_t; /* same comments as above */ 715 syntax(m) = special | macro | slash_output | splice; 716 stack_ptr = addr(stack -> temp(6)); 717 go to ssa3a; 718 719 ssaction(3): /* sstatus macro c (form) [splicing] */ 720 721 sw = "0"b; 722 call del_macro; /* if already was a macro, get rid of old macro property */ 723 if stack -> temp(3) = nil then go to return_nil; /* (sstatus macro c nil) just removes macro prop. */ 724 725 if lsubf then if stack -> temp(4) = nil then go to reg_mac; 726 else go to splice_mac; 727 else if stack -> temp_type(1) | stack -> temp(1) = nil then; 728 else if stack -> temp_ptr(1) -> cons_types36.car & Atsym36 729 then if substr(stack -> temp_ptr(1) -> cons_ptrs.car -> atom.pname, 1, 1) = "s" 730 then do; 731 splice_mac: syntax(m) = special | macro | slash_output | splice; 732 go to ssa3a; 733 end; 734 reg_mac: syntax(m) = special | macro | slash_output; 735 myname = fn_sstatus; /* because setsyntax joins here but has to 736* return a different value. */ 737 ssa3a: 738 do i = 1 to num_macs; 739 if macro_table(i) = nil then do; /* grab this free slot */ 740 macro_table(i) = stack -> temp(3); 741 translation(m) = i; 742 go to ssa3b; 743 end; 744 end; 745 /* LOSER -- have to append to more_macros list */ 746 747 748 sw = "1"b; 749 stack -> temp(4) = more_macros; 750 stack -> temp(5) = nil; 751 do i = num_macs+1 by 1 while (stack -> temp(4) ^= nil); 752 stack -> temp(5) = stack -> temp(4); 753 stack -> temp(4) = stack -> temp_ptr(4) -> cons.cdr; 754 end; 755 756 stack -> temp(4) = stack -> temp(3); /* cons up a list node */ 757 stack -> temp(3) = stack -> temp(5); /* saving this */ 758 stack -> temp(5) = nil; 759 call lisp_special_fns_$cons; 760 stack_ptr = addr(stack -> temp(6)); /* because cons has changed it */ 761 if stack -> temp(3) = nil then more_macros = stack -> temp(4); 762 else stack -> temp_ptr(3) -> cons.cdr = stack -> temp(4); 763 translation(m) = i; 764 ssa3b: if myname = fn_setsyntax then go to return_t; 765 else go to saction3a; 766 767 saction(3): /* status macro c - returns list of the function and nil or s */ 768 769 /* find the macro */ 770 771 if syntax(m) & macro then; 772 else do; /* not a macro char., return nil */ 773 return_nil: stack -> temp(1) = nil; 774 go to exit; 775 end; 776 i = translation(m); 777 if i < num_macs then sw = "0"b; 778 else do; 779 /* hard case, have to get it off the list */ 780 781 sw = "1"b; 782 stack -> temp(4) = more_macros; 783 stack -> temp(5) = nil; 784 do i = num_macs+1 to i; 785 stack -> temp(5) = stack -> temp(4); 786 stack -> temp(4) = stack -> temp_ptr(4) -> cons.cdr; 787 end; 788 end; 789 790 saction3a: /* cons up a list of the form and s or nil */ 791 792 if sw then stack -> temp(3) = stack -> temp_ptr(4) -> cons.car; 793 else stack -> temp(3) = macro_table(i); 794 stack -> temp(5) = nil; 795 if syntax(m) & splice then stack -> temp(4) = s_atom; 796 else stack -> temp(4) = nil; 797 call lisp_special_fns_$cons; 798 call lisp_special_fns_$cons; 799 stack -> temp(1) = stack -> temp(3); 800 go to exit; 801 802 803 ssaction(6): /* (sstatus uread -args-) */ 804 switch = 0; 805 go to ss67com; 806 ssaction(15): /* (sstatus crunit -args-) */ 807 808 switch = 1; 809 go to ss67com; 810 811 812 ssaction(7): /* (sstatus uwrite -args- ) */ 813 814 switch = 2; 815 816 ss67com: /* just call uread or uwrite with the given args */ 817 818 819 /* How clever, stack -> temp(1) is currently list of rest of args to sstatus */ 820 821 stack_ptr = addr(stack -> temp(3)); 822 stack -> temp(2) = stack -> temp(1); /* have to use apply since uread is now in lisp code */ 823 go to ssio(switch); 824 ssiojn: call lisp_$apply; 825 return; 826 827 ssio(0): stack -> temp_ptr(1) = lisp_static_vars_$uread_atom; 828 go to ssiojn; 829 ssio(1): stack -> temp(1) = lisp_static_vars_$crunit_atom; 830 go to ssiojn; 831 ssio(2): stack -> temp_ptr(1) = lisp_static_vars_$uwrite_atom; 832 go to ssiojn; 833 834 exit: stack_ptr = addr(stack -> temp(2)); 835 rtn: return; 836 837 /* 838* * status uread, uwrite, and crunit for the new I/O system 839* */ 840 841 saction(7): /* (status uwrite) */ 842 843 stack -> temp(1) = uwrite; 844 go to s_ur_uw; 845 846 saction(6): /* (status uread) */ 847 848 stack -> temp(1) = uread; 849 s_ur_uw: 850 if stack -> temp(1) = nil then go to exit; 851 s_cr: stack_ptr = addr(stack -> temp(3)); 852 addr(stack -> temp(2)) -> fixnum_fmt.type_info = fixnum_type; 853 addr(stack -> temp(2)) -> fixedb = -2; 854 call lisp_io_fns_$names; 855 856 s_cr_reform: 857 stack_ptr = addr(stack -> temp(6)); 858 stack -> temp(5) = nil; 859 stack -> temp(4) = stack -> temp_ptr(1) -> cons.car; 860 stack -> temp(3) = lisp_static_vars_$dsk_atom; 861 stack -> temp(2) = stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons_ptrs.cdr -> cons.car; 862 stack -> temp(1) = stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons.car; 863 call lisp_special_fns_$cons; 864 call lisp_special_fns_$cons; 865 if j ^= 6 then do; /* (status uwrite), (status crunit) take only last 2 things in list */ 866 stack -> temp(1) = stack -> temp(3); 867 go to exit; 868 end; 869 call lisp_special_fns_$cons; 870 call lisp_special_fns_$cons; 871 return; 872 873 saction(15): /* (status crunit) */ 874 875 stack -> temp(1) = addr(lisp_static_vars_$old_io_defaults)->based_ptr -> atom.value; 876 if stack -> temp(1) = nil then go to s_cr; 877 else go to s_cr_reform; 878 879 /* (status features) and (status feature foo) are implemented here */ 880 881 saction(37): 882 883 /* Watch out for status feature NIL, as opposed to Multics. */ 884 885 if stack -> temp(1) = nil then do; /* (status features) - return list */ 886 stack -> temp(1) = addr(lisp_static_vars_$semicolon_macro) /* KLUDGE */ 887 -> based_ptr -> atom.value; 888 go to exit; 889 end; 890 call check_arg; 891 892 if find_feature () then go to return_t; 893 else go to return_nil; 894 895 896 ssaction(37): /* (sstatus feature foo) - make foo a feature */ 897 898 call check_arg; 899 if find_feature () then go to return_t; /* Don't double them */ 900 stack -> temp(4) = addr(lisp_static_vars_$semicolon_macro) -> based_ptr -> atom.value; 901 stack_ptr = addr(stack -> temp(6)); 902 call lisp_special_fns_$xcons; 903 addr(lisp_static_vars_$semicolon_macro)-> based_ptr -> atom.value = stack -> temp(4); 904 go to return_t; /* say we won */ 905 906 ssaction(46): /* (sstatus nofeature foo) - cause foo to not be a feature */ 907 908 call check_arg; 909 stack -> temp_ptr(2) = addrel(addr(lisp_static_vars_$semicolon_macro)->based_ptr, -2); 910 911 if find_feature () 912 then stack -> temp_ptr(2) -> cons.cdr = stack -> temp_ptr(1) -> cons.cdr; 913 go to return_t; 914 915 916 saction(47): /* (status linmode) just return t because Multics always runs in line mode */ 917 918 go to return_t; 919 920 /* evalhook stuff */ 921 922 saction(49): 923 if lisp_static_vars_$evalhook_status = lisp_$evalhook_on_status 924 then go to return_t; 925 else go to return_nil; 926 927 ssaction(49): 928 stack -> temp(1) = stack -> temp(2); 929 if stack -> temp(1) = nil 930 then lisp_static_vars_$evalhook_status = lisp_$evalhook_off_status; 931 else lisp_static_vars_$evalhook_status = lisp_$evalhook_on_status; 932 go to exit; 933 934 /* (status system 'atom) returns list of system properties of atom, i.e. value and fcnl properties */ 935 936 937 saction(31): 938 do while (^stack -> temp_type36(2) & Atsym36); /* make sure it has a property list */ 939 i = 2; 940 call bad_arg; 941 end; 942 stack -> temp(3) = nil; /* init return value */ 943 do argptr = addr(lisp_static_vars_$first_value_atom) /* see if value cell is used by system */ 944 repeat(addrel(argptr, 2)) 945 while(argptr ^= addr(lisp_static_vars_$last_value_atom)); 946 if argptr -> temp(1) = stack -> temp(2) then do; 947 stack_ptr = addr(stack -> temp(5)); 948 stack -> temp(4) = lisp_static_vars_$value_atom; 949 call lisp_special_fns_$xcons; 950 go to saction_31_a; /* escape from the loop */ 951 end; 952 end; 953 saction_31_a: 954 stack_ptr = addr(stack -> temp(5)); 955 stack -> temp(4) = stack -> temp(2); 956 call lisp_defsubr_$sysp; /* get indicator of system fcnl property, if there is one */ 957 if stack -> temp(4) ^= nil then call lisp_special_fns_$xcons; 958 stack -> temp(1) = stack -> temp(3); 959 go to exit; 960 961 962 963 /* (status charmode f), (sstatus charmode x f) -- fiddle iochan.interactive bit */ 964 965 ssaction(32): 966 stack -> temp(1) = stack -> temp(2); /* get file arg in temp(2) */ 967 stack -> temp(2) = stack -> temp(3); 968 saction(32): 969 if stack -> temp(2) = nil then argptr = tty_output_chan; 970 else if stack -> temp(2) = t_atom then argptr = tty_output_chan; 971 else if stack -> temp_type36(2) & File36 then argptr = stack -> temp_ptr(2); 972 else do; 973 saction_32_loss: i = 2; 974 call bad_arg; 975 go to saction(32); 976 end; 977 if argptr -> iochan.write then go to saction_32_loss; /* must be output file */ 978 if ssf 979 then if stack -> temp(1) = nil 980 then argptr -> iochan.charmode = "0"b; 981 else argptr -> iochan.charmode = "1"b; 982 else if argptr -> iochan.charmode 983 then stack -> temp(1) = t_atom; 984 else stack -> temp(1) = nil; 985 go to exit; 986 987 /* (sstatus cleanup a) sets cleanup list to a and also sets flag 988* as to whether it is non-nil, since it cannot be looked at 989* during a gc */ 990 991 ssaction(48): 992 lisp_static_vars_$cleanup_list = stack -> temp(2); 993 if stack -> temp(2) = nil 994 then lisp_static_vars_$cleanup_list_exists = "0"b; 995 else lisp_static_vars_$cleanup_list_exists = "1"b; 996 stack -> temp(1) = stack -> temp(2); 997 go to exit; 998 999 /* (sstatus gctime n) resets gc timer to n and returns old value (in usec) */ 1000 1001 ssaction(18): 1002 i = 2; 1003 call verify_num; 1004 /* and fall into (status gctime) routine */ 1005 1006 /* (status gctime) returns the number of usec spent collecting garbage */ 1007 1008 dcl lisp_static_vars_$gc_time fixed bin(71) external; 1009 1010 saction(18): 1011 stack -> fixnum_fmt.type_info = fixnum_type; 1012 stack -> fixedb = lisp_static_vars_$gc_time; 1013 if ssf then lisp_static_vars_$gc_time = n; /* if was sstatus fn, reset timer */ 1014 go to exit; 1015 1016 1017 1018 /****** The gctwa fsubr sets and gets the control flags for the gctwa feature */ 1019 1020 dcl gctwa_sts bit(36) aligned based(addr( addr(lisp_static_vars_$status_gctwa) 1021 -> fixedb)); 1022 1023 gctwa: entry; 1024 1025 if addr(lisp_static_vars_$status_gctwa) -> fixnum_fmt.type_info ^= fixnum_type 1026 then do; 1027 addr(lisp_static_vars_$status_gctwa) -> fixnum_fmt.type_info = fixnum_type; 1028 gctwa_sts = "0"b; 1029 end; 1030 1031 stack = addrel(stack_ptr, -2); 1032 if stack -> temp(1) = nil then /* (gctwa) turns on temp-gctwa bit */ 1033 gctwa_sts = gctwa_sts | "000000000000000000000000000000000001"b; 1034 else if stack -> temp_ptr(1) -> cons.car = nil then /* (gctwa nil) turns off perm bit */ 1035 gctwa_sts = gctwa_sts & "111111111111111111111111111111110111"b; 1036 else /* (gctwa t) turns on both bits */ 1037 gctwa_sts = "000000000000000000000000000000001001"b; 1038 /* now return gctwa_sts as our value */ 1039 1040 stack -> temp(1) = lisp_static_vars_$status_gctwa; 1041 go to exit; 1042 1043 saction(14): /* status spcnames */ 1044 1045 stack -> temp(1) = lisp_static_vars_$space_names_atom -> atom.value; 1046 go to exit; 1047 1048 1049 /*** status and sstatus functions for looking at various attributes of spaces ****/ 1050 1051 dcl lisp_static_vars_$space_names_atom external static pointer, 1052 lisp_garbage_collector_$set_gc_params entry, 1053 ListSpace fixed bin static init(0), 1054 MarkedPdlSpace fixed bin static init(1), 1055 UnmarkedPdlSpace fixed bin static init(2), 1056 which_space fixed bin, 1057 lisp_segment_manager_$set_stack_size entry(pointer, fixed bin(35)), 1058 lisp_segment_manager_$get_stack_size entry(pointer, fixed bin(35)), 1059 st_ptr pointer, 1060 lisp_static_vars_$gcmax fixed bin(35) external, 1061 lisp_static_vars_$gcsize fixed bin(5) external, 1062 lisp_static_vars_$gcmin_fraction bit(1) external, 1063 lisp_static_vars_$gcmin external, 1064 lisp_static_vars_$gcmin_fixed fixed bin(35) based(addr(lisp_static_vars_$gcmin)), 1065 lisp_static_vars_$gcmin_float float bin(27) based(addr(lisp_static_vars_$gcmin)); 1066 1067 decode_space_name: proc; 1068 1069 retry: stack -> temp(1) = lisp_static_vars_$space_names_atom -> atom.value; 1070 do which_space = 0 by 1 to 2; 1071 if stack -> temp_ptr(1) -> cons.car = stack -> temp(2) 1072 then return; 1073 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 1074 end; 1075 /* erroneous space name */ 1076 1077 i = 2; 1078 call bad_arg; 1079 go to retry; 1080 end decode_space_name; 1081 1082 1083 saction(19): /* status spcsize space */ 1084 1085 call decode_space_name; 1086 if which_space ^= ListSpace then go to pdlsize; 1087 n = 0; 1088 do st_ptr = lisp_alloc_$cur_seg 1089 repeat (st_ptr -> alloc_segment.next_seg) 1090 while (st_ptr ^= null); 1091 n = n + fixed(st_ptr -> alloc_segment.tally_word.seg_offset, 18); 1092 end; 1093 go to ret_fix; 1094 16 1 /* Include file describing the data related to the free storage allocation package */ 16 2 16 3 dcl lisp_alloc_$alloc_fault_word ext bit(36) aligned, 16 4 alloc_fault_word bit(36) defined ( lisp_alloc_$alloc_fault_word), 16 5 lisp_alloc_$alloc_info bit(288) aligned ext, /* info to save for recursiveness of lisp */ 16 6 16 7 /* FAULT BIT MASKS FOR FAULT BITS IN ALLOC_FAULT_WORD 16 8* THE FAULT CODES ARE: 16 9* 6 ft3 - car or cdr of number 16 10* 5 mme4 - array oob 16 11* 4 quit 16 12* 2 alrm 16 13* 1 cput 16 14* */ 16 15 16 16 16 17 quit_fault bit(36) static init ("000000000000000000000000000000000100"b), 16 18 alrm_fault bit(36) static init ("000000000000000000000000000000000010"b), 16 19 cput_fault bit(36) static init ("000000000000000000000000000000000001"b), 16 20 16 21 fault_mask bit(36) static init ("000000000000000000000000000000000111"b), 16 22 lisp_alloc_$gc_blk_cntr ext fixed bin, /* number of 16k blocks before next gc. */ 16 23 lisp_alloc_$seg_blk_cntr ext fixed bin, /* number of 16k blocks to end of segment */ 16 24 lisp_alloc_$consptr ext ptr aligned, /* pointer to ad tally word */ 16 25 1 consptr_ovly based (addr(lisp_alloc_$consptr)) aligned, /* overlay to set further modification field of pointer */ 16 26 2 padding bit(66) unal, 16 27 2 mod bit(6) unal, 16 28 lisp_alloc_$cur_seg ext ptr aligned, /* pointer to current allocation segment */ 16 29 16 30 1 alloc_segment based aligned, /* structure of a free storage segment */ 16 31 2 next_seg ptr, /* chain to next older segment */ 16 32 2 tally_word, /* ad tally word */ 16 33 3 seg_offset bit(18) unal, /* next address in this seg to be allocated */ 16 34 3 tally bit(12) unal, /* decremented once for every 4 words, 16k runout */ 16 35 3 delta fixed bin(5) unal, /* should be set to 4, the size of a cons */ 16 36 2 pad bit(36), 16 37 2 first_allocatable_word bit(72); 16 38 16 39 /* end include file describing free storage structure */ 1095 1096 1097 1098 saction(20): /* (status pdlsize space) */ 1099 1100 call decode_space_name; 1101 if which_space = ListSpace then n = 0; /* ?? */ 1102 else do; 1103 pdlsize: 1104 if which_space = MarkedPdlSpace then n = fixed(rel(stack_ptr), 18); 1105 else n = fixed(rel(unmkd_ptr), 18); 1106 end; 1107 go to ret_fix; 1108 1109 1110 saction(21): /* (status pdlroom space) */ 1111 1112 call decode_space_name; 1113 if which_space = ListSpace then n = 0; /* ?? */ 1114 else n = 65536; 1115 go to ret_fix; 1116 1117 1118 saction(22): /* (status pdlmax space) */ 1119 1120 call decode_space_name; 1121 if which_space = ListSpace then n = 0; /* ?? */ 1122 else do; 1123 if which_space = MarkedPdlSpace then st_ptr = stack_ptr; 1124 else st_ptr = unmkd_ptr; 1125 call lisp_segment_manager_$get_stack_size(st_ptr, n); 1126 end; 1127 go to ret_fix; 1128 1129 1130 ssaction(22): /* (sstatus pdlmax space n) */ 1131 1132 call decode_space_name; 1133 i = 3; 1134 call verify_num; 1135 if which_space = ListSpace then go to return_nil; /* Oh, well, just ignore it */ 1136 else if which_space = MarkedPdlSpace then st_ptr = stack_ptr; 1137 else st_ptr = unmkd_ptr; 1138 1139 call lisp_segment_manager_$set_stack_size(st_ptr, n); 1140 go to ret_fix; 1141 1142 /***** An Emulation of the Bibop "alloc" function on the pdp-10 *****/ 1143 1144 alloc: entry; 1145 1146 stack = addrel(stack_ptr, -2); /* subr 1 arg*/ 1147 if stack -> temp_type(1) = Cons then go to realloc; 1148 1149 /* (alloc t) returns current parametervalues */ 1150 1151 stack_ptr = addr(stack -> temp(6)); 1152 stack -> temp(5) = nil; 1153 addr(stack -> temp(2)) -> fixnum_fmt.type_info, 1154 addr(stack -> temp(3)) -> fixnum_fmt.type_info, 1155 addr(stack -> temp(4)) -> fixnum_fmt.type_info = fixnum_type; 1156 addr(stack -> temp(2)) -> fixedb = lisp_static_vars_$gcsize; 1157 addr(stack -> temp(3)) -> fixedb = lisp_static_vars_$gcmax; 1158 if lisp_static_vars_$gcmin_fraction then do; 1159 addr(stack -> temp(4)) -> flonum_fmt.type_info = flonum_type; 1160 addr(stack -> temp(4)) -> floatb = lisp_static_vars_$gcmin_float; 1161 end; 1162 else addr(stack -> temp(4)) -> fixedb = lisp_static_vars_$gcmin_fixed; 1163 do i = 1 to 3; 1164 call lisp_special_fns_$cons; 1165 end; 1166 stack_ptr = addr(stack -> temp(8)); 1167 stack -> temp(7) = nil; 1168 addr(stack -> temp(6)) -> fixnum_fmt.type_info, 1169 addr(stack -> temp(4)) -> fixnum_fmt.type_info = fixnum_type; 1170 stack -> temp(1) = lisp_static_vars_$space_names_atom -> atom_ptrs.value -> cons.car; 1171 stack -> temp(3) = lisp_static_vars_$space_names_atom -> atom_ptrs.value -> cons_ptrs.cdr -> cons.car; 1172 stack -> temp(5) = lisp_static_vars_$space_names_atom -> atom_ptrs.value -> cons_ptrs.cdr -> cons_ptrs.cdr -> cons.car; 1173 call lisp_segment_manager_$get_stack_size(stack_ptr, n); 1174 addr(stack -> temp(4)) -> fixedb = n; 1175 call lisp_segment_manager_$get_stack_size(unmkd_ptr, n); 1176 addr(stack -> temp(6)) -> fixedb = n; 1177 do i = 1 to 6; 1178 call lisp_special_fns_$cons; 1179 end; 1180 return; 1181 1182 realloc: /** analyze argument and set parameters */ 1183 1184 stack_ptr = addr(stack -> temp(3)); 1185 1186 do while(stack -> temp_type(1) = Cons); /* map down argument */ 1187 if stack -> temp_ptr(1) -> cons.car = 1188 lisp_static_vars_$space_names_atom -> atom_ptrs.value -> cons.car 1189 then do; /* list */ 1190 stack -> temp(2) = stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons.car; 1191 if stack -> temp_type(2) = Cons then do; /* list of size,max,min */ 1192 if stack -> temp_ptr(2) -> cons_types36.car & Fixed36 then 1193 lisp_static_vars_$gcsize = addr(stack -> temp_ptr(2) -> cons.car) 1194 -> fixedb; 1195 if stack -> temp_ptr(2) -> cons_ptrs.cdr -> cons_types36.car & Fixed36 then 1196 lisp_static_vars_$gcmax = addr(stack -> temp_ptr(2) -> cons_ptrs.cdr -> cons.car) -> fixedb; 1197 stack -> temp(2) = stack -> temp_ptr(2) -> cons_ptrs.cdr -> cons_ptrs.cdr -> cons.car; 1198 if stack -> temp_type36(2) & Fixed36 then do; 1199 lisp_static_vars_$gcmin_fixed = max(500, addr(stack -> temp(2)) -> fixedb); 1200 lisp_static_vars_$gcmin_fraction = "0"b; 1201 end; 1202 else if stack -> temp_type36(2) & Float36 then do; 1203 lisp_static_vars_$gcmin_float = min(0.85, max(0.15, addr(stack -> temp(2)) -> floatb)); 1204 lisp_static_vars_$gcmin_fraction = "1"b; 1205 end; 1206 else; 1207 end; 1208 else if stack -> temp_type36(2) & Fixed36 then do; /* number to set gcsize from */ 1209 lisp_static_vars_$gcsize = addr(stack -> temp(2)) -> fixedb; 1210 lisp_static_vars_$gcmax = max(lisp_static_vars_$gcsize, lisp_static_vars_$gcmax); 1211 end; 1212 else; 1213 call lisp_garbage_collector_$set_gc_params; 1214 end; 1215 1216 else if stack -> temp_ptr(1) -> cons.car = 1217 lisp_static_vars_$space_names_atom -> atom_ptrs.value -> cons_ptrs.cdr -> cons.car then do; 1218 n = addr(stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons.car) -> fixedb; 1219 call lisp_segment_manager_$set_stack_size(stack_ptr, n); 1220 end; 1221 else if stack -> temp_ptr(1) -> cons.car = 1222 lisp_static_vars_$space_names_atom -> atom_ptrs.value -> cons_ptrs.cdr -> cons_ptrs.cdr -> cons.car then do; 1223 n = addr(stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons.car) -> fixedb; 1224 call lisp_segment_manager_$set_stack_size(unmkd_ptr, n); 1225 end; 1226 else; /* ignore random space names here */ 1227 1228 stack -> temp(1) = stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons.cdr; 1229 end; 1230 1231 go to return_t; 1232 1233 loss_13: i = 2; 1234 call bad_arg; 1235 /* fall back into status/sstatus interrupt routine */ 1236 1237 /* status interrupt & sstatus interrupt */ 1238 1239 ssaction(13): /* to set a user interrupt function */ 1240 1241 1242 saction(13): /* to get a user interrupt function */ 1243 1244 i = 2; 1245 call verify_num; /* make sure is user interrupt _n_u_m_b_e_r */ 1246 if n ^= 0 then /* allow intr channel 0, which is out of subscript range 1247* but is stored at right place so that it works anyway. 1248* This is a kludge, but I didn't want to change the dcl 1249* of user_intr_array */ 1250 if n < lbound(user_intr_array, 1) then go to loss_13; 1251 if n > hbound(user_intr_array, 1) then go to loss_13; 1252 1253 /* check for non-existent user interrupt channel */ 1254 1255 if user_intr_array(n) = nil then go to loss_13; 1256 1257 if ssf then addr(user_intr_array(n)) -> based_ptr -> atom.value = stack -> temp(3); /* if sstatus */ 1258 1259 /* return the interrupt service function */ 1260 1261 stack -> temp(1) = addr(user_intr_array(n)) -> based_ptr -> atom.value; 1262 go to exit; 1263 1264 saction(28): /* (status terpri) - extract data from readtable */ 1265 1266 if status_terpri then stack -> temp(1) = t_atom; else stack -> temp(1) = nil; 1267 go to exit; 1268 1269 saction(29): /* (status _) - extract data from readtable */ 1270 1271 if status_underline then stack -> temp(1) = t_atom; else stack -> temp(1) = nil; 1272 go to exit; 1273 1274 saction(35): /* (status ttyread) - extract data from readtable */ 1275 1276 if status_ttyread then stack -> temp(1) = t_atom; else stack -> temp(1) = nil; 1277 go to exit; 1278 1279 ssaction(28): /* (sstatus terpri torn) */ 1280 1281 if stack -> temp(2) = nil then status_terpri = "0"b; else status_terpri = "1"b; 1282 exit2: 1283 stack -> temp(1) = stack -> temp(2); 1284 go to exit; 1285 1286 ssaction(29): /* (sstatus _ torn) */ 1287 1288 if stack -> temp(2) = nil then status_underline = "0"b; else status_underline = "1"b; 1289 go to exit2; 1290 1291 ssaction(35): /* (sstatus ttyread torn) - does nothing !! */ 1292 1293 if stack -> temp(2) = nil then status_ttyread = "0"b; else status_ttyread = "1"b; 1294 go to exit2; 1295 1296 1297 saction(41): /* (status abbreviate) - pick up two bits from readtable and make number */ 1298 1299 if abbreviate_on_files then n = 1; else n = 0; 1300 if abbreviate_on_flat then n = n + 2; 1301 go to ret_fix; 1302 1303 ssaction(41): /* (sstatus abbreviate) - store into two bits in readtable */ 1304 1305 if stack -> temp(2) = nil then abbreviate_on_files, abbreviate_on_flat = "0"b; 1306 else if stack -> temp(2) = t_atom then abbreviate_on_files, abbreviate_on_flat = "1"b; 1307 else do; 1308 i = 2; 1309 call verify_num; 1310 abbreviate_on_files = substr(unspec(n), 36, 1); 1311 abbreviate_on_flat = substr(unspec(n), 35, 1); 1312 end; 1313 go to saction(41); /* generate return value */ 1314 1315 /* uuolinks stuff - used to mung the fast linkages between compiled/machine-coded functions */ 1316 1317 saction(39): /* (status uuolinks) - number of unused link slots (just a big number) */ 1318 1319 n = 32766; /* chosen more or less at random */ 1320 go to ret_fix; 1321 1322 ssaction(39): 1323 if stack -> temp(2) = nil then do; /* (sstatus uuolinks) - unsnap all links */ 1324 if lisp_static_vars_$no_snapped_links then; /* don't have to do anything */ 1325 else call lisp_load_$unsnap_all_links; 1326 end; 1327 else do; /* (sstatus uuolinks t) - prelink all links */ 1328 call lisp_prelinker_; 1329 end; 1330 1331 stack -> temp(1) = nil; /* random return value */ 1332 go to exit; 1333 1334 saction(33): /* (status tabsize) */ 1335 1336 n = 10; /* Multics tab spacing is 10. */ 1337 go to ret_fix; 1338 1339 1340 saction(45): /* (status newline) - returns 10. which is ascii code for newline */ 1341 1342 n = 10; 1343 go to ret_fix; 1344 1345 ssaction(34): /* (sstatus crfile foo bar) - set default file name pair for 1346* uread to (foo bar) */ 1347 1348 call check_arg; 1349 stack -> temp(2) = stack -> temp(5); 1350 call check_arg; 1351 stack -> temp(3) = stack -> temp(5); 1352 stack -> temp(4) = nil; 1353 stack -> temp(1) = addr(lisp_static_vars_$old_io_defaults)->based_ptr -> atom_ptrs.value -> cons.car; /* car of nil is nil */ 1354 if stack -> temp(1) = nil then stack -> temp(1) = STAR; 1355 stack_ptr = addr(stack -> temp(5)); 1356 call lisp_special_fns_$cons; /* cons up new defaults list */ 1357 call lisp_special_fns_$cons; 1358 call lisp_special_fns_$cons; 1359 addr(lisp_static_vars_$old_io_defaults)->based_ptr -> atom.value = stack -> temp(1); 1360 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 1361 go to exit; 1362 1363 saction(34): /* (status crfile) - returns current file name pair for uread */ 1364 1365 1366 stack -> temp(1) = addr(lisp_static_vars_$old_io_defaults)->based_ptr -> atom.value; 1367 if stack -> temp(1) = nil then go to exit; /* get list of default names for lisp_old_io_ module */ 1368 1369 stack_ptr = addr(stack -> temp(4)); 1370 stack -> temp(3) = nil; 1371 if stack -> temp_type(1) = Cons then 1372 if stack -> temp_ptr(1) -> cons_types.cdr = Cons then do; 1373 if stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons_types.cdr = Cons then 1374 stack -> temp(2) = stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons_ptrs.cdr -> cons.car; 1375 else do; 1376 stack -> temp(2) = nil; 1377 stack_ptr = addr(stack -> temp(3)); /* random. */ 1378 end; 1379 stack -> temp(1) = stack -> temp_ptr(1) -> cons_ptrs.cdr -> cons.car; 1380 end; 1381 else go to return_nil; /* no names right now */ 1382 else go to return_nil; /* old_io_defaults is nil, there are no names */ 1383 do while(stack_ptr ^= addr(stack -> temp(2))); 1384 call lisp_special_fns_$cons; 1385 end; 1386 return; 1387 1388 /* internal proc for getting date and time info */ 1389 1390 1391 dcl clock_ ext entry returns(fixed bin(71)), 1392 (year, hour def (year), mon, minute def (mon), day, sec def (day), week_day) fixed bin, 1393 tod fixed bin(71), 1394 decode_clock_value_ ext entry(fixed bin(71), fixed bin, fixed bin, 1395 fixed bin, fixed bin(71), fixed bin, char(3) aligned); 1396 1397 gclock: proc; 1398 1399 call decode_clock_value_((clock_()), 1400 mon, day, year, tod, week_day, ""); /* ignore last arg, which is timezone */ 1401 end gclock; 1402 1403 1404 1405 saction(9): /* (status date) */ 1406 1407 call gclock; 1408 1409 /* cons up a list of y, m, d */ 1410 1411 year = year - 1900; /* since MACLISP returns two digit year */ 1412 1413 cons3n: 1414 addr(stack -> temp(3)) -> fixnum_fmt.type_info, 1415 addr(stack -> temp(2)) -> fixnum_fmt.type_info, 1416 addr(stack -> temp(1)) -> fixnum_fmt.type_info = fixnum_type; 1417 addr(stack -> temp(1)) -> fixedb = year; 1418 addr(stack -> temp(2)) -> fixedb = mon; 1419 addr(stack -> temp(3)) -> fixedb = day; 1420 1421 cons3x: stack -> temp(4) = nil; 1422 stack_ptr = addr(stack -> temp(5)); 1423 call lisp_special_fns_$cons; 1424 call lisp_special_fns_$cons; 1425 call lisp_special_fns_$cons; 1426 return; 1427 1428 saction(42): /* (status dow) - day of week */ 1429 1430 call gclock; 1431 call lisp_get_atom_((Atoms_for_day_of_the_week(week_day)), stack -> temp(1)); 1432 go to exit; 1433 1434 /* Table of names of the days of the week */ 1435 1436 dcl Atoms_for_day_of_the_week (1:7) char(9) varying static init( 1437 "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"); 1438 1439 1440 saction(10): /* (status daytime) */ 1441 1442 call gclock; 1443 sec = divide(tod, 1000000, 17, 0); /* prec 17 is ok since max is about 86000 */ 1444 hour = divide(sec, 3600, 17, 0); 1445 sec = sec - 3600 * hour; 1446 minute = divide(sec, 60, 17, 0); 1447 sec = sec - 60 * minute; 1448 go to cons3n; /* works because h, m, s defined onto y, m, d */ 1449 1450 saction(11): /* (status runtime) */ 1451 1452 dcl virtual_cpu_time_ ext entry returns(fixed bin(52)); 1453 1454 n = fixed(virtual_cpu_time_(), 35); 1455 go to ret_fix; 1456 1457 saction(12): /* (status time) - system uptime */ 1458 1459 if timeup = 0 then call system_info_$timeup(timeup); /* find out when the system came up */ 1460 fn = float(clock_() - timeup) / 1e6; /* time sys has been up in seconds, float bin */ 1461 ret_flo: 1462 stack -> flonum_fmt.type_info = flonum_type; 1463 stack -> floatb = fn; 1464 go to exit; 1465 1466 1467 time: entry; /*** the lisp time function, same as (status time) ***/ 1468 1469 stack = stack_ptr; 1470 stack_ptr = addr(stack -> temp(2)); 1471 go to saction(12); 1472 1473 1474 dcl timeup fixed bin(71) static init(0), system_info_$timeup external entry (fixed bin(71)); 1475 1476 /* (status ioc c) */ 1477 1478 saction(2): 1479 1480 if m = 100 then stack -> temp(1) = addr(ctrlD) -> based_ptr -> atom.value; 1481 else if m = 113 then stack -> temp(1) = addr(ctrlQ) -> based_ptr -> atom.value; 1482 else if m = 114 then stack -> temp(1) = addr(ctrlR) -> based_ptr -> atom.value; 1483 else if m = 119 then stack -> temp(1) = addr(ctrlW) -> based_ptr -> atom.value; 1484 else stack -> temp(1) = nil; /* if not implemented here, let it be nil */ 1485 go to exit; 1486 1487 1488 /* sstatus ioc ccccc */ 1489 1490 ssaction(2): 1491 call check_arg; 1492 stack -> temp(1) = stack -> temp(5); 1493 stack_ptr = addr(stack -> temp(2)); 1494 call lisp_fault_handler_$ioc; /* go call the regular ioc function */ 1495 return; 1496 1497 dcl user_info_$whoami ext entry(char(*), char(*)), 1498 personid char(22), 1499 projectid char(9), 1500 username char(32) aligned, 1501 ioa_$rsnpnnl ext entry options(variable), 1502 cpu_time_and_paging_ ext entry(fixed bin(35), fixed bin(71), fixed bin(35)); 1503 1504 1505 /* (status udir) gets user directory = default wdir */ 1506 1507 saction(36): 1508 dcl get_default_wdir_ entry(char(*)aligned), 1509 udir char(168)aligned; 1510 1511 call get_default_wdir_(udir); 1512 n = length(udir)+1 - verify(reverse(udir), " "); 1513 call lisp_get_atom_(substr(udir, 1, n), stack -> temp(1)); 1514 go to exit; 1515 1516 /* (status uname) gets login id */ 1517 1518 saction(25): 1519 call user_info_$whoami(personid, projectid); 1520 call ioa_$rsnpnnl("^a.^a", username, n, personid, projectid); 1521 call lisp_get_atom_(substr(username, 1, n), stack -> temp(1)); 1522 go to exit; 1523 1524 1525 /* (status paging) gets the list (pre-paging page-faults) */ 1526 1527 saction(24): 1528 call cpu_time_and_paging_(n, 0, m); 1529 stack_ptr = addr(stack -> temp(4)); 1530 stack -> temp(3) = nil; 1531 addr(stack -> temp(2)) -> fixnum_fmt.type_info, 1532 addr(stack -> temp(1)) -> fixnum_fmt.type_info = fixnum_type; 1533 addr(stack -> temp(2)) -> fixedb = n; 1534 addr(stack -> temp(1)) -> fixedb = m; 1535 call lisp_special_fns_$cons; 1536 call lisp_special_fns_$cons; 1537 go to exit; 1538 1539 1540 1541 /* status lispversion returns the value of the manifest constant lispversion [3] */ 1542 1543 saction(23): 1544 stack -> fixnum_fmt.type_info = fixnum_type; 1545 stack -> fixedb = lispversion; 1546 go to exit; 1547 1548 1549 1550 1551 /* (status jcl) returns exploded 2nd arg of lisp command, nil if only 0 or 1 args */ 1552 1553 saction(26): 1554 stack -> temp(1) = nil; /* clear return list */ 1555 call cu_$arg_ptr_rel(2, argptr, arglen, code, lisp_static_vars_$arg_list_ptr); 1556 if code ^= 0 then go to exit; /* arg not given, return nil */ 1557 do n = 1 to arglen; /* arg given, make list of the chars */ 1558 stack_ptr = addr(stack -> temp(3)); 1559 call lisp_get_atom_(substr(arg, n, 1), stack -> temp(2)); 1560 call lisp_special_fns_$xcons; 1561 end; 1562 stack_ptr = addr(stack -> temp(2)); 1563 call lisp_list_utils_$nreverse; 1564 go to exit; 1565 1566 1567 1568 1569 /* (status arg n) returns (n+1)th arg to lisp command as an atomic symbol, nil if <= n args only */ 1570 1571 saction(27): 1572 i = 2; 1573 call verify_num; /* get n */ 1574 call cu_$arg_ptr_rel(n+1, argptr, arglen, code, lisp_static_vars_$arg_list_ptr); 1575 if code = 0 then do; 1576 if arglen > length(arg_buffer) then arglen = length(arg_buffer); /* truncate if too long */ 1577 aligned_arg = arg; /* make aligned copy */ 1578 call lisp_get_atom_(aligned_arg, stack -> temp(1)); 1579 end; 1580 else stack -> temp(1) = nil; 1581 go to exit; 1582 1583 /* (status status foo) and (status status) are implemented here */ 1584 1585 saction(43): 1586 1587 call check_arg; 1588 if stack -> temp(5) = nil then go to return_list_of_status_functions; 1589 1590 char4 = addr(stack -> temp_ptr(5) -> atom.pname) -> char4b; 1591 do j = 1 to nnames; 1592 if char4 = names(j) then go to got_it_43; 1593 end; 1594 go to return_nil; /* not valid */ 1595 1596 got_it_43: 1597 if sbits(j) & illeg then go to return_nil; /* not valid */ 1598 else go to return_t; /* valid */ 1599 1600 1601 /* (status sstatus foo) and (status sstatus) */ 1602 1603 saction(44): 1604 1605 call check_arg; 1606 if stack -> temp(5) = nil then go to return_list_of_sstatus_functions; 1607 1608 char4 = addr(stack -> temp_ptr(5) -> atom.pname) -> char4b; 1609 do j = 1 to nnames; 1610 if char4 = names(j) then go to got_it_44; 1611 end; 1612 go to return_nil; /* not valid */ 1613 1614 got_it_44: 1615 if ssbits(j) & illeg then go to return_nil; /* not valid */ 1616 else go to return_t; /* valid */ 1617 1618 1619 1620 return_list_of_status_functions: 1621 1622 stack -> temp(1) = nil; 1623 do j = nnames repeat (j-1) while (j > 0); 1624 if sbits(j) & illeg then; 1625 else do; 1626 stack_ptr = addr(stack -> temp(3)); 1627 do i = 4 repeat (i-1) while(substr(names(j),i,1) = NullChar); /* flush \000's */ 1628 end; 1629 call lisp_get_atom_(char(names(j), i), stack -> temp(2)); 1630 call lisp_special_fns_$xcons; 1631 end; 1632 end; 1633 go to exit; 1634 1635 1636 return_list_of_sstatus_functions: 1637 1638 stack -> temp(1) = nil; 1639 do j = nnames repeat (j-1) while (j > 0); 1640 if ssbits(j) & illeg then; 1641 else do; 1642 stack_ptr = addr(stack -> temp(3)); 1643 do i = 4 repeat (i-1) while(substr(names(j),i,1) = NullChar); /* flush \000's */ 1644 end; 1645 call lisp_get_atom_(char(names(j), i), stack -> temp(2)); 1646 call lisp_special_fns_$xcons; 1647 end; 1648 end; 1649 go to exit; 1650 1651 1652 1653 /* (status mulquit n-t-nil) and (status mulpi n-t-nil) are implemented here */ 1654 1655 saction (50): /* (status mulquit n-t-nil) */ 1656 1657 mulquit_mulpi_value_ptr = addr (lisp_static_vars_$mulquit_state); 1658 go to status_mulxx_join; 1659 1660 saction (51): /* (status mulpi n-t-nil) */ 1661 1662 mulquit_mulpi_value_ptr = addr (lisp_static_vars_$mulpi_state); 1663 1664 status_mulxx_join: 1665 1666 if mulquit_mulpi_value_ptr -> based_fxb17 = -1 then stack -> temp (1) = lisp_static_vars_$nil; 1667 else if mulquit_mulpi_value_ptr -> based_fxb17 = -2 then stack -> temp (1) = lisp_static_vars_$t_atom; 1668 else do; 1669 addr (stack -> temp (1)) -> fixnum_fmt.type_info = fixnum_type; /* must do first, for gc reaasons */ 1670 addr (stack -> temp (1)) -> fixnum_fmt.fixedb = mulquit_mulpi_value_ptr -> based_fxb17; 1671 end; 1672 go to exit; 1673 1674 ssaction (50): /* (sstatus mulquit n-t-nil) */ 1675 1676 mulquit_mulpi_value_ptr = addr (lisp_static_vars_$mulquit_state); 1677 go to sstatus_mulxx_join; 1678 1679 ssaction (51): /* (sstatus mulpi n-t-nil) */ 1680 1681 mulquit_mulpi_value_ptr = addr (lisp_static_vars_$mulpi_state); 1682 1683 sstatus_mulxx_join: 1684 1685 i = 2; /* for error recovery */ 1686 sstatus_mulxx_retry: 1687 1688 if stack -> temp (2) = lisp_static_vars_$t_atom then mulquit_mulpi_value_ptr -> based_fxb17 = -2; 1689 else if stack -> temp (2) = lisp_static_vars_$nil then mulquit_mulpi_value_ptr -> based_fxb17 = -1; 1690 else if addr (stack -> temp (2)) -> lisp_ptr.type & Fixed then do; /* A fixnum */ 1691 if (addr (stack -> temp (2)) -> fixnum_fmt.fixedb < lbound (user_intr_array, 1) 1692 & (addr (stack -> temp (2)) -> fixnum_fmt.fixedb ^= 0)) /* See comment at status interrupt */ 1693 | addr (stack -> temp (2)) -> fixnum_fmt.fixedb > hbound (user_intr_array, 1) 1694 then do; 1695 call ill_arg; 1696 go to sstatus_mulxx_retry; 1697 end; 1698 else mulquit_mulpi_value_ptr -> based_fxb17 = addr (stack -> temp (2)) -> fixnum_fmt.fixedb; 1699 end; 1700 else do; 1701 call ill_arg; 1702 go to sstatus_mulxx_retry; 1703 end; 1704 1705 go to status_mulxx_join; /* Get the "status" looking answer */ 1706 1707 /* Reimplementation of status/sstatus feature/nofeature -- BSG 4/26/80 */ 1708 1709 find_feature: 1710 proc returns (bit (1) aligned); 1711 1712 char4 = translate (stack -> temp_ptr(5) -> atom.pname, LOWER_CASES, UPPER_CASES); 1713 1714 stack -> temp(1) = addr(lisp_static_vars_$semicolon_macro) -> based_ptr -> atom.value; 1715 do while(stack -> temp_type(1) = Cons); 1716 char4a = translate (stack -> temp_ptr(1) -> cons_ptrs.car -> atom.pname, LOWER_CASES, UPPER_CASES); 1717 if char4a = char4 then do; 1718 if translate (stack -> temp_ptr(5)->atom.pname, LOWER_CASES, UPPER_CASES) 1719 = translate (stack->temp_ptr(1) -> cons_ptrs.car -> atom.pname, LOWER_CASES, UPPER_CASES) 1720 then return ("1"b); 1721 end; 1722 stack -> temp(2) = stack -> temp(1); /* for deleter*/ 1723 stack -> temp(1) = stack -> temp_ptr(1) -> cons.cdr; 1724 end; 1725 return ("0"b); /* must not be a feature */ 1726 end find_feature; 1727 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/83 1542.6 lisp_status_fns_.pl1 >special_ldd>on>06/27/83>lisp_status_fns_.pl1 305 1 03/27/82 0437.0 lisp_common_vars.incl.pl1 >ldd>include>lisp_common_vars.incl.pl1 306 2 03/27/82 0437.0 lisp_initial_atoms.incl.pl1 >ldd>include>lisp_initial_atoms.incl.pl1 307 3 03/27/82 0437.0 lisp_io.incl.pl1 >ldd>include>lisp_io.incl.pl1 3-5 4 03/27/82 0437.0 lisp_iochan.incl.pl1 >ldd>include>lisp_iochan.incl.pl1 3-45 5 03/27/82 0437.0 lisp_control_chars.incl.pl1 >ldd>include>lisp_control_chars.incl.pl1 308 6 03/27/82 0437.0 lisp_stack_fmt.incl.pl1 >ldd>include>lisp_stack_fmt.incl.pl1 309 7 03/27/82 0437.0 lisp_cons_fmt.incl.pl1 >ldd>include>lisp_cons_fmt.incl.pl1 310 8 03/27/82 0437.0 lisp_ptr_fmt.incl.pl1 >ldd>include>lisp_ptr_fmt.incl.pl1 311 9 03/27/82 0437.0 lisp_error_codes.incl.pl1 >ldd>include>lisp_error_codes.incl.pl1 312 10 06/29/83 1425.3 lisp_name_codes.incl.pl1 >ldd>include>lisp_name_codes.incl.pl1 313 11 03/27/82 0437.1 lisp_array_fmt.incl.pl1 >ldd>include>lisp_array_fmt.incl.pl1 314 12 03/27/82 0437.0 lisp_readtable.incl.pl1 >ldd>include>lisp_readtable.incl.pl1 315 13 03/27/82 0437.0 lisp_nums.incl.pl1 >ldd>include>lisp_nums.incl.pl1 316 14 03/27/82 0437.1 lisp_atom_fmt.incl.pl1 >ldd>include>lisp_atom_fmt.incl.pl1 317 15 03/27/82 0436.9 lisp_string_fmt.incl.pl1 >ldd>include>lisp_string_fmt.incl.pl1 1095 16 03/27/82 0437.0 lisp_free_storage.incl.pl1 >ldd>include>lisp_free_storage.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) Array internal static bit(9) initial unaligned dcl 8-17 Array36 internal static bit(36) initial dcl 8-17 Atomic internal static bit(9) initial unaligned dcl 8-17 Atomic36 internal static bit(36) initial dcl 8-17 Atoms_for_day_of_the_week 000151 constant varying char(9) initial array dcl 1436 ref 1431 Atsym internal static bit(9) initial unaligned dcl 8-17 Atsym36 constant bit(36) initial dcl 8-17 ref 406 434 635 670 691 728 937 Bigfix internal static bit(9) initial unaligned dcl 8-17 Bigfix36 internal static bit(36) initial dcl 8-17 Bignum internal static bit(9) initial unaligned dcl 8-17 Bignum36 internal static bit(36) initial dcl 8-17 Cons constant bit(9) initial unaligned dcl 8-17 ref 1147 1186 1191 1371 1371 1373 1715 Cons36 internal static bit(36) initial dcl 8-17 Dead_array internal static fixed bin(17,0) initial dcl 11-20 File internal static bit(9) initial unaligned dcl 8-17 File36 constant bit(36) initial dcl 8-17 ref 971 Fixed constant bit(9) initial unaligned dcl 8-17 ref 1690 Fixed36 constant bit(36) initial dcl 8-17 ref 380 439 490 1192 1195 1198 1208 Fixnum_array internal static fixed bin(17,0) initial dcl 11-20 Float internal static bit(9) initial unaligned dcl 8-17 Float36 constant bit(36) initial dcl 8-17 ref 1202 Flonum_array internal static fixed bin(17,0) initial dcl 11-20 JOIN 000555 constant label dcl 349 ref 326 333 339 345 LOWER_CASES 000445 constant char(26) initial unaligned dcl 27 ref 1712 1716 1718 1718 ListSpace constant fixed bin(17,0) initial dcl 1051 ref 1086 1101 1113 1121 1135 MINUS defined fixed bin(71,0) dcl 2-3 MarkedPdlSpace constant fixed bin(17,0) initial dcl 1051 ref 1103 1123 1136 NotConsOrAtsym36 internal static bit(36) initial dcl 8-17 NullChar 006575 constant char(1) initial unaligned dcl 27 ref 1627 1643 Numeric internal static bit(9) initial unaligned dcl 8-17 Numeric36 internal static bit(36) initial dcl 8-17 Obarray_array internal static fixed bin(17,0) initial dcl 11-20 PLUS defined fixed bin(71,0) dcl 2-3 Readtable_array internal static fixed bin(17,0) initial dcl 11-20 SLASH defined fixed bin(71,0) dcl 2-3 STAR defined fixed bin(71,0) dcl 2-3 ref 1354 S_expr_array internal static fixed bin(17,0) initial dcl 11-20 String internal static bit(9) initial unaligned dcl 8-17 String36 constant bit(36) initial dcl 8-17 ref 633 653 688 Subr internal static bit(9) initial unaligned dcl 8-17 Subr36 internal static bit(36) initial dcl 8-17 SubrNumeric36 internal static bit(36) initial dcl 8-17 System_Subr internal static bit(9) initial unaligned dcl 8-17 System_Subr36 internal static bit(36) initial dcl 8-17 UPPER_CASES 000436 constant char(26) initial unaligned dcl 27 ref 1712 1716 1718 1718 Un_gc_array internal static fixed bin(17,0) initial dcl 11-20 Uncollectable internal static bit(9) initial unaligned dcl 8-17 Undefined internal static bit(72) initial unaligned dcl 8-17 UnmarkedPdlSpace internal static fixed bin(17,0) initial dcl 1051 ZERO internal static fixed bin(17,0) initial dcl 11-37 abbreviate_on_files 435 based bit(1) level 2 dcl 12-11 set ref 1297 1303* 1306* 1310* abbreviate_on_flat 436 based bit(1) level 2 dcl 12-11 set ref 1300 1303* 1306* 1311* addr builtin function dcl 257 ref 350 351 352 353 359 371 375 382 415 440 492 519 523 530 539 559 559 560 560 565 565 567 567 570 570 582 582 585 585 588 588 590 590 591 591 595 595 598 598 604 604 612 612 612 612 612 612 612 612 650 650 671 682 682 682 682 701 701 702 702 709 709 710 715 715 716 731 731 734 734 739 739 740 740 741 741 749 749 760 761 761 763 763 767 767 776 776 782 782 793 793 795 795 816 834 841 846 851 852 853 856 873 886 900 901 903 909 943 943 947 953 1025 1027 1028 1028 1032 1032 1032 1032 1034 1034 1034 1034 1036 1036 1151 1153 1153 1153 1156 1157 1159 1160 1160 1162 1162 1166 1168 1168 1174 1176 1182 1192 1195 1199 1199 1203 1203 1209 1218 1223 1257 1261 1264 1264 1269 1269 1274 1274 1279 1279 1281 1281 1286 1286 1288 1288 1291 1291 1293 1293 1297 1297 1300 1300 1303 1303 1303 1303 1306 1306 1306 1306 1310 1310 1311 1311 1353 1355 1359 1363 1369 1377 1383 1413 1413 1413 1417 1418 1419 1422 1470 1478 1481 1482 1483 1493 1529 1531 1531 1533 1534 1558 1562 1577 1578 1590 1608 1626 1642 1655 1660 1669 1670 1674 1679 1690 1691 1691 1691 1698 1714 addrel builtin function dcl 257 ref 358 365 516 528 537 622 663 909 952 1031 1146 aligned_arg based char dcl 262 set ref 1577* 1578* alloc 003233 constant entry external dcl 1144 alloc_fault_word defined bit(36) unaligned dcl 16-3 alloc_segment based structure level 1 dcl 16-3 alpha internal static bit(27) initial unaligned dcl 12-27 alrm_fault internal static bit(36) initial unaligned dcl 16-3 arg based char unaligned dcl 262 ref 1559 1559 1577 arg2pn automatic char(1) dcl 27 arg_buffer 000133 automatic char(200) dcl 262 set ref 1576 1576 1577 1578 arglen 000132 automatic fixed bin(17,0) dcl 262 set ref 1555* 1557 1559 1559 1574* 1576 1576* 1577 1577 1578 1578 argptr 000130 automatic pointer dcl 262 set ref 364* 373 374 375* 375 943* 943* 946* 952 968* 970* 971* 977 978 981 982 1555* 1559 1559 1574* 1577 argument_must_be_array internal static fixed bin(17,0) initial dcl 9-8 array_atom defined fixed bin(71,0) dcl 1-6 array_bound_error internal static fixed bin(17,0) initial dcl 9-8 array_data based structure level 1 dcl 11-31 array_data_ptr 2 based pointer level 2 dcl 11-8 ref 559 560 565 567 570 582 585 588 590 591 595 598 604 612 612 612 612 701 702 709 715 731 734 739 740 741 749 761 763 767 776 782 793 795 1264 1269 1274 1279 1281 1286 1288 1291 1293 1297 1300 1303 1303 1306 1306 1310 1311 array_info based structure level 1 dcl 11-8 array_too_big internal static fixed bin(17,0) initial dcl 9-8 atan_0_0_err internal static fixed bin(17,0) initial dcl 9-8 atom based structure level 1 dcl 14-5 atom_double_words based structure level 1 dcl 14-5 atom_ptrs based structure level 1 dcl 14-5 bad_arg 005702 constant entry internal dcl 502 ref 369 397 409 444 940 974 1078 1234 bad_arg_correctable constant fixed bin(17,0) initial dcl 9-8 ref 517 bad_argument internal static fixed bin(17,0) initial dcl 9-8 bad_array_subscript internal static fixed bin(17,0) initial dcl 9-8 bad_base internal static fixed bin(17,0) initial dcl 9-8 bad_bv internal static fixed bin(17,0) initial dcl 9-8 bad_do_format internal static fixed bin(17,0) initial dcl 9-8 bad_entry_name internal static fixed bin(17,0) initial dcl 9-8 bad_f_fcn internal static fixed bin(17,0) initial dcl 9-8 bad_function internal static fixed bin(17,0) initial dcl 9-8 bad_ibase internal static fixed bin(17,0) initial dcl 9-8 bad_input_source internal static fixed bin(17,0) initial dcl 9-8 bad_output_dest internal static fixed bin(17,0) initial dcl 9-8 bad_prog_op internal static fixed bin(17,0) initial dcl 9-8 badmacro internal static fixed bin(17,0) initial dcl 9-8 badobarray internal static fixed bin(17,0) initial dcl 9-8 badreadlist internal static fixed bin(17,0) initial dcl 9-8 badreadtable internal static fixed bin(17,0) initial dcl 9-8 base defined fixed bin(71,0) dcl 3-17 based_fxb17 based fixed bin(17,0) dcl 27 set ref 1664 1667 1670 1686* 1689* 1698* based_ptr based pointer dcl 8-16 ref 530 539 559 559 560 560 565 565 567 567 570 570 582 582 585 585 588 588 590 590 591 591 595 595 598 598 604 604 612 612 612 612 612 612 612 612 701 701 702 702 709 709 715 715 731 731 734 734 739 739 740 740 741 741 749 749 761 761 763 763 767 767 776 776 782 782 793 793 795 795 873 886 900 903 909 1257 1261 1264 1264 1269 1269 1274 1274 1279 1279 1281 1281 1286 1286 1288 1288 1291 1291 1293 1293 1297 1297 1300 1300 1303 1303 1303 1303 1306 1306 1306 1306 1310 1310 1311 1311 1353 1359 1363 1478 1481 1482 1483 1714 binding_block based structure level 1 dcl 6-7 binding_top defined pointer dcl 1-6 bindings based structure array level 1 dcl 6-7 bit builtin function dcl 257 ref 559 701 bit12 internal static bit(27) initial unaligned dcl 12-27 blank internal static bit(27) initial unaligned dcl 12-27 cant_filepos internal static fixed bin(17,0) initial dcl 9-8 cant_subscript_readtable internal static fixed bin(17,0) initial dcl 9-8 car based bit(36) level 2 in structure "cons_types36" dcl 7-22 in procedure "status" ref 728 1192 1195 car based pointer level 2 in structure "cons_ptrs" dcl 7-5 in procedure "status" ref 728 1716 1718 car based fixed bin(71,0) level 2 in structure "cons" dcl 7-5 in procedure "status" set ref 481 790 859 861 862 1034 1071 1170 1171 1172 1187 1187 1190 1192 1195 1197 1216 1216 1218 1221 1221 1223 1353 1373 1379 car_cdr_error internal static fixed bin(17,0) initial dcl 9-8 catch_frame defined pointer dcl 1-6 cdr 2(21) based bit(9) level 2 in structure "cons_types" packed unaligned dcl 7-5 in procedure "status" ref 1371 1373 cdr 2 based fixed bin(71,0) level 2 in structure "cons" dcl 7-5 in procedure "status" set ref 482 602 604 606* 606 753 762* 786 911* 911 1073 1228 1360 1723 cdr 2 based pointer level 2 in structure "cons_ptrs" dcl 7-5 in procedure "status" ref 861 861 862 1171 1172 1172 1190 1195 1195 1197 1197 1216 1218 1221 1221 1223 1228 1373 1373 1373 1379 char builtin function ref 1629 1629 1645 1645 char4 000107 automatic char(4) dcl 27 set ref 415* 417 663* 664 665 666 1590* 1592 1608* 1610 1712* 1717 char4a 000110 automatic char(4) dcl 27 set ref 1716* 1717 char4b based char(4) dcl 27 ref 415 663 1590 1608 charmode 15(07) based bit(1) level 3 packed unaligned dcl 4-13 set ref 978* 981* 982 check_arg 005634 constant entry internal dcl 475 ref 401 429 450 890 896 906 1345 1350 1490 1585 1603 check_j 000606 constant label dcl 366 ref 370 clock_ 000354 constant entry external dcl 1391 ref 1399 1460 code 000215 automatic fixed bin(17,0) dcl 262 set ref 1555* 1556 1574* 1575 cons based structure level 1 dcl 7-5 cons3n 004325 constant label dcl 1413 ref 1448 cons3x 004340 constant label dcl 1421 cons_ptrs based structure level 1 dcl 7-5 cons_types based structure level 1 dcl 7-5 cons_types36 based structure level 1 dcl 7-22 consptr automatic pointer dcl 7-5 consptr_ovly based structure level 1 dcl 16-3 cpu_time_and_paging_ 000370 constant entry external dcl 1497 ref 1527 cput_fault internal static bit(36) initial unaligned dcl 16-3 ctrlD defined fixed bin(71,0) dcl 5-5 set ref 1478 ctrlQ defined fixed bin(71,0) dcl 5-8 set ref 1481 ctrlR defined fixed bin(71,0) dcl 5-11 set ref 1482 ctrlW defined fixed bin(71,0) dcl 5-14 set ref 1483 cu_$arg_ptr_rel 000250 constant entry external dcl 262 ref 1555 1574 day 000224 automatic fixed bin(17,0) dcl 1391 set ref 1399* 1419 1443* 1443 1444 1444 1445* 1445 1445 1445 1446 1446 1447* 1447 1447 1447 dead_array_reference internal static fixed bin(17,0) initial dcl 9-8 decimal_point internal static bit(27) initial unaligned dcl 12-27 decode_clock_value_ 000356 constant entry external dcl 1391 ref 1399 decode_space_name 006166 constant entry internal dcl 1067 ref 1083 1098 1110 1118 1130 del_macro 005766 constant entry internal dcl 578 ref 558 645 722 digit internal static bit(27) initial unaligned dcl 12-27 divide builtin function dcl 257 ref 1443 1444 1446 division_by_zero internal static fixed bin(17,0) initial dcl 9-8 doterror internal static fixed bin(17,0) initial dcl 9-8 dotted_pair_dot internal static bit(27) initial unaligned dcl 12-27 eof_in_object internal static fixed bin(17,0) initial dcl 9-8 err_frame defined pointer dcl 1-6 err_recp defined pointer dcl 1-6 errcode based fixed bin(17,0) array dcl 255 set ref 517* 518* errlist defined fixed bin(71,0) dcl 2-3 eval2 constant bit(6) initial dcl 76 ref 427 430 eval3 constant bit(6) initial dcl 76 ref 386 389 449 452 eval_frame defined pointer dcl 1-6 exit 002321 constant label dcl 834 ref 466 576 704 774 800 849 867 888 932 959 985 997 1014 1041 1046 1262 1267 1272 1277 1284 1332 1361 1367 1432 1464 1485 1514 1522 1537 1546 1556 1564 1581 1633 1649 1672 exit2 003737 constant label dcl 1282 ref 1289 1294 extd_alpha constant bit(27) initial unaligned dcl 12-27 ref 587 fault_mask internal static bit(36) initial unaligned dcl 16-3 file_is_closed internal static fixed bin(17,0) initial dcl 9-8 file_sys_fun_err internal static fixed bin(17,0) initial dcl 9-8 file_system_error internal static fixed bin(17,0) initial dcl 9-8 filepos_oob internal static fixed bin(17,0) initial dcl 9-8 find_feature 006254 constant entry internal dcl 1709 ref 892 899 911 fixed builtin function dcl 257 ref 434 559 570 633 635 657 660 688 691 701 1091 1103 1105 1454 fixedb 1 based fixed bin(17,0) level 2 dcl 13-4 set ref 363 366 382 440 492 575* 627 627 627 650 682 682 682 853* 1012* 1028 1032 1032 1034 1034 1036 1156* 1157* 1162* 1174* 1176* 1192 1195 1199 1209 1218 1223 1417* 1418* 1419* 1533* 1534* 1545* 1670* 1691 1691 1691 1698 fixnum_fmt based structure level 1 dcl 13-4 fixnum_type constant bit(36) initial dcl 13-4 ref 574 627 650 682 852 1010 1025 1027 1153 1168 1413 1531 1543 1669 flag_reset_mask internal static bit(36) initial dcl 4-13 flags 15 based structure level 2 packed unaligned dcl 4-13 float builtin function dcl 257 ref 1460 floatb 1 based float bin(27) level 2 dcl 13-4 set ref 1160* 1203 1463* flonum_fmt based structure level 1 dcl 13-4 flonum_too_big internal static fixed bin(17,0) initial dcl 9-8 flonum_type constant bit(36) initial dcl 13-4 ref 1159 1461 fn 000123 automatic float bin(27) dcl 27 set ref 1460* 1463 fn_CtoI internal static fixed bin(17,0) initial dcl 10-9 fn_ItoC internal static fixed bin(17,0) initial dcl 10-9 fn_abs internal static fixed bin(17,0) initial dcl 10-9 fn_add1 internal static fixed bin(17,0) initial dcl 10-9 fn_add1_fix internal static fixed bin(17,0) initial dcl 10-9 fn_add1_flo internal static fixed bin(17,0) initial dcl 10-9 fn_alarmclock internal static fixed bin(17,0) initial dcl 10-9 fn_allfiles internal static fixed bin(17,0) initial dcl 10-9 fn_alphalessp internal static fixed bin(17,0) initial dcl 10-9 fn_apply internal static fixed bin(17,0) initial dcl 10-9 fn_arg internal static fixed bin(17,0) initial dcl 10-9 fn_args internal static fixed bin(17,0) initial dcl 10-9 fn_array internal static fixed bin(17,0) initial dcl 10-9 fn_arraydims internal static fixed bin(17,0) initial dcl 10-9 fn_ascii internal static fixed bin(17,0) initial dcl 10-9 fn_atan internal static fixed bin(17,0) initial dcl 10-9 fn_baktrace internal static fixed bin(17,0) initial dcl 10-9 fn_bltarray internal static fixed bin(17,0) initial dcl 10-9 fn_boole internal static fixed bin(17,0) initial dcl 10-9 fn_boundp internal static fixed bin(17,0) initial dcl 10-9 fn_catch internal static fixed bin(17,0) initial dcl 10-9 fn_catenate internal static fixed bin(17,0) initial dcl 10-9 fn_charpos internal static fixed bin(17,0) initial dcl 10-9 fn_chrct internal static fixed bin(17,0) initial dcl 10-9 fn_clear_input internal static fixed bin(17,0) initial dcl 10-9 fn_cline internal static fixed bin(17,0) initial dcl 10-9 fn_close internal static fixed bin(17,0) initial dcl 10-9 fn_cos internal static fixed bin(17,0) initial dcl 10-9 fn_cursorpos internal static fixed bin(17,0) initial dcl 10-9 fn_defaultf internal static fixed bin(17,0) initial dcl 10-9 fn_definedp internal static fixed bin(17,0) initial dcl 10-9 fn_defsubr internal static fixed bin(17,0) initial dcl 10-9 fn_defun internal static fixed bin(17,0) initial dcl 10-9 fn_delete internal static fixed bin(17,0) initial dcl 10-9 fn_deletef internal static fixed bin(17,0) initial dcl 10-9 fn_delq internal static fixed bin(17,0) initial dcl 10-9 fn_diff_fix internal static fixed bin(17,0) initial dcl 10-9 fn_diff_flo internal static fixed bin(17,0) initial dcl 10-9 fn_difference internal static fixed bin(17,0) initial dcl 10-9 fn_displace internal static fixed bin(17,0) initial dcl 10-9 fn_do internal static fixed bin(17,0) initial dcl 10-9 fn_dumparrays internal static fixed bin(17,0) initial dcl 10-9 fn_endpagefn internal static fixed bin(17,0) initial dcl 10-9 fn_eoffn internal static fixed bin(17,0) initial dcl 10-9 fn_eql internal static fixed bin(17,0) initial dcl 10-9 fn_errframe internal static fixed bin(17,0) initial dcl 10-9 fn_errprint internal static fixed bin(17,0) initial dcl 10-9 fn_errset internal static fixed bin(17,0) initial dcl 10-9 fn_eval internal static fixed bin(17,0) initial dcl 10-9 fn_eval_when internal static fixed bin(17,0) initial dcl 10-9 fn_evalframe internal static fixed bin(17,0) initial dcl 10-9 fn_exp internal static fixed bin(17,0) initial dcl 10-9 fn_expt internal static fixed bin(17,0) initial dcl 10-9 fn_expt_fix internal static fixed bin(17,0) initial dcl 10-9 fn_expt_flo internal static fixed bin(17,0) initial dcl 10-9 fn_filepos internal static fixed bin(17,0) initial dcl 10-9 fn_fillarray internal static fixed bin(17,0) initial dcl 10-9 fn_fix internal static fixed bin(17,0) initial dcl 10-9 fn_float internal static fixed bin(17,0) initial dcl 10-9 fn_force_output internal static fixed bin(17,0) initial dcl 10-9 fn_freturn internal static fixed bin(17,0) initial dcl 10-9 fn_fsc internal static fixed bin(17,0) initial dcl 10-9 fn_gcd internal static fixed bin(17,0) initial dcl 10-9 fn_gensym internal static fixed bin(17,0) initial dcl 10-9 fn_get internal static fixed bin(17,0) initial dcl 10-9 fn_get_pname internal static fixed bin(17,0) initial dcl 10-9 fn_getchar internal static fixed bin(17,0) initial dcl 10-9 fn_getl internal static fixed bin(17,0) initial dcl 10-9 fn_greaterp internal static fixed bin(17,0) initial dcl 10-9 fn_gt internal static fixed bin(17,0) initial dcl 10-9 fn_haipart internal static fixed bin(17,0) initial dcl 10-9 fn_haulong internal static fixed bin(17,0) initial dcl 10-9 fn_ifix internal static fixed bin(17,0) initial dcl 10-9 fn_in internal static fixed bin(17,0) initial dcl 10-9 fn_includef internal static fixed bin(17,0) initial dcl 10-9 fn_index internal static fixed bin(17,0) initial dcl 10-9 fn_inpush internal static fixed bin(17,0) initial dcl 10-9 fn_isqrt internal static fixed bin(17,0) initial dcl 10-9 fn_lessp internal static fixed bin(17,0) initial dcl 10-9 fn_linel internal static fixed bin(17,0) initial dcl 10-9 fn_linenum internal static fixed bin(17,0) initial dcl 10-9 fn_listarray internal static fixed bin(17,0) initial dcl 10-9 fn_listify internal static fixed bin(17,0) initial dcl 10-9 fn_loadarrays internal static fixed bin(17,0) initial dcl 10-9 fn_log internal static fixed bin(17,0) initial dcl 10-9 fn_ls internal static fixed bin(17,0) initial dcl 10-9 fn_lsh internal static fixed bin(17,0) initial dcl 10-9 fn_make_atom internal static fixed bin(17,0) initial dcl 10-9 fn_makunbound internal static fixed bin(17,0) initial dcl 10-9 fn_mapatoms internal static fixed bin(17,0) initial dcl 10-9 fn_max internal static fixed bin(17,0) initial dcl 10-9 fn_mergef internal static fixed bin(17,0) initial dcl 10-9 fn_min internal static fixed bin(17,0) initial dcl 10-9 fn_minus internal static fixed bin(17,0) initial dcl 10-9 fn_minusp internal static fixed bin(17,0) initial dcl 10-9 fn_namelist internal static fixed bin(17,0) initial dcl 10-9 fn_names internal static fixed bin(17,0) initial dcl 10-9 fn_namestring internal static fixed bin(17,0) initial dcl 10-9 fn_nointerrupt internal static fixed bin(17,0) initial dcl 10-9 fn_nth internal static fixed bin(17,0) initial dcl 10-9 fn_nthcdr internal static fixed bin(17,0) initial dcl 10-9 fn_oddp internal static fixed bin(17,0) initial dcl 10-9 fn_open internal static fixed bin(17,0) initial dcl 10-9 fn_opena internal static fixed bin(17,0) initial dcl 10-9 fn_openi internal static fixed bin(17,0) initial dcl 10-9 fn_openo internal static fixed bin(17,0) initial dcl 10-9 fn_out internal static fixed bin(17,0) initial dcl 10-9 fn_pagel internal static fixed bin(17,0) initial dcl 10-9 fn_pagenum internal static fixed bin(17,0) initial dcl 10-9 fn_plus internal static fixed bin(17,0) initial dcl 10-9 fn_plus_fix internal static fixed bin(17,0) initial dcl 10-9 fn_plus_flo internal static fixed bin(17,0) initial dcl 10-9 fn_plusp internal static fixed bin(17,0) initial dcl 10-9 fn_prin1 internal static fixed bin(17,0) initial dcl 10-9 fn_princ internal static fixed bin(17,0) initial dcl 10-9 fn_print internal static fixed bin(17,0) initial dcl 10-9 fn_prog internal static fixed bin(17,0) initial dcl 10-9 fn_progv internal static fixed bin(17,0) initial dcl 10-9 fn_putprop internal static fixed bin(17,0) initial dcl 10-9 fn_quot_fix internal static fixed bin(17,0) initial dcl 10-9 fn_quot_flo internal static fixed bin(17,0) initial dcl 10-9 fn_quotient internal static fixed bin(17,0) initial dcl 10-9 fn_random internal static fixed bin(17,0) initial dcl 10-9 fn_read internal static fixed bin(17,0) initial dcl 10-9 fn_read_from_string internal static fixed bin(17,0) initial dcl 10-9 fn_readch internal static fixed bin(17,0) initial dcl 10-9 fn_readstring internal static fixed bin(17,0) initial dcl 10-9 fn_remainder internal static fixed bin(17,0) initial dcl 10-9 fn_remprop internal static fixed bin(17,0) initial dcl 10-9 fn_rename internal static fixed bin(17,0) initial dcl 10-9 fn_rot internal static fixed bin(17,0) initial dcl 10-9 fn_rplaca internal static fixed bin(17,0) initial dcl 10-9 fn_samepnamep internal static fixed bin(17,0) initial dcl 10-9 fn_save internal static fixed bin(17,0) initial dcl 10-9 fn_set internal static fixed bin(17,0) initial dcl 10-9 fn_setarg internal static fixed bin(17,0) initial dcl 10-9 fn_setq internal static fixed bin(17,0) initial dcl 10-9 fn_setsyntax 006574 constant fixed bin(17,0) initial dcl 10-9 ref 623 764 fn_shortnamestring internal static fixed bin(17,0) initial dcl 10-9 fn_signp internal static fixed bin(17,0) initial dcl 10-9 fn_sin internal static fixed bin(17,0) initial dcl 10-9 fn_sleep internal static fixed bin(17,0) initial dcl 10-9 fn_sort internal static fixed bin(17,0) initial dcl 10-9 fn_sortcar internal static fixed bin(17,0) initial dcl 10-9 fn_sqrt internal static fixed bin(17,0) initial dcl 10-9 fn_sstatus constant fixed bin(17,0) initial dcl 10-9 ref 509 735 fn_star_array internal static fixed bin(17,0) initial dcl 10-9 fn_star_rearray internal static fixed bin(17,0) initial dcl 10-9 fn_star_sstatus constant fixed bin(17,0) initial dcl 10-9 ref 508 fn_star_status constant fixed bin(17,0) initial dcl 10-9 ref 510 fn_status constant fixed bin(17,0) initial dcl 10-9 ref 511 fn_store internal static fixed bin(17,0) initial dcl 10-9 fn_stringlength internal static fixed bin(17,0) initial dcl 10-9 fn_sub1 internal static fixed bin(17,0) initial dcl 10-9 fn_sub1_fix internal static fixed bin(17,0) initial dcl 10-9 fn_sub1_flo internal static fixed bin(17,0) initial dcl 10-9 fn_substr internal static fixed bin(17,0) initial dcl 10-9 fn_sxhash internal static fixed bin(17,0) initial dcl 10-9 fn_sysp internal static fixed bin(17,0) initial dcl 10-9 fn_throw internal static fixed bin(17,0) initial dcl 10-9 fn_times internal static fixed bin(17,0) initial dcl 10-9 fn_times_fix internal static fixed bin(17,0) initial dcl 10-9 fn_times_flo internal static fixed bin(17,0) initial dcl 10-9 fn_truename internal static fixed bin(17,0) initial dcl 10-9 fn_tyi internal static fixed bin(17,0) initial dcl 10-9 fn_tyipeek internal static fixed bin(17,0) initial dcl 10-9 fn_tyo internal static fixed bin(17,0) initial dcl 10-9 fn_unwind_protect internal static fixed bin(17,0) initial dcl 10-9 fn_zerop internal static fixed bin(17,0) initial dcl 10-9 forcefeed internal static bit(27) initial unaligned dcl 12-27 gclock 006216 constant entry internal dcl 1397 ref 1405 1428 1440 gctwa 003006 constant entry external dcl 1023 gctwa_sts based bit(36) dcl 1020 set ref 1028* 1032* 1032 1034* 1034 1036* get_default_wdir_ 000372 constant entry external dcl 1507 ref 1511 got_it 000756 constant label dcl 422 ref 417 got_it_43 005260 constant label dcl 1596 ref 1592 got_it_44 005316 constant label dcl 1614 ref 1610 hbound builtin function dcl 257 ref 1251 1691 hour defined fixed bin(17,0) dcl 1391 set ref 1444* 1445 i 000111 automatic fixed bin(17,0) dcl 27 set ref 368* 395* 408* 443* 490 492 520 522 547* 549 555* 600* 611* 612 612 612 612* 638* 675* 694* 737* 739 740 741* 751* 763 776* 777 784* 784* 793 939* 973* 1001* 1077* 1133* 1163* 1177* 1233* 1239* 1308* 1571* 1627* 1627* 1628 1629 1629 1643* 1643* 1644 1645 1645 1683* ibase defined fixed bin(71,0) dcl 3-17 ill_arg 005700 constant entry internal dcl 502 ref 497 1695 1701 ill_arg_nsm 005725 constant entry internal dcl 513 ref 639 676 695 illeg constant bit(6) initial dcl 76 ref 426 1596 1614 1624 1640 illobj internal static fixed bin(17,0) initial dcl 9-8 include_file_error internal static fixed bin(17,0) initial dcl 9-8 index builtin function dcl 257 initss 000156 internal static bit(1) initial unaligned dcl 76 set ref 349 355* io_wrong_direction internal static fixed bin(17,0) initial dcl 9-8 ioa_$rsnpnnl 000366 constant entry external dcl 1497 ref 1520 iochan based structure level 1 dcl 4-13 j 000112 automatic fixed bin(17,0) dcl 27 set ref 366* 367 367 377 378 387 416* 417* 422 424 451 464 465 469 470 865 1591* 1592* 1596 1609* 1610* 1614 1623* 1623* 1624 1627 1629 1629* 1632 1639* 1639* 1640 1643 1645 1645* 1648 j_ok 000623 constant label dcl 371 ref 367 l_loss_2 000713 constant label dcl 395 ref 381 383 384 l_retry_2 000654 constant label dcl 380 ref 391 398 lbound builtin function dcl 257 ref 1246 1691 length builtin function dcl 257 ref 1512 1576 1576 lisp_$apply 000232 constant entry external dcl 262 ref 824 lisp_$eval 000222 constant entry external dcl 262 ref 431 438 456 lisp_$evalhook_off_status 000210 external static bit(36) dcl 27 ref 929 lisp_$evalhook_on_status 000212 external static bit(36) dcl 27 ref 922 931 lisp_alloc_$alloc_fault_word external static bit(36) dcl 16-3 lisp_alloc_$alloc_info external static bit(288) dcl 16-3 lisp_alloc_$consptr external static pointer dcl 16-3 lisp_alloc_$cur_seg 000352 external static pointer dcl 16-3 ref 1088 lisp_alloc_$gc_blk_cntr external static fixed bin(17,0) dcl 16-3 lisp_alloc_$seg_blk_cntr external static fixed bin(17,0) dcl 16-3 lisp_defsubr_$sysp 000236 constant entry external dcl 262 ref 956 lisp_error_ 000252 constant entry external dcl 262 ref 521 lisp_fault_handler_$ioc 000230 constant entry external dcl 262 ref 1494 lisp_garbage_collector_$set_gc_params 000334 constant entry external dcl 1051 ref 1213 lisp_get_atom_ 000242 constant entry external dcl 262 ref 1431 1513 1521 1559 1578 1629 1645 lisp_io_fns_$names 000234 constant entry external dcl 262 ref 854 lisp_list_utils_$nreverse 000244 constant entry external dcl 262 ref 1563 lisp_load_$unsnap_all_links 000224 constant entry external dcl 262 ref 1325 lisp_prelinker_ 000226 constant entry external dcl 262 ref 1328 lisp_prog_fns_$lisp_err 000000 constant entry external dcl 262 lisp_ptr based structure level 1 dcl 8-17 lisp_ptr_type based bit(36) dcl 8-17 lisp_reader_alm_$initial_readtable 000162 external static structure level 1 dcl 27 lisp_segment_manager_$get_stack_size 000340 constant entry external dcl 1051 ref 1125 1173 1175 lisp_segment_manager_$set_stack_size 000336 constant entry external dcl 1051 ref 1139 1219 1224 lisp_special_fns_$cons 000240 constant entry external dcl 262 ref 759 797 798 863 864 869 870 1164 1178 1356 1357 1358 1384 1423 1424 1425 1535 1536 lisp_special_fns_$xcons 000246 constant entry external dcl 262 ref 902 949 957 1560 1630 1646 lisp_static_vars_$MINUS external static fixed bin(71,0) dcl 2-3 lisp_static_vars_$PLUS external static fixed bin(71,0) dcl 2-3 lisp_static_vars_$SLASH external static fixed bin(71,0) dcl 2-3 lisp_static_vars_$STAR 000306 external static fixed bin(71,0) dcl 2-3 ref 1354 1354 lisp_static_vars_$arg_list_ptr 000264 external static pointer dcl 286 set ref 1555* 1574* lisp_static_vars_$array_atom external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$base external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$binding_top external static pointer dcl 1-6 lisp_static_vars_$catch_frame external static pointer dcl 1-6 lisp_static_vars_$cleanup_list 000202 external static fixed bin(71,0) dcl 27 set ref 353 991* lisp_static_vars_$cleanup_list_exists 000204 external static bit(1) dcl 27 set ref 993* 995* lisp_static_vars_$crunit_atom 000214 external static fixed bin(71,0) dcl 27 ref 829 lisp_static_vars_$ctrlD 000320 external static fixed bin(71,0) dcl 5-5 ref 1478 1478 lisp_static_vars_$ctrlQ 000322 external static fixed bin(71,0) dcl 5-8 ref 1481 1481 lisp_static_vars_$ctrlR 000324 external static fixed bin(71,0) dcl 5-11 ref 1482 1482 lisp_static_vars_$ctrlW 000326 external static fixed bin(71,0) dcl 5-14 ref 1483 1483 lisp_static_vars_$divov_flag 000172 external static fixed bin(71,0) dcl 27 set ref 352 lisp_static_vars_$dsk_atom 000254 external static fixed bin(71,0) dcl 286 ref 860 lisp_static_vars_$err_frame external static pointer dcl 1-6 lisp_static_vars_$err_recp external static pointer dcl 1-6 lisp_static_vars_$errlist external static fixed bin(71,0) dcl 2-3 lisp_static_vars_$eval_frame external static pointer dcl 1-6 lisp_static_vars_$evalhook_status 000206 external static bit(36) dcl 27 set ref 922 929* 931* lisp_static_vars_$first_value_atom 000166 external static fixed bin(71,0) dcl 27 set ref 943 lisp_static_vars_$gc_time 000330 external static fixed bin(71,0) dcl 1008 set ref 1012 1013* lisp_static_vars_$gcmax 000342 external static fixed bin(35,0) dcl 1051 set ref 1157 1195* 1210* 1210 lisp_static_vars_$gcmin 000350 external static fixed bin(17,0) dcl 1051 set ref 1160 1162 1199 1203 lisp_static_vars_$gcmin_fixed based fixed bin(35,0) dcl 1051 set ref 1162 1199* lisp_static_vars_$gcmin_float based float bin(27) dcl 1051 set ref 1160 1203* lisp_static_vars_$gcmin_fraction 000346 external static bit(1) unaligned dcl 1051 set ref 1158 1200* 1204* lisp_static_vars_$gcsize 000344 external static fixed bin(5,0) dcl 1051 set ref 1156 1192* 1209* 1210 lisp_static_vars_$ibase external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$iochan_list external static pointer dcl 1-6 lisp_static_vars_$last_value_atom 000176 external static fixed bin(71,0) dcl 27 set ref 943 lisp_static_vars_$lisp_static_vars_ external static structure level 1 unaligned dcl 1-6 lisp_static_vars_$mulpi_state 000262 external static fixed bin(17,0) dcl 286 set ref 1660 1679 lisp_static_vars_$mulquit_state 000260 external static fixed bin(17,0) dcl 286 set ref 1655 1674 lisp_static_vars_$nil 000274 external static fixed bin(71,0) dcl 1-6 ref 374 374 459 459 477 477 478 478 529 529 538 538 595 595 599 599 604 604 652 652 690 690 708 708 713 713 723 723 725 725 727 727 739 739 750 750 751 751 758 758 761 761 773 773 783 783 794 794 796 796 849 849 858 858 876 876 881 881 929 929 942 942 957 957 968 968 978 978 984 984 993 993 1032 1032 1034 1034 1152 1152 1167 1167 1255 1255 1266 1266 1271 1271 1276 1276 1279 1279 1286 1286 1291 1291 1303 1303 1322 1322 1331 1331 1352 1352 1354 1354 1367 1367 1370 1370 1376 1376 1421 1421 1484 1484 1530 1530 1553 1553 1580 1580 1588 1588 1606 1606 1620 1620 1636 1636 1664 1689 lisp_static_vars_$no_snapped_links 000164 external static bit(1) dcl 27 ref 1324 lisp_static_vars_$noret_flag 000256 external static fixed bin(71,0) dcl 286 set ref 539 lisp_static_vars_$nouuo_flag external static fixed bin(71,0) dcl 286 lisp_static_vars_$obarray external static fixed bin(71,0) dcl 1-6 lisp_static_vars_$old_io_defaults 000174 external static fixed bin(71,0) dcl 27 set ref 873 1353 1359 1363 lisp_static_vars_$plus_status 000316 external static fixed bin(71,0) dcl 3-17 ref 351 351 lisp_static_vars_$prog_frame external static pointer dcl 1-6 lisp_static_vars_$quote_atom external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$read_print_nl_sync external static bit(36) unaligned dcl 3-17 lisp_static_vars_$readtable 000314 external static fixed bin(71,0) dcl 3-17 ref 559 559 560 560 565 565 567 567 570 570 582 582 585 585 588 588 590 590 591 591 595 595 598 598 604 604 612 612 612 612 612 612 612 612 701 701 702 702 709 709 715 715 731 731 734 734 739 739 740 740 741 741 749 749 761 761 763 763 767 767 776 776 782 782 793 793 795 795 1264 1264 1269 1269 1274 1274 1279 1279 1281 1281 1286 1286 1288 1288 1291 1291 1293 1293 1297 1297 1300 1300 1303 1303 1303 1303 1306 1306 1306 1306 1310 1310 1311 1311 lisp_static_vars_$s_atom 000312 external static fixed bin(71,0) dcl 3-17 ref 795 795 lisp_static_vars_$semicolon_macro 000200 external static fixed bin(71,0) dcl 27 set ref 886 900 903 909 1714 lisp_static_vars_$space_names_atom 000332 external static pointer dcl 1051 ref 1043 1069 1170 1171 1172 1187 1216 1221 lisp_static_vars_$stack_ptr 000266 external static pointer dcl 1-6 set ref 358 358 359* 359 371* 371 373 373 519* 519 523* 523 528 528 537 537 622 622 710* 710 716* 716 760* 760 816* 816 834* 834 851* 851 856* 856 901* 901 947* 947 953* 953 1031 1031 1103 1103 1123 1123 1136 1136 1146 1146 1151* 1151 1166* 1166 1173 1173 1182* 1182 1219 1219 1355* 1355 1369* 1369 1377* 1377 1383 1383 1422* 1422 1469 1469 1470* 1470 1493* 1493 1529* 1529 1558* 1558 1562* 1562 1626* 1626 1642* 1642 lisp_static_vars_$star_rset 000302 external static fixed bin(71,0) dcl 1-45 ref 530 530 lisp_static_vars_$status_gctwa 000310 external static fixed bin(71,0) dcl 3-17 set ref 1025 1027 1028 1032 1032 1034 1034 1036 1040 lisp_static_vars_$stnopoint external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$t_atom 000270 external static fixed bin(71,0) dcl 1-6 ref 459 459 529 529 538 538 703 703 970 970 982 982 1264 1264 1269 1269 1274 1274 1306 1306 1667 1686 lisp_static_vars_$top_level external static label variable dcl 1-6 lisp_static_vars_$toplevel 000304 external static fixed bin(71,0) dcl 2-3 ref 350 350 lisp_static_vars_$tty_atom external static fixed bin(71,0) dcl 3-17 lisp_static_vars_$tty_input_chan external static pointer dcl 1-6 lisp_static_vars_$tty_output_chan 000276 external static pointer dcl 1-6 ref 968 968 970 970 lisp_static_vars_$unmkd_ptr 000272 external static pointer dcl 1-6 set ref 515 515 516* 516 1105 1105 1124 1124 1137 1137 1175 1175 1224 1224 lisp_static_vars_$unwp_frame external static pointer dcl 1-6 lisp_static_vars_$uread_atom 000216 external static pointer dcl 27 ref 827 846 lisp_static_vars_$user_intr_array 000300 external static fixed bin(71,0) array dcl 1-45 ref 1246 1246 1251 1251 1255 1255 1257 1257 1261 1261 1691 1691 1691 1691 lisp_static_vars_$uwrite_atom 000220 external static pointer dcl 27 ref 831 841 lisp_static_vars_$value_atom 000170 external static fixed bin(71,0) dcl 27 ref 948 lisp_string based structure level 1 dcl 15-6 lispversion constant fixed bin(17,0) initial dcl 27 ref 1545 loss_1 000730 constant label dcl 408 ref 419 426 loss_13 003601 constant label dcl 1233 ref 1246 1251 1255 lparn internal static bit(27) initial unaligned dcl 12-27 lsub_join 001104 constant label dcl 459 ref 394 lsubf 000114 automatic bit(1) unaligned dcl 27 set ref 325* 332* 338* 344* 361 508 510 725 m 000120 automatic fixed bin(35,0) dcl 27 set ref 382* 383 384 388 434* 440* 441 441 453 547 548* 559 560 565 565 567 570 582 584 585 588 588 590 590 591 627* 633* 635* 701 702 709 715 731 734 741 763 767 776 795 1478 1481 1482 1483 1527* 1534 macro constant bit(27) initial unaligned dcl 12-27 ref 565 582 586 612 709 715 731 734 767 macro_table based fixed bin(71,0) array level 2 dcl 12-11 set ref 595* 739 740* 793 max builtin function dcl 257 ref 1199 1203 1210 min builtin function dcl 257 ref 1203 minute defined fixed bin(17,0) dcl 1391 set ref 1446* 1447 mismatch_super_parens internal static fixed bin(17,0) initial dcl 9-8 mm 000121 automatic fixed bin(17,0) dcl 27 set ref 585* 594 595 600 612 682* 688* 690* 691* 702 702 mon 000223 automatic fixed bin(17,0) dcl 1391 set ref 1399* 1418 1446* 1446 1447 1447 more_macros 20 based fixed bin(71,0) level 2 dcl 12-11 set ref 598 604* 749 761* 782 mulquit_mulpi_value_ptr 000124 automatic pointer dcl 27 set ref 1655* 1660* 1664 1667 1670 1674* 1679* 1686 1689 1698 myname 000106 automatic fixed bin(17,0) dcl 27 set ref 508* 509* 510* 511* 518 623* 735* 764 n 000122 automatic fixed bin(35,0) dcl 27 set ref 388* 453* 492* 548 549* 559 560 565* 567* 570* 575 650* 652* 657* 658 659 660* 660 664* 701 701 1013 1087* 1091* 1091 1101* 1103* 1105* 1113* 1114* 1121* 1125* 1139* 1173* 1174 1175* 1176 1218* 1219* 1223* 1224* 1246 1246 1251 1255 1257 1261 1297* 1299* 1300* 1300 1310 1311 1317* 1334* 1340* 1454* 1512* 1513 1513 1520* 1521 1521 1527* 1533 1557* 1559 1559* 1574 names 000353 constant char(4) initial array dcl 76 ref 417 1592 1610 1627 1629 1629 1643 1645 1645 nargs 000115 automatic fixed bin(17,0) dcl 27 set ref 363* 365 newsyntax 000362 automatic bit(27) unaligned dcl 580 set ref 584* 586 587* 591 next_seg based pointer level 2 dcl 16-3 ref 1092 nihil_ex_nihile internal static fixed bin(17,0) initial dcl 9-8 nil defined fixed bin(71,0) dcl 1-6 ref 374 459 477 478 529 538 595 599 604 652 690 708 713 723 725 727 739 750 751 758 761 773 783 794 796 849 858 876 881 929 942 957 968 978 984 993 1032 1034 1152 1167 1255 1266 1271 1276 1279 1286 1291 1303 1322 1331 1352 1354 1367 1370 1376 1421 1484 1530 1553 1580 1588 1606 1620 1636 nil_ptr based pointer dcl 1-6 nnames constant fixed bin(17,0) initial dcl 76 ref 367 416 1591 1609 1623 1639 no_2nd_arg 001116 constant label dcl 462 ref 428 no_left_super_paren internal static fixed bin(17,0) initial dcl 9-8 no_lexpr internal static fixed bin(17,0) initial dcl 9-8 nonfixedarg internal static fixed bin(17,0) initial dcl 9-8 noret 001173 constant entry external dcl 535 not_alpha_array internal static fixed bin(17,0) initial dcl 9-8 not_an_array internal static fixed bin(17,0) initial dcl 9-8 not_ok_to_read internal static bit(36) initial unaligned dcl 3-9 not_ok_to_read_fixnum internal static bit(36) initial unaligned dcl 3-11 not_ok_to_write internal static bit(36) initial unaligned dcl 3-9 not_ok_to_write_fixnum internal static bit(36) initial unaligned dcl 3-11 not_pdl_ptr internal static fixed bin(17,0) initial dcl 9-8 not_same_type internal static fixed bin(17,0) initial dcl 9-8 null builtin function dcl 257 ref 1088 num_macs constant fixed bin(17,0) initial dcl 12-4 ref 594 600 737 751 777 784 obarray defined fixed bin(71,0) dcl 1-6 ok2 001055 constant label dcl 449 ref 441 overflow_err internal static fixed bin(17,0) initial dcl 9-8 parenmissing internal static fixed bin(17,0) initial dcl 9-8 pdl_ptr_types36 based structure array level 1 dcl 6-7 pdlsize 003116 constant label dcl 1103 ref 1086 personid 000230 automatic char(22) unaligned dcl 1497 set ref 1518* 1520* plus_minus internal static bit(27) initial unaligned dcl 12-27 plus_status defined fixed bin(71,0) dcl 3-17 set ref 351 pname 5 based char level 2 dcl 14-5 set ref 415 434 635 691 728 1590 1608 1712 1716 1718 1718 pname2 constant bit(6) initial dcl 76 ref 379 427 434 pnamel 4 based fixed bin(17,0) level 2 dcl 14-5 set ref 415 434 635 671 691 728 1590 1608 1712 1716 1718 1718 pnamep 000104 automatic pointer dcl 27 set ref 654* 655 657 663 671* pointr based structure level 1 dcl 296 prog_frame defined pointer dcl 1-6 projectid 000236 automatic char(9) unaligned dcl 1497 set ref 1518* 1520* push_down_list_ptr_types based structure array level 1 dcl 6-7 quit_fault internal static bit(36) initial unaligned dcl 16-3 quote_atom defined fixed bin(71,0) dcl 3-17 quoterror internal static fixed bin(17,0) initial dcl 9-8 rdr_save_f automatic bit(1) unaligned dcl 27 rdtbl 001230 constant label dcl 555 rdtbl1 001233 constant label dcl 558 ref 550 re_verify_num 005662 constant label dcl 490 ref 498 read_print_nl_sync defined bit(36) unaligned dcl 3-17 read_table based structure level 1 dcl 12-11 read_table_dim_vector internal static fixed bin(17,0) initial array dcl 12-7 readtable defined fixed bin(71,0) dcl 3-17 set ref 559 560 565 567 570 582 585 588 590 591 595 598 604 612 612 612 612 701 702 709 715 731 734 739 740 741 749 761 763 767 776 782 793 795 1264 1269 1274 1279 1281 1286 1288 1291 1293 1297 1300 1303 1303 1306 1306 1310 1311 realloc 003405 constant label dcl 1182 ref 1147 reg_mac 001741 constant label dcl 734 ref 725 rel builtin function ref 1103 1105 reopen_inconsistent internal static fixed bin(17,0) initial dcl 9-8 ret_fix 001317 constant label dcl 574 ref 561 568 1093 1107 1115 1127 1140 1301 1320 1337 1343 1455 ret_flo 004512 constant label dcl 1461 retry 006167 constant label dcl 1069 in procedure "decode_space_name" ref 1079 retry 000717 constant label dcl 401 in procedure "status" retry_1 000723 constant label dcl 406 ref 410 retry_2 001015 constant label dcl 434 ref 445 454 return_list_of_sstatus_functions 005422 constant label dcl 1636 ref 1606 return_list_of_status_functions 005323 constant label dcl 1620 ref 1588 return_nil 002133 constant label dcl 773 ref 723 893 925 1135 1381 1382 1594 1596 1612 1614 return_t 001613 constant label dcl 703 ref 708 713 764 892 899 904 913 916 922 1231 1598 1616 reverse builtin function dcl 257 ref 1512 rparn internal static bit(27) initial unaligned dcl 12-27 rset 001147 constant entry external dcl 526 rtn 002325 constant label dcl 835 rubout internal static bit(27) initial unaligned dcl 12-27 s_atom defined fixed bin(71,0) dcl 3-17 ref 795 s_cr 002343 constant label dcl 851 ref 876 s_cr_reform 002357 constant label dcl 856 ref 877 s_ur_uw 002337 constant label dcl 849 ref 844 saction 000063 constant label array(51) dcl 565 ref 470 975 1313 1471 saction3a 002203 constant label dcl 790 ref 765 saction_31_a 002632 constant label dcl 953 ref 950 saction_32_loss 002714 constant label dcl 973 ref 977 sbits 000205 constant bit(6) initial array dcl 76 ref 378 424 1596 1624 sec defined fixed bin(17,0) dcl 1391 set ref 1443* 1444 1445* 1445 1446 1447* 1447 seg_offset 2 based bit(18) level 3 packed unaligned dcl 16-3 ref 1091 setsyntax 001326 constant entry external dcl 620 shift_scale internal static bit(27) initial unaligned dcl 12-27 shortreadlist internal static fixed bin(17,0) initial dcl 9-8 single_char_object internal static bit(27) initial unaligned dcl 12-27 slash_if_first internal static bit(27) initial unaligned dcl 12-27 slash_if_not_first internal static bit(27) initial unaligned dcl 12-27 slash_output constant bit(27) initial unaligned dcl 12-27 ref 587 709 715 731 734 slashifier internal static bit(27) initial unaligned dcl 12-27 snx1 001404 constant label dcl 638 ref 631 632 snx1a 001342 constant label dcl 627 ref 640 snx2 001506 constant label dcl 675 ref 658 659 667 snx2a 001411 constant label dcl 650 ref 677 snx2jsa 001434 constant label dcl 655 ref 672 snx3 001561 constant label dcl 694 ref 686 687 snx3a 001512 constant label dcl 682 ref 696 snxmacro 001617 constant label dcl 708 ref 665 snxsplice 001641 constant label dcl 713 ref 666 special constant bit(27) initial unaligned dcl 12-27 ref 709 715 731 734 special_array_type internal static fixed bin(17,0) initial dcl 9-8 splice constant bit(27) initial unaligned dcl 12-27 ref 715 731 795 splice_mac 001726 constant label dcl 731 ref 726 ss67com 002270 constant label dcl 816 ref 805 809 ssa3a 001754 constant label dcl 737 ref 711 717 732 ssa3b 002114 constant label dcl 764 ref 742 ssaction 000000 constant label array(51) dcl 545 ref 469 ssatoms 000010 internal static pointer initial array dcl 76 set ref 350* 351* 352* 353* 464 465 ssbit 000126 automatic bit(6) dcl 76 set ref 377* 378* 379 386 389* 389 422* 424* 426 427 430 434 449 452* 452 459 462 ssbits 000270 constant bit(6) initial array dcl 76 ref 377 422 1614 1640 ssf 000113 automatic bit(1) unaligned dcl 27 set ref 324* 331* 337* 343* 377 386 422 449 464 469 508 978 1013 1257 ssio 000146 constant label array(0:2) dcl 827 ref 823 ssiojn 002300 constant label dcl 824 ref 828 830 832 sstatus 000520 constant entry external dcl 329 sstatus_ 000544 constant entry external dcl 341 sstatus_mulxx_join 005562 constant label dcl 1683 ref 1677 sstatus_mulxx_retry 005564 constant label dcl 1686 ref 1696 1702 st_ptr 000220 automatic pointer dcl 1051 set ref 1088* 1088* 1091* 1092 1123* 1124* 1125* 1136* 1137* 1139* stack 000100 automatic pointer dcl 27 set ref 358* 359 363 364 365* 365 366 371 380 382 390 390 405 405 406 415 432 432 434 434 439 440 457 457 459 459 464 465 477 478 478 481 481 482 482 490 492 519 520 520 522 522 523 528* 529 529 530 537* 538 538 539 574 575 598 599 601 601 602 602 604 604 606 606 622* 627 627 627 627 633 633 635 635 650 650 652 653 654 670 671 682 682 682 682 688 688 690 691 691 703 708 710 713 716 723 725 727 727 728 728 740 749 750 751 752 752 753 753 756 756 757 757 758 760 761 761 762 762 773 782 783 785 785 786 786 790 790 793 794 795 796 799 799 816 822 822 827 829 831 834 841 846 849 851 852 853 856 858 859 859 860 861 861 862 862 866 866 873 876 881 886 900 901 903 909 911 911 927 927 929 937 942 946 947 948 953 955 955 957 958 958 965 965 967 967 968 970 971 971 978 982 984 991 993 996 996 1010 1012 1031* 1032 1034 1040 1043 1069 1071 1071 1073 1073 1146* 1147 1151 1152 1153 1153 1153 1156 1157 1159 1160 1162 1166 1167 1168 1168 1170 1171 1172 1174 1176 1182 1186 1187 1190 1190 1191 1192 1192 1195 1195 1197 1197 1198 1199 1202 1203 1208 1209 1216 1218 1221 1223 1228 1228 1257 1261 1264 1266 1269 1271 1274 1276 1279 1282 1282 1286 1291 1303 1306 1322 1331 1349 1349 1351 1351 1352 1353 1354 1354 1355 1359 1360 1360 1363 1367 1369 1370 1371 1371 1373 1373 1373 1376 1377 1379 1379 1383 1413 1413 1413 1417 1418 1419 1421 1422 1431 1461 1463 1469* 1470 1478 1481 1482 1483 1484 1492 1492 1493 1513 1521 1529 1530 1531 1531 1533 1534 1543 1545 1553 1558 1559 1562 1578 1580 1588 1590 1606 1608 1620 1626 1629 1636 1642 1645 1664 1667 1669 1670 1686 1689 1690 1691 1691 1691 1698 1712 1714 1715 1716 1718 1718 1722 1722 1723 1723 stack_loss_error internal static fixed bin(17,0) initial dcl 9-8 stack_ptr defined pointer dcl 1-6 set ref 358 359* 371* 373 519* 523* 528 537 622 710* 716* 760* 816* 834* 851* 856* 901* 947* 953* 1031 1103 1123 1136 1146 1151* 1166* 1173* 1182* 1219* 1355* 1369* 1377* 1383 1422* 1469 1470* 1493* 1529* 1558* 1562* 1626* 1642* star_rset defined fixed bin(71,0) dcl 1-45 set ref 530 stars_left_in_name internal static fixed bin(17,0) initial dcl 9-8 status 000507 constant entry external dcl 6 status_ 000532 constant entry external dcl 335 status_gctwa defined fixed bin(71,0) dcl 3-17 status_mulxx_join 005527 constant label dcl 1664 ref 1658 1705 status_terpri 432 based bit(1) level 2 dcl 12-11 set ref 1264 1279* 1281* status_ttyread 434 based bit(1) level 2 dcl 12-11 set ref 1274 1291* 1293* status_underline 433 based bit(1) level 2 dcl 12-11 set ref 1269 1286* 1288* std_syntax 000162 external static bit(27) array level 2 dcl 27 ref 584 660 std_translation 204 000162 external static fixed bin(17,0) array level 2 dcl 27 ref 590 stnopoint defined fixed bin(71,0) dcl 3-17 store_function_misused internal static fixed bin(17,0) initial dcl 9-8 store_not_allowed internal static fixed bin(17,0) initial dcl 9-8 stoval constant bit(6) initial dcl 76 ref 462 string 1 based char level 2 dcl 15-6 ref 633 657 688 string_length based fixed bin(17,0) level 2 dcl 15-6 ref 633 655 657 688 string_quote_exp internal static bit(27) initial unaligned dcl 12-27 substr builtin function dcl 257 ref 434 633 635 657 688 691 728 1310 1311 1513 1513 1521 1521 1559 1559 1627 1643 sw 000116 automatic bit(1) unaligned dcl 27 set ref 545* 552* 559 719* 748* 777* 781* 790 switch 000117 automatic fixed bin(17,0) dcl 27 set ref 803* 806* 812* 823 syntax 22 based bit(27) array level 2 dcl 12-11 set ref 559* 565 570 582 591* 612 701* 709* 715* 731* 734* 767 795 system_info_$timeup 000362 constant entry external dcl 1474 ref 1457 t_atom defined fixed bin(71,0) dcl 1-6 ref 459 529 538 703 970 982 1264 1269 1274 1306 t_atom_ptr based pointer dcl 1-6 t_or_nil constant bit(6) initial dcl 76 ref 459 tally_word 2 based structure level 2 dcl 16-3 temp based fixed bin(71,0) array dcl 6-7 set ref 359 371 374* 375 382 390* 390 405* 405 432* 432 440 457* 457 459 459* 464* 464 465* 465 477 478* 481* 482* 492 519 520* 520 522* 522 523 529 529* 530 538 538* 539 598* 599* 601* 601 602* 604 650 650 652 682 682 682 682 690 703* 708 710 713 716 723 725 727 740 749* 750* 751 752* 752 753* 756* 756 757* 757 758* 760 761 761 762 773* 782* 783* 785* 785 786* 790* 793* 794* 795* 796* 799* 799 816 822* 822 829* 834 841* 846* 849 851 852 853 856 858* 859* 860* 861* 862* 866* 866 873* 876 881 886* 900* 901 903 927* 927 929 942* 946 946 947 948* 953 955* 955 957 958* 958 965* 965 967* 967 968 970 978 982* 984* 991 993 996* 996 1032 1040* 1043* 1069* 1071 1073* 1151 1152* 1153 1153 1153 1156 1157 1159 1160 1162 1166 1167* 1168 1168 1170* 1171* 1172* 1174 1176 1182 1190* 1197* 1199 1203 1209 1228* 1257 1261* 1264* 1266* 1269* 1271* 1274* 1276* 1279 1282* 1282 1286 1291 1303 1306 1322 1331* 1349* 1349 1351* 1351 1352* 1353* 1354 1354* 1355 1359 1360* 1363* 1367 1369 1370* 1373* 1376* 1377 1379* 1383 1413 1413 1413 1417 1418 1419 1421* 1422 1431* 1470 1478* 1481* 1482* 1483* 1484* 1492* 1492 1493 1513* 1521* 1529 1530* 1531 1531 1533 1534 1553* 1558 1559* 1562 1578* 1580* 1588 1606 1620* 1626 1629* 1636* 1642 1645* 1664* 1667* 1669 1670 1686 1689 1690 1691 1691 1691 1698 1714* 1722* 1722 1723* temp_ptr based pointer array dcl 6-7 set ref 415 434 481 482 602 604 606 606 633 635 654 671 688 691 728 728 753 762 786 790 827* 831* 859 861 862 909* 911 911 971 1034 1071 1073 1187 1190 1192 1192 1195 1195 1197 1216 1218 1221 1223 1228 1360 1371 1373 1373 1379 1590 1608 1712 1716 1718 1718 1723 temp_type 0(21) based bit(9) array level 2 packed unaligned dcl 6-7 ref 478 727 1147 1186 1191 1371 1715 temp_type36 based bit(36) array level 2 dcl 6-7 ref 380 406 434 439 490 633 635 653 670 688 691 937 971 1198 1202 1208 throw_to_no_catch internal static fixed bin(17,0) initial dcl 9-8 time 004521 constant entry external dcl 1467 timeup 000160 internal static fixed bin(71,0) initial dcl 1474 set ref 1457 1457* 1460 tod 000226 automatic fixed bin(71,0) dcl 1391 set ref 1399* 1443 too_few 005645 constant label dcl 478 ref 477 too_few_args internal static fixed bin(17,0) initial dcl 9-8 too_many_args internal static fixed bin(17,0) initial dcl 9-8 toplevel defined fixed bin(71,0) dcl 2-3 set ref 350 translate builtin function ref 1712 1716 1718 1718 translation 226 based fixed bin(17,0) array level 2 dcl 12-11 set ref 560* 567 585 588* 590* 612 612* 612 702* 741* 763* 776 tty_atom defined fixed bin(71,0) dcl 3-17 tty_input_chan defined pointer dcl 1-6 tty_output_chan defined pointer dcl 1-6 ref 968 970 type 0(21) based bit(9) level 2 packed unaligned dcl 8-17 ref 1690 type_info based bit(36) level 2 in structure "fixnum_fmt" dcl 13-4 in procedure "status" set ref 574* 627 650 682 852* 1010* 1025 1027* 1153* 1153* 1153* 1168* 1168* 1413* 1413* 1413* 1531* 1531* 1543* 1669* type_info based bit(36) level 2 in structure "flonum_fmt" dcl 13-4 in procedure "status" set ref 1159* 1461* udir 000251 automatic char(168) dcl 1507 set ref 1511* 1512 1512 1513 1513 unable_to_float internal static fixed bin(17,0) initial dcl 9-8 undefined_atom internal static fixed bin(17,0) initial dcl 9-8 undefined_function internal static fixed bin(17,0) initial dcl 9-8 undefined_subr internal static fixed bin(17,0) initial dcl 9-8 underflow_fault internal static fixed bin(17,0) initial dcl 9-8 unm 000102 automatic pointer dcl 27 set ref 515* 516 517 518 unmkd_ptr defined pointer dcl 1-6 set ref 515 516* 1105 1124 1137 1175* 1224* unseen_go_tag internal static fixed bin(17,0) initial dcl 9-8 unspec builtin function dcl 257 ref 434 633 635 657 688 691 1310 1311 unwp_frame defined pointer dcl 1-6 uread based fixed bin(71,0) dcl 27 ref 846 user_info_$whoami 000364 constant entry external dcl 1497 ref 1518 user_intr_array defined fixed bin(71,0) array dcl 1-45 set ref 1246 1251 1255 1257 1261 1691 1691 username 000241 automatic char(32) dcl 1497 set ref 1520* 1521 1521 uwrite based fixed bin(71,0) dcl 27 ref 841 value based fixed bin(71,0) level 2 in structure "atom" dcl 14-5 in procedure "status" set ref 530* 539* 559 560 565 567 570 582 585 588 590 591 595 598 604 612 612 612 612 701 702 709 715 731 734 739 740 741 749 761 763 767 776 782 793 795 841 846 873 886 900 903* 1043 1069 1257* 1261 1264 1269 1274 1279 1281 1286 1288 1291 1293 1297 1300 1303 1303 1306 1306 1310 1311 1359* 1363 1478 1481 1482 1483 1714 value based pointer level 2 in structure "atom_ptrs" dcl 14-5 in procedure "status" ref 1170 1171 1172 1187 1216 1221 1353 verify builtin function dcl 257 ref 1512 verify_num 005661 constant entry internal dcl 488 ref 557 1003 1134 1245 1309 1573 vertical_motion internal static bit(27) initial unaligned dcl 12-27 virtual_cpu_time_ 000360 constant entry external dcl 1450 ref 1454 week_day 000225 automatic fixed bin(17,0) dcl 1391 set ref 1399* 1431 which_space 000216 automatic fixed bin(17,0) dcl 1051 set ref 1070* 1086 1101 1103 1113 1121 1123 1135 1136 write 15(02) based bit(1) level 3 packed unaligned dcl 4-13 ref 977 wrong_no_args internal static fixed bin(17,0) initial dcl 9-8 year 000222 automatic fixed bin(17,0) dcl 1391 set ref 1399* 1411* 1411 1417 1444* 1444 1445 1445 zerodivide_fault internal static fixed bin(17,0) initial dcl 9-8 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 7664 10260 6601 7674 Length 11322 6601 374 1025 1063 152 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME status 340 external procedure is an external procedure. check_arg internal procedure shares stack frame of external procedure status. verify_num internal procedure shares stack frame of external procedure status. ill_arg internal procedure shares stack frame of external procedure status. del_macro internal procedure shares stack frame of external procedure status. decode_space_name internal procedure shares stack frame of external procedure status. gclock internal procedure shares stack frame of external procedure status. find_feature internal procedure shares stack frame of external procedure status. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 ssatoms status 000156 initss status 000160 timeup status STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME status 000100 stack status 000102 unm status 000104 pnamep status 000106 myname status 000107 char4 status 000110 char4a status 000111 i status 000112 j status 000113 ssf status 000114 lsubf status 000115 nargs status 000116 sw status 000117 switch status 000120 m status 000121 mm status 000122 n status 000123 fn status 000124 mulquit_mulpi_value_ptr status 000126 ssbit status 000130 argptr status 000132 arglen status 000133 arg_buffer status 000215 code status 000216 which_space status 000220 st_ptr status 000222 year status 000223 mon status 000224 day status 000225 week_day status 000226 tod status 000230 personid status 000236 projectid status 000241 username status 000251 udir status 000362 newsyntax del_macro THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a r_g_a r_e_as r_ne_as r_ge_a alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry divide_fx3 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. clock_ cpu_time_and_paging_ cu_$arg_ptr_rel decode_clock_value_ get_default_wdir_ ioa_$rsnpnnl lisp_$apply lisp_$eval lisp_defsubr_$sysp lisp_error_ lisp_fault_handler_$ioc lisp_garbage_collector_$set_gc_params lisp_get_atom_ lisp_io_fns_$names lisp_list_utils_$nreverse lisp_load_$unsnap_all_links lisp_prelinker_ lisp_segment_manager_$get_stack_size lisp_segment_manager_$set_stack_size lisp_special_fns_$cons lisp_special_fns_$xcons system_info_$timeup user_info_$whoami virtual_cpu_time_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lisp_$evalhook_off_status lisp_$evalhook_on_status lisp_alloc_$cur_seg lisp_reader_alm_$initial_readtable lisp_static_vars_$STAR lisp_static_vars_$arg_list_ptr lisp_static_vars_$cleanup_list lisp_static_vars_$cleanup_list_exists lisp_static_vars_$crunit_atom lisp_static_vars_$ctrlD lisp_static_vars_$ctrlQ lisp_static_vars_$ctrlR lisp_static_vars_$ctrlW lisp_static_vars_$divov_flag lisp_static_vars_$dsk_atom lisp_static_vars_$evalhook_status lisp_static_vars_$first_value_atom lisp_static_vars_$gc_time lisp_static_vars_$gcmax lisp_static_vars_$gcmin lisp_static_vars_$gcmin_fraction lisp_static_vars_$gcsize lisp_static_vars_$last_value_atom lisp_static_vars_$mulpi_state lisp_static_vars_$mulquit_state lisp_static_vars_$nil lisp_static_vars_$no_snapped_links lisp_static_vars_$noret_flag lisp_static_vars_$old_io_defaults lisp_static_vars_$plus_status lisp_static_vars_$readtable lisp_static_vars_$s_atom lisp_static_vars_$semicolon_macro lisp_static_vars_$space_names_atom lisp_static_vars_$stack_ptr lisp_static_vars_$star_rset lisp_static_vars_$status_gctwa lisp_static_vars_$t_atom lisp_static_vars_$toplevel lisp_static_vars_$tty_output_chan lisp_static_vars_$unmkd_ptr lisp_static_vars_$uread_atom lisp_static_vars_$user_intr_array lisp_static_vars_$uwrite_atom lisp_static_vars_$value_atom LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000506 324 000514 325 000515 326 000516 329 000517 331 000525 332 000527 333 000530 335 000531 337 000537 338 000540 339 000542 341 000543 343 000551 344 000553 345 000554 349 000555 350 000560 351 000562 352 000564 353 000566 355 000570 358 000571 359 000575 361 000577 363 000601 364 000603 365 000604 366 000606 367 000611 368 000617 369 000621 370 000622 371 000623 373 000626 374 000633 375 000635 376 000640 377 000641 378 000647 379 000652 380 000654 381 000661 382 000662 383 000664 384 000666 386 000671 387 000676 388 000701 389 000703 390 000706 391 000711 394 000712 395 000713 397 000715 398 000716 401 000717 405 000720 406 000723 408 000730 409 000732 410 000733 415 000734 416 000737 417 000747 418 000753 419 000755 422 000756 424 000763 426 000765 427 000770 428 000775 429 000776 430 000777 431 001002 432 001007 433 001012 434 001013 438 001026 439 001033 440 001037 441 001041 443 001051 444 001053 445 001054 449 001055 450 001062 451 001063 452 001066 453 001071 454 001073 456 001074 457 001101 459 001104 462 001116 464 001121 465 001132 466 001137 469 001140 470 001144 526 001146 528 001154 529 001161 530 001166 531 001171 535 001172 537 001200 538 001205 539 001212 540 001215 545 001216 547 001217 548 001221 549 001223 550 001225 552 001226 555 001230 557 001232 558 001233 559 001234 560 001252 561 001262 565 001263 567 001277 568 001305 570 001306 574 001317 575 001321 576 001324 620 001325 622 001333 623 001340 627 001342 631 001356 632 001360 633 001362 635 001373 638 001404 639 001406 640 001407 645 001410 650 001411 652 001420 653 001427 654 001432 655 001434 657 001437 658 001443 659 001446 660 001451 661 001455 663 001456 664 001462 665 001467 666 001472 667 001475 669 001476 670 001477 671 001502 672 001505 675 001506 676 001510 677 001511 682 001512 686 001526 687 001530 688 001532 690 001542 691 001551 694 001561 695 001563 696 001564 701 001565 702 001602 703 001613 704 001616 708 001617 709 001625 710 001636 711 001640 713 001641 715 001647 716 001661 717 001663 719 001664 722 001665 723 001666 725 001674 726 001702 727 001703 728 001715 731 001726 732 001740 734 001741 735 001752 737 001754 739 001763 740 001774 741 002006 742 002015 744 002016 748 002020 749 002022 750 002032 751 002034 752 002043 753 002045 754 002050 756 002052 757 002054 758 002056 759 002060 760 002064 761 002070 762 002102 763 002105 764 002114 765 002120 767 002121 773 002133 774 002136 776 002137 777 002145 781 002151 782 002153 783 002162 784 002164 785 002173 786 002176 787 002201 790 002203 793 002211 794 002223 795 002227 796 002242 797 002244 798 002250 799 002255 800 002260 803 002261 805 002262 806 002263 809 002265 812 002266 816 002270 822 002274 823 002276 824 002300 825 002305 827 002306 828 002311 829 002312 830 002314 831 002315 832 002320 834 002321 835 002325 841 002326 844 002332 846 002333 849 002337 851 002343 852 002347 853 002351 854 002353 856 002357 858 002363 859 002365 860 002367 861 002371 862 002375 863 002400 864 002404 865 002411 866 002414 867 002417 869 002420 870 002425 871 002432 873 002433 876 002437 877 002443 881 002444 886 002450 888 002453 890 002454 892 002455 893 002463 896 002464 899 002465 900 002473 901 002500 902 002502 903 002506 904 002513 906 002514 909 002515 911 002523 913 002536 916 002537 922 002540 925 002545 927 002546 929 002551 931 002560 932 002562 937 002563 939 002571 940 002573 941 002574 942 002575 943 002600 946 002611 947 002615 948 002617 949 002621 950 002625 952 002626 953 002632 955 002636 956 002640 957 002644 958 002655 959 002660 965 002661 967 002664 968 002666 970 002677 971 002706 973 002714 974 002716 975 002717 977 002720 978 002724 981 002734 982 002737 984 002745 985 002747 991 002750 993 002754 995 002761 996 002763 997 002765 1001 002766 1003 002770 1010 002771 1012 002773 1013 002777 1014 003004 1023 003005 1025 003013 1027 003017 1028 003021 1031 003023 1032 003027 1034 003036 1036 003045 1040 003050 1041 003052 1043 003053 1046 003057 1083 003060 1086 003061 1087 003064 1088 003065 1091 003076 1092 003105 1093 003110 1098 003111 1101 003112 1103 003116 1105 003127 1107 003135 1110 003136 1113 003137 1114 003143 1115 003145 1118 003146 1121 003147 1123 003153 1124 003162 1125 003166 1127 003176 1130 003177 1133 003200 1134 003202 1135 003203 1136 003206 1137 003215 1139 003221 1140 003231 1144 003232 1146 003240 1147 003245 1151 003251 1152 003253 1153 003255 1156 003261 1157 003263 1158 003265 1159 003267 1160 003271 1161 003273 1162 003274 1163 003276 1164 003303 1165 003310 1166 003312 1167 003316 1168 003320 1170 003323 1171 003327 1172 003333 1173 003340 1174 003350 1175 003353 1176 003364 1177 003367 1178 003375 1179 003402 1180 003404 1182 003405 1186 003407 1187 003413 1190 003422 1191 003427 1192 003432 1195 003440 1197 003450 1198 003454 1199 003457 1200 003464 1201 003465 1202 003466 1203 003471 1204 003501 1207 003503 1208 003504 1209 003507 1210 003511 1213 003515 1214 003521 1216 003522 1218 003530 1219 003535 1220 003545 1221 003546 1223 003555 1224 003562 1228 003572 1229 003577 1231 003600 1233 003601 1234 003603 1239 003604 1245 003606 1246 003607 1251 003614 1255 003617 1257 003626 1261 003640 1262 003646 1264 003647 1266 003661 1267 003663 1269 003664 1271 003676 1272 003700 1274 003701 1276 003713 1277 003715 1279 003716 1281 003731 1282 003737 1284 003742 1286 003743 1288 003756 1289 003764 1291 003765 1293 004000 1294 004006 1297 004007 1299 004021 1300 004022 1301 004034 1303 004035 1306 004055 1308 004074 1309 004076 1310 004077 1311 004107 1313 004117 1317 004120 1320 004122 1322 004123 1324 004130 1325 004133 1326 004137 1328 004140 1331 004144 1332 004147 1334 004150 1337 004152 1340 004153 1343 004155 1345 004156 1349 004157 1350 004162 1351 004163 1352 004166 1353 004171 1354 004175 1355 004202 1356 004204 1357 004210 1358 004215 1359 004222 1360 004226 1361 004232 1363 004233 1367 004237 1369 004243 1370 004246 1371 004250 1373 004257 1376 004271 1377 004273 1379 004275 1380 004300 1381 004301 1382 004303 1383 004304 1384 004314 1385 004320 1386 004321 1405 004322 1411 004323 1413 004325 1417 004332 1418 004334 1419 004336 1421 004340 1422 004343 1423 004345 1424 004351 1425 004356 1426 004363 1428 004364 1431 004365 1432 004416 1440 004420 1443 004421 1444 004426 1445 004431 1446 004436 1447 004441 1448 004446 1454 004447 1455 004460 1457 004461 1460 004472 1461 004512 1463 004514 1464 004517 1467 004520 1469 004526 1470 004532 1471 004534 1478 004535 1481 004545 1482 004554 1483 004563 1484 004572 1485 004575 1490 004576 1492 004577 1493 004602 1494 004605 1495 004611 1511 004612 1512 004623 1513 004640 1514 004664 1518 004666 1520 004703 1521 004736 1522 004762 1527 004764 1529 005001 1530 005005 1531 005007 1533 005012 1534 005014 1535 005016 1536 005022 1537 005027 1543 005030 1545 005032 1546 005035 1553 005036 1555 005041 1556 005061 1557 005064 1558 005073 1559 005077 1560 005120 1561 005125 1562 005132 1563 005136 1564 005142 1571 005143 1573 005145 1574 005146 1575 005171 1576 005173 1577 005200 1578 005204 1579 005223 1580 005224 1581 005227 1585 005230 1588 005231 1590 005237 1591 005242 1592 005251 1593 005255 1594 005257 1596 005260 1598 005264 1603 005265 1606 005266 1608 005274 1609 005277 1610 005307 1611 005313 1612 005315 1614 005316 1616 005322 1620 005323 1623 005325 1624 005332 1626 005336 1627 005342 1628 005356 1629 005361 1630 005410 1632 005416 1633 005421 1636 005422 1639 005424 1640 005430 1642 005434 1643 005440 1644 005454 1645 005457 1646 005506 1648 005514 1649 005517 1655 005520 1658 005523 1660 005524 1664 005527 1667 005536 1669 005545 1670 005547 1672 005552 1674 005553 1677 005556 1679 005557 1683 005562 1686 005564 1689 005574 1690 005602 1691 005607 1695 005624 1696 005625 1698 005626 1699 005630 1701 005631 1702 005632 1705 005633 475 005634 477 005635 478 005642 481 005651 482 005655 485 005660 488 005661 490 005662 492 005670 493 005675 497 005676 498 005677 502 005700 508 005703 509 005712 510 005715 511 005722 513 005724 515 005726 516 005732 517 005735 518 005737 519 005741 520 005744 521 005750 522 005754 523 005762 524 005765 578 005766 582 005767 584 006000 585 006002 586 006010 587 006012 588 006015 589 006023 590 006024 591 006033 592 006040 593 006041 594 006042 595 006045 596 006055 598 006056 599 006065 600 006067 601 006077 602 006102 603 006105 604 006107 606 006124 611 006130 612 006135 614 006163 616 006165 1067 006166 1069 006167 1070 006173 1071 006177 1073 006205 1074 006210 1077 006212 1078 006214 1079 006215 1397 006216 1399 006217 1401 006253 1709 006254 1712 006256 1714 006271 1715 006276 1716 006301 1717 006315 1718 006321 1722 006355 1723 006360 1724 006363 1725 006364 ----------------------------------------------------------- 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