1 //  More subroutines to augment Transbody.
  2 //  Last modified on 06/26/74 at 22:19:29 by R F Mabee.
  3 //  First installed as Version 3.4 by R F Mabee.
  4 //  Separated from bcpl_trans2 and bcpl_trans3 during 6180 conversion.
  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 
 13 get "bcpl_trans_head"
 14 
 15 let AllocateLocal (n) = valof
 16      $(   test n = 1
 17           then unless FreeLocalList = 0 do
 18                $(   let t, p = FreeLocalList, FreeLocalList!1
 19                     FreeLocalList := t!2
 20                     Freevec (t, 2)
 21                     resultis p
 22                $)
 23           or unless SSP rem 2 = 0 do              //  Make multi-word blocks even addresses.
 24                $(   ResetSSP (SSP + 1)            //  This is a kludge for the Multics implementation.
 25                     DeallocateLocal (SSP - 1)
 26                $)
 27           let p = SSP
 28           ResetSSP (p + n)
 29           resultis p
 30      $)
 31 and DeallocateLocal (p) be
 32      $(   let New = Newvec (2)
 33           New!0, New!1, New!2 := 0, p, FreeLocalList
 34           FreeLocalList := New
 35      $)
 36 and ResetSSP (p) be
 37      $(   let t = PendingTemps
 38           until t = 0 do
 39                $(   if t!1 ge p do p := t!1 + 1
 40                     t := t!2
 41                $)
 42           if p = SSP return
 43           SSP := p
 44           GenerateSSP (SSP)
 45           t := lv FreeLocalList
 46           until rv t = 0 do             //  Dis-remember all temporaries outside new SSP.
 47                $(   let u = rv t
 48                     test u!1 ge SSP
 49                     then $(   rv t := u!2
 50                               Freevec (u, 2)
 51                          $)
 52                     or t := lv u!2
 53                $)
 54      $)
 55 and MakeTemp () = valof
 56      $(   let Temp = AllocateLocal (1)
 57           let New = Newvec (2)
 58           New!0, New!1, New!2 := TEMP_S, Temp, PendingTemps
 59           PendingTemps := New
 60           resultis New
 61      $)
 62 and MakeCopy (x) = valof
 63      $(   let P = MakeTemp ()
 64           P!0 := LOCAL_S
 65           CompileExpression (P, x)
 66           resultis P
 67      $)
 68 and PutBackTemps (PT) be
 69           until PendingTemps = PT | PendingTemps = 0 do
 70                $(   let Old = PendingTemps
 71                     PendingTemps := PendingTemps!2
 72                     Old!2 := FreeLocalList
 73                     FreeLocalList := Old
 74                $)
 75 
 76 let ContainsFnap (x) = valof
 77   switchon x!0 & Right into
 78      $(   case FNAP_S: case VALOF_S: case LIST_S: case COND_S: case REL_S:
 79           default:  resultis true
 80 
 81           case POS_S: case POS_F: case NEG_S: case NEG_F: case NOT_S: case RV_S: case LV_S:
 82                     resultis ContainsFnap (x!1)
 83 
 84           case PLUS_S: case PLUS_F: case MINUS_S: case MINUS_F:
 85                     case MULT_S: case MULT_F: case DIV_S: case DIV_F:
 86           case REM_S: case LOGOR_S: case LOGAND_S: case EQV_S: case NEQV_S:
 87           case LSHIFT_S: case RSHIFT_S: case VECAP_S:
 88                     if ContainsFnap (x!1) resultis true
 89                     resultis ContainsFnap (x!2)
 90 
 91           case NAME_S: case NUMBER_S: case CHARCONST_S: case CONSTANT_S: case STRINGCONST_S:
 92           case NIL_S: case TRUE_S: case FALSE_S: case TABLE_S:
 93                     resultis false
 94      $)
 95 
 96 let TransFnap (ResultDesc, F, Args) be
 97      $(   let Nargs = ListSize (Args)
 98           and Ai, PT = ArgInfo, PendingTemps
 99           if ContainsFnap (F) do F := MakeCopy (F)
100           ArgInfo := Newvec (Nargs - 1)
101           WalkList (Args, PreCheckArg, 0)
102           ReserveArglist (Nargs)
103           let TempDesc = vec DescSize
104           for i = 0 to Nargs - 1 do
105                $(   CompileOperand (ArgInfo!i, TempDesc)
106                     GenerateArg (i, TempDesc)
107                $)
108           Freevec (ArgInfo, Nargs - 1)
109           ArgInfo := Ai
110           StoreAll ()
111           CompileOperand (F, TempDesc)
112           GenerateFnap (ResultDesc, TempDesc)
113           PutBackTemps (PT)
114      $)
115 and PreCheckArg (x, n) be
116      $(   if ContainsFnap (x) do x := MakeCopy (x)
117           ArgInfo!n := x
118      $)
119 
120 let TransSystemCall (x) be
121      $(   test (x!0 & Right) = FNAP_S
122           then $(   let Nargs = ListSize (x!2)
123                     and Ai, PT = ArgInfo, PendingTemps
124                     ArgInfo := Newvec (Nargs * 5)
125                     WalkList (x!2, StoreSystemArg, 0)
126                     ReserveSystemArglist (Nargs)
127                     for i = 0 to Nargs - 1 do
128                          $(   let Info = lv ArgInfo!(i * 5)
129                               and Arg, Offset, Type, Length = vec DescSize, vec DescSize, vec DescSize, vec DescSize
130                               CompileOperand (Info!0, Arg)
131                               test Info!1 = 0
132                               then Offset := 0
133                               or CompileOperand (Info!1, Offset)
134                               CompileOperand (Info!2, Type)
135                               test Info!3 = 0
136                               then Length := 0
137                               or CompileOperand (Info!3, Length)
138                               GenerateSystemArg (i, Arg, Offset, Type, Length, Info!4)
139                          $)
140                     Freevec (ArgInfo, Nargs * 5)
141                     ArgInfo := Ai
142                     StoreAll ()
143                     let TempDesc = vec DescSize
144                     CompileOperand (x!1, TempDesc)
145                     GenerateSystemCall (TempDesc)
146                     PutBackTemps (PT)
147                $)
148           or Transreport (BadCall, x)
149      $)
150 and StoreSystemArg (x, Ai) be
151      $(   let TypeC, TypeE, LengthE, OffsetE = 1, 0, 0, 0
152           let String, Double = false, false
153                $(   switchon x!0 & Right into
154                          $(   default:  break
155                               case FIXED_S:
156                                         TypeC := 1
157                                         endcase
158                               case FLOAT_S:
159                                         TypeC := 3
160                                         endcase
161                               case DOUBLE_S:
162                                         Double := true
163                                         endcase
164                               case POINTER_S:
165                                         TypeC := 13
166                                         endcase
167                               case TYPE_S:
168                                         TypeE := x!2
169                                         endcase
170                               case CHAR_S:
171                                         LengthE := x!2
172                                         TypeC := 21
173                                         endcase
174                               case BIT_S:
175                                         LengthE := x!2
176                                         TypeC := 19
177                                         endcase
178                               case OFFSET_S:
179                                         OffsetE := x!2
180                                         endcase
181                               case LENGTH_S:
182                                         LengthE := x!2
183                                         endcase
184                               case STRING_S:
185                                         String := true
186                                         TypeC := 21
187                                         endcase
188                          $)
189                     x := x!1
190                $)   repeat
191 
192           if Double test TypeE = 0 & (TypeC = 1 | TypeC = 3)
193                     then TypeC := TypeC + 1
194                     or Transreport (BadDescriptors, x)
195           if TypeE = 0 do TypeE := List2 (CONSTANT_S, TypeC)
196           if String & LengthE = 0 then if (x!0 & Right) = STRINGCONST_S do
197                          $(   let v = vec Vmax
198                               RemoveEscapes (x!1, v)
199                               LengthE := List2 (CONSTANT_S, Length (v))
200                          $)
201 
202           if ContainsFnap (x) do x := MakeCopy (x)
203           if OffsetE ne 0 then if ContainsFnap (OffsetE) do OffsetE := MakeCopy (OffsetE)
204           if ContainsFnap (TypeE) do TypeE := MakeCopy (TypeE)
205           if LengthE ne 0 then if ContainsFnap (LengthE) do LengthE := MakeCopy (LengthE)
206           let Info = lv ArgInfo!(Ai * 5)
207           Info!0, Info!1, Info!2, Info!3, Info!4 := x, OffsetE, TypeE, LengthE, String
208      $)