1
2
3
4
5
6
7
8
9
10
11
12 get "head"
13 get "bcpl_compiler_head"
14 get "bcpl_metering_head"
15
16 external
17 $( TranslatorInfo = "translator_info_$get_source_info"
18
19
20 DateTime = "date_time_"
21 MaxSegSize = "sys_info$max_seg_size"
22 $)
23 global
24 $( TimeNotAccountedFor : 158
25 TimingFudgeFactor : 159
26
27 FreeareaP : 160
28 FreeareaT : 161
29 FreeList : 162
30 FreeListArray : 163
31 TempsegID : 164
32 ParamNumber : 165
33 GetP : 166
34 $)
35 static
36 $( OverflowCount = 0 $)
37
38 let Newvec (n) = valof
39 $( if n < 0 do n := 0
40 test n < 20
41 then $( let p = FreeListArray!n
42 unless p = 0 do
43 $( FreeListArray!n := p!0
44 resultis p
45 $)
46 $)
47 or $( let q = lv FreeList
48 $( let p = rv q
49 if p = 0 break
50 if p!1 = n do
51 $( rv q := p!0
52 resultis p
53 $)
54 q := lv p!0
55 $) repeat
56 $)
57
58 let p = FreeareaP
59 FreeareaP := FreeareaP + n + 1
60 if FreeareaP < FreeareaT resultis p
61 Errcode := 0
62 unless TempsegID = 0 do Complain ("Out of space in Newvec.")
63 OverflowCount := OverflowCount + 1
64 TempsegID := OverflowCount
65 p := MakeTempSeg (TempsegID, "Newvec")
66 FreeareaP, FreeareaT := p + n + 1, p + rv MaxSegSize
67 resultis p
68 $)
69 and List1 (a) = valof
70 $( let p = FreeareaP
71 FreeareaP := FreeareaP + 1
72 if FreeareaP > FreeareaT do p := Newvec (0)
73 p!0 := a
74 resultis p
75 $)
76 and List2 (a, b) = valof
77 $( let p = FreeareaP
78 FreeareaP := FreeareaP + 2
79 if FreeareaP > FreeareaT do p := Newvec (1)
80 p!0, p!1 := a, b
81 resultis p
82 $)
83 and List3 (a, b, c) = valof
84 $( let p = FreeareaP
85 FreeareaP := FreeareaP + 3
86 if FreeareaP > FreeareaT do p := Newvec (2)
87 p!0, p!1, p!2 := a, b, c
88 resultis p
89 $)
90 and List4 (a, b, c, d) = valof
91 $( let p = FreeareaP
92 FreeareaP := FreeareaP + 4
93 if FreeareaP > FreeareaT do p := Newvec (3)
94 p!0, p!1, p!2, p!3 := a, b, c, d
95 resultis p
96 $)
97 and List5 (a, b, c, d, e) = valof
98 $( let p = FreeareaP
99 FreeareaP := FreeareaP + 5
100 if FreeareaP > FreeareaT do p := Newvec (4)
101 p!0, p!1, p!2, p!3, p!4 := a, b, c, d, e
102 resultis p
103 $)
104 and List6 (a, b, c, d, e, f) = valof
105 $( let p = FreeareaP
106 FreeareaP := FreeareaP + 6
107 if FreeareaP > FreeareaT do p := Newvec (5)
108 p!0, p!1, p!2, p!3, p!4, p!5 := a, b, c, d, e, f
109 resultis p
110 $)
111 and Freevec (p, n) be
112 $( test n < 20
113 then $( p!0 := FreeListArray!n
114 FreeListArray!n := p
115 $)
116 or $( p!0, p!1 := FreeList, n
117 FreeList := p
118 $)
119 $)
120 and StoreString (s) = valof
121 $( let l = LengthInWords (s)
122 let x = Newvec (l - 1)
123 Move (x, s, l)
124 resultis x
125 $)
126
127 let MakeTimeString (t) = valof
128 $( let v, w = vec 24, vec 24
129 call DateTime (t fixed double, w char 24)
130 MakeBcplString (w, 24, v)
131 resultis StoreString (v)
132 $)
133
134
135 let Nextparam () = valof
136 $( ParamNumber := ParamNumber + 1
137 resultis ParamNumber
138 $)
139
140 let GetStream (Arg, ParentStream) be
141 $( let Name = vec Vmax
142 RemoveEscapes (Arg, Name)
143 FileNames!FileCount := StoreString (Name)
144 Concatenate (Name, Vmax, Name, ".bcpl")
145 INPUT := ParentStream = 0 -> Open (PathName + Read + MultiSegmentFile, Name),
146 Open (SearchName + Read + MultiSegmentFile, Name, ParentStream)
147 unless Errcode = 0 do Complain (Name)
148
149
150 let Dir, Ent = vec 50, vec 10
151 and Path, w = vec 50, vec 10
152 let Info = lv FilesInfo!(FileCount * 4)
153 call TranslatorInfo (ITS (StreamPointer (INPUT), w) pointer, Dir char 168, Ent char 32, lv Info!2 fixed double,
154 lv Info!1 bit 36, lv Errcode)
155 unless Errcode = 0 do Complain (Name)
156 Info!0 := StoreString (JoinPathname (Dir, Ent, Path))
157
158 LineCount := FileCount lshift FileShift
159 $)
160
161 let PushInput (NewName) be
162 $( FileCount := FileCount + 1
163 if FileCount ge 32 do Complain ("The number of head files has exceeded the implementation limit of 32.")
164 let x = Newvec (2)
165 x!0, x!1, x!2 := GetP, INPUT, LineCount
166 GetP := x
167 INPUT := 0
168 GetStream (NewName, GetP!1)
169 $)
170 and PopInput () be
171 $( Close (INPUT)
172 INPUT, LineCount := GetP!1, GetP!2
173 let x = GetP
174 GetP := GetP!0
175 Freevec (x, 2)
176 $)
177
178 let SaveOldUsage () = valof
179 $( let T = GetCpuUsage ()
180 let R = TimeNotAccountedFor
181 TimeNotAccountedFor := T
182 resultis R - T
183 $)
184 and RecordUsage (MeterSlot, OldT) be
185 $( let T = GetCpuUsage ()
186 MeterData!MeterSlot := MeterData!MeterSlot + (T - TimeNotAccountedFor - TimingFudgeFactor)
187 MeterData!(MeterSlot + 1) := MeterData!(MeterSlot + 1) + 1
188 TimeNotAccountedFor := T + OldT + TimingFudgeFactor
189 $)
190
191 let FormCharconst (s) = valof
192 $( let R, v, w = 0, vec Vmax, vec Vmax
193 Unpackstring (RemoveEscapes (s, v), w)
194 for i = 1 to w!0 do R := R lshift ByteSize | w!i
195 resultis R
196 $)
197 and FormStringconst (s, Space) = valof
198 $( let v, w = vec Vmax, vec Vmax + 4
199 Unpackstring (RemoveEscapes (s, v), w)
200 let Len, Nwords = w!0, 0
201 w!(Len + 1), w!(Len + 2), w!(Len + 3) := 0, 0, 0
202 test Machine = 6180
203 then $( Space!0 := Len lshift 18 | w!1 lshift 9 | w!2
204 Nwords := 1
205 for i = 3 to Len by 4 do
206 $( Space!Nwords := w!i lshift 27 | w!(i + 1) lshift 18 | w!(i + 2) lshift 9 | w!(i + 3)
207 Nwords := Nwords + 1
208 $)
209 $)
210 or for i = 0 to Len by 4 do
211 $( Space!Nwords := w!i lshift 27 | w!(i + 1) lshift 18 | w!(i + 2) lshift 9 | w!(i + 3)
212 Nwords := Nwords + 1
213 $)
214 resultis Nwords - 1
215 $)
216
217 let UtilitiesInit (v, Len, StartingTime) be
218 $( TempsegID, FreeList := 0, 0
219 FreeListArray := v
220 for i = 0 to 20 do FreeListArray!i := 0
221 FreeareaP, FreeareaT := v + 21, v + Len
222
223 ParamNumber := 0
224
225 FileNames, FileCount, FilesInfo := Newvec (32), 0, Newvec (32 * 4)
226 FilesInfo := (FilesInfo + 1) & Even
227 GetP, INPUT := 0, 0
228
229 if Metering do
230 $( MeterData := Newvec (Meters_Length)
231 for i = 0 to Meters_Length do MeterData!i := 0
232 TimeNotAccountedFor, TimingFudgeFactor := StartingTime, 0
233 let t = vec 10
234 RecordUsage (MeteringOverhead_Meter, SaveOldUsage ())
235 MeterData!MeteringOverhead_Meter := 0
236 for i = 1 to 10 do t!i := SaveOldUsage ()
237 for i = 10 to 1 by -1 do RecordUsage (MeteringOverhead_Meter, t!i)
238 TimingFudgeFactor := MeterData!MeteringOverhead_Meter / 19
239 $)
240 $)
241 and Cleanup () be
242 $( until GetP = 0 do
243 $( Close (GetP!1)
244 GetP := GetP!0
245 $)
246 unless TempsegID = 0 do
247 $( DeleteTempSeg (TempsegID, "Newvec")
248 TempsegID := 0
249 $)
250 unless INPUT = 0 do
251 $( Close (INPUT)
252 INPUT := 0
253 $)
254 $)