1 //  Miscellaneous short routines for Trans.
  2 //  Last modified on 06/06/74 at 18:26:32 by R F Mabee.
  3 //  Installed on 6180 as Version 3.4 by R F Mabee.
  4 //  First installed as part of Version 2.7, 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 "bcpl_trans_head"
 13 
 14 let Addname (x, Type, Val) be
 15      $(   test (x!0 & Right) = NAME_S
 16           then $(   let New = Newvec (DvecSize)
 17                     New!DvecSize := DvecP
 18                     DvecP := New
 19                     DvecP!0, DvecP!1, DvecP!2, DvecP!3 := x, Type, Val, x!2
 20                $)
 21           or Transreport (NotName, x)
 22      $)
 23 and Checkdistinct () be
 24      $(   let Cp = DvecP
 25           until Cp = DvecC do
 26                $(   let b, Dict = Cp!DvecSize, Cp!0
 27                     until b = DvecC do
 28                          $(   if b!0 = Dict do
 29                                    $(   Transreport (DupName, Dict)
 30                                         break
 31                                    $)
 32                               b := b!DvecSize
 33                          $)
 34                     Dict!2 := Cp
 35                     Cp := Cp!DvecSize
 36                $)
 37           DvecC := DvecP
 38      $)
 39 and Cellwithname (Name) = valof
 40      $(   let Dp = Name!2
 41           if Dp = 0 do
 42                $(   Transreport (UndefName, Name)
 43                     Addname (Name, GLOBAL_S, 0)             //  Create dummy declaration to avoid extra error messages.
 44                     Name!2, DvecC, Dp := DvecP, DvecP, DvecP
 45                $)
 46           resultis Dp
 47      $)
 48 and Removenames (p) be
 49      $(   until DvecP = p do
 50                $(   if DvecP!1 = LOCAL_S do DeallocateLocal (DvecP!2 & Right)             //  Reclaim space.
 51                     DvecP!0!2 := DvecP!3
 52                     let Old = DvecP
 53                     DvecP := DvecP!DvecSize
 54                     DvecC := DvecP
 55                     Freevec (Old, DvecSize)
 56                $)
 57      $)
 58 and SaveEnv () = valof
 59      $(   let t, u = DvecP, 0
 60           until t = EnvBase do
 61                $(   let New = Newvec (DvecSize)
 62                     New!0, New!1, New!2, New!3 := t!0, t!1, t!2, t!3
 63                     New!DvecSize := u
 64                     u := New
 65                     t := t!DvecSize
 66                $)
 67           resultis u
 68      $)
 69 and RestoreEnv (u) be
 70      $(   until u = 0 do
 71                $(   let Old = u
 72                     u := Old!DvecSize
 73                     Old!DvecSize := DvecP
 74                     DvecP := Old
 75                     DvecP!0!2 := DvecP
 76                $)
 77      $)
 78 
 79 and Declnames (x) be
 80      $(   switchon x!0 & Right into
 81                $(   default:  return              //  Error message for this case is produced later.
 82 
 83                     case AND_S:
 84                               Declnames (x!1)
 85                               Declnames (x!2)
 86                               return
 87 
 88                     case VALDEF_S:
 89                               WalkList (x!1, Addlocal, 0)
 90                               return
 91 
 92                     case FNDEF_S:
 93                     case RTDEF_S:
 94                               let L = Nextparam ()
 95                               let T = x!1!2                 //  Previous value of this name.
 96                               if T ne 0 then if T!1 = EXTERNAL_S do
 97                                         DefList := List3 (DefList, T!2, L)
 98                               Addname (x!1, RTDEF_S, L)
 99                               return
100                $)
101      $)
102 and Transdef (x) be
103      $(
104   Top:    let Op = x!0
105                $(   let NewLine = Op rshift Left
106                     if NewLine ne LineCount & (NewLine rshift FileShift) = 0 do GenerateLineNumber (NewLine)
107                     LineCount := NewLine
108                $)
109           Op := Op & Right
110           switchon Op into
111                $(   default:  CGreport (UnexpectedCase, Op, "Transdef")
112                               return
113 
114                     case AND_S:
115                                    $(   let a, b = x!1, x!2
116                                         if (RandomI () & 1) ne 0 do a, b := x!2, x!1      //  Make order undefined.
117                                         Transdef (a)
118                                         x := b              //  Same as "Transdef (b); return" but saves stack space.
119                                         goto Top
120                                    $)
121 
122                     case VALDEF_S:
123                               Assignlist (x!1, x!2)
124                               return
125 
126                     case FNDEF_S:
127                     case RTDEF_S:
128                               test InsideRtdef
129                               then $(   let New = Newvec (3)
130                                         New!0, New!1, New!2, New!3 := x, SaveEnv (), RtdefNesting, RtdefList
131                                         RtdefList := New
132                                    $)
133                               or   $(   InsideRtdef, RtdefNesting, EnvBase := true, 1, DvecP
134                                         TransRtdef (x)
135                                         Removenames (EnvBase)
136                                         until RtdefList = 0 do                  //  Translate all embedded routines.
137                                              $(   let Old = RtdefList
138                                                   RtdefList := Old!3
139                                                   RestoreEnv (Old!1)
140                                                   RtdefNesting := Old!2 + 1
141                                                             TransRtdef (Old!0)
142                                                   Removenames (EnvBase)
143                                                   Freevec (Old, 3)
144                                              $)
145                                         InsideRtdef, RtdefNesting := false, 0
146                                    $)
147                $)
148      $)
149 and TransRtdef (x) be
150      $(   let FunctSw, MainSw = ((x!0 & Right) = FNDEF_S), (x!5 = MAIN_S)
151           and Dp = DvecP
152           and M = Cellwithname (x!1)!2            //  Label of entry point.
153           WalkList (x!2, AddFormalParameter, 0)
154           Decllabels (x!4)
155           Checkdistinct ()
156           GenerateRtdefBegin (M, x!1!1, FunctSw, MainSw)
157           ResetSSP (ListSize (x!2))               //  First n locals are formal parameters.
158           test FunctSw
159           then $(   let Desc = vec DescSize
160                     ReturnLabel := 0              //  RETURN not allowed in function definition.
161                     CompileOperand (x!3, Desc)
162                     GenerateRtdefEnd (Desc)
163                $)
164           or   $(   ReturnLabel := Nextparam ()
165                     Transbody (x!3)
166                     GenerateLabel (ReturnLabel)
167                     GenerateRtdefEnd (0)
168                $)
169 
170           Removenames (Dp)
171           PutBackTemps (0)
172           until FreeLocalList = 0 do
173                $(   let t = FreeLocalList
174                     FreeLocalList := FreeLocalList!2
175                     Freevec (t, 2)
176                $)
177           SSP := 0
178      $)
179 and AddFormalParameter (Name, Loc) be
180           unless (Name!0 & Right) = NIL_S do Addname (Name, LOCAL_S, (RtdefNesting lshift Left) | Loc)
181 and Decllabels (x) be
182      $(   until x = 0 do
183                $(   let L = Nextparam ()
184                     Addname (x!1, LABEL_S, L)
185                     x!4 := L
186                     x := x!3
187                $)
188      $)
189 
190 and Addlocal (x) be
191      $(   let p = AllocateLocal (1)
192           Addname (x, LOCAL_S, p logor (RtdefNesting lshift Left))
193      $)
194 
195 let Declitem (Op, Name, Val) be
196      $(   let n = valof switchon Op into
197                $(   case EXTERNAL_S:
198                               unless Val = 0 do
199                                    $(   if (Val!0 & Right) = STRINGCONST_S resultis Val!1
200                                         Transreport (BadLink, Val)
201                                    $)
202                               resultis Name!1
203 
204                     case MANIFEST_S:
205                               let v = vec 2
206                               PartialEvalconst (Val, v)
207                               Op := v!0
208                               resultis v!1
209 
210                     case GLOBAL_S:
211                               resultis Evalconst (Val)
212 
213                     case STATIC_S:
214                               let New = Newvec (4)
215                               New!0, New!1, New!2 := 0, StaticAllocationCounter, Name!1
216                               PartialEvalconst (Val, lv New!3)
217                               test StaticList = 0
218                               then StaticFirst := New
219                               or StaticList!0 := New
220                               StaticList := New
221                               StaticAllocationCounter := StaticAllocationCounter + 1
222                               resultis StaticAllocationCounter - 1
223 
224                     default:  CGreport (UnexpectedCase, Op, "Declitem")
225                               resultis Val
226                $)
227           Addname (Name, Op, n)
228      $)