1 //  Simple routines used throughout the compiler.
  2 //  Last modified on 08/06/74 at 17:34:26 by R F Mabee.
  3 //  Prepared for installation as Version 3.4 after 6180 bootstrap, R F Mabee.
  4 //  First installed as Version 2.7 by R F Mabee.
  5 
  6 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
  7 
  8 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
  9 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
 10 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
 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                               //  call translator_info_$get_source_info (pointer, return dir name, return entry name,
 19                               //                                                return 52-bit DTM, return UID, return code)
 20           DateTime = "date_time_"       //  call date_time_ (52-bit time, return 24-character date-time string)
 21           MaxSegSize = "sys_info$max_seg_size"    //  dcl sys_info$max_seg_size external static fixed binary
 22      $)
 23 global
 24      $(   TimeNotAccountedFor : 158               //  Metering temporaries.
 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             //  Make safe-stored copy of string s in free storage.
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          //  Convert double-word time to string and allocate it.
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              //  Open new stream for input.
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 //  Acquire and save some information about the source file needed for the symbol table.
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           //  Reset counter to agree with new stream.
159      $)
160 
161 let PushInput (NewName) be              //  Open new stream, saving current stream and line count.
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                    //  Policy: INPUT should not be a duplicate or closed stream.
168           GetStream (NewName, GetP!1)
169      $)
170 and PopInput () be                      //  Revert to previous stream.
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             //  Half of the metering provision.
179      $(   let T = GetCpuUsage ()
180           let R = TimeNotAccountedFor
181           TimeNotAccountedFor := T
182           resultis R - T
183      $)
184 and RecordUsage (MeterSlot, OldT) be    //  Other half, called at end of interval to be metered.
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            //  Returns length in words (minus one).
198      $(   let v, w = vec Vmax, vec Vmax + 4       //  Form a BCPL-format string explicitly -
199           Unpackstring (RemoveEscapes (s, v), w)  //  this is where the string format is defined.
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               //  Even alignment required to hold clock values.
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                //  Calculate time spent to read clock.
234                     RecordUsage (MeteringOverhead_Meter, SaveOldUsage ())
235                     MeterData!MeteringOverhead_Meter := 0             //  First time doesn't count.
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                       //  Things that get done on normal or abnormal termination.
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      $)