-
-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathLOOPSSPEEDUP
348 lines (270 loc) · 13.6 KB
/
LOOPSSPEEDUP
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Aug-2022 14:47:13" {DSK}<home>larry>loops>system>LOOPSSPEEDUP.;2 13729
:CHANGES-TO (VARS LOOPSSPEEDUPCOMS)
:PREVIOUS-DATE "11-Mar-2022 19:19:08" {DSK}<home>larry>loops>system>LOOPSSPEEDUP.;1)
(* ; "
Copyright (c) 1986-1987, 1990-1991, 2022 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT LOOPSSPEEDUPCOMS)
(RPAQQ LOOPSSPEEDUPCOMS
(
(* ;;; "Need the following low-level stuff to make a datatype non-garbage-collectable. This saves us the effort of maintaining reference counts")
(FNS Make-Not-Reference-Counted)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
SYSEDIT)
(EXPORT (MACROS \GETDTD)))
(* ;;; "Datatype for in-line caches")
(CONSTANTS (\IN-LINE-CACHE-BLOCK-SIZE 100))
(RECORDS \IN-LINE-CACHE-BLOCK)
(P (Make-Not-Reference-Counted '\IN-LINE-CACHE-BLOCK))
(* ;;; "IV Lookup cache stuff")
(FNS FlushIVIndexCache \Make-IV-Cache-Entry)
[INITVARS (*IV-Cache-Block* (CREATE \IN-LINE-CACHE-BLOCK))
(*IV-Cache-Index* 0)
(*All-IV-Cache-Block* (LIST *IV-Cache-Block*))
(*Global-IV-Cache-Block* (\ALLOCBLOCK (TIMES 4 1024]
(GLOBALVARS *IV-Cache-Block* *IV-Cache-Index* *All-IV-Cache-Block* *Global-IV-Cache-Block*)
(ADDVARS (GLOBALVARS *Global-IV-Cache-Block*))
(* ;;; "Method lookup caching stuff")
(FNS FlushMethodCache \Make-Method-Cache-Entry)
[INITVARS (*Method-Cache-Block* (CREATE \IN-LINE-CACHE-BLOCK))
(*Method-Cache-Index* 0)
(*All-Method-Cache-Block* (LIST *Method-Cache-Block*))
(*Global-Method-Cache* (\ALLOCBLOCK (TIMES 4 1024]
(GLOBALVARS *Method-Cache-Index* *Method-Cache-Block* *All-Method-Cache-Block*
*Global-Method-Cache*)
(ADDVARS (GLOBALVARS *Global-Method-Cache*))))
(* ;;;
"Need the following low-level stuff to make a datatype non-garbage-collectable. This saves us the effort of maintaining reference counts"
)
(DEFINEQ
(Make-Not-Reference-Counted
(LAMBDA (TYPENAME) (* ; "Edited 9-Jun-87 07:09 by smL")
(* ;;; "Make datatype TYPENAME not ref counted. Must not have allocated any yet!")
(* ; "Thanks to bvm for this magic")
(LET* ((DTD (\GETDTD (\TYPENUMBERFROMNAME TYPENAME)))
(BITS (LOGOR 32768 (fetch DTDTYPEENTRY of DTD)))
NEW)
(COND
((NOT (EQP BITS (fetch DTDTYPEENTRY of DTD))) (* ;
"Type is ref-counted, so need to change it")
(change (fetch DTDTYPEENTRY of DTD)
BITS) (* ;
"Have to fix type of already allocated page, if any")
(SETQ NEW (fetch DTDFREE of DTD))
(COND
(NEW (\MAKEMDSENTRY (IPLUS (LLSH (\HILOC NEW)
8)
(LRSH (\LOLOC NEW)
8))
BITS))))))))
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
SYSEDIT)
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS \GETDTD MACRO ((typeNum)
(ADDBASE \DTDSpaceBase (ITIMES typeNum 18))))
)
(* "END EXPORTED DEFINITIONS")
)
(* ;;; "Datatype for in-line caches")
(DECLARE%: EVAL@COMPILE
(RPAQQ \IN-LINE-CACHE-BLOCK-SIZE 100)
(CONSTANTS (\IN-LINE-CACHE-BLOCK-SIZE 100))
)
(DECLARE%: EVAL@COMPILE
(DATATYPE \IN-LINE-CACHE-BLOCK
(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))
)
(/DECLAREDATATYPE '\IN-LINE-CACHE-BLOCK
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)
'((\IN-LINE-CACHE-BLOCK 0 POINTER)
(\IN-LINE-CACHE-BLOCK 2 POINTER)
(\IN-LINE-CACHE-BLOCK 4 POINTER)
(\IN-LINE-CACHE-BLOCK 6 POINTER)
(\IN-LINE-CACHE-BLOCK 8 POINTER)
(\IN-LINE-CACHE-BLOCK 10 POINTER)
(\IN-LINE-CACHE-BLOCK 12 POINTER)
(\IN-LINE-CACHE-BLOCK 14 POINTER)
(\IN-LINE-CACHE-BLOCK 16 POINTER)
(\IN-LINE-CACHE-BLOCK 18 POINTER)
(\IN-LINE-CACHE-BLOCK 20 POINTER)
(\IN-LINE-CACHE-BLOCK 22 POINTER)
(\IN-LINE-CACHE-BLOCK 24 POINTER)
(\IN-LINE-CACHE-BLOCK 26 POINTER)
(\IN-LINE-CACHE-BLOCK 28 POINTER)
(\IN-LINE-CACHE-BLOCK 30 POINTER)
(\IN-LINE-CACHE-BLOCK 32 POINTER)
(\IN-LINE-CACHE-BLOCK 34 POINTER)
(\IN-LINE-CACHE-BLOCK 36 POINTER)
(\IN-LINE-CACHE-BLOCK 38 POINTER)
(\IN-LINE-CACHE-BLOCK 40 POINTER)
(\IN-LINE-CACHE-BLOCK 42 POINTER)
(\IN-LINE-CACHE-BLOCK 44 POINTER)
(\IN-LINE-CACHE-BLOCK 46 POINTER)
(\IN-LINE-CACHE-BLOCK 48 POINTER)
(\IN-LINE-CACHE-BLOCK 50 POINTER)
(\IN-LINE-CACHE-BLOCK 52 POINTER)
(\IN-LINE-CACHE-BLOCK 54 POINTER)
(\IN-LINE-CACHE-BLOCK 56 POINTER)
(\IN-LINE-CACHE-BLOCK 58 POINTER)
(\IN-LINE-CACHE-BLOCK 60 POINTER)
(\IN-LINE-CACHE-BLOCK 62 POINTER)
(\IN-LINE-CACHE-BLOCK 64 POINTER)
(\IN-LINE-CACHE-BLOCK 66 POINTER)
(\IN-LINE-CACHE-BLOCK 68 POINTER)
(\IN-LINE-CACHE-BLOCK 70 POINTER)
(\IN-LINE-CACHE-BLOCK 72 POINTER)
(\IN-LINE-CACHE-BLOCK 74 POINTER)
(\IN-LINE-CACHE-BLOCK 76 POINTER)
(\IN-LINE-CACHE-BLOCK 78 POINTER)
(\IN-LINE-CACHE-BLOCK 80 POINTER)
(\IN-LINE-CACHE-BLOCK 82 POINTER)
(\IN-LINE-CACHE-BLOCK 84 POINTER)
(\IN-LINE-CACHE-BLOCK 86 POINTER)
(\IN-LINE-CACHE-BLOCK 88 POINTER)
(\IN-LINE-CACHE-BLOCK 90 POINTER)
(\IN-LINE-CACHE-BLOCK 92 POINTER)
(\IN-LINE-CACHE-BLOCK 94 POINTER)
(\IN-LINE-CACHE-BLOCK 96 POINTER)
(\IN-LINE-CACHE-BLOCK 98 POINTER)
(\IN-LINE-CACHE-BLOCK 100 POINTER)
(\IN-LINE-CACHE-BLOCK 102 POINTER)
(\IN-LINE-CACHE-BLOCK 104 POINTER)
(\IN-LINE-CACHE-BLOCK 106 POINTER)
(\IN-LINE-CACHE-BLOCK 108 POINTER)
(\IN-LINE-CACHE-BLOCK 110 POINTER)
(\IN-LINE-CACHE-BLOCK 112 POINTER)
(\IN-LINE-CACHE-BLOCK 114 POINTER)
(\IN-LINE-CACHE-BLOCK 116 POINTER)
(\IN-LINE-CACHE-BLOCK 118 POINTER)
(\IN-LINE-CACHE-BLOCK 120 POINTER)
(\IN-LINE-CACHE-BLOCK 122 POINTER)
(\IN-LINE-CACHE-BLOCK 124 POINTER)
(\IN-LINE-CACHE-BLOCK 126 POINTER)
(\IN-LINE-CACHE-BLOCK 128 POINTER)
(\IN-LINE-CACHE-BLOCK 130 POINTER)
(\IN-LINE-CACHE-BLOCK 132 POINTER)
(\IN-LINE-CACHE-BLOCK 134 POINTER)
(\IN-LINE-CACHE-BLOCK 136 POINTER)
(\IN-LINE-CACHE-BLOCK 138 POINTER)
(\IN-LINE-CACHE-BLOCK 140 POINTER)
(\IN-LINE-CACHE-BLOCK 142 POINTER)
(\IN-LINE-CACHE-BLOCK 144 POINTER)
(\IN-LINE-CACHE-BLOCK 146 POINTER)
(\IN-LINE-CACHE-BLOCK 148 POINTER)
(\IN-LINE-CACHE-BLOCK 150 POINTER)
(\IN-LINE-CACHE-BLOCK 152 POINTER)
(\IN-LINE-CACHE-BLOCK 154 POINTER)
(\IN-LINE-CACHE-BLOCK 156 POINTER)
(\IN-LINE-CACHE-BLOCK 158 POINTER)
(\IN-LINE-CACHE-BLOCK 160 POINTER)
(\IN-LINE-CACHE-BLOCK 162 POINTER)
(\IN-LINE-CACHE-BLOCK 164 POINTER)
(\IN-LINE-CACHE-BLOCK 166 POINTER)
(\IN-LINE-CACHE-BLOCK 168 POINTER)
(\IN-LINE-CACHE-BLOCK 170 POINTER)
(\IN-LINE-CACHE-BLOCK 172 POINTER)
(\IN-LINE-CACHE-BLOCK 174 POINTER)
(\IN-LINE-CACHE-BLOCK 176 POINTER)
(\IN-LINE-CACHE-BLOCK 178 POINTER)
(\IN-LINE-CACHE-BLOCK 180 POINTER)
(\IN-LINE-CACHE-BLOCK 182 POINTER)
(\IN-LINE-CACHE-BLOCK 184 POINTER)
(\IN-LINE-CACHE-BLOCK 186 POINTER)
(\IN-LINE-CACHE-BLOCK 188 POINTER)
(\IN-LINE-CACHE-BLOCK 190 POINTER)
(\IN-LINE-CACHE-BLOCK 192 POINTER)
(\IN-LINE-CACHE-BLOCK 194 POINTER)
(\IN-LINE-CACHE-BLOCK 196 POINTER)
(\IN-LINE-CACHE-BLOCK 198 POINTER))
'200)
(Make-Not-Reference-Counted '\IN-LINE-CACHE-BLOCK)
(* ;;; "IV Lookup cache stuff")
(DEFINEQ
(FlushIVIndexCache
(LAMBDA NIL (* ; "Edited 11-Jun-87 12:46 by smL")
(* ;;; "Wipe out the IVIndex cache")
(if *Global-IV-Cache-Block*
then (\ZEROWORDS *Global-IV-Cache-Block* (\ADDBASE *Global-IV-Cache-Block*
(SUB1 (TIMES 2 (TIMES 4 1024))))))
(for block in *All-IV-Cache-Block* when block do (\ZEROWORDS block (\ADDBASE block
(SUB1 (TIMES 2
\IN-LINE-CACHE-BLOCK-SIZE
)))))))
(\Make-IV-Cache-Entry
(LAMBDA NIL (* ; "Edited 11-Jun-87 12:46 by smL")
(* ;;; "Return a new method cache entry position")
(UNINTERRUPTABLY
(LET (CACHE-BLOCK)
(SETQ CACHE-BLOCK (\ADDBASE *IV-Cache-Block* *IV-Cache-Index*))
(add *IV-Cache-Index* 4)
(* ;; "If we have used up the current block, allocate another one")
(if (NOT (LESSP *IV-Cache-Index* (TIMES 2 \IN-LINE-CACHE-BLOCK-SIZE)))
then (SETQ *IV-Cache-Block* (CREATE \IN-LINE-CACHE-BLOCK))
(push *All-IV-Cache-Block* *IV-Cache-Block*)
(SETQ *IV-Cache-Index* 0))
CACHE-BLOCK))))
)
(RPAQ? *IV-Cache-Block* (CREATE \IN-LINE-CACHE-BLOCK))
(RPAQ? *IV-Cache-Index* 0)
(RPAQ? *All-IV-Cache-Block* (LIST *IV-Cache-Block*))
(RPAQ? *Global-IV-Cache-Block* (\ALLOCBLOCK (TIMES 4 1024)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *IV-Cache-Block* *IV-Cache-Index* *All-IV-Cache-Block* *Global-IV-Cache-Block*)
)
(ADDTOVAR GLOBALVARS *Global-IV-Cache-Block*)
(* ;;; "Method lookup caching stuff")
(DEFINEQ
(FlushMethodCache
(LAMBDA NIL (* ; "Edited 11-Jun-87 12:46 by smL")
(* ;;; "A method has changed, so clear out any cached information about messages.")
(CLEARCLISPARRAY '_Super 'MACROS)
(CLEARCLISPARRAY '(NIL _SuperFringe) 'MACROS)
(AND *Global-Method-Cache* (\ZEROWORDS *Global-Method-Cache*
(\ADDBASE *Global-Method-Cache* (SUB1 (TIMES 2 (TIMES 4 1024)))
)))
(for block in *All-Method-Cache-Block* when block
do (\ZEROWORDS block (\ADDBASE block (SUB1 (TIMES 2 \IN-LINE-CACHE-BLOCK-SIZE)))))))
(\Make-Method-Cache-Entry
(LAMBDA NIL (* ; "Edited 11-Jun-87 12:45 by smL")
(* ;;; "Return a new method cache entry position")
(UNINTERRUPTABLY
(LET (CACHE-BLOCK)
(SETQ CACHE-BLOCK (\ADDBASE *Method-Cache-Block* *Method-Cache-Index*))
(add *Method-Cache-Index* 4)
(* ;; "If we have run out, allocate another big block")
(if (NOT (LESSP *Method-Cache-Index* (TIMES 2 \IN-LINE-CACHE-BLOCK-SIZE)))
then (SETQ *Method-Cache-Block* (CREATE \IN-LINE-CACHE-BLOCK))
(push *All-Method-Cache-Block* *Method-Cache-Block*)
(SETQ *Method-Cache-Index* 0))
CACHE-BLOCK))))
)
(RPAQ? *Method-Cache-Block* (CREATE \IN-LINE-CACHE-BLOCK))
(RPAQ? *Method-Cache-Index* 0)
(RPAQ? *All-Method-Cache-Block* (LIST *Method-Cache-Block*))
(RPAQ? *Global-Method-Cache* (\ALLOCBLOCK (TIMES 4 1024)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *Method-Cache-Index* *Method-Cache-Block* *All-Method-Cache-Block* *Global-Method-Cache*)
)
(ADDTOVAR GLOBALVARS *Global-Method-Cache*)
(PUTPROPS LOOPSSPEEDUP COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2199 3406 (Make-Not-Reference-Counted 2209 . 3404)) (9844 11333 (FlushIVIndexCache 9854
. 10598) (\Make-IV-Cache-Entry 10600 . 11331)) (11777 13198 (FlushMethodCache 11787 . 12439) (
\Make-Method-Cache-Entry 12441 . 13196)))))
STOP