1 &  **************************************************************
  2 &  *                                                            *
  3 &  * Copyright, (C) Massachusetts Institute of Technology, 1982 *
  4 &  *                                                            *
  5 &  **************************************************************
  6 &  This ec has two entrypoints, lisp_standard_environment_ and lisp_nostartup.
  7 &  They take one argument which is the directory which will contain the installed
  8 &  lisp.  This argument is used to set up autoload properties for tracing, grinding
  9 &  and editing.  The only difference between the two entrypoints is that
 10 &  lisp_nostartup does not initialize the environment to run [hd]>start_up.lisp
 11 &  when it is loaded.  This environment is used to initialize the saved environments
 12 &  for lcp and lap.  The lisp_standard_environment_ entrypoint accepts an additional
 13 &  argument.  If this argument is present, it stops just before saving the
 14 &  environment, so you can poke around.  The saved environment is named
 15 &  lisp_standard_environment_, which is special cased.  The lisp_nostartup
 16 &  environment is called lisp_nostartup.sv.lisp.
 17 &
 18 &if [exists argument &1]
 19 &then &goto OK
 20 &print You must give an argument which is the library directory
 21 &quit
 22 &
 23 &label OK
 24 &command_line off
 25 &input_line off
 26 &attach
 27 lisp -boot
 28 & note next thing makes sure obarray exists as a true array...
 29 (progn (putprop 'obarray obarray 'array)
 30        (putprop 'readtable readtable 'array)
 31        (setq prin1 nil)
 32        (setq evalhook nil)
 33        (setq defun nil)
 34        (*rset t)
 35 
 36 ; set up user interrupt service functions
 37 
 38 (prog2 nil nil
 39        (setq ^a                                   nil
 40              zunderflow                           nil
 41              internal_interrupt_0_atom_           nil
 42              ^b                                   '*internal-^b-break
 43              internal_interrupt_2_atom_           nil
 44              alarmclock                           nil
 45              errset                               nil
 46              undf-fnctn                           '*internal-undf-fnctn-break
 47              unbnd-vrbl                           '*internal-unbnd-vrbl-break
 48              wrng-type-arg                        '*internal-wrng-type-arg-break
 49              unseen-go-tag                        '*internal-unseen-go-tag-break
 50              wrng-no-args                         '*internal-wrng-no-args-break
 51              fail-act                             '*internal-fail-act-break
 52              pdl-overflow                         '*internal-pdl-overflow-break
 53              gc-lossage                           '*internal-gc-lossage-break
 54              internal_interrupt_14_atom_          nil
 55              internal_interrupt_15_atom_          nil
 56              internal_interrupt_16_atom_          nil
 57              gc-daemon                            nil
 58              internal_autoload_atom_              '*internal-autoload-trap
 59              *rset-trap                           '*internal-*rset-break)
 60 
 61        (putprop 'stack-loss t 'break-tag)         ;this has to stay in the obarray.  break-tag will be remob'ed.
 62 
 63 ;;; set up self - loading trace and grind packages
 64 
 65        (defprop lap "&1>lap_" autoload)
 66        (defprop trace "&1>lisp_trace_" autoload)
 67 
 68        (defprop grind "&1>lisp_gfile_" autoload)
 69 
 70        (defprop grindef "&1>lisp_gfn_" autoload)
 71 
 72        (defprop grind0 "&1>lisp_gfile_" autoload)
 73 
 74        (defprop sprinter "&1>lisp_gfn_" autoload)
 75 
 76 ;;; Set up self-loading editor.
 77 
 78        (mapc '(lambda (x) (putprop x "&1>lisp_editor_" 'autoload))
 79              '(editf editp editv edit))
 80 
 81 
 82 ;;; This hack sets up (status features)
 83 
 84        (setq internal_semicolon_macro_ '(sort string fasload newio bignum H6180 Multics maclisp))
 85 
 86 ;;;this hack is for (status spcnames)
 87 
 88        (setq internal_quote_macro_ '(list markedpdl unmarkedpdl))     ;do not change the order
 89 
 90 ;now remove those atoms we wanted uninterned....
 91 
 92        (defun fremob fexpr (fremob) (mapc 'remob fremob))
 93        (fremob internal_quote_macro_ internal_semicolon_macro_ internal_vertical_bar_macro_
 94                cruft          ;used to fill obsolete cells in lisp_static_vars_
 95                err-break errprint? break-tag
 96                internal_interrupt_0_atom_ internal_interrupt_2_atom_
 97                internal_interrupt_14_atom_ internal_interrupt_15_atom_ internal_interrupt_16_atom_
 98                *internal-^b-break *internal-undf-fnctn-break *internal-unbnd-vrbl-break
 99                *internal-wrng-type-arg-break *internal-unseen-go-tag-break
100                *internal-wrng-no-args-break *internal-fail-act-break *internal-pdl-overflow-break
101                *internal-gc-lossage-break *internal-autoload-trap *internal-*rset-break
102                internal_autoload_atom_ autoload_remob)
103 
104        (setq ^d nil nouuo nil)
105 
106          (mapc '(lambda (x) (putprop x "&1>lisp_old_io_" 'autoload))
107                '(uread fasload uwrite ufile ukill crunit uappend uprobe))
108        (fremob fremob)
109        ) ; end of moby prog2
110 )        ; end of moby progn
111 ;here is where we set up for reading start_up.lisp's
112 
113 
114 ;;; code to run a start_up.lisp in home dir, if there is one.
115 
116 &if [equal &ec_name lisp_nostartup]
117 &then &goto NOSTARTUP
118 
119 (prog2
120   (setq errlist
121         '((setq errlist nil)  ;once-only code, used only when lisp command with no args is given.
122 
123           (and (allfiles (list (status udir) 'start_up 'lisp))
124                (load (namestring (list (status udir) 'start_up 'lisp))))))
125   "errlist setup for start_up.lisp"
126   (gctwa) (gc))
127 
128 
129 &if [exists argument &r2]
130 &then &quit
131 (save standard/.new)
132 &detach
133 answer yes -brief "rename standard.new.sv.lisp lisp_standard_environment_"
134 &quit
135 
136 &label NOSTARTUP
137 (gctwa)
138 (gc)
139 (save lisp_nostartup)
140 &quit