1 //  This routine walks the command nodes of the tree.
  2 //  Last modified on 06/06/74 at 18:26:24 by R F Mabee.
  3 //  Installed with Version 3.4 for 6180 bootstrap by 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 "bcpl_trans_head"
 13 
 14 let Transbody (x) be
 15      $(
 16   Top:    if x = 0 return
 17           let Op = x!0
 18                $(   let NewLine = Op rshift Left
 19                     if NewLine ne LineCount & (NewLine rshift FileShift) = 0 do GenerateLineNumber (NewLine)
 20                     LineCount := NewLine
 21                $)
 22           Op := Op & Right
 23           let a, b = x!1, x!2
 24           let s, p = nil, nil
 25           switchon Op into
 26                $(   default:  CGreport (UnexpectedCase, Op, "Transbody")
 27                               return
 28 
 29                     case LET_S:
 30                               s, p := SSP, DvecP
 31                               Declnames (a)
 32                               Checkdistinct ()
 33                               Transdef (a)
 34                               Transbody (b)
 35                               Removenames (p)
 36                               ResetSSP (s)
 37                               return
 38 
 39                     case MANIFEST_S:
 40                     case EXTERNAL_S:
 41                     case STATIC_S:
 42                     case GLOBAL_S:
 43                               p := DvecP
 44                               until a = 0 do
 45                                    $(   Declitem (Op, a!1, a!2)
 46                                         a := a!3
 47                                    $)
 48                               Checkdistinct ()
 49                               Transbody (b)
 50                               Removenames (p)
 51                               return
 52 
 53                     case LABDEF_S:
 54                               p := DvecP
 55                               Decllabels (b)
 56                               Checkdistinct ()
 57                               Transbody (a)
 58                               Removenames (p)
 59                               return
 60 
 61                     case ASSIGN_S:
 62                               Assignlist (a, b)
 63                               return
 64 
 65                     case SEMICOLON_S:
 66                               Transbody (a)
 67                               x := b                        //  Same as "Transbody (b); return" but saves stack space.
 68                               goto Top
 69 
 70                     case RTAP_S:
 71                               TransFnap (0, a, b)
 72                               return
 73 
 74                     case CALL_S:
 75                               TransSystemCall (a)
 76                               return
 77 
 78                     case GOTO_S:
 79                               p := Target (x)
 80                               test p ne 0
 81                               then GenerateJump (p)                   //  Optimize common hop.
 82                               or   $(   let PT, Desc = PendingTemps, vec DescSize
 83                                         CompileOperand (a, Desc)
 84                                         GenerateGoto (Desc)
 85                                         PutBackTemps (PT)
 86                                    $)
 87                               return
 88 
 89                     case COLON_S:
 90                               GenerateLabel (x!4)
 91                               Transbody (b)
 92                               return
 93 
 94                     case FINISH_S:
 95                               GenerateFinish ()
 96                               return
 97 
 98                     case LOOP_S:
 99                     case BREAK_S:
100                     case RETURN_S:
101                     case ENDCASE_S:
102                               GenerateJump (Target (x))
103                               return
104 
105                     case RESULTIS_S:
106                               test ValofFlag
107                               then $(   p := PendingTemps
108                                         SetResult (a)
109                                         GenerateJump (ValofLabel)
110                                         PutBackTemps (p)
111                                    $)
112                               or Transreport (NoValof, x)
113                               return
114 
115                     case IF_S:
116                     case UNLESS_S: $(   let Sense = (Op = IF_S)
117                                         if Optimize do
118                                              $(   if IsConst (a) do
119                                                        $(   if Evalconst (a) eqv Sense do Transbody (b)
120                                                             return
121                                                        $)
122                                                   let M = Target (b)
123                                                   if M ne 0 do        //  b is a loop, break, return, or goto command.
124                                                        $(   TransConditional (a, Sense, M)
125                                                             return
126                                                        $)
127                                              $)
128                                         let L = Nextparam ()
129                                         TransConditional (a, not Sense, L)
130                                         Transbody (b)
131                                         GenerateLabel (L)
132                                         return
133                                    $)
134 
135                     case TEST_S:   $(   let c = x!3
136                                         if Optimize then if IsConst (a) do
137                                              $(   Transbody (Evalconst (a) -> b, c)
138                                                   return
139                                              $)
140                                         let L, M = Nextparam (), Nextparam ()
141                                         TransConditional (a, false, L)
142                                         Transbody (b)
143                                         GenerateJump (M)
144                                         GenerateLabel (L)
145                                         Transbody (c)
146                                         GenerateLabel (M)
147                                         return
148                                    $)
149 
150                     case WHILE_S:
151                     case UNTIL_S:
152                               TransLoop (b, a, Op = WHILE_S, Nextparam ())
153                               return
154 
155                     case REPEAT_S:
156                               TransLoop (a, 0, 0, 0)
157                               return
158 
159                     case REPEATWHILE_S:
160                     case REPEATUNTIL_S:
161                               TransLoop (a, b, Op = REPEATWHILE_S, 0)
162                               return
163 
164                     case FOR_S:
165                               TransFor (x)
166                               return
167 
168                     case SWITCHON_S:
169                                    $(   s := SSP
170                                         let El, Dl = EndcaseLabel, DefaultLabel
171                                         let Cf, Cl, Sf = CaseFirst, CaseList, SwitchFlag
172                                         EndcaseLabel, DefaultLabel := Nextparam (), 0
173                                         CaseFirst, CaseList, SwitchFlag := 0, 0, true
174 
175                                         let Begin = Nextparam ()
176                                         GenerateJump (Begin)
177                                         Transbody (x!2)
178                                         GenerateJump (EndcaseLabel)
179 
180                                         GenerateLabel (Begin)
181                                         let PT, Val = PendingTemps, vec DescSize
182                                         CompileOperand (x!1, Val)
183                                         GenerateSwitch (Val, CaseFirst, DefaultLabel, EndcaseLabel)
184                                         PutBackTemps (PT)
185                                         GenerateLabel (EndcaseLabel)
186 
187                                         EndcaseLabel, DefaultLabel := El, Dl
188                                         CaseFirst, CaseList, SwitchFlag := Cf, Cl, Sf
189                                         ResetSSP (s)
190                                         return
191                                    $)
192 
193                     case CASE_S:
194                               p := Nextparam ()
195                               GenerateLabel (p)
196                               unless SwitchFlag do Transreport (NoSwitch, x)
197                                    $(   let t = Newvec (5)
198                                         t!0, t!1 := 0, p
199                                         PartialEvalconst (x!1, lv t!2)
200                                         test x!2 = 0
201                                         then t!4, t!5 := t!2, t!3               //  Limit same as first value.
202                                         or PartialEvalconst (x!2, lv t!4)
203                                         test CaseList = 0
204                                         then CaseFirst := t
205                                         or CaseList!0 := t
206                                         CaseList := t
207                                         x := x!3
208                                         if x = 0 break
209                                    $)   repeatwhile (x!0 & Right) = CASE_S      //  This is to economize on labels.
210                               Transbody (x)
211                               return
212 
213                     case DEFAULT_S:
214                               test SwitchFlag
215                               then $(   unless DefaultLabel = 0 do Transreport (DupDefault, x)
216                                         DefaultLabel := Nextparam ()
217                                         GenerateLabel (DefaultLabel)
218                                    $)
219                               or Transreport (NoSwitch, x)
220                               Transbody (a)
221                               return
222                $)
223      $)