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